Have constructor definition compilers take a DB parameter.

3 files changed, 28 insertions, 24 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 0f7983ef..8adfcbcc 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,12 @@
 2013-05-28  Gabriel Dos Reis  <gdr@integrable-solutions.net>
 
+	* interp/define.boot (compDefineCategory1): Take DB parameter.
+	(compDefineCategory2): Likewise.
+	(compDefineFunctor1): Likewise.
+	* interp/lisplib.boot (compDefineLisplib): Likewise.
+
+2013-05-28  Gabriel Dos Reis  <gdr@integrable-solutions.net>
+
 	* interp/sys-globals.boot ($domainShell): Remove.
 	* interp/c-util.boot (%CompilationData): Add shell field.
 	(dbDomainShell): New accessor.  Replace $domainShell variable.
diff --git a/src/interp/define.boot b/src/interp/define.boot
index bb4f541a..f4b2887e 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -980,7 +980,7 @@ evalCategoryForm(x,e) ==
 skipCategoryPackage? capsule ==
   null capsule or $bootStrapMode
 
-compDefineCategory1(df is ['DEF,form,sig,body],m,e,fal) ==
+compDefineCategory1(db,df is ['DEF,form,sig,body],m,e,fal) ==
   categoryCapsule :=
     body is ['add,cat,capsule] =>
       body := cat
@@ -988,11 +988,10 @@ compDefineCategory1(df is ['DEF,form,sig,body],m,e,fal) ==
     nil
   if form isnt [.,:.] then
     form := [form]
-  [d,m,e]:= compDefineCategory2(form,sig,body,m,e,fal)
+  [d,m,e]:= compDefineCategory2(db,form,sig,body,m,e,fal)
   if not skipCategoryPackage? categoryCapsule then [.,.,e] :=
     $insideCategoryPackageIfTrue: local := true
-    $categoryPredicateList: local :=
-        makeCategoryPredicates(form,dbCategory constructorDB form.op)
+    $categoryPredicateList: local := makeCategoryPredicates(form,dbCategory db)
     defaults := mkCategoryPackage(form,cat,categoryCapsule)
     T := compDefine1(nil,defaults,$EmptyMode,e)
            or return stackSemanticError(
@@ -1108,7 +1107,7 @@ getArgumentModeOrMoan(x,form,e) ==
   getArgumentMode(x,e) or
     stackSemanticError(["argument ",x," of ",form," is not declared"],nil)
 
-compDefineCategory2(form,signature,body,m,e,$formalArgList) ==
+compDefineCategory2(db,form,signature,body,m,e,$formalArgList) ==
     --1. bind global variables
     $prefix: local := nil
     $op: local := form.op
@@ -1120,9 +1119,6 @@ compDefineCategory2(form,signature,body,m,e,$formalArgList) ==
     $currentCategoryBody : local := body
          --Set in DomainSubstitutionFunction, used further down
     -- 1.1  augment e to add declaration $: <form>
-    db := constructorDB $op
-    dbClearForCompilation! db
-    dbCompilerData(db) := makeCompilationData()
     dbFormalSubst(db) := pairList(form.args,$TriangleVariableList)
     dbInstanceCache(db) := true
     deduceImplicitParameters(db,e)
@@ -1201,11 +1197,13 @@ compDefineCategory(df,m,e,fal) ==
   db := constructorDB ctor
   kind := dbConstructorKind db
   kind ~= "category" => throwKeyedMsg("S2IC0016",[ctor,"category",kind])
+  dbClearForCompilation! db
   dbConstructorForm(db) := lhs
-  $insideFunctorIfTrue =>
-    try compDefineCategory1(df,m,e,fal)
-    finally dbCompilerData(db) := nil
-  compDefineLisplib(df,m,e,fal,'compDefineCategory1)
+  dbCompilerData(db) := makeCompilationData()
+  try
+    $insideFunctorIfTrue => compDefineCategory1(db,df,m,e,fal)
+    compDefineLisplib(db,df,m,e,fal,'compDefineCategory1)
+  finally dbCompilerData(db) := nil
 
 
 %CatObjRes                   -- result of compiling a category
@@ -1445,9 +1443,15 @@ getDollarName env ==
 compDefineFunctor(df,m,e,fal) ==
   $profileCompiler: local := true
   $profileAlist:    local := nil
-  compDefineLisplib(df,m,e,fal,'compDefineFunctor1)
- 
-compDefineFunctor1(df is ['DEF,form,signature,body],m,$e,$formalArgList) ==
+  form := second df
+  db := constructorDB opOf form
+  dbClearForCompilation! db
+  dbConstructorForm(db) := form
+  dbCompilerData(db) := makeCompilationData()
+  try compDefineLisplib(db,df,m,e,fal,'compDefineFunctor1)
+  finally dbCompilerData(db) := nil
+ 
+compDefineFunctor1(db,df is ['DEF,form,signature,body],m,$e,$formalArgList) ==
     -- 0.  Make `form' a constructor instantiation form
     if form isnt [.,:.] then
       form := [form]
@@ -1469,10 +1473,6 @@ compDefineFunctor1(df is ['DEF,form,signature,body],m,$e,$formalArgList) ==
     $insideFunctorIfTrue: local:= true
     $genSDVar: local:= 0
     originale:= $e
-    db := constructorDB $op
-    dbClearForCompilation! db
-    dbConstructorForm(db) := form
-    dbCompilerData(db) := makeCompilationData()
     dbFormalSubst(db) := pairList(form.args,$FormalMapVariableList)
     $e := registerConstructor($op,$e)
     $e := setDollarName(form,$e)
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 54220181..6695c431 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -413,12 +413,10 @@ compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) ==
   val:= _/D_,2_,LIB(fun,infile,outstream,auxOp,editFlag,traceFlag)
   val
  
-compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,fal,fn) ==
+compDefineLisplib(db,df:=["DEF",[op,:.],:.],m,e,fal,fn) ==
   --fn= compDefineCategory1 OR compDefineFunctor1
   sayMSG fillerSpaces(72,char "-")
   $op: local := op
-  db := constructorDB op
-  dbPredicates(db) := nil
   $lisplibOperationAlist: local := nil
   $libFile: local := nil
   --for categories, is rhs of definition; otherwise, is target of functor
@@ -435,13 +433,12 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,fal,fn) ==
   -- following guarantee's compiler output files get closed.
   ok := false;
   try
-    res:= FUNCALL(fn,df,m,e,fal)
+    res:= FUNCALL(fn,db,df,m,e,fal)
     leaveIfErrors(libName,dbConstructorKind db)
     sayMSG ['"   finalizing ",$spadLibFT,:bright libName]
     ok := finalizeLisplib(db,libName)
   finally
     RSHUT $libFile
-    dbCompilerData(db) := nil
   if ok then lisplibDoRename(libName)
   filearg := makeFullFilePath [libName,$spadLibFT,$libraryDirectory]
   RPACKFILE filearg