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 * ** *** *features* *gensym-counter*
  52           *package* *print-circle* + ++ +++ - / // /// 1+ 1- < <= = = > >= acons
  53           adjoin alpha-char-p and append apply aref arrayp assoc atom block
  54           boundp butlast caaaar caaadr caaar caadar caaddr caadr caar cadaar
  55           cadadr cadar caddar cadddr caddr cadr car car case catch cdaaar
  56           cdaadr cdaar cdadar cdaddr cdadr cdar cddaar cddadr cddar cdddar
  57           cddddr cdddr cddr cdr cdr char char-code char= code-char cond cons
  58           consp constantly copy-alist copy-list copy-tree decf declaim declare
  59           defconstant define-setf-expander define-symbol-macro defmacro
  60           defparameter defun defvar destructuring-bind digit-char digit-char-p
  61           disassemble do do* documentation dolist dotimes ecase eighth eq eql
  62           equal error eval every export expt fdefinition fifth find
  63           find-package find-symbol first flet format fourth fboundp fset funcall
  64           function functionp gensym get-internal-real-time get-setf-expansion
  65           get-universal-time go identity if in-package incf integerp intern
  66           intersection keywordp labels lambda last length let let*
  67           lisp-implementation-type list list* list-all-packages listp loop
  68           make-array make-package make-symbol mapc mapcar member minusp mod
  69           multiple-value-bind multiple-value-call multiple-value-list
  70           multiple-value-prog1 nconc nil ninth not nreconc nth nthcdr null
  71           numberp or otherwise package-name package-use-list packagep pairlis
  72           parse-integer plusp pop prin1-to-string print proclaim prog prog1
  73           prog2 progn psetq push quote rassoc read-from-string remove remove-if
  74           remove-if-not return return-from revappend reverse rplaca rplacd
  75           second set setf setq seventh sixth some string string-upcase string=
  76 <<<<<<< HEAD
  77           string< stringp subseq subst symbol-function symbol-name symbol-package
  78 =======
  79           stringp sublis subseq subst symbol-function symbol-name symbol-package
  80 >>>>>>> ee0ae303e9d3f7f99eeb3af1824b61f2616f5925
  81           symbol-plist symbol-value symbolp t tagbody tailp tenth third throw
  82           time trace tree-equal truncate unless untrace unwind-protect values
  83           values-list variable vector-push-extend warn when write-line write-string
  84           zerop))
  85
  86 (setq *package* *user-package*)
  87
  88 ;;; Set some external entry point to the Lisp implementation to the
  89 ;;; console. It would not be necessary when FFI is finished.
  90 (js-eval "var lisp")
  91 (%js-vset "lisp" (new))
  92 (%js-vset "lisp.read" #'ls-read-from-string)
  93 (%js-vset "lisp.print" #'prin1-to-string)
  94 (%js-vset "lisp.eval" #'eval)
  95 (%js-vset "lisp.compile" (lambda (s) (ls-compile-toplevel s t)))
  96 (%js-vset "lisp.evalString" (lambda (str) (eval (ls-read-from-string str))))
  97 (%js-vset "lisp.evalInput" (lambda (str) (eval-interactive (ls-read-from-string str))))
  98 (%js-vset "lisp.compileString" (lambda (str) (ls-compile-toplevel (ls-read-from-string str) t)))