author | Alan Dipert
<alan@dipert.org> 2020-08-21 04:44:16 UTC |
committer | Alan Dipert
<alan@dipert.org> 2020-08-21 04:44:16 UTC |
parent | 27ebd29ce38bb48d630de61a1ccc1d78f590cc2c |
boot.lisp | +60 | -60 |
diff --git a/boot.lisp b/boot.lisp index aa0876f..687ba4b 100644 --- a/boot.lisp +++ b/boot.lisp @@ -48,8 +48,8 @@ (vname# (%internal-name "BLOCK-VALUE" block-name)) (labelname# (%internal-name "BLOCK-LABEL" block-name))) `(%let ((,vname# nil)) - (jacl:%tagbody (%setq ,vname# (%progn ,@forms)) - ,labelname#) + (%tagbody (%setq ,vname# (%progn ,@forms)) + ,labelname#) ,vname#))) (%js "(~{}.fvalue = ~{})" @@ -68,28 +68,28 @@ &aux (vname# (%internal-name "BLOCK-VALUE" nil)) (labelname# (%internal-name "BLOCK-LABEL" nil))) - `(jacl:%progn - (jacl:%js "(~{}.setMacro().fvalue = ~{})" - ',name - (jacl:%lambda nil t - ,params - ,@(%if (%has-declare? body) `(,(%js "~{}.car" body))) - (block ,name ,@(%if (%has-declare? body) - (%js "~{}.cdr" body) - body)))) - ',name))) - -(\. *package* (|exportSymbol| (\. 'defun |name|))) -(defmacro defun (name params &rest body) - `(jacl:%progn - (jacl:%js "(~{}.fvalue = ~{})" + `(%progn + (%js "(~{}.setMacro().fvalue = ~{})" ',name - (jacl:%lambda ,name nil + (%lambda nil t ,params ,@(%if (%has-declare? body) `(,(%js "~{}.car" body))) (block ,name ,@(%if (%has-declare? body) (%js "~{}.cdr" body) body)))) + ',name))) + +(\. *package* (|exportSymbol| (\. 'defun |name|))) +(defmacro defun (name params &rest body) + `(%progn + (%js "(~{}.fvalue = ~{})" + ',name + (%lambda ,name nil + ,params + ,@(%if (%has-declare? body) `(,(%js "~{}.car" body))) + (block ,name ,@(%if (%has-declare? body) + (%js "~{}.cdr" body) + body)))) ',name)) (defun %export (symbol &optional (package *package*)) @@ -108,20 +108,20 @@ `(return-from nil ,expr)) (defun %debug (&rest objs) - (declare (jacl:rest-array)) + (declare (rest-array)) (%js "console.debug.apply(null, ~{})" objs)) (%export 'let) (defmacro let (bindings &rest body) - `(jacl:%let ,bindings ,@body)) + `(%let ,bindings ,@body)) (%export 'if) (defmacro if (test true-form &optional else-form) - `(jacl:%if ,test ,true-form ,else-form)) + `(%if ,test ,true-form ,else-form)) (%export 'progn) (defmacro progn (&rest forms) - `(jacl:%progn ,@forms)) + `(%progn ,@forms)) (%export 'prog1) (defmacro prog1 (first-form &rest forms) @@ -146,14 +146,14 @@ (%export 'defvar) (defmacro defvar (symbol &optional (value nil value?)) `(progn - (jacl:%js "~{}.isSpecial = true" ',symbol) - (when (jacl:%js "(((~{}.value === UNDEFINED) && ~{}) ? true : null)" ',symbol ,value?) - (jacl:%js "(~{}.value = ~{})" ',symbol ,value)) + (%js "~{}.isSpecial = true" ',symbol) + (when (%js "(((~{}.value === UNDEFINED) && ~{}) ? true : null)" ',symbol ,value?) + (%js "(~{}.value = ~{})" ',symbol ,value)) ',symbol)) (%export 'eq) (defun eq (x y) - (jacl:%js "~{} === ~{} ? true : null" x y)) + (%js "~{} === ~{} ? true : null" x y)) ;; TODO Real EQL (%export 'eql) @@ -168,22 +168,22 @@ (%export 'cons) (defun cons (car cdr) - (jacl:%new (jacl:%js "Cons") car cdr)) + (%new (%js "Cons") car cdr)) (%export 'car) (defun car (x) (when (not (null x)) - (jacl:\. x |car|))) + (\. x |car|))) (%export 'cdr) (defun cdr (x) (when (not (null x)) - (jacl:\. x |cdr|))) + (\. x |cdr|))) (%export 'rplacd) (defun rplacd (cons obj) ;; TODO type check - (jacl:%js "~{}.cdr=~{}" cons obj) + (%js "~{}.cdr=~{}" cons obj) cons) (%export 'cadr) @@ -215,59 +215,59 @@ (%export 'numberp) (defun numberp (x) - (jacl:%js "typeof ~{} === 'number' ? true : null" x)) + (%js "typeof ~{} === 'number' ? true : null" x)) (%export 'stringp) (defun stringp (x) - (jacl:%js "~{} instanceof LispString ? true : null" x)) + (%js "~{} instanceof LispString ? true : null" x)) (%export 'symbolp) (defun symbolp (x) - (jacl:%js "(~{} === null || ~{} instanceof LispSymbol) ? true : null" x x)) + (%js "(~{} === null || ~{} instanceof LispSymbol) ? true : null" x x)) (%export 'consp) (defun consp (x) - (jacl:%js "~{} instanceof Cons ? true : null" x)) + (%js "~{} instanceof Cons ? true : null" x)) (%export 'tagbody) (defmacro tagbody (&rest body) - `(jacl:%tagbody ,@body)) + `(%tagbody ,@body)) (%export 'go) (defmacro go (tag) - `(jacl:%go ,tag)) + `(%go ,tag)) (%export '*gensym-counter*) (defvar *gensym-counter* 0) (defmacro %type-error (expected-type) - `(jacl:%throw - (jacl:%new (jacl:%js "TypeError") - (jacl:%js "'Not a ' + ~{}.toString()" ,expected-type)))) + `(%throw + (%new (%js "TypeError") + (%js "'Not a ' + ~{}.toString()" ,expected-type)))) (%export 'set) (defun set (symbol value) (when (not (symbolp symbol)) (%type-error "symbol")) - (jacl:%js "(~{}.value = ~{})" symbol value)) + (%js "(~{}.value = ~{})" symbol value)) (%export '1+) (defun 1+ (x) (when (not (numberp x)) (%type-error "number")) - (jacl:%js "~{}+1" x)) + (%js "~{}+1" x)) (%export '1-) (defun 1- (x) (when (not (numberp x)) (%type-error "number")) - (jacl:%js "~{}-1" x)) + (%js "~{}-1" x)) (defun %aref (arr i) - (jacl:%js "~{}[~{}]" arr i)) + (%js "~{}[~{}]" arr i)) (%export '+) (defun + (&rest nums) - (declare (jacl:rest-array)) - (jacl:%js " + (declare (rest-array)) + (%js " var nums = ~{}, sum = 0; for(var i = 0; i < nums.length; i++) { var num = nums[i]; @@ -283,9 +283,9 @@ (%export '-) (defun - (minuend &rest subtrahends) - (declare (jacl:rest-array)) + (declare (rest-array)) (when (not (numberp minuend)) (%type-error "number")) - (jacl:%js " + (%js " var minuend = ~{}, subtrahends = ~{}; if (subtrahends.length) { for (var i = 0; i < subtrahends.length; i++) { @@ -346,7 +346,7 @@ (%export 'lambda) (defmacro lambda (params &rest body) - `(jacl:%lambda nil nil ,params ,@body)) + `(%lambda nil nil ,params ,@body)) (%export 'list) (defun list (&rest objects) @@ -354,7 +354,7 @@ (%export 'functionp) (defun functionp (x) - (jacl:%js "~{} instanceof Function ? true : null" x)) + (%js "~{} instanceof Function ? true : null" x)) (%export 'symbol-function) (defun symbol-function (symbol) @@ -377,7 +377,7 @@ (%export 'funcall) (defun funcall (function &rest args) - (declare (jacl:rest-array args)) + (declare (rest-array args)) (\. function (|apply| function args))) (defun %map-pairs (fun pairs) @@ -387,14 +387,14 @@ start (when (not pairs) (go end)) (when (not head) - (jacl:%setq head (list (funcall fun (car pairs) (cadr pairs)))) - (jacl:%setq tail head) + (%setq head (list (funcall fun (car pairs) (cadr pairs)))) + (%setq tail head) (go next)) (let ((new-tail (list (funcall fun (car pairs) (cadr pairs))))) (rplacd tail new-tail) - (jacl:%setq tail new-tail)) + (%setq tail new-tail)) next - (jacl:%setq pairs (cddr pairs)) + (%setq pairs (cddr pairs)) (go start) end) head)) @@ -402,7 +402,7 @@ (%export 'setq) (defmacro setq (&rest pairs) `(cl:progn - ,@(%map-pairs (lambda (x y) `(jacl:%setq ,x ,y)) pairs))) + ,@(%map-pairs (lambda (x y) `(%setq ,x ,y)) pairs))) (%export 'zerop) (defun zerop (x) @@ -412,12 +412,12 @@ (defun %> (x y) (when (not (numberp x)) (%type-error "number")) (when (not (numberp y)) (%type-error "number")) - (jacl:%js "~{}>~{}?true:null" x y)) + (%js "~{}>~{}?true:null" x y)) (defun %< (x y) (when (not (numberp x)) (%type-error "number")) (when (not (numberp y)) (%type-error "number")) - (jacl:%js "~{}<~{}?true:null" x y)) + (%js "~{}<~{}?true:null" x y)) (%export '>) (defun > (number &rest more-numbers) @@ -440,8 +440,8 @@ (%export '<) (defun < (num &rest nums) - (declare (jacl:rest-array)) - (let ((len (jacl:%dot nums |length|)) + (declare (rest-array)) + (let ((len (%dot nums |length|)) (ret t) (i 0)) (tagbody @@ -534,7 +534,7 @@ ;; start ;; (when syms ;; (%export (car syms) package) -;; (jacl:%setq syms (cdr syms)) +;; (%setq syms (cdr syms)) ;; (go start))))) ;; Use COMMON-LISP from COMMON-LISP-USER and switch to