aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog6
-rw-r--r--src/boot/ast.boot4
-rw-r--r--src/boot/parser.boot5
-rw-r--r--src/boot/strap/ast.clisp5
-rw-r--r--src/boot/strap/parser.clisp10
-rw-r--r--src/boot/strap/translator.clisp59
-rw-r--r--src/boot/translator.boot31
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")