diff options
Diffstat (limited to 'src/boot/strap')
| -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 |
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")) |