X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Ftoplevel.lisp;h=0bd763f632b1584ddd44ce62564f0b0de373efd7;hb=6b1ca8628e9818fb891fcbef20d090ec244d3593;hp=64a0e87808f64aa9eec2d478524f56ee1cf04bea;hpb=142c8756f0052115a4c32cb3b66fe613292c4a83;p=jscl.git diff --git a/src/toplevel.lisp b/src/toplevel.lisp index 64a0e87..0bd763f 100644 --- 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 . +;; along with JSCL. If not, see . (defun eval (x) @@ -48,36 +48,40 @@ + -) (values-list /)) -(export '(&body &key &optional &rest * ** *** *gensym-counter* *package* + ++ - +++ - / // /// 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 - 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 - 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)) +(export '(&body &key &optional &rest * ** *** *features* *gensym-counter* + *package* *print-circle* + ++ +++ - / // /// 1+ 1- < <= = = > >= acons + adjoin alpha-char-p and append apply aref arrayp assoc atom block + boundp butlast caaaar caaadr caaar caadar caaddr caadr caar cadaar + cadadr cadar caddar cadddr caddr cadr car car case catch cdaaar + cdaadr cdaar cdadar cdaddr cdadr cdar cddaar cddadr cddar cdddar + cddddr cdddr cddr cdr cdr char char-code char= code-char cond cons + consp constantly copy-alist copy-list copy-tree decf declaim declare + defconstant define-setf-expander define-symbol-macro defmacro + defparameter defun defvar destructuring-bind digit-char digit-char-p + disassemble do do* documentation dolist dotimes ecase eighth eq eql + equal error eval every export expt fdefinition fifth find + find-package find-symbol first flet format fourth fboundp fset funcall + function functionp gensym get-internal-real-time get-setf-expansion + get-universal-time go identity if in-package incf integerp intern + intersection keywordp labels lambda last length let let* + lisp-implementation-type list list* list-all-packages listp loop + make-array make-package make-symbol mapc mapcar member minusp mod + multiple-value-bind multiple-value-call multiple-value-list + multiple-value-prog1 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 prog 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 setq seventh sixth some string string-upcase string= + stringp sublis 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 + vector-push-extend 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) @@ -87,25 +91,3 @@ (%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*))))