Merge branch 'origin-master' into origin-format

[jscl.git] / src / toplevel.lisp

diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index ba9b129..d6f8cb4 100644 (file)
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -3,18 +3,18 @@
 ;; Copyright (C) 2012, 2013 David Vazquez
 ;; Copyright (C) 2012 Raimon Grau
 
-;; This program is free software: you can redistribute it and/or
+;; JSCL is free software: you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
 ;; published by the Free Software Foundation, either version 3 of the
 ;; License, or (at your option) any later version.
 ;;
-;; This program is distributed in the hope that it will be useful, but
+;; JSCL is distributed in the hope that it will be useful, but
 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;; General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License
-;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
 
 
 (defun eval (x)
@@ -40,36 +40,42 @@
           *** **
           ** *
           * (car results)))
+  (unless (boundp '*)
+    ;; FIXME: Handle error
+    (setf * nil))
   (setf +++ ++
         ++ +
         + -)
   (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 declare 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
           fdefinition find-package find-symbol first flet format fourth fset
-          funcall function functionp gensym get-setf-expansion
-          get-universal-time go identity if in-package incf integerp
-          intern keywordp labels lambda last length let let* list
+          funcall function functionp gensym get-internal-real-time
+          get-setf-expansion get-universal-time go identity if in-package
+          incf integerp intern keywordp labels lambda last length let let* list
           list* list-all-packages listp loop make-array make-package
           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
+          nconc nil not nreconc nth nthcdr null numberp or otherwise
+          package-name package-use-list packagep parse-integer plusp pop
           prin1-to-string print proclaim prog1 prog2 progn psetq push
-          quote remove remove-if remove-if-not return return-from
-          revappend reverse rplaca rplacd second set setf setq some
-          string string-upcase string= stringp subseq 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 write-string zerop))
+          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 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
+          write-string zerop))
 
 (setq *package* *user-package*)
 
@@ -94,11 +100,10 @@
    (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*)))))
+       (setq *gensym-counter* ,*gensym-counter*)))))
 
 (eval-when-compile
   (toplevel-compilation