git » jacl.git » commit 05b6ff5

Implicit BLOCK in DEFUN and DEFMACRO, credit John Soo

author Alan Dipert
2020-07-03 20:50:36 UTC
committer Alan Dipert
2020-07-03 20:50:36 UTC
parent d246341268f5f0f632fffa65ceb66ead0affe908

Implicit BLOCK in DEFUN and DEFMACRO, credit John Soo

boot.lisp +16 -2

diff --git a/boot.lisp b/boot.lisp
index 90ea7c1..68f3c21 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -36,6 +36,12 @@
              name
              name)))))
 
+(%js "~(~{}.fvalue = ~{})"
+     '%has-declare?
+     (%lambda nil nil
+       (body)
+       (%js "(List.isProperList(~{}) && List.isProperList(~{}.car) && ~{}.car.car === Package.get('COMMON-LISP').intern('DECLARE')) ? true : null" body body body)))
+
 (\. *package* (|exportSymbol| (\. 'defmacro |name|)))
 (%js "(~{}.setMacro().fvalue = ~{})"
      'defmacro
@@ -51,8 +57,13 @@
             ',name
             (jacl:%lambda nil t
               ,params
+              ,@(%if (%has-declare? body) `(,(%js "~{}.car" body)))
               (%let ((,vname# nil))
-                    (%tagbody (%setq ,vname# (%progn ,@body))
+                    (%tagbody (%setq ,vname#
+                                     (%progn
+                                      ,@(%if (%has-declare? body)
+                                             (%js "~{}.cdr" body)
+                                             body)))
                               ,labelname#)
                     ,vname#)))
           ',name)))
@@ -73,7 +84,10 @@
        ',name
        (jacl:%lambda ,name nil
          ,params
-         (block ,name ,@body)))
+         ,@(%if (%has-declare? body) `(,(%js "~{}.car" body)))
+         (block ,name ,@(%if (%has-declare? body)
+                             (%js "~{}.cdr" body)
+                             body))))
      ',name))
 
 (defun %export (symbol &optional (package *package*))