* boot/ast.boot (bfAtScope): New.

	* boot/parser.boot (bpDo): Accept scoped expressions.
	* boot/translator.boot: Cleanup.

3 files changed, 31 insertions, 43 deletions

diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 74194f69..d0e75830 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -199,6 +199,11 @@
 
 (DEFUN |bfDo| (|x|) |x|)
 
+(DEFUN |bfAtScope| (|s| |x|)
+  (LIST 'LET (LIST (LIST '*PACKAGE* |s|)) |x|))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) (TRACE |bfAtScope|))
+
 (DECLAIM (FTYPE (FUNCTION ((|%List| (|%List| |%Form|)))
                     (|%List| |%Form|))
                 |bfAppend|))
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 06dc31e3..11213e00 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -356,7 +356,7 @@
           (COND
             (|done| (RETURN NIL))
             (T (SETQ |found|
-                     (LET ((#0=#:G1354
+                     (LET ((#0=#:G1355
                                (CATCH :OPEN-AXIOM-CATCH-POINT
                                  (APPLY |f| NIL))))
                        (COND
@@ -819,8 +819,12 @@
        (|bpPush| (|bfLeave| (|bpPop1|)))))
 
 (DEFUN |bpDo| ()
-  (AND (|bpEqKey| 'DO) (OR (|bpAssign|) (|bpTrap|))
-       (|bpPush| (|bfDo| (|bpPop1|)))))
+  (COND
+    ((|bpEqKey| 'IN) (OR (|bpNamespace|) (|bpTrap|))
+     (OR (|bpDo|) (|bpTrap|))
+     (|bpPush| (|bfAtScope| (|bpPop2|) (|bpPop1|))))
+    (T (AND (|bpEqKey| 'DO) (OR (|bpAssign|) (|bpTrap|))
+            (|bpPush| (|bfDo| (|bpPop1|)))))))
 
 (DEFUN |bpReturn| ()
   (OR (AND (|bpEqKey| 'RETURN) (OR (|bpAssign|) (|bpTrap|))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index cff39c1b..25f4332d 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -128,17 +128,12 @@
   (COMPILE-FILE |lspFileName|))
 
 (DEFUN BOOTTOCL (|fn| |out|)
-  (PROG (|result| |callingPackage|)
-    (RETURN
-      (UNWIND-PROTECT
-        (PROGN
-          (|startCompileDuration|)
-          (SETQ |callingPackage| *PACKAGE*)
-          (IN-PACKAGE "BOOTTRAN")
-          (SETQ |result| (BOOTTOCLLINES NIL |fn| |out|))
-          (|setCurrentPackage| |callingPackage|)
-          |result|)
-        (|endCompileDuration|)))))
+  (UNWIND-PROTECT
+    (PROGN
+      (|startCompileDuration|)
+      (LET ((*PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
+        (BOOTTOCLLINES NIL |fn| |out|)))
+    (|endCompileDuration|)))
 
 (DEFUN BOOTCLAM (|fn| |out|)
   (PROG (|$bfClamming|)
@@ -183,17 +178,12 @@
              (|closeFile| |stream|)))))))
 
 (DEFUN BOOTTOCLC (|fn| |out|)
-  (PROG (|result| |callingPackage|)
-    (RETURN
-      (UNWIND-PROTECT
-        (PROGN
-          (|startCompileDuration|)
-          (SETQ |callingPackage| *PACKAGE*)
-          (IN-PACKAGE "BOOTTRAN")
-          (SETQ |result| (BOOTTOCLCLINES NIL |fn| |out|))
-          (|setCurrentPackage| |callingPackage|)
-          |result|)
-        (|endCompileDuration|)))))
+  (UNWIND-PROTECT
+    (PROGN
+      (|startCompileDuration|)
+      (LET ((*PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
+        (BOOTTOCLCLINES NIL |fn| |out|)))
+    (|endCompileDuration|)))
 
 (DEFUN BOOTTOCLCLINES (|lines| |fn| |outfn|)
   (PROG (|a|)
@@ -538,7 +528,7 @@
         (SETQ |$bpParenCount| 0)
         (|bpFirstTok|)
         (SETQ |found|
-              (LET ((#0=#:G1364
+              (LET ((#0=#:G1365
                         (CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem|))))
                 (COND
                   ((AND (CONSP #0#)
@@ -1242,14 +1232,7 @@
          (SETQ |s| (CDR |s|))))))
 
 (DEFUN |bStreamPackageNull| (|s|)
-  (PROG (|b| |a|)
-    (RETURN
-      (PROGN
-        (SETQ |a| *PACKAGE*)
-        (IN-PACKAGE "BOOTTRAN")
-        (SETQ |b| (|bStreamNull| |s|))
-        (|setCurrentPackage| |a|)
-        |b|))))
+  (LET ((*PACKAGE* (FIND-PACKAGE "BOOTTRAN"))) (|bStreamNull| |s|)))
 
 (DEFUN PSTTOMC (|string|)
   (PROG (|$GenVarCounter|)
@@ -1290,17 +1273,13 @@
                (T (PSTOUT (LIST |a|)) (BOOTPO)))))))))
 
 (DEFUN PSTOUT (|string|)
-  (PROG (|$GenVarCounter| |result| |callingPackage|)
+  (PROG (|$GenVarCounter|)
     (DECLARE (SPECIAL |$GenVarCounter|))
     (RETURN
-      (PROGN
-        (SETQ |callingPackage| *PACKAGE*)
-        (IN-PACKAGE "BOOTTRAN")
-        (SETQ |$GenVarCounter| 0)
-        (SETQ |result|
-              (|shoeConsoleTrees| (|shoeTransformString| |string|)))
-        (|setCurrentPackage| |callingPackage|)
-        |result|))))
+      (LET ((*PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
+        (PROGN
+          (SETQ |$GenVarCounter| 0)
+          (|shoeConsoleTrees| (|shoeTransformString| |string|)))))))
 
 (DEFUN |defaultBootToLispFile| (|file|)
   (CONCAT (|pathBasename| |file|) ".clisp"))