src/toplevel.lisp

   1 ;;; toplevel.lisp ---
   2
   3 ;; Copyright (C) 2012, 2013 David Vazquez
   4 ;; Copyright (C) 2012 Raimon Grau
   5
   6 ;; JSCL 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 ;; JSCL 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 JSCL.  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- < <= = = > >= acons adjoin and append apply aref
  53           arrayp 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-alist copy-list copy-tree decf declaim declare defconstant
  59           define-setf-expander define-symbol-macro defmacro defparameter defun
  60           defvar destructuring-bind digit-char digit-char-p disassemble do do* documentation
  61           dolist dotimes ecase eighth eq eql equal error eval every export expt
  62           fdefinition fifth find-package find find-symbol first flet format fourth
  63           fset funcall function functionp gensym get-internal-real-time
  64           get-setf-expansion get-universal-time go identity if in-package
  65           incf integerp intern intersection keywordp labels lambda last length
  66           let let* list list* list-all-packages listp loop make-array
  67           make-package make-symbol mapcar member minusp mod multiple-value-bind
  68           multiple-value-call multiple-value-list multiple-value-prog1
  69           nconc nil ninth not nreconc nth nthcdr null numberp or otherwise
  70           package-name package-use-list packagep pairlis parse-integer plusp
  71           pop prin1-to-string print proclaim prog prog1 prog2 progn psetq push
  72           quote rassoc read-from-string remove remove-if remove-if-not return
  73           return-from revappend reverse rplaca rplacd second set setf seventh
  74           setq sixth some string string-upcase string= stringp subseq subst
  75           symbol-function symbol-name symbol-package symbol-plist
  76           symbol-value symbolp t tagbody tailp tenth third throw tree-equal
  77           truncate unless unwind-protect values values-list variable vector-push-extend warn when
  78           write-line write-string zerop))
  79
  80 (setq *package* *user-package*)
  81
  82 ;;; Set some external entry point to the Lisp implementation to the
  83 ;;; console. It would not be necessary when FFI is finished.
  84 (js-eval "var lisp")
  85 (%js-vset "lisp" (new))
  86 (%js-vset "lisp.read" #'ls-read-from-string)
  87 (%js-vset "lisp.print" #'prin1-to-string)
  88 (%js-vset "lisp.eval" #'eval)
  89 (%js-vset "lisp.compile" (lambda (s) (ls-compile-toplevel s t)))
  90 (%js-vset "lisp.evalString" (lambda (str) (eval (ls-read-from-string str))))
  91 (%js-vset "lisp.evalInput" (lambda (str) (eval-interactive (ls-read-from-string str))))
  92 (%js-vset "lisp.compileString" (lambda (str) (ls-compile-toplevel (ls-read-from-string str) t)))