git » jacl.git » commit d246341

BLOCK progress

author Alan Dipert
2020-07-03 14:22:58 UTC
committer Alan Dipert
2020-07-03 14:22:58 UTC
parent 6bd1b12a1250ded3f60764b0421c6a05083ed68a

BLOCK progress

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)