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 copy-tree 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 pop
  71           prin1-to-string print proclaim prog1 prog2 progn psetq push
  72           quote read-from-string remove remove-if remove-if-not return
  73           return-from revappend reverse rplaca rplacd second set setf
  74           setq some string string-upcase string= stringp subseq subst
  75           symbol-function symbol-name symbol-package symbol-plist
  76           symbol-value symbolp t tagbody third throw truncate unless
  77           unwind-protect values values-list variable warn when write-line
  78           write-string zerop))
  79
  80 (setq *package* *user-package*)
  81
  82 (js-eval "var lisp")
  83 (%js-vset "lisp" (new))
  84 (%js-vset "lisp.read" #'ls-read-from-string)
  85 (%js-vset "lisp.print" #'prin1-to-string)
  86 (%js-vset "lisp.eval" #'eval)
  87 (%js-vset "lisp.compile" (lambda (s) (ls-compile-toplevel s t)))
  88 (%js-vset "lisp.evalString" (lambda (str) (eval (ls-read-from-string str))))
  89 (%js-vset "lisp.evalInput" (lambda (str) (eval-interactive (ls-read-from-string str))))
  90 (%js-vset "lisp.compileString" (lambda (str) (ls-compile-toplevel (ls-read-from-string str) t)))
  91
  92 ;; Set the initial global environment to be equal to the host global
  93 ;; environment at this point of the compilation.
  94 (eval-when-compile
  95   (toplevel-compilation
  96    (ls-compile `(setq *environment* ',*environment*))))
  97
  98 (eval-when-compile
  99   (toplevel-compilation
 100    (ls-compile
 101     `(progn
 102        ,@(mapcar (lambda (s) `(%intern-symbol (%js-vref ,(cdr s))))
 103                  *literal-table*)
 104        (setq *literal-table* ',*literal-table*)
 105        (setq *variable-counter* ,*variable-counter*)
 106        (setq *gensym-counter* ,*gensym-counter*)
 107        (setq *block-counter* ,*block-counter*)))))
 108
 109 (eval-when-compile
 110   (toplevel-compilation
 111    (ls-compile
 112     `(setq *literal-counter* ,*literal-counter*))))