src/toplevel.lisp

   1 ;;; toplevel.lisp ---
   2
   3 ;; Copyright (C) 2012, 2013 David Vazquez
   4 ;; Copyright (C) 2012 Raimon Grau
   5
   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.
  10 ;;
  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.
  15 ;;
  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/>.
  18
  19
  20 (defun eval (x)
  21   (js-eval (ls-compile-toplevel x t)))
  22
  23 (defvar * nil)
  24 (defvar ** nil)
  25 (defvar *** nil)
  26 (defvar / nil)
  27 (defvar // nil)
  28 (defvar /// nil)
  29 (defvar + nil)
  30 (defvar ++ nil)
  31 (defvar +++ nil)
  32 (defvar - nil)
  33
  34 (defun eval-interactive (x)
  35   (setf - x)
  36   (let ((results (multiple-value-list (eval x))))
  37     (setf /// //
  38           // /
  39           / results
  40           *** **
  41           ** *
  42           * (car results)))
  43   (unless (boundp '*)
  44     ;; FIXME: Handle error
  45     (setf * nil))
  46   (setf +++ ++
  47         ++ +
  48         + -)
  49   (values-list /))
  50
  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))
  78
  79 (setq *package* *user-package*)
  80
  81 (js-eval "var lisp")
  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)))
  90
  91 ;; Set the initial global environment to be equal to the host global
  92 ;; environment at this point of the compilation.
  93 (eval-when-compile
  94   (toplevel-compilation
  95    (ls-compile `(setq *environment* ',*environment*))))
  96
  97 (eval-when-compile
  98   (toplevel-compilation
  99    (ls-compile
 100     `(progn
 101        ,@(mapcar (lambda (s) `(%intern-symbol (%js-vref ,(cdr s))))
 102                  *literal-symbols*)
 103        (setq *literal-symbols* ',*literal-symbols*)
 104        (setq *variable-counter* ,*variable-counter*)
 105        (setq *gensym-counter* ,*gensym-counter*)
 106        (setq *block-counter* ,*block-counter*)))))
 107
 108 (eval-when-compile
 109   (toplevel-compilation
 110    (ls-compile
 111     `(setq *literal-counter* ,*literal-counter*))))