Misc cleanup.

4 files changed, 60 insertions, 65 deletions

diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 50b70484..2ad1bd00 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -40,10 +40,10 @@ module c_-util where
   makeWorkerName: %Symbol -> %Symbol
   clearReplacement: %Symbol -> %Thing
   replaceSimpleFunctions: %Form -> %Form
-  foldExportedFunctionReferences: %List %Form -> %List %Form
+  foldExportedFunctionReferences: (%Database,%List %Code) -> %List %Code
   diagnoseUnknownType: (%Mode,%Env) -> %Form
   declareUnusedParameters: %Code -> %Code
-  registerFunctionReplacement: (%Symbol,%Form) -> %Thing
+  registerFunctionReplacement: (%Database,%Symbol,%Form) -> %Thing
   getSuccessEnvironment: (%Form,%Env) -> %Env
   getInverseEnvironment: (%Form,%Env) -> %Env
   giveVariableSomeValue: (%Symbol,%Mode,%Env) -> %Env
@@ -1309,12 +1309,12 @@ clearReplacement name ==
   property(name,'%redex) := nil
 
 ++ Register the inlinable form of a function.
-registerFunctionReplacement(name,body) ==
+registerFunctionReplacement(db,name,body) ==
   evalAndPrintBackendStmt
     ["PUT",MKQ name,MKQ "SPADreplace",quoteMinimally body]
 
 ++ Remember the redex form of this function
-registerRedexForm(name,parms,body) ==
+registerRedexForm(db,name,parms,body) ==
   evalAndPrintBackendStmt
     ["PUT",quote name,quote '%redex,quote ['ILAM,parms,body]]
 
@@ -1454,17 +1454,17 @@ almostPure? x ==
 ++ `defs' is a list of function definitions from the current domain.
 ++ Walk that list and replace references to unconditional operations
 ++ with their corresponding linkage names.  
-foldExportedFunctionReferences defs ==
+foldExportedFunctionReferences(db,defs) ==
   for fun in defs repeat
     fun isnt [name,lamex] => nil
     getFunctionReplacement name => nil
     lamex isnt ['%lambda,vars,body] => nil
     body := replaceSimpleFunctions body
     form := expandableDefinition?(vars,body) =>
-      registerFunctionReplacement(name,form)
+      registerFunctionReplacement(db,name,form)
       second(fun) := ["LAMBDA",vars,["DECLARE",["IGNORE",last vars]],body]
     if almostPure? body then
-      registerRedexForm(name,vars,body)
+      registerRedexForm(db,name,vars,body)
     lamex.absBody := body
   defs
 
@@ -1491,7 +1491,7 @@ setCompilerOptimizations level ==
 ++ Proclaim the type of the capsule function `op' with signature `sig'.
 ++ Note that all capsule functions take an additional argument 
 ++ standing for the domain of computation object.
-proclaimCapsuleFunction(op,sig) ==
+proclaimCapsuleFunction(db,op,sig) ==
   printBackendStmt
     ["DECLAIM",["FTYPE",
        ["FUNCTION",[:[vmType first d for d in tails rest sig],"%Shell"], 
diff --git a/src/interp/clam.boot b/src/interp/clam.boot
index 6b8cbaa9..c921e953 100644
--- a/src/interp/clam.boot
+++ b/src/interp/clam.boot
@@ -80,41 +80,6 @@ $clamList ==
 ++
 $failed := '"failed"
  
-compHash(op,argl,body) ==
---   Entries will be stored on the global hashtable in a uniform way:
---        (<argument list>, <reference count>,:<value>)
---   where the reference count is optional
-  auxfn := makeWorkerName op
-  cacheName := "$ConstructorCache"
-  g2 := gensym()  --value computed by calling function
-  putCode :=
-    argl = nil =>
-      ['CDDAR,['%store,['tableValue,cacheName,MKQ op],
-        ['%list,['%pair,'%nil,['%pair,1,[auxfn]]]]]]
-    [auxfn,:argl]
-  putCode :=
-     ['UNWIND_-PROTECT,['PROG1,putCode,['%store,g2,'%true]],
-                  ['%when,[['%not,g2],['tableRemove!,cacheName,MKQ op]]]]
-  getCode :=
-    argl = nil => ['tableValue,cacheName,MKQ op]
-    key :=
-      argl is [g] => ['%list,['devaluate,g]]
-      ['%list,:[['devaluate,x] for x in argl]]
-    ['lassocShiftWithFunction,key,
-      ['tableValue,cacheName,MKQ op],['%function,'domainEqualList]]
-  returnFoundValue :=
-    argl = nil => ['CDRwithIncrement,['CDAR,g2]]
-    ['CDRwithIncrement,g2]
-  codeBody := mkBind([[g2,getCode]],
-                ['%when,[g2,returnFoundValue],['%otherwise,putCode]])
- 
-  computeFunction := [auxfn,['%lambda,argl,:body]]
-  if $reportCompilation then
-    sayBrightlyI bright '"Generated code for function:"
-    pp computeFunction
-  compQuietly [[op,['%lambda,argl,codeBody]],computeFunction]
-  op
- 
 CDRwithIncrement x ==
   x.first := first x + 1
   rest x
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 464e8f00..ff3789aa 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1588,7 +1588,7 @@ compFunctorBody(db,body,m,e) ==
   -- ??? Don't resolve default definitions, yet.
   backendCompile
     $insideCategoryPackageIfTrue => $capsuleFunctionStack
-    foldExportedFunctionReferences $capsuleFunctionStack
+    foldExportedFunctionReferences(db,$capsuleFunctionStack)
   clearCapsuleDirectory()        -- release storage.
   body is [op,:.] and op in '(add CAPSULE) => T
   $NRTaddForm :=
@@ -1984,7 +1984,7 @@ compDefineCapsuleFunction(db,df is ['DEF,form,signature,body],
       updateCapsuleDirectory([n,:op'],pred)
     -- Let the backend know about this function's type
     if $optProclaim then
-      proclaimCapsuleFunction(op',signature)
+      proclaimCapsuleFunction(db,op',signature)
     clearReplacement op'   -- Make sure we have fresh info
     -- Finally, build a lambda expression for this function.
     fun :=
@@ -2120,10 +2120,10 @@ spadCompileOrSetq(db,form is [nam,[lam,vl,body]]) ==
     body := replaceSimpleFunctions body
 
   if nam' := forwardingCall?(vl,body) then
-      registerFunctionReplacement(nam,nam')
+      registerFunctionReplacement(db,nam,nam')
       sayBrightly ['"     ",:bright nam,'"is replaced by",:bright nam']
   else if macform := expandableDefinition?(vl,body) then
-    registerFunctionReplacement(nam,macform)
+    registerFunctionReplacement(db,nam,macform)
     [:vl',.] := vl
     sayBrightly ['"     ",:bright prefix2String [nam,:vl'],
                    '"is replaced by",:bright prefix2String body]
@@ -2154,7 +2154,42 @@ compileConstructor1(db,form:=[fn,[key,vl,:bodyl]]) ==
     first compAndDefine [[fn,['%slam,vl,:bodyl]]]
   dbInstanceCache db = nil =>
     first backendCompile [[fn,['%lambda,vl,:bodyl]]]
-  compHash(fn,vl,bodyl)
+  compHash(db,fn,vl,bodyl)
+ 
+compHash(db,op,argl,body) ==
+--   Entries will be stored on the global hashtable in a uniform way:
+--        (<argument list>, <reference count>,:<value>)
+--   where the reference count is optional
+  auxfn := makeWorkerName op
+  cacheName := "$ConstructorCache"
+  g2 := gensym()  --value computed by calling function
+  putCode :=
+    argl = nil =>
+      ['CDDAR,['%store,['tableValue,cacheName,MKQ op],
+        ['%list,['%pair,'%nil,['%pair,1,[auxfn]]]]]]
+    [auxfn,:argl]
+  putCode :=
+     ['UNWIND_-PROTECT,['PROG1,putCode,['%store,g2,'%true]],
+                  ['%when,[['%not,g2],['tableRemove!,cacheName,MKQ op]]]]
+  getCode :=
+    argl = nil => ['tableValue,cacheName,MKQ op]
+    key :=
+      argl is [g] => ['%list,['devaluate,g]]
+      ['%list,:[['devaluate,x] for x in argl]]
+    ['lassocShiftWithFunction,key,
+      ['tableValue,cacheName,MKQ op],['%function,'domainEqualList]]
+  returnFoundValue :=
+    argl = nil => ['CDRwithIncrement,['CDAR,g2]]
+    ['CDRwithIncrement,g2]
+  codeBody := mkBind([[g2,getCode]],
+                ['%when,[g2,returnFoundValue],['%otherwise,putCode]])
+ 
+  computeFunction := [auxfn,['%lambda,argl,:body]]
+  if $reportCompilation then
+    sayBrightlyI bright '"Generated code for function:"
+    pp computeFunction
+  backendCompile [[op,['%lambda,argl,codeBody]],computeFunction]
+  op
  
 constructMacro: %Form -> %Form
 constructMacro (form is [nam,[lam,vl,body]]) ==
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index ded60ffa..16cd8bcb 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -392,26 +392,21 @@ clearLocalModemaps x ==
   $e
  
 compileInteractive fn ==
-  if $InteractiveMode then startTimingProcess 'compilation
-  if fn is [.,[bindOp,.,.]] and abstractionOperator? bindOp then
-    fn := [first fn,declareUnusedParameters second fn]
-  if $reportCompilation then
-    sayBrightlyI bright '"Generated LISP code for function:"
-    pp fn
-  optfn :=
-     $InteractiveMode => [timedOptimization fn]
-     [fn]
-  result := compQuietly optfn
-  if $InteractiveMode then stopTimingProcess 'compilation
-  result
+  try
+    startTimingProcess 'compilation
+    if fn is [.,[bindOp,.,.]] and abstractionOperator? bindOp then
+      fn := [first fn,declareUnusedParameters second fn]
+    if $reportCompilation then
+      sayBrightlyI bright '"Generated LISP code for function:"
+      pp fn
+    compQuietly [timedOptimization fn]
+  finally stopTimingProcess 'compilation
 
 ++ Subroutine of compileInteractive.
 compQuietly fn ==
-  _*COMP370_-APPLY_* :=
-    $InteractiveMode =>
-      $compileDontDefineFunctions => "COMPILE-DEFUN"
-      "EVAL-DEFUN"
-    function printBackendDecl
+  _*COMP370_-APPLY_*: local :=
+    $compileDontDefineFunctions => "COMPILE-DEFUN"
+    "EVAL-DEFUN"
   quietlyIfInteractive backendCompile fn
 
 clearAllSlams x ==