Merge branch 'master' of https://github.com/davazp/jscl
authorOwen Rodley <Strigoides@gmail.com>
Sun, 28 Apr 2013 01:19:14 +0000 (13:19 +1200)
committerOwen Rodley <Strigoides@gmail.com>
Sun, 28 Apr 2013 01:19:14 +0000 (13:19 +1200)
1  2 
jscl.lisp
src/boot.lisp
src/toplevel.lisp

diff --combined jscl.lisp
+++ b/jscl.lisp
@@@ -23,7 -23,6 +23,7 @@@
      ("print"     :target)
      ("read"      :both)
      ("compiler"  :both)
 +    ("list"      :target)
      ("toplevel"  :target)))
  
  (defun source-pathname
@@@ -65,7 -64,7 +65,7 @@@
  
  (defun bootstrap ()
    (setq *environment* (make-lexenv))
-   (setq *literal-symbols* nil)
+   (setq *literal-table* nil)
    (setq *variable-counter* 0
          *gensym-counter* 0
          *literal-counter* 0
diff --combined src/boot.lisp
@@@ -82,6 -82,7 +82,7 @@@
  
  (defmacro defun (name args &rest body)
    `(progn
+      
       (fset ',name
             (named-lambda ,(symbol-name name) ,args
               ,@(if (and (stringp (car body)) (not (null (cdr body))))
        (incf pos))
      pos))
  
 -(defun assoc (x alist)
 +(defun assoc (x alist &key (test #'eql))
    (while alist
 -    (if (eql x (caar alist))
 +    (if (funcall test x (caar alist))
          (return)
          (setq alist (cdr alist))))
    (car alist))
                           `((,(ecase (car c)
                                      (integer 'integerp)
                                      (cons 'consp)
+                                     (symbol 'symbolp)
+                                     (array 'arrayp)
                                      (string 'stringp)
                                      (atom 'atom)
                                      (null 'null))
diff --combined src/toplevel.lisp
    (values-list /))
  
  (export '(&body &key &optional &rest * ** *** *gensym-counter* *package* + ++
 -          +++ - / // /// 1+ 1- < <= = = > >= and append apply aref
 -          arrayp assoc atom block boundp butlast caar cadddr caddr
 +          +++ - / // /// 1+ 1- < <= = = > >= and append apply aref arrayp
 +          assoc atom block boundp butlast cadar caaar caadr cdaar cdadr
 +          cddar caaaar caaadr caadar caaddr cadaar cadadr caddar cdaaar
 +          cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr caar cadddr caddr
            cadr car car case catch cdar cdddr cddr cdr cdr char
            char-code char= code-char cond cons consp constantly
 -          copy-list decf declaim defconstant define-setf-expander
 +          copy-list copy-tree decf declaim defconstant define-setf-expander
            define-symbol-macro defmacro defparameter defun defvar
            digit-char digit-char-p disassemble do do* documentation
            dolist dotimes ecase eq eql equal error eval every export expt
            make-symbol mapcar member minusp mod multiple-value-bind
            multiple-value-call multiple-value-list multiple-value-prog1
            nconc nil not nreconc nth nthcdr null numberp or
 -          package-name package-use-list packagep parse-integer plusp
 +          package-name package-use-list packagep parse-integer plusp pop
            prin1-to-string print proclaim prog1 prog2 progn psetq push
            quote read-from-string remove remove-if remove-if-not return
            return-from revappend reverse rplaca rplacd second set setf
 -          setq some string string-upcase string= stringp subseq
 +          setq some string string-upcase string= stringp subseq subst
            symbol-function symbol-name symbol-package symbol-plist
            symbol-value symbolp t tagbody third throw truncate unless
            unwind-protect values values-list variable warn when write-line
     (ls-compile
      `(progn
         ,@(mapcar (lambda (s) `(%intern-symbol (%js-vref ,(cdr s))))
-                  *literal-symbols*)
-        (setq *literal-symbols* ',*literal-symbols*)
+                  *literal-table*)
+        (setq *literal-table* ',*literal-table*)
         (setq *variable-counter* ,*variable-counter*)
         (setq *gensym-counter* ,*gensym-counter*)
         (setq *block-counter* ,*block-counter*)))))