3 ;; Copyright (C) 2012, 2013 David Vazquez
4 ;; Copyright (C) 2012 Raimon Grau
6 ;; This program is free software: you can redistribute it and/or
7 ;; modify it under the terms of the GNU General Public License as
8 ;; published by the Free Software Foundation, either version 3 of the
9 ;; License, or (at your option) any later version.
11 ;; This program is distributed in the hope that it will be useful, but
12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;; General Public License for more details.
16 ;; You should have received a copy of the GNU General Public License
17 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
21 (js-eval (ls-compile-toplevel x t)))
34 (defun eval-interactive (x)
36 (let ((results (multiple-value-list (eval x))))
44 ;; FIXME: Handle error
51 (export '(&body &key &optional &rest * ** *** *gensym-counter* *package* + ++
52 +++ - / // /// 1+ 1- < <= = = > >= and append apply aref arrayp
53 assoc atom block boundp butlast cadar caaar caadr cdaar cdadr
54 cddar caaaar caaadr caadar caaddr cadaar cadadr caddar cdaaar
55 cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr caar cadddr caddr
56 cadr car car case catch cdar cdddr cddr cdr cdr char
57 char-code char= code-char cond cons consp constantly
58 copy-list decf declaim defconstant define-setf-expander
59 define-symbol-macro defmacro defparameter defun defvar
60 digit-char digit-char-p disassemble do do* documentation
61 dolist dotimes ecase eq eql equal error eval every export expt
62 fdefinition find-package find-symbol first flet fourth fset
63 funcall function functionp gensym get-internal-real-time
64 get-setf-expansion get-universal-time go identity if in-package
65 incf integerp intern keywordp labels lambda last length let let* list
66 list* list-all-packages listp loop make-array make-package
67 make-symbol mapcar member minusp mod multiple-value-bind
68 multiple-value-call multiple-value-list multiple-value-prog1
69 nconc nil not nreconc nth nthcdr null numberp or
70 package-name package-use-list packagep parse-integer plusp
71 prin1-to-string print proclaim prog1 prog2 progn psetq push
72 quote remove remove-if remove-if-not return return-from
73 revappend reverse rplaca rplacd second set setf setq some
74 string string-upcase string= stringp subseq symbol-function
75 symbol-name symbol-package symbol-plist symbol-value symbolp
76 t tagbody third throw truncate unless unwind-protect values
77 values-list variable warn when write-line write-string zerop))
79 (setq *package* *user-package*)
82 (%js-vset "lisp" (new))
83 (%js-vset "lisp.read" #'ls-read-from-string)
84 (%js-vset "lisp.print" #'prin1-to-string)
85 (%js-vset "lisp.eval" #'eval)
86 (%js-vset "lisp.compile" (lambda (s) (ls-compile-toplevel s t)))
87 (%js-vset "lisp.evalString" (lambda (str) (eval (ls-read-from-string str))))
88 (%js-vset "lisp.evalInput" (lambda (str) (eval-interactive (ls-read-from-string str))))
89 (%js-vset "lisp.compileString" (lambda (str) (ls-compile-toplevel (ls-read-from-string str) t)))
91 ;; Set the initial global environment to be equal to the host global
92 ;; environment at this point of the compilation.
95 (ls-compile `(setq *environment* ',*environment*))))
101 ,@(mapcar (lambda (s) `(%intern-symbol (%js-vref ,(cdr s))))
103 (setq *literal-symbols* ',*literal-symbols*)
104 (setq *variable-counter* ,*variable-counter*)
105 (setq *gensym-counter* ,*gensym-counter*)
106 (setq *block-counter* ,*block-counter*)))))
109 (toplevel-compilation
111 `(setq *literal-counter* ,*literal-counter*))))