author | Alan Dipert
<alan@dipert.org> 2020-07-03 14:22:58 UTC |
committer | Alan Dipert
<alan@dipert.org> 2020-07-03 14:22:58 UTC |
parent | 6bd1b12a1250ded3f60764b0421c6a05083ed68a |
boot.lisp | +25 | -12 |
jacl-tests.lisp | +4 | -0 |
diff --git a/boot.lisp b/boot.lisp index 66b48dc..90ea7c1 100644 --- a/boot.lisp +++ b/boot.lisp @@ -39,19 +39,41 @@ (\. *package* (|exportSymbol| (\. 'defmacro |name|))) (%js "(~{}.setMacro().fvalue = ~{})" 'defmacro - (%lambda nil t (name params &rest body) + (%lambda nil t + (name + params + &body body + &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 ,@body)) + (jacl:%lambda nil t + ,params + (%let ((,vname# nil)) + (%tagbody (%setq ,vname# (%progn ,@body)) + ,labelname#) + ,vname#))) ',name))) +(\. *package* (|exportSymbol| (\. 'block |name|))) +(defmacro block (block-name &body forms) + (jacl:%let ((vname# (%internal-name "BLOCK-VALUE" block-name)) + (labelname# (%internal-name "BLOCK-LABEL" block-name))) + `(%let ((,vname# nil)) + (jacl:%tagbody (%setq ,vname# (%progn ,@forms)) + ,labelname#) + ,vname#))) + (\. *package* (|exportSymbol| (\. 'defun |name|))) (defmacro defun (name params &rest body) `(jacl:%progn (jacl:%js "(~{}.fvalue = ~{})" ',name - (jacl:%lambda ,name nil ,params ,@body)) + (jacl:%lambda ,name nil + ,params + (block ,name ,@body))) ',name)) (defun %export (symbol &optional (package *package*)) @@ -422,15 +444,6 @@ (defmacro return (expr) `(return-from nil ,expr)) -(%export 'block) -(defmacro block (block-name &body forms) - (let ((vname# (%internal-name "BLOCK-VALUE" block-name)) - (labelname# (%internal-name "BLOCK-LABEL" block-name))) - `(let ((,vname# nil)) - (tagbody (setq ,vname# (progn ,@forms)) - ,labelname#) - ,vname#))) - (%export 'dolist) (defmacro dolist (binding &rest body) (let ((var (car binding)) diff --git a/jacl-tests.lisp b/jacl-tests.lisp index 6292810..b147b55 100644 --- a/jacl-tests.lisp +++ b/jacl-tests.lisp @@ -247,3 +247,7 @@ ;; eval: (put 'with-label 'lisp-indent-function 1) ;; eval: (put 'with-read 'lisp-indent-function 1) ;; End: + +(defun snoob (&rest rest &aux (x "snoob")) + (log x)) +(snoob)