X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Ftoplevel.lisp;h=9d6594b464d08e442ca04a3e02980a9e105edb88;hb=HEAD;hp=33e4a82887ec32f588efa6f77c48fb4f7cf7340f;hpb=8809acf5541ef49238d27c8e8c630ba3ba6e069f;p=jscl.git diff --git a/src/toplevel.lisp b/src/toplevel.lisp index 33e4a82..9d6594b 100644 --- a/src/toplevel.lisp +++ b/src/toplevel.lisp @@ -16,9 +16,10 @@ ;; You should have received a copy of the GNU General Public License ;; along with JSCL. If not, see . +(/debug "loading toplevel.lisp!") (defun eval (x) - (js-eval (ls-compile-toplevel x t))) + (js-eval (compile-toplevel x t))) (defvar * nil) (defvar ** nil) @@ -48,45 +49,246 @@ + -) (values-list /)) -(export '(&body &key &optional &rest * ** *** *gensym-counter* *package* + ++ - +++ - / // /// 1+ 1- < <= = = > >= acons adjoin and append apply aref - arrayp assoc atom block boundp butlast cadar caaar caadr cdaar cdadr - cddar caaaar caaadr caadar caaddr cadaar cadadr caddar cdaaar - cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr caar cadddr caddr - cadr car car case catch cdar cdddr cddr cdr cdr char - char-code char= code-char cond cons consp constantly - copy-alist copy-list copy-tree decf declaim declare defconstant - define-setf-expander define-symbol-macro defmacro defparameter defun - defvar destructuring-bind digit-char digit-char-p disassemble do do* documentation - dolist dotimes ecase eighth eq eql equal error eval every export expt - fdefinition fifth find-package find-symbol first flet format fourth - fset funcall function functionp gensym get-internal-real-time - get-setf-expansion get-universal-time go identity if in-package - incf integerp intern intersection keywordp labels lambda last length - let let* list list* list-all-packages listp loop make-array - make-package make-symbol mapcar member minusp mod multiple-value-bind - multiple-value-call multiple-value-list multiple-value-prog1 - nconc nil ninth not nreconc nth nthcdr null numberp or otherwise - package-name package-use-list packagep pairlis parse-integer plusp - pop prin1-to-string print proclaim prog prog1 prog2 progn psetq push - quote rassoc read-from-string remove remove-if remove-if-not return - return-from revappend reverse rplaca rplacd second set setf seventh - setq sixth some string string-upcase string= stringp subseq subst - symbol-function symbol-name symbol-package symbol-plist - symbol-value symbolp t tagbody tailp tenth third throw tree-equal - truncate unless unwind-protect values values-list variable vector-push-extend warn when - write-line write-string zerop)) +(export + '(&allow-other-keys &aux &body &environment &key &optional &rest &whole + * ** *** *break-on-signals* *compile-file-pathname* + *compile-file-truename* *compile-print* *compile-verbose* *debug-io* + *debugger-hook* *default-pathname-defaults* *error-output* *features* + *gensym-counter* *load-pathname* *load-print* *load-truename* + *load-verbose* *macroexpand-hook* *modules* *package* *print-array* + *print-base* *print-case* *print-circle* *print-escape* *print-gensym* + *print-length* *print-level* *print-lines* *print-miser-width* + *print-pprint-dispatch* *print-pretty* *print-radix* *print-readably* + *print-right-margin* *query-io* *random-state* *read-base* + *read-default-float-format* *read-eval* *read-suppress* *readtable* + *standard-input* *standard-output* *terminal-io* *trace-output* + ++ + +++ - / // /// /= 1+ 1- < <= = > >= abort abs acons acos acosh + add-method adjoin adjust-array adjustable-array-p allocate-instance + alpha-char-p alphanumericp and append apply apropos apropos-list aref + arithmetic-error arithmetic-error-operands arithmetic-error-operation + array array-dimension array-dimension-limit array-dimensions + array-displacement array-element-type array-has-fill-pointer-p + array-in-bounds-p array-rank array-rank-limit array-row-major-index + array-total-size array-total-size-limit arrayp ash asin asinh assert + assoc assoc-if assoc-if-not atan atanh atom base-char base-string + bignum bit bit-and bit-andc1 bit-andc2 bit-eqv bit-ior bit-nand + bit-nor bit-not bit-orc1 bit-orc2 bit-vector bit-vector-p bit-xor + block boole boole-1 boole-2 boole-and boole-andc1 boole-andc2 boole-c1 + boole-c2 boole-clr boole-eqv boole-ior boole-nand boole-nor boole-orc1 + boole-orc2 boole-set boole-xor boolean both-case-p boundp break + broadcast-stream broadcast-stream-streams built-in-class butlast byte + byte-position byte-size caaaar caaadr caaar caadar caaddr caadr caar + cadaar cadadr cadar caddar cadddr caddr cadr call-arguments-limit + call-method call-next-method car case catch ccase cdaaar cdaadr cdaar + cdadar cdaddr cdadr cdar cddaar cddadr cddar cdddar cddddr cdddr cddr + cdr ceiling cell-error cell-error-name cerror change-class char + char-code char-code-limit char-downcase char-equal char-greaterp + char-int char-lessp char-name char-not-equal char-not-greaterp + char-not-lessp char-upcase char/= char< char<= char= char> char>= + character characterp check-type cis class class-name class-of + clear-input clear-output close clrhash code-char coerce + compilation-speed compile compile-file compile-file-pathname + compiled-function compiled-function-p compiler-macro + compiler-macro-function complement complex complexp + compute-applicable-methods compute-restarts concatenate + concatenated-stream concatenated-stream-streams cond condition + conjugate cons consp constantly constantp continue control-error + copy-alist copy-list copy-pprint-dispatch copy-readtable copy-seq + copy-structure copy-symbol copy-tree cos cosh count count-if + count-if-not ctypecase debug decf declaim declaration declare + decode-float decode-universal-time defclass defconstant defgeneric + define-compiler-macro define-condition define-method-combination + define-modify-macro define-setf-expander define-symbol-macro defmacro + defmethod defpackage defparameter defsetf defstruct deftype defun + defvar delete delete-duplicates delete-file delete-if delete-if-not + delete-package denominator deposit-field describe describe-object + destructuring-bind digit-char digit-char-p directory + directory-namestring disassemble division-by-zero do do* + do-all-symbols do-external-symbols do-symbols documentation dolist + dotimes double-float double-float-epsilon + double-float-negative-epsilon dpb dribble dynamic-extent ecase + echo-stream echo-stream-input-stream echo-stream-output-stream ed + eighth elt encode-universal-time end-of-file endp enough-namestring + ensure-directories-exist ensure-generic-function eq eql equal equalp + error etypecase eval eval-when evenp every exp export expt + extended-char fboundp fceiling fdefinition ffloor fifth file-author + file-error file-error-pathname file-length file-namestring + file-position file-stream file-string-length file-write-date fill + fill-pointer find find-all-symbols find-class find-if find-if-not + find-method find-package find-restart find-symbol finish-output first + fixnum flet float float-digits float-precision float-radix float-sign + floating-point-inexact floating-point-invalid-operation + floating-point-overflow floating-point-underflow floatp floor + fmakunbound force-output format formatter fourth fresh-line fround + ftruncate ftype funcall function function-keywords + function-lambda-expression functionp gcd generic-function gensym + gentemp get get-decoded-time get-dispatch-macro-character + get-internal-real-time get-internal-run-time get-macro-character + get-output-stream-string get-properties get-setf-expansion + get-universal-time getf gethash go graphic-char-p handler-bind + handler-case hash-table hash-table-count hash-table-p + hash-table-rehash-size hash-table-rehash-threshold hash-table-size + hash-table-test host-namestring identity if ignorable ignore + ignore-errors imagpart import in-package incf initialize-instance + inline input-stream-p inspect integer integer-decode-float + integer-length integerp interactive-stream-p intern + internal-time-units-per-second intersection invalid-method-error + invoke-debugger invoke-restart invoke-restart-interactively isqrt + keyword keywordp labels lambda lambda-list-keywords + lambda-parameters-limit last lcm ldb ldb-test ldiff + least-negative-double-float least-negative-long-float + least-negative-normalized-double-float + least-negative-normalized-long-float + least-negative-normalized-short-float + least-negative-normalized-single-float least-negative-short-float + least-negative-single-float least-positive-double-float + least-positive-long-float least-positive-normalized-double-float + least-positive-normalized-long-float + least-positive-normalized-short-float + least-positive-normalized-single-float least-positive-short-float + least-positive-single-float length let let* lisp-implementation-type + lisp-implementation-version list list* list-all-packages list-length + listen listp load load-logical-pathname-translations load-time-value + locally log logand logandc1 logandc2 logbitp logcount logeqv + logical-pathname logical-pathname-translations logior lognand lognor + lognot logorc1 logorc2 logtest logxor long-float long-float-epsilon + long-float-negative-epsilon long-site-name loop loop-finish + lower-case-p machine-instance machine-type machine-version + macro-function macroexpand macroexpand-1 macrolet make-array + make-broadcast-stream make-concatenated-stream make-condition + make-dispatch-macro-character make-echo-stream make-hash-table + make-instance make-instances-obsolete make-list make-load-form + make-load-form-saving-slots make-method make-package make-pathname + make-random-state make-sequence make-string make-string-input-stream + make-string-output-stream make-symbol make-synonym-stream + make-two-way-stream makunbound map map-into mapc mapcan mapcar mapcon + maphash mapl maplist mask-field max member member-if member-if-not + merge merge-pathnames method method-combination + method-combination-error method-qualifiers min minusp mismatch mod + most-negative-double-float most-negative-fixnum + most-negative-long-float most-negative-short-float + most-negative-single-float most-positive-double-float + most-positive-fixnum most-positive-long-float + most-positive-short-float most-positive-single-float muffle-warning + multiple-value-bind multiple-value-call multiple-value-list + multiple-value-prog1 multiple-value-setq multiple-values-limit + name-char namestring nbutlast nconc next-method-p nil nintersection + ninth no-applicable-method no-next-method not notany notevery + notinline nreconc nreverse nset-difference nset-exclusive-or + nstring-capitalize nstring-downcase nstring-upcase nsublis nsubst + nsubst-if nsubst-if-not nsubstitute nsubstitute-if nsubstitute-if-not + nth nth-value nthcdr null number numberp numerator nunion oddp open + open-stream-p optimize or otherwise output-stream-p package + package-error package-error-package package-name package-nicknames + package-shadowing-symbols package-use-list package-used-by-list + packagep pairlis parse-error parse-integer parse-namestring pathname + pathname-device pathname-directory pathname-host pathname-match-p + pathname-name pathname-type pathname-version pathnamep peek-char phase + pi plusp pop position position-if position-if-not pprint + pprint-dispatch pprint-exit-if-list-exhausted pprint-fill + pprint-indent pprint-linear pprint-logical-block pprint-newline + pprint-pop pprint-tab pprint-tabular prin1 prin1-to-string princ + princ-to-string print print-not-readable print-not-readable-object + print-object print-unreadable-object probe-file proclaim prog prog* + prog1 prog2 progn program-error progv provide psetf psetq push pushnew + quote random random-state random-state-p rassoc rassoc-if + rassoc-if-not ratio rational rationalize rationalp read read-byte + read-char read-char-no-hang read-delimited-list read-from-string + read-line read-preserving-whitespace read-sequence reader-error + readtable readtable-case readtablep real realp realpart reduce + reinitialize-instance rem remf remhash remove remove-duplicates + remove-if remove-if-not remove-method remprop rename-file + rename-package replace require rest restart restart-bind restart-case + restart-name return return-from revappend reverse room rotatef round + row-major-aref rplaca rplacd safety satisfies sbit scale-float schar + search second sequence serious-condition set set-difference + set-dispatch-macro-character set-exclusive-or set-macro-character + set-pprint-dispatch set-syntax-from-char setf setq seventh shadow + shadowing-import shared-initialize shiftf short-float + short-float-epsilon short-float-negative-epsilon short-site-name + signal signed-byte signum simple-array simple-base-string + simple-bit-vector simple-bit-vector-p simple-condition + simple-condition-format-arguments simple-condition-format-control + simple-error simple-string simple-string-p simple-type-error + simple-vector simple-vector-p simple-warning sin single-float + single-float-epsilon single-float-negative-epsilon sinh sixth sleep + slot-boundp slot-exists-p slot-makunbound slot-missing slot-unbound + slot-value software-type software-version some sort space special + special-operator-p speed sqrt stable-sort standard standard-char + standard-char-p standard-class standard-generic-function + standard-method standard-object step storage-condition store-value + stream stream-element-type stream-error stream-error-stream + stream-external-format streamp string string-capitalize + string-downcase string-equal string-greaterp string-left-trim + string-lessp string-not-equal string-not-greaterp string-not-lessp + string-right-trim string-stream string-trim string-upcase string/= + string< string<= string= string> string>= stringp structure + structure-class structure-object style-warning sublis subseq subsetp + subst subst-if subst-if-not substitute substitute-if substitute-if-not + subtypep svref sxhash symbol symbol-function symbol-macrolet + symbol-name symbol-package symbol-plist symbol-value symbolp + synonym-stream synonym-stream-symbol t tagbody tailp tan tanh tenth + terpri the third throw time trace translate-logical-pathname + translate-pathname tree-equal truename truncate two-way-stream + two-way-stream-input-stream two-way-stream-output-stream type + type-error type-error-datum type-error-expected-type type-of typecase + typep unbound-slot unbound-slot-instance unbound-variable + undefined-function unexport unintern union unless unread-char + unsigned-byte untrace unuse-package unwind-protect + update-instance-for-different-class + update-instance-for-redefined-class upgraded-array-element-type + upgraded-complex-part-type upper-case-p use-package use-value + user-homedir-pathname values values-list variable vector vector-pop + vector-push vector-push-extend vectorp warn warning when + wild-pathname-p with-accessors with-compilation-unit + with-condition-restarts with-hash-table-iterator + with-input-from-string with-open-file with-open-stream + with-output-to-string with-package-iterator with-simple-restart + with-slots with-standard-io-syntax write write-byte write-char + write-line write-sequence write-string write-to-string y-or-n-p + yes-or-no-p zerop)) (setq *package* *user-package*) -;;; Set some external entry point to the Lisp implementation to the -;;; console. It would not be necessary when FFI is finished. -(js-eval "var lisp") -(%js-vset "lisp" (new)) -(%js-vset "lisp.read" #'ls-read-from-string) -(%js-vset "lisp.print" #'prin1-to-string) -(%js-vset "lisp.eval" #'eval) -(%js-vset "lisp.compile" (lambda (s) (ls-compile-toplevel s t))) -(%js-vset "lisp.evalString" (lambda (str) (eval (ls-read-from-string str)))) -(%js-vset "lisp.evalInput" (lambda (str) (eval-interactive (ls-read-from-string str)))) -(%js-vset "lisp.compileString" (lambda (str) (ls-compile-toplevel (ls-read-from-string str) t))) +(defvar *root* (%js-vref "window")) + + +(defun load-history () + (#j:jqconsole:SetHistory (#j:JSON:parse (#j:localStorage:getItem "jqhist")))) + +(defun save-history () + (#j:localStorage:setItem "jqhist" (#j:JSON:stringify (#j:jqconsole:GetHistory)))) + +(defun toplevel () + (let ((prompt (format nil "~a> " (package-name *package*)))) + (#j:jqconsole:Write prompt "jqconsole-prompt")) + (flet ((process-input (input) + (let* ((form (read-from-string input)) + (successp nil) + result) + ;; Capture errors. We evaluate the form and set successp + ;; to T. However, if a non-local exist happens, we cancel + ;; it, so it is not propagated more. + (block nil + (unwind-protect + (progn + (setq result (multiple-value-list (eval-interactive form))) + (setq successp t)) + (return))) + + (if successp + (dolist (x result) + (#j:jqconsole:Write (format nil "~S~%" x) "jqconsole-return")) + (#j:jqconsole:Write (format nil "Error occurred~%") "jqconsole-error")) + + (save-history)) + (toplevel))) + (#j:jqconsole:Prompt t #'process-input))) + + +(defun init (&rest args) + (#j:jqconsole:RegisterMatching "(" ")" "parents") + (load-history) + (toplevel)) + +(#j:window:addEventListener "load" #'init)