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