Merge branch 'master' of github.com:davazp/ecmalisp
authorDavid Vázquez <davazp@gmail.com>
Thu, 25 Apr 2013 14:58:54 +0000 (15:58 +0100)
committerDavid Vázquez <davazp@gmail.com>
Thu, 25 Apr 2013 14:58:54 +0000 (15:58 +0100)
Conflicts:
ecmalisp.lisp

* src/toplevel.lisp: Clean and sort symbol exports

1  2 
src/toplevel.lisp

index d2cd2d4,0000000..6b66792
mode 100644,000000..100644
--- /dev/null
@@@ -1,108 -1,0 +1,106 @@@
 +;;; toplevel.lisp ---
 +
 +;; Copyright (C) 2012, 2013 David Vazquez
 +;; Copyright (C) 2012 Raimon Grau
 +
 +;; This program 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
 +;; 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/>.
 +
 +
 +(defun eval (x)
 +  (js-eval (ls-compile-toplevel x t)))
 +
 +(defvar * nil)
 +(defvar ** nil)
 +(defvar *** nil)
 +(defvar / nil)
 +(defvar // nil)
 +(defvar /// nil)
 +(defvar + nil)
 +(defvar ++ nil)
 +(defvar +++ nil)
 +(defvar - nil)
 +
 +(defun eval-interactive (x)
 +  (setf - x)
 +  (let ((results (multiple-value-list (eval x))))
 +    (setf /// //
 +          // /
 +          / results
 +          *** **
 +          ** *
 +          * (car results)))
 +  (setf +++ ++
 +        ++ +
 +        + -)
 +  (values-list /))
 +
- (export '(&body &key &optional &rest * *gensym-counter* *package* + - / 1+ 1- <
-           <= = = > >= and append apply aref arrayp assoc atom block
-           boundp boundp butlast 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
++(export '(&body &key &optional &rest * ** *** *gensym-counter* *package* + ++
++          +++ - / // /// 1+ 1- < <= = = > >= and append apply aref
++          arrayp assoc atom block boundp butlast 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
-           fdefinition find-package find-symbol first flet fourth
-           fset funcall function functionp gensym get-setf-expansion
++          fdefinition find-package find-symbol first flet fourth fset
++          funcall function functionp gensym get-setf-expansion
 +          get-universal-time go identity if in-package incf integerp
-           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 ** *** // /// ++ +++))
++          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))
 +
 +(setq *package* *user-package*)
 +
 +(js-eval "var lisp")
 +(%js-vset "lisp" (new))
 +(%js-vset "lisp.read" #'ls-read-from-string)
 +(%js-vset "lisp.print" #'prin1-to-string)
 +(%js-vset "lisp.eval" #'eval)
 +(%js-vset "lisp.compile" (lambda (s) (ls-compile-toplevel s t)))
 +(%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*))))