diff options
Diffstat (limited to 'src/boot')
| -rw-r--r-- | src/boot/ast.boot | 4 | ||||
| -rw-r--r-- | src/boot/parser.boot | 5 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 5 | ||||
| -rw-r--r-- | src/boot/strap/parser.clisp | 10 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 59 | ||||
| -rw-r--r-- | src/boot/translator.boot | 31 |
6 files changed, 49 insertions, 65 deletions
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") |