From 3e326898dae226b97b4234ae45bf0eb2620176ec Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 29 May 2013 05:35:32 +0000
Subject: Add DB parameter to middle end functions.

---
 src/interp/c-util.boot       | 10 +++++-----
 src/interp/define.boot       | 10 +++++-----
 src/interp/lisp-backend.boot |  4 ++--
 src/interp/slam.boot         |  2 +-
 4 files changed, 13 insertions(+), 13 deletions(-)

(limited to 'src')

diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 0eaf1ad9..a5496abc 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1524,8 +1524,8 @@ proclaimCapsuleFunction(db,op,sig) ==
 ++ its values are cached, so that equal lists of argument values
 ++ yield equal values.  The arguments-value pairs are stored
 ++ in a hash table.  This backend compiler is used to compile constructors.
-backendCompileSPADSLAM: (%Symbol,%List %Symbol,%Code) -> %Symbol
-backendCompileSPADSLAM(name,args,body) ==
+backendCompileSPADSLAM: (%Database,%Symbol,%List %Symbol,%Code) -> %Symbol
+backendCompileSPADSLAM(db,name,args,body) ==
   al := mkCacheName name       -- global name for the cache hash table.
   auxfn := makeWorkerName name -- name of the worker function.
   g2 := gensym()               -- local name for the cache value.
@@ -1551,11 +1551,11 @@ backendCompileSPADSLAM(name,args,body) ==
   assembleCode [auxfn,["LAMBDA",args,:body]]
   assembleCode [name,["LAMBDA",args,code]]
 
-backendCompile2: %Code -> %Symbol
-backendCompile2 code ==
+backendCompile2: (%Maybe %Database,%Code) -> %Symbol
+backendCompile2 (db,code) ==
   code isnt [name,[type,args,:body]] =>
     systemError ['"parenthesis error in: ", code]
-  type = '%slam => backendCompileSPADSLAM(name,args,body)
+  type = '%slam => backendCompileSPADSLAM(db,name,args,body)
   assembleCode [name,[type,args,:body]]
 
 ++ returns all fuild variables contained in `x'.  Fuild variables are
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 62dce91b..7b9fbb4f 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1586,7 +1586,7 @@ compFunctorBody(db,body,m,e) ==
   T:= compOrCroak(body,m,e)
   $capsuleFunctionStack := reverse! $capsuleFunctionStack
   -- ??? Don't resolve default definitions, yet.
-  backendCompile
+  backendCompile(db,defs) where defs() ==
     $insideCategoryPackageIfTrue => $capsuleFunctionStack
     foldExportedFunctionReferences(db,$capsuleFunctionStack)
   clearCapsuleDirectory()        -- release storage.
@@ -2137,7 +2137,7 @@ spadCompileOrSetq(db,form is [nam,[lam,vl,body]]) ==
     $optExportedFunctionReference =>
       $capsuleFunctionStack := [form,:$capsuleFunctionStack]
       first form
-    first backendCompile [form]
+    first backendCompile(db,[form])
   compileConstructor(db,form)
  
 compileConstructor(db,form) ==
@@ -2153,14 +2153,14 @@ compileConstructor1(db,form:=[fn,[key,vl,:bodyl]]) ==
   dbConstructorKind db = 'category =>
     first compAndDefine(db,[[fn,['%slam,vl,:bodyl]]])
   dbInstanceCache db = nil =>
-    first backendCompile [[fn,['%lambda,vl,:bodyl]]]
+    first backendCompile(db,[[fn,['%lambda,vl,:bodyl]]])
   compHash(db,fn,vl,bodyl)
  
 ++ Subroutine of compileConstructor1.  Called to compile the body
 ++ of a category constructor definition.
 compAndDefine(db,l) ==
   $backend: local := function evalAndPrintBackendDecl
-  backendCompile l
+  backendCompile(db,l)
 
 compHash(db,op,argl,body) ==
 --   Entries will be stored on the global hashtable in a uniform way:
@@ -2194,7 +2194,7 @@ compHash(db,op,argl,body) ==
   if $reportCompilation then
     sayBrightlyI bright '"Generated code for function:"
     pp computeFunction
-  backendCompile [[op,['%lambda,argl,codeBody]],computeFunction]
+  backendCompile(db,[[op,['%lambda,argl,codeBody]],computeFunction])
   op
  
 constructMacro: %Form -> %Form
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index fddaabcd..1bb39713 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -1033,6 +1033,6 @@ backendCompile1 x ==
     formatToStdout('"~&~%;;;     ***       ~S REDEFINED~%",fname)
   [[fname,lamex],:$CLOSEDFNS]
 
-backendCompile l ==
-  [backendCompile2 f2 for f2 in [:backendCompile1(f1) for f1 in l]]
+backendCompile(db,l) ==
+  [backendCompile2(db,f2) for f2 in [:backendCompile1(f1) for f1 in l]]
 
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index d854a76d..7ee0d05d 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -407,7 +407,7 @@ compQuietly fn ==
   $backend: local :=
     $compileDontDefineFunctions => "COMPILE-DEFUN"
     "EVAL-DEFUN"
-  quietlyIfInteractive backendCompile fn
+  quietlyIfInteractive backendCompile(nil,fn)
 
 clearAllSlams x ==
   fn(x,nil) where
-- 
cgit v1.2.3