Merge https://github.com/Strigoides/jscl into pull-requests
authorDavid Vázquez <davazp@gmail.com>
Wed, 1 May 2013 01:05:17 +0000 (02:05 +0100)
committerDavid Vázquez <davazp@gmail.com>
Wed, 1 May 2013 01:05:17 +0000 (02:05 +0100)
# Please enter a commit message to explain why this merge is necessary,
# especially if it merges an updated upstream into a topic branch.
#
# Lines starting with '#' will be ignored, and an empty message aborts
# the commit.

1  2 
jscl.lisp
src/boot.lisp
src/toplevel.lisp

diff --combined jscl.lisp
+++ b/jscl.lisp
@@@ -23,6 -23,7 +23,7 @@@
      ("print"     :target)
      ("read"      :both)
      ("compiler"  :both)
+     ("list"      :target)
      ("toplevel"  :target)))
  
  (defun source-pathname
@@@ -64,7 -65,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,7 -82,6 +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*)))))