* 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.

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|)