RASSOC
[jscl.git] / src / toplevel.lisp
index 64a0e87..99d8602 100644 (file)
@@ -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)
   (values-list /))
 
 (export '(&body &key &optional &rest * ** *** *gensym-counter* *package* + ++
-          +++ - / // /// 1+ 1- < <= = = > >= and append apply aref arrayp
+          +++ - / // /// 1+ 1- < <= = = > >= acons 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
-          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 fourth fset
-          funcall function functionp gensym get-internal-real-time
+          copy-alist 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 eighth eq eql equal error eval every export expt
+          fdefinition fifth find-package find-symbol first flet format fourth
+          fset 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
-          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))
+          nconc nil ninth not nreconc nth nthcdr null numberp or otherwise
+          package-name package-use-list packagep pairlis parse-integer plusp
+          pop prin1-to-string print proclaim prog1 prog2 progn psetq push
+          quote rassoc read-from-string remove remove-if remove-if-not return
+          return-from revappend reverse rplaca rplacd second set setf seventh
+          setq sixth some string string-upcase string= stringp subseq subst
+          symbol-function symbol-name symbol-package symbol-plist
+          symbol-value symbolp t tagbody tailp tenth third throw tree-equal
+          truncate unless unwind-protect values values-list variable warn when
+          write-line write-string zerop))
 
 (setq *package* *user-package*)
 
+;;; Set some external entry point to the Lisp implementation to the
+;;; console. It would not be necessary when FFI is finished.
 (js-eval "var lisp")
 (%js-vset "lisp" (new))
 (%js-vset "lisp.read" #'ls-read-from-string)
 (%js-vset "lisp.evalString" (lambda (str) (eval (ls-read-from-string str))))
 (%js-vset "lisp.evalInput" (lambda (str) (eval-interactive (ls-read-from-string str))))
 (%js-vset "lisp.compileString" (lambda (str) (ls-compile-toplevel (ls-read-from-string str) t)))
-
-;; Set the initial global environment to be equal to the host global
-;; environment at this point of the compilation.
-(eval-when-compile
-  (toplevel-compilation
-   (ls-compile `(setq *environment* ',*environment*))))
-
-(eval-when-compile
-  (toplevel-compilation
-   (ls-compile
-    `(progn
-       ,@(mapcar (lambda (s) `(%intern-symbol (%js-vref ,(cdr s))))
-                 *literal-symbols*)
-       (setq *literal-symbols* ',*literal-symbols*)
-       (setq *variable-counter* ,*variable-counter*)
-       (setq *gensym-counter* ,*gensym-counter*)
-       (setq *block-counter* ,*block-counter*)))))
-
-(eval-when-compile
-  (toplevel-compilation
-   (ls-compile
-    `(setq *literal-counter* ,*literal-counter*))))