X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Ftoplevel.lisp;h=b5ef24b1becec70f4c02efd97ea582eba063ccc0;hb=dfca8efb6fdc56c94d954d0c29eaebafd53aec58;hp=d2cd2d4c2668130b58004d2b0d5c90512e6a0de9;hpb=261c79ce0f1b20b7f917a4139239facbd3e89eed;p=jscl.git
diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index d2cd2d4..b5ef24b 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)
@@ -40,41 +40,48 @@
*** **
** *
* (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 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
- 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 ** *** // /// ++ +++))
+(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 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 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 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)
@@ -84,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*))))