diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/boot/ChangeLog | 18 | ||||
| -rw-r--r-- | src/boot/ast.boot.pamphlet | 8 | ||||
| -rw-r--r-- | src/boot/translator.boot.pamphlet | 81 |
3 files changed, 53 insertions, 54 deletions
diff --git a/src/boot/ChangeLog b/src/boot/ChangeLog index cf785f41..54c0e0fc 100644 --- a/src/boot/ChangeLog +++ b/src/boot/ChangeLog @@ -1,3 +1,21 @@ +2007-11-17 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * ast.boot.pamphlet ($bfCamming): Define as global. + Update cached Lisp translation. + * translator.boot.pamphlet (BOOTTOCL): Don't set $bfClamming. + (BOOTCLAMLINES): Likewise. + (BOOTCLAM): Don't set it. + (BOOTTOCLCLINES): Likewise. + (BOOTTOMC): Likewise. + (EVAL_-BOOT_-FILE): Likewise. + (BO): Likewise. + (STEVAL): Likewise. + (STTOMC): Likewise. + (FC): Likewise. + (PSTTOMC): Likewise. + (BOOTLOOP): Likewise. + Update cached Lisp translation. + 2007-10-27 Gabriel Dos Reis <gdr@cs.tamu.edu> * ast.boot.pamphlet (bfLp1): Simplify loop code generation. diff --git a/src/boot/ast.boot.pamphlet b/src/boot/ast.boot.pamphlet index 20371331..ab47df8a 100644 --- a/src/boot/ast.boot.pamphlet +++ b/src/boot/ast.boot.pamphlet @@ -123,6 +123,12 @@ module '"boot-ast" import '"includer" )package "BOOTTRAN" + +++ True means that Boot functions should be translated to use +++ hash tables to remember values. By default, functions are +++ translated with the obvious semantics, e.g. no caching. +$bfClamming := false + <<abstract syntax tree>> -- TRUE if we are currently building the syntax tree for an 'is' @@ -1110,6 +1116,8 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1)) (IN-PACKAGE "BOOTTRAN") +(DEFPARAMETER |$bfClamming| NIL) + (DEFTYPE |String| () 'STRING) (DEFTYPE |Symbol| () 'SYMBOL) diff --git a/src/boot/translator.boot.pamphlet b/src/boot/translator.boot.pamphlet index 406820b1..f64e35e5 100644 --- a/src/boot/translator.boot.pamphlet +++ b/src/boot/translator.boot.pamphlet @@ -132,19 +132,19 @@ shoeCOMPILE_-FILE lspFileName == -- the common lisp file "filename.clisp" BOOTTOCL(fn, out) == - $bfClamming:local:=false - BOOTTOCLLINES(nil,fn, out) + BOOTTOCLLINES(nil,fn, out) -- (bootclam "filename") translates the file "filename.boot" to -- the common lisp file "filename.clisp" , producing, for each function -- a hash table to store previously computed values indexed by argument -- list. -BOOTCLAM(fn, out) == BOOTCLAMLINES(nil,fn, out) +BOOTCLAM(fn, out) == + $bfClamming := true + BOOTCLAMLINES(nil,fn, out) BOOTCLAMLINES(lines, fn, out) == - $bfClamming:local:=true - BOOTTOCLLINES(lines, fn, out) + BOOTTOCLLINES(lines, fn, out) <<BOOTTOCLLINES>> shoeClLines(a,fn,lines,outfn)== @@ -166,7 +166,6 @@ BOOTTOCLC(fn, out)==BOOTTOCLCLINES(nil, fn, out) BOOTTOCLCLINES(lines, fn, outfn)== callingPackage := _*PACKAGE_* IN_-PACKAGE '"BOOTTRAN" - $bfClamming:local:=false infn:=shoeAddbootIfNec fn result := shoeOpenInputFile(a,infn, shoeClCLines(a,fn,lines,outfn)) @@ -191,7 +190,6 @@ shoeClCLines(a,fn,lines,outfn)== BOOTTOMC fn== callingPackage := _*PACKAGE_* IN_-PACKAGE '"BOOTTRAN" - $bfClamming:local:=false $GenVarCounter:local := 0 infn:=shoeAddbootIfNec fn result := shoeOpenInputFile(a,infn,shoeMc(a,fn)) @@ -208,7 +206,6 @@ shoeMc(a,fn)== EVAL_-BOOT_-FILE fn == b := _*PACKAGE_* IN_-PACKAGE '"BOOTTRAN" - $bfClamming:local:=false infn:=shoeAddbootIfNec fn outfn:=CONCAT(shoeRemovebootIfNec fn,'".",_*LISP_-SOURCE_-FILETYPE_*) shoeOpenInputFile(a,infn,shoeClLines(a,infn,[],outfn)) @@ -222,7 +219,6 @@ BO fn== b := _*PACKAGE_* IN_-PACKAGE '"BOOTTRAN" $GenVarCounter:local := 0 - $bfClamming:local := false infn:=shoeAddbootIfNec fn shoeOpenInputFile(a,infn,shoeToConsole(a,fn)) setCurrentPackage b @@ -256,7 +252,6 @@ STEVAL string== callingPackage := _*PACKAGE_* IN_-PACKAGE '"BOOTTRAN" $GenVarCounter:local := 0 - $bfClamming:local:=false a:= shoeTransformString [string] result := bStreamPackageNull a => nil @@ -272,7 +267,6 @@ STTOMC string== callingPackage := _*PACKAGE_* IN_-PACKAGE '"BOOTTRAN" $GenVarCounter:local := 0 - $bfClamming:local:=false a:= shoeTransformString [string] result := bStreamPackageNull a => nil @@ -722,7 +716,6 @@ shoePCompile fn== EVAL fn FC(name,fn)== - $bfClamming:local:=false $GenVarCounter:local := 0 infn:=shoeAddbootIfNec fn shoeOpenInputFile(a,infn,shoeFindName(fn,name, a)) @@ -745,7 +738,6 @@ bStreamPackageNull s== PSTTOMC string== $GenVarCounter:local := 0 - $bfClamming:local:=false shoePCompileTrees shoeTransformString string BOOTLOOP ()== @@ -780,7 +772,6 @@ PSTOUT string== callingPackage := _*PACKAGE_* IN_-PACKAGE '"BOOTTRAN" $GenVarCounter:local := 0 - $bfClamming:local:=false result := shoeConsoleTrees shoeTransformString string setCurrentPackage callingPackage result @@ -840,21 +831,16 @@ associateRequestWithFileType(Option '"compile", '"boot", (PROG () (RETURN (COMPILE-FILE |lspFileName|)))) (DEFUN BOOTTOCL (|fn| |out|) - (PROG (|$bfClamming|) - (DECLARE (SPECIAL |$bfClamming|)) - (RETURN - (PROGN (SETQ |$bfClamming| NIL) (BOOTTOCLLINES NIL |fn| |out|))))) + (PROG () (RETURN (BOOTTOCLLINES NIL |fn| |out|)))) (DEFUN BOOTCLAM (|fn| |out|) - (PROG () (RETURN (BOOTCLAMLINES NIL |fn| |out|)))) - -(DEFUN BOOTCLAMLINES (|lines| |fn| |out|) - (PROG (|$bfClamming|) + (PROG () (DECLARE (SPECIAL |$bfClamming|)) (RETURN - (PROGN - (SETQ |$bfClamming| T) - (BOOTTOCLLINES |lines| |fn| |out|))))) + (PROGN (SETQ |$bfClamming| T) (BOOTCLAMLINES NIL |fn| |out|))))) + +(DEFUN BOOTCLAMLINES (|lines| |fn| |out|) + (PROG () (RETURN (BOOTTOCLLINES |lines| |fn| |out|)))) (DEFUN BOOTTOCLLINES (|lines| |fn| |outfn|) (PROG (|result| |infn| |callingPackage|) @@ -894,13 +880,11 @@ associateRequestWithFileType(Option '"compile", '"boot", (PROG () (RETURN (BOOTTOCLCLINES NIL |fn| |out|)))) (DEFUN BOOTTOCLCLINES (|lines| |fn| |outfn|) - (PROG (|$bfClamming| |result| |infn| |callingPackage|) - (DECLARE (SPECIAL |$bfClamming|)) + (PROG (|result| |infn| |callingPackage|) (RETURN (PROGN (SETQ |callingPackage| *PACKAGE*) (IN-PACKAGE "BOOTTRAN") - (SETQ |$bfClamming| NIL) (SETQ |infn| (|shoeAddbootIfNec| |fn|)) (SETQ |result| (|shoeOpenInputFile| |a| |infn| @@ -933,14 +917,12 @@ associateRequestWithFileType(Option '"compile", '"boot", |outfn|))))) (DEFUN BOOTTOMC (|fn|) - (PROG (|$GenVarCounter| |$bfClamming| |result| |infn| - |callingPackage|) - (DECLARE (SPECIAL |$GenVarCounter| |$bfClamming|)) + (PROG (|$GenVarCounter| |result| |infn| |callingPackage|) + (DECLARE (SPECIAL |$GenVarCounter|)) (RETURN (PROGN (SETQ |callingPackage| *PACKAGE*) (IN-PACKAGE "BOOTTRAN") - (SETQ |$bfClamming| NIL) (SETQ |$GenVarCounter| 0) (SETQ |infn| (|shoeAddbootIfNec| |fn|)) (SETQ |result| @@ -957,13 +939,11 @@ associateRequestWithFileType(Option '"compile", '"boot", (|shoeConsole| (CONCAT |fn| " COMPILED AND LOADED"))))))) (DEFUN EVAL-BOOT-FILE (|fn|) - (PROG (|$bfClamming| |outfn| |infn| |b|) - (DECLARE (SPECIAL |$bfClamming|)) + (PROG (|outfn| |infn| |b|) (RETURN (PROGN (SETQ |b| *PACKAGE*) (IN-PACKAGE "BOOTTRAN") - (SETQ |$bfClamming| NIL) (SETQ |infn| (|shoeAddbootIfNec| |fn|)) (SETQ |outfn| (CONCAT (|shoeRemovebootIfNec| |fn|) "." @@ -974,14 +954,13 @@ associateRequestWithFileType(Option '"compile", '"boot", (LOAD |outfn|))))) (DEFUN BO (|fn|) - (PROG (|$bfClamming| |$GenVarCounter| |infn| |b|) - (DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|)) + (PROG (|$GenVarCounter| |infn| |b|) + (DECLARE (SPECIAL |$GenVarCounter|)) (RETURN (PROGN (SETQ |b| *PACKAGE*) (IN-PACKAGE "BOOTTRAN") (SETQ |$GenVarCounter| 0) - (SETQ |$bfClamming| NIL) (SETQ |infn| (|shoeAddbootIfNec| |fn|)) (|shoeOpenInputFile| |a| |infn| (|shoeToConsole| |a| |fn|)) (|setCurrentPackage| |b|))))) @@ -1017,15 +996,13 @@ associateRequestWithFileType(Option '"compile", '"boot", (DEFUN STOUT (|string|) (PROG () (RETURN (PSTOUT (LIST |string|))))) (DEFUN STEVAL (|string|) - (PROG (|$bfClamming| |$GenVarCounter| |result| |fn| |a| - |callingPackage|) - (DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|)) + (PROG (|$GenVarCounter| |result| |fn| |a| |callingPackage|) + (DECLARE (SPECIAL |$GenVarCounter|)) (RETURN (PROGN (SETQ |callingPackage| *PACKAGE*) (IN-PACKAGE "BOOTTRAN") (SETQ |$GenVarCounter| 0) - (SETQ |$bfClamming| NIL) (SETQ |a| (|shoeTransformString| (LIST |string|))) (SETQ |result| (COND @@ -1040,14 +1017,13 @@ associateRequestWithFileType(Option '"compile", '"boot", |result|)))) (DEFUN STTOMC (|string|) - (PROG (|$bfClamming| |$GenVarCounter| |result| |a| |callingPackage|) - (DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|)) + (PROG (|$GenVarCounter| |result| |a| |callingPackage|) + (DECLARE (SPECIAL |$GenVarCounter|)) (RETURN (PROGN (SETQ |callingPackage| *PACKAGE*) (IN-PACKAGE "BOOTTRAN") (SETQ |$GenVarCounter| 0) - (SETQ |$bfClamming| NIL) (SETQ |a| (|shoeTransformString| (LIST |string|))) (SETQ |result| (COND @@ -1800,11 +1776,10 @@ associateRequestWithFileType(Option '"compile", '"boot", ('T (EVAL |fn|))))))) (DEFUN FC (|name| |fn|) - (PROG (|$GenVarCounter| |$bfClamming| |infn|) - (DECLARE (SPECIAL |$GenVarCounter| |$bfClamming|)) + (PROG (|$GenVarCounter| |infn|) + (DECLARE (SPECIAL |$GenVarCounter|)) (RETURN (PROGN - (SETQ |$bfClamming| NIL) (SETQ |$GenVarCounter| 0) (SETQ |infn| (|shoeAddbootIfNec| |fn|)) (|shoeOpenInputFile| |a| |infn| @@ -1839,12 +1814,11 @@ associateRequestWithFileType(Option '"compile", '"boot", |b|)))) (DEFUN PSTTOMC (|string|) - (PROG (|$bfClamming| |$GenVarCounter|) - (DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|)) + (PROG (|$GenVarCounter|) + (DECLARE (SPECIAL |$GenVarCounter|)) (RETURN (PROGN (SETQ |$GenVarCounter| 0) - (SETQ |$bfClamming| NIL) (|shoePCompileTrees| (|shoeTransformString| |string|)))))) (DEFUN BOOTLOOP () @@ -1888,14 +1862,13 @@ associateRequestWithFileType(Option '"compile", '"boot", (#0# (PROGN (PSTOUT (LIST |a|)) (BOOTPO))))))))))) (DEFUN PSTOUT (|string|) - (PROG (|$bfClamming| |$GenVarCounter| |result| |callingPackage|) - (DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|)) + (PROG (|$GenVarCounter| |result| |callingPackage|) + (DECLARE (SPECIAL |$GenVarCounter|)) (RETURN (PROGN (SETQ |callingPackage| *PACKAGE*) (IN-PACKAGE "BOOTTRAN") (SETQ |$GenVarCounter| 0) - (SETQ |$bfClamming| NIL) (SETQ |result| (|shoeConsoleTrees| (|shoeTransformString| |string|))) (|setCurrentPackage| |callingPackage|) |