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

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

7 files changed, 55 insertions, 65 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 2b03097c..c8e4b572 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2011-05-16  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* boot/ast.boot (bfAtScope): New.
+	* boot/parser.boot (bpDo): Accept scoped expressions.
+	* boot/translator.boot: Cleanup.
+
 2011-05-15  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* boot/tokens.boot: "do" is now a keyword.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 6472449b..61fc648a 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -164,6 +164,10 @@ bfPile(part) ==
 bfDo x ==
   x
 
+bfAtScope(s,x) ==
+  ["LET",[["*PACKAGE*",s]],x]
+TRACE bfAtScope  
+
 bfAppend: %List %List %Form -> %List %Form
 bfAppend ls ==
   ls isnt [l,:ls] => nil
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index db07d2f9..472d98ac 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -757,8 +757,13 @@ bpLeave() ==
     bpPush bfLeave bpPop1()
 
 ++ Do:
+++  IN Namespace Do
 ++  DO Assign
 bpDo() ==
+  bpEqKey "IN" =>
+    bpNamespace() or bpTrap()
+    bpDo() or bpTrap()
+    bpPush bfAtScope(bpPop2(),bpPop1())
   bpEqKey "DO" and (bpAssign() or bpTrap()) and bpPush bfDo bpPop1()
 
 ++ Return:
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"))
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 646e876d..749d0b6f 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -86,11 +86,8 @@ shoeCOMPILE_-FILE lspFileName ==
 BOOTTOCL(fn, out) ==
   try
     startCompileDuration()
-    callingPackage := namespace .
-    IN_-PACKAGE '"BOOTTRAN"
-    result := BOOTTOCLLINES(nil,fn, out)
-    setCurrentPackage callingPackage
-    result
+    in namespace BOOTTRAN do
+      BOOTTOCLLINES(nil,fn, out)
   finally endCompileDuration()
  
 ++ (bootclam "filename") translates the file "filename.boot" to
@@ -129,11 +126,8 @@ shoeClLines(a,fn,lines,outfn)==
 BOOTTOCLC(fn, out)==
   try
     startCompileDuration()
-    callingPackage := namespace .
-    IN_-PACKAGE '"BOOTTRAN"
-    result := BOOTTOCLCLINES(nil, fn, out)
-    setCurrentPackage callingPackage
-    result
+    in namespace BOOTTRAN do
+      BOOTTOCLCLINES(nil, fn, out)
   finally endCompileDuration()
  
 BOOTTOCLCLINES(lines, fn, outfn)==
@@ -688,11 +682,8 @@ shoePCompileTrees s==
     s := rest s
  
 bStreamPackageNull s==
-  a := namespace .
-  IN_-PACKAGE '"BOOTTRAN"
-  b:=bStreamNull s
-  setCurrentPackage a
-  b
+  in namespace BOOTTRAN do
+    bStreamNull s
  
 PSTTOMC string==
   $GenVarCounter: local := 0
@@ -727,13 +718,9 @@ BOOTPO() ==
   BOOTPO()
  
 PSTOUT string==
-  callingPackage := namespace .
-  IN_-PACKAGE '"BOOTTRAN"
-  $GenVarCounter: local := 0
-  result := shoeConsoleTrees shoeTransformString string
-  setCurrentPackage callingPackage
-  result
-
+  in namespace BOOTTRAN do
+    $GenVarCounter: local := 0
+    shoeConsoleTrees shoeTransformString string
 
 defaultBootToLispFile file ==
   strconc(pathBasename file, '".clisp")