git » jacl.git » commit 46f96c0

Move BLOCK up

author Alan Dipert
2020-07-04 04:03:24 UTC
committer Alan Dipert
2020-07-04 04:03:24 UTC
parent cb9b8b856fccd99f27b01a8b6c36c22ce9be1016

Move BLOCK up

boot.lisp +29 -36

diff --git a/boot.lisp b/boot.lisp
index 39bdef9..c8f39de 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -36,6 +36,20 @@
              name
              name)))))
 
+(\. *package* (|exportSymbol| (\. 'block |name|)))
+(%js "(~{}.setMacro().fvalue = ~{})"
+     'block
+     (%lambda nil t
+       (block-name
+        &body forms
+        &aux
+        (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#)))
+
 (%js "~(~{}.fvalue = ~{})"
      '%has-declare?
      (%lambda nil nil
@@ -58,25 +72,11 @@
             (jacl:%lambda nil t
               ,params
               ,@(%if (%has-declare? body) `(,(%js "~{}.car" body)))
-              (%let ((,vname# nil))
-                    (%tagbody (%setq ,vname#
-                                     (%progn
-                                      ,@(%if (%has-declare? body)
-                                             (%js "~{}.cdr" body)
-                                             body)))
-                              ,labelname#)
-                    ,vname#)))
+              (block ,name ,@(%if (%has-declare? body)
+                                  (%js "~{}.cdr" body)
+                                  body))))
           ',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
@@ -93,6 +93,18 @@
 (defun %export (symbol &optional (package *package*))
   (\. package (|exportSymbol| (\. symbol |name|))))
 
+(%export 'return-from)
+(defmacro return-from (block-name expr
+                       &aux
+                         (vname# (%internal-name "BLOCK-VALUE" block-name))
+                         (labelname# (%internal-name "BLOCK-LABEL" block-name)))
+  `(%progn (%setq ,vname# ,expr)
+           (%go ,labelname)))
+
+(%export 'return)
+(defmacro return (expr)
+  `(return-from nil ,expr))
+
 (defun %debug (&rest objs)
   (declare (jacl:rest-array))
   (%js "console.debug.apply(null, ~{})" objs))
@@ -439,25 +451,6 @@
       "NIL"
       (\. symbol |name|)))
 
-(defun %internal-name (prefix-string name)
-  (\.
-   (%js "Package")
-   (|get| (\. "JACL" (|toString|)))
-   (|intern| (%js "('INTERNAL-' + ~{}.toString() + '-' + ~{})"
-                  prefix-string
-                  (symbol-name name)))))
-
-(%export 'return-from)
-(defmacro return-from (block-name expr)
-  (let ((vname# (%internal-name "BLOCK-VALUE" block-name))
-        (labelname# (%internal-name "BLOCK-LABEL" block-name)))
-    `(progn (setq ,vname# ,expr)
-            (go ,labelname#))))
-
-(%export 'return)
-(defmacro return (expr)
-  `(return-from nil ,expr))
-
 (%export 'dolist)
 (defmacro dolist (binding &rest body)
   (let ((var (car binding))