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
  52  '(&allow-other-keys &aux &body &environment &key &optional &rest &whole
  53    * ** *** *break-on-signals* *compile-file-pathname*
  54    *compile-file-truename* *compile-print* *compile-verbose* *debug-io*
  55    *debugger-hook* *default-pathname-defaults* *error-output* *features*
  56    *gensym-counter* *load-pathname* *load-print* *load-truename*
  57    *load-verbose* *macroexpand-hook* *modules* *package* *print-array*
  58    *print-base* *print-case* *print-circle* *print-escape* *print-gensym*
  59    *print-length* *print-level* *print-lines* *print-miser-width*
  60    *print-pprint-dispatch* *print-pretty* *print-radix* *print-readably*
  61    *print-right-margin* *query-io* *random-state* *read-base*
  62    *read-default-float-format* *read-eval* *read-suppress* *readtable*
  63    *standard-input* *standard-output* *terminal-io* *trace-output* + ++
  64    +++ - / // /// /= 1+ 1- < <= = > >= abort abs acons acos acosh
  65    add-method adjoin adjust-array adjustable-array-p allocate-instance
  66    alpha-char-p alphanumericp and append apply apropos apropos-list aref
  67    arithmetic-error arithmetic-error-operands arithmetic-error-operation
  68    array array-dimension array-dimension-limit array-dimensions
  69    array-displacement array-element-type array-has-fill-pointer-p
  70    array-in-bounds-p array-rank array-rank-limit array-row-major-index
  71    array-total-size array-total-size-limit arrayp ash asin asinh assert
  72    assoc assoc-if assoc-if-not atan atanh atom base-char base-string
  73    bignum bit bit-and bit-andc1 bit-andc2 bit-eqv bit-ior bit-nand
  74    bit-nor bit-not bit-orc1 bit-orc2 bit-vector bit-vector-p bit-xor
  75    block boole boole-1 boole-2 boole-and boole-andc1 boole-andc2 boole-c1
  76    boole-c2 boole-clr boole-eqv boole-ior boole-nand boole-nor boole-orc1
  77    boole-orc2 boole-set boole-xor boolean both-case-p boundp break
  78    broadcast-stream broadcast-stream-streams built-in-class butlast byte
  79    byte-position byte-size caaaar caaadr caaar caadar caaddr caadr caar
  80    cadaar cadadr cadar caddar cadddr caddr cadr call-arguments-limit
  81    call-method call-next-method car case catch ccase cdaaar cdaadr cdaar
  82    cdadar cdaddr cdadr cdar cddaar cddadr cddar cdddar cddddr cdddr cddr
  83    cdr ceiling cell-error cell-error-name cerror change-class char
  84    char-code char-code-limit char-downcase char-equal char-greaterp
  85    char-int char-lessp char-name char-not-equal char-not-greaterp
  86    char-not-lessp char-upcase char/= char< char<= char= char> char>=
  87    character characterp check-type cis class class-name class-of
  88    clear-input clear-output close clrhash code-char coerce
  89    compilation-speed compile compile-file compile-file-pathname
  90    compiled-function compiled-function-p compiler-macro
  91    compiler-macro-function complement complex complexp
  92    compute-applicable-methods compute-restarts concatenate
  93    concatenated-stream concatenated-stream-streams cond condition
  94    conjugate cons consp constantly constantp continue control-error
  95    copy-alist copy-list copy-pprint-dispatch copy-readtable copy-seq
  96    copy-structure copy-symbol copy-tree cos cosh count count-if
  97    count-if-not ctypecase debug decf declaim declaration declare
  98    decode-float decode-universal-time defclass defconstant defgeneric
  99    define-compiler-macro define-condition define-method-combination
 100    define-modify-macro define-setf-expander define-symbol-macro defmacro
 101    defmethod defpackage defparameter defsetf defstruct deftype defun
 102    defvar delete delete-duplicates delete-file delete-if delete-if-not
 103    delete-package denominator deposit-field describe describe-object
 104    destructuring-bind digit-char digit-char-p directory
 105    directory-namestring disassemble division-by-zero do do*
 106    do-all-symbols do-external-symbols do-symbols documentation dolist
 107    dotimes double-float double-float-epsilon
 108    double-float-negative-epsilon dpb dribble dynamic-extent ecase
 109    echo-stream echo-stream-input-stream echo-stream-output-stream ed
 110    eighth elt encode-universal-time end-of-file endp enough-namestring
 111    ensure-directories-exist ensure-generic-function eq eql equal equalp
 112    error etypecase eval eval-when evenp every exp export expt
 113    extended-char fboundp fceiling fdefinition ffloor fifth file-author
 114    file-error file-error-pathname file-length file-namestring
 115    file-position file-stream file-string-length file-write-date fill
 116    fill-pointer find find-all-symbols find-class find-if find-if-not
 117    find-method find-package find-restart find-symbol finish-output first
 118    fixnum flet float float-digits float-precision float-radix float-sign
 119    floating-point-inexact floating-point-invalid-operation
 120    floating-point-overflow floating-point-underflow floatp floor
 121    fmakunbound force-output format formatter fourth fresh-line fround
 122    ftruncate ftype funcall function function-keywords
 123    function-lambda-expression functionp gcd generic-function gensym
 124    gentemp get get-decoded-time get-dispatch-macro-character
 125    get-internal-real-time get-internal-run-time get-macro-character
 126    get-output-stream-string get-properties get-setf-expansion
 127    get-universal-time getf gethash go graphic-char-p handler-bind
 128    handler-case hash-table hash-table-count hash-table-p
 129    hash-table-rehash-size hash-table-rehash-threshold hash-table-size
 130    hash-table-test host-namestring identity if ignorable ignore
 131    ignore-errors imagpart import in-package incf initialize-instance
 132    inline input-stream-p inspect integer integer-decode-float
 133    integer-length integerp interactive-stream-p intern
 134    internal-time-units-per-second intersection invalid-method-error
 135    invoke-debugger invoke-restart invoke-restart-interactively isqrt
 136    keyword keywordp labels lambda lambda-list-keywords
 137    lambda-parameters-limit last lcm ldb ldb-test ldiff
 138    least-negative-double-float least-negative-long-float
 139    least-negative-normalized-double-float
 140    least-negative-normalized-long-float
 141    least-negative-normalized-short-float
 142    least-negative-normalized-single-float least-negative-short-float
 143    least-negative-single-float least-positive-double-float
 144    least-positive-long-float least-positive-normalized-double-float
 145    least-positive-normalized-long-float
 146    least-positive-normalized-short-float
 147    least-positive-normalized-single-float least-positive-short-float
 148    least-positive-single-float length let let* lisp-implementation-type
 149    lisp-implementation-version list list* list-all-packages list-length
 150    listen listp load load-logical-pathname-translations load-time-value
 151    locally log logand logandc1 logandc2 logbitp logcount logeqv
 152    logical-pathname logical-pathname-translations logior lognand lognor
 153    lognot logorc1 logorc2 logtest logxor long-float long-float-epsilon
 154    long-float-negative-epsilon long-site-name loop loop-finish
 155    lower-case-p machine-instance machine-type machine-version
 156    macro-function macroexpand macroexpand-1 macrolet make-array
 157    make-broadcast-stream make-concatenated-stream make-condition
 158    make-dispatch-macro-character make-echo-stream make-hash-table
 159    make-instance make-instances-obsolete make-list make-load-form
 160    make-load-form-saving-slots make-method make-package make-pathname
 161    make-random-state make-sequence make-string make-string-input-stream
 162    make-string-output-stream make-symbol make-synonym-stream
 163    make-two-way-stream makunbound map map-into mapc mapcan mapcar mapcon
 164    maphash mapl maplist mask-field max member member-if member-if-not
 165    merge merge-pathnames method method-combination
 166    method-combination-error method-qualifiers min minusp mismatch mod
 167    most-negative-double-float most-negative-fixnum
 168    most-negative-long-float most-negative-short-float
 169    most-negative-single-float most-positive-double-float
 170    most-positive-fixnum most-positive-long-float
 171    most-positive-short-float most-positive-single-float muffle-warning
 172    multiple-value-bind multiple-value-call multiple-value-list
 173    multiple-value-prog1 multiple-value-setq multiple-values-limit
 174    name-char namestring nbutlast nconc next-method-p nil nintersection
 175    ninth no-applicable-method no-next-method not notany notevery
 176    notinline nreconc nreverse nset-difference nset-exclusive-or
 177    nstring-capitalize nstring-downcase nstring-upcase nsublis nsubst
 178    nsubst-if nsubst-if-not nsubstitute nsubstitute-if nsubstitute-if-not
 179    nth nth-value nthcdr null number numberp numerator nunion oddp open
 180    open-stream-p optimize or otherwise output-stream-p package
 181    package-error package-error-package package-name package-nicknames
 182    package-shadowing-symbols package-use-list package-used-by-list
 183    packagep pairlis parse-error parse-integer parse-namestring pathname
 184    pathname-device pathname-directory pathname-host pathname-match-p
 185    pathname-name pathname-type pathname-version pathnamep peek-char phase
 186    pi plusp pop position position-if position-if-not pprint
 187    pprint-dispatch pprint-exit-if-list-exhausted pprint-fill
 188    pprint-indent pprint-linear pprint-logical-block pprint-newline
 189    pprint-pop pprint-tab pprint-tabular prin1 prin1-to-string princ
 190    princ-to-string print print-not-readable print-not-readable-object
 191    print-object print-unreadable-object probe-file proclaim prog prog*
 192    prog1 prog2 progn program-error progv provide psetf psetq push pushnew
 193    quote random random-state random-state-p rassoc rassoc-if
 194    rassoc-if-not ratio rational rationalize rationalp read read-byte
 195    read-char read-char-no-hang read-delimited-list read-from-string
 196    read-line read-preserving-whitespace read-sequence reader-error
 197    readtable readtable-case readtablep real realp realpart reduce
 198    reinitialize-instance rem remf remhash remove remove-duplicates
 199    remove-if remove-if-not remove-method remprop rename-file
 200    rename-package replace require rest restart restart-bind restart-case
 201    restart-name return return-from revappend reverse room rotatef round
 202    row-major-aref rplaca rplacd safety satisfies sbit scale-float schar
 203    search second sequence serious-condition set set-difference
 204    set-dispatch-macro-character set-exclusive-or set-macro-character
 205    set-pprint-dispatch set-syntax-from-char setf setq seventh shadow
 206    shadowing-import shared-initialize shiftf short-float
 207    short-float-epsilon short-float-negative-epsilon short-site-name
 208    signal signed-byte signum simple-array simple-base-string
 209    simple-bit-vector simple-bit-vector-p simple-condition
 210    simple-condition-format-arguments simple-condition-format-control
 211    simple-error simple-string simple-string-p simple-type-error
 212    simple-vector simple-vector-p simple-warning sin single-float
 213    single-float-epsilon single-float-negative-epsilon sinh sixth sleep
 214    slot-boundp slot-exists-p slot-makunbound slot-missing slot-unbound
 215    slot-value software-type software-version some sort space special
 216    special-operator-p speed sqrt stable-sort standard standard-char
 217    standard-char-p standard-class standard-generic-function
 218    standard-method standard-object step storage-condition store-value
 219    stream stream-element-type stream-error stream-error-stream
 220    stream-external-format streamp string string-capitalize
 221    string-downcase string-equal string-greaterp string-left-trim
 222    string-lessp string-not-equal string-not-greaterp string-not-lessp
 223    string-right-trim string-stream string-trim string-upcase string/=
 224    string< string<= string= string> string>= stringp structure
 225    structure-class structure-object style-warning sublis subseq subsetp
 226    subst subst-if subst-if-not substitute substitute-if substitute-if-not
 227    subtypep svref sxhash symbol symbol-function symbol-macrolet
 228    symbol-name symbol-package symbol-plist symbol-value symbolp
 229    synonym-stream synonym-stream-symbol t tagbody tailp tan tanh tenth
 230    terpri the third throw time trace translate-logical-pathname
 231    translate-pathname tree-equal truename truncate two-way-stream
 232    two-way-stream-input-stream two-way-stream-output-stream type
 233    type-error type-error-datum type-error-expected-type type-of typecase
 234    typep unbound-slot unbound-slot-instance unbound-variable
 235    undefined-function unexport unintern union unless unread-char
 236    unsigned-byte untrace unuse-package unwind-protect
 237    update-instance-for-different-class
 238    update-instance-for-redefined-class upgraded-array-element-type
 239    upgraded-complex-part-type upper-case-p use-package use-value
 240    user-homedir-pathname values values-list variable vector vector-pop
 241    vector-push vector-push-extend vectorp warn warning when
 242    wild-pathname-p with-accessors with-compilation-unit
 243    with-condition-restarts with-hash-table-iterator
 244    with-input-from-string with-open-file with-open-stream
 245    with-output-to-string with-package-iterator with-simple-restart
 246    with-slots with-standard-io-syntax write write-byte write-char
 247    write-line write-sequence write-string write-to-string y-or-n-p
 248    yes-or-no-p zerop))
 249
 250 (setq *package* *user-package*)
 251
 252 ;;; Set some external entry point to the Lisp implementation to the
 253 ;;; console. It would not be necessary when FFI is finished.
 254 (let ((*root* #j:lisp))
 255   (setf #j:read #'ls-read-from-string)
 256   (setf #j:print #'prin1-to-string)
 257   (setf #j:eval #'eval)
 258   (setf #j:compile (lambda (s) (ls-compile-toplevel s t)))
 259   (setf #j:evalString (lambda (str) (eval (ls-read-from-string str))))
 260   (setf #j:evalInput (lambda (str) (eval-interactive (ls-read-from-string str))))
 261   (setf #j:compileString (lambda (str) (ls-compile-toplevel (ls-read-from-string str) t))))
 262