* interp/daase.lisp (dbCompilerData): New accessor macro.

	(dbBeingDefined?): Adjust.
	* interp/c-util.boot (makeCompilationData): New.
	(dbFormalSubst): New accessor macro.
	(dbSubstituteFormals): New.
	* interp/define.boot ($pairlis): Remove.
	(NRTmakeCategoryAlist): Use dbSubstituteFormals.
	(NRTgetLookupFunction): Likewise.
	(compDefineCategory2): Likewise.  Set dbCompilerData and dbFormalSubst.
	(compDefineFunctor1): Likewise.
	* interp/functor.boot (ProcessCond): Use dbSubstituteFormals.
	* interp/lisplib.boot (NRTgenInitialAttributeAlist): Likewise.
	(makePredicateBitVector): Likewise.
	(finalizeLisplib): Do not set $pairlis.

6 files changed, 67 insertions, 32 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 4e883459..506e5b5a 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,22 @@
 2011-10-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/daase.lisp (dbCompilerData): New accessor macro.
+	(dbBeingDefined?): Adjust.
+	* interp/c-util.boot (makeCompilationData): New.
+	(dbFormalSubst): New accessor macro.
+	(dbSubstituteFormals): New.
+	* interp/define.boot ($pairlis): Remove.
+	(NRTmakeCategoryAlist): Use dbSubstituteFormals.
+	(NRTgetLookupFunction): Likewise.
+	(compDefineCategory2): Likewise.  Set dbCompilerData and dbFormalSubst.
+	(compDefineFunctor1): Likewise.
+	* interp/functor.boot (ProcessCond): Use dbSubstituteFormals.
+	* interp/lisplib.boot (NRTgenInitialAttributeAlist): Likewise.
+	(makePredicateBitVector): Likewise.
+	(finalizeLisplib): Do not set $pairlis.
+
+2011-10-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/nruncomp.boot (NRTaddDeltaCode): Take a DB parameter.
 	Adjust callers.
 	(NRTdescendCodeTran): Likewise.
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index bd1566da..20230eb9 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -131,6 +131,24 @@ macro domainPredicates d ==
 macro domainData d ==
   domainRef(d,4)
 
+--%  
+--% Constructor Compilation Data.
+--% Operational Semantics:
+--%    structure CompilationData ==
+--%       Record(formalSubst: Substitution)
+--%
+
+++ Make a fresh compilation data structure.
+makeCompilationData() ==
+  [nil]
+
+macro dbFormalSubst db ==
+  first dbCompilerData db
+
+++ Apply the formal substitution or `db'to th form `x'.
+dbSubstituteFormals(db,x) ==
+  applySubst(dbFormalSubst db,x)
+
 --%
 $SetCategory ==
   '(SetCategory)
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index fce8ca41..d848d8be 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -226,7 +226,7 @@
  dependents                 ; browse.
  superdomain                ; interp.
  instantiations		    ; nil if mutable constructor
- being-defined		    ; T is definition of constructor is being processed
+ compiler-data		    ; holds compiler data when processing constructor
  load-path		    ; full object path name, when loaded.
  capsule-definitions	    ; capsule-level definitions
  template		    ; for a category, this is the generic instance.
@@ -291,8 +291,11 @@
 (defmacro |dbInstanceCache| (db)
   `(database-instantiations ,db))
 
+(defmacro |dbCompilerData| (db)
+  `(database-compiler-data ,db))
+
 (defmacro |dbBeingDefined?| (db)
-  `(database-being-defined ,db))
+  `(|dbCompilerData| ,db))
 
 (defmacro |dbLoadPath| (db)
   `(database-load-path ,db))
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 16282ee6..3a6ce68b 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -67,7 +67,6 @@ $functionStats := nil
 $functorStats := nil
 
 $CheckVectorList := []
-$pairlis := []
 $functorTarget := nil
 $condAlist := []
 $uncondAlist := []
@@ -479,12 +478,12 @@ NRTmakeCategoryAlist(db,e) ==
   pcAlist := [:[[x,:"T"] for x in $uncondAlist],:$condAlist]
   $levelAlist: local := depthAssocList [CAAR x for x in pcAlist]
   opcAlist := reverse! SORTBY(function NRTcatCompare,pcAlist)
-  newPairlis := [[5 + i,:b] for [.,:b] in $pairlis for i in 1..]
-  slot1 := [[a,:k] for [a,:b] in applySubst($pairlis,opcAlist)
+  newPairlis := [[5 + i,:b] for [.,:b] in dbFormalSubst db for i in 1..]
+  slot1 := [[a,:k] for [a,:b] in dbSubstituteFormals(db,opcAlist)
                    | (k := predicateBitIndex(b,e)) ~= -1]
   slot0 := [hasDefaultPackage opOf a for [a,:b] in slot1]
-  sixEtc := [5 + i for i in 1..#$pairlis]
-  formals := ASSOCRIGHT $pairlis
+  sixEtc := [5 + i for i in 1..dbArity db]
+  formals := ASSOCRIGHT dbFormalSubst db
   for x in slot1 repeat
     x.first := applySubst(pairList(['$,:formals],["$$",:sixEtc]),first x)
   -----------code to make a new style slot4 -----------------
@@ -522,14 +521,14 @@ getXmode(x,e) ==
 --=======================================================================
 NRTgetLookupFunction(db,domform,exCategory,addForm,env) ==
   $why: local := nil
-  domform := applySubst($pairlis,domform)
+  domform := dbSubstituteFormals(db,domform)
   addForm isnt [.,:.] =>
-    ident? addForm and (m := getmode(addForm,env)) ~= nil
-      and isCategoryForm(m,env) 
-        and extendsCategory(db,domform,exCategory,applySubst($pairlis,m),env) =>
+    ident? addForm and (m := getmode(addForm,env)) ~= nil and
+      isCategoryForm(m,env) and
+        extendsCategory(db,domform,exCategory,dbSubstituteFormals(db,m),env) =>
           'lookupIncomplete
     'lookupComplete
-  addForm := applySubst($pairlis,addForm)
+  addForm := dbSubstituteFormals(db,addForm)
   NRTextendsCategory1(db,domform,exCategory,getExportCategory addForm,env) =>
     'lookupIncomplete
   [u,msg,:v] := $why
@@ -1011,7 +1010,8 @@ compDefineCategory2(form,signature,body,m,e,$prefix,$formalArgList) ==
     -- 1.1  augment e to add declaration $: <form>
     [$op,:argl] := $definition
     db := constructorDB $op
-    dbBeingDefined?(db) := true
+    dbCompilerData(db) := makeCompilationData()
+    dbFormalSubst(db) := pairList(form.args,$TriangleVariableList)
     dbInstanceCache(db) := true
     e:= addBinding("$",[['mode,:$definition]],e)
  
@@ -1026,9 +1026,8 @@ compDefineCategory2(form,signature,body,m,e,$prefix,$formalArgList) ==
     sargl:= TAKE(# argl, $TriangleVariableList)
     $functorForm:= $form:= [$op,:sargl]
     $formalArgList:= [:sargl,:$formalArgList]
-    aList := pairList(argl,sargl)
-    formalBody:= applySubst(aList,body)
-    signature' := applySubst(aList,signature')
+    formalBody := dbSubstituteFormals(db,body)
+    signature' := dbSubstituteFormals(db,signature')
     --Begin lines for category default definitions
     $functionStats: local:= [0,0]
     $functorStats: local:= [0,0]
@@ -1073,7 +1072,7 @@ compDefineCategory2(form,signature,body,m,e,$prefix,$formalArgList) ==
     dbPrincipals(db) := getParentsFor(db,$FormalMapVariableList)
     dbAncestors(db) := computeAncestorsOf($form,nil)
     dbModemaps(db) := modemapsFromCategory([op',:sargl],formalBody,signature')
-    dbBeingDefined?(db) := false
+    dbCompilerData(db) := nil
     [fun,$Category,e]
 
 mkConstructor: %Form -> %Form
@@ -1355,10 +1354,10 @@ compDefineFunctor1(df is ['DEF,form,signature,body],
     originale:= $e
     [$op,:argl]:= form
     db := constructorDB $op
-    dbBeingDefined?(db) := true
     dbConstructorForm(db) := form
+    dbCompilerData(db) := makeCompilationData()
+    dbFormalSubst(db) := pairList(form.args,$FormalMapVariableList)
     $formalArgList:= [:argl,:$formalArgList]
-    $pairlis: local := pairList(argl,$FormalMapVariableList)
     -- all defaulting packages should have caching turned off
     dbInstanceCache(db) := not isCategoryPackageName $op
     signature':=
@@ -1393,8 +1392,8 @@ compDefineFunctor1(df is ['DEF,form,signature,body],
       $e := augModemapsFromCategory('_$,'_$,target,$e)
       $e := put('$,'%form,form,$e)
     $signature:= signature'
-    parSignature:= applySubst($pairlis,signature')
-    parForm:= applySubst($pairlis,form)
+    parSignature := dbSubstituteFormals(db,signature')
+    parForm := dbSubstituteFormals(db,form)
  
     --  3. give operator a 'modemap property
     modemap := [[parForm,:parSignature],[true,$op]]
@@ -1431,9 +1430,9 @@ compDefineFunctor1(df is ['DEF,form,signature,body],
     lamOrSlam :=
       dbInstanceCache db = nil => 'LAM
       'SPADSLAM
-    fun:= compile applySubst($pairlis, [op',[lamOrSlam,argl,body']])
+    fun := compile dbSubstituteFormals(db,[op',[lamOrSlam,argl,body']])
     --The above statement stops substitutions gettting in one another's way
-    operationAlist := applySubst($pairlis,$lisplibOperationAlist)
+    operationAlist := dbSubstituteFormals(db,$lisplibOperationAlist)
     dbModemaps(db) := modemapsFromFunctor(parForm,operationAlist,parSignature)
     reportOnFunctorCompilation()
  
@@ -1458,7 +1457,7 @@ compDefineFunctor1(df is ['DEF,form,signature,body],
     if $bootStrapMode then
       evalAndRwriteLispForm('%incomplete,
             ['MAKEPROP,quote op',quote '%incomplete,true])
-    dbBeingDefined?(db) := false
+    dbBeingDefined?(db) := nil
     [fun,['Mapping,:signature'],originale]
 
 
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index f91491b0..fd887f9a 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -509,7 +509,7 @@ ConstantCreator u ==
   true
  
 ProcessCond(db,cond,e) ==
-  ncond := applySubst($pairlis,cond)
+  ncond := dbSubstituteFormals(db,cond)
   valuePosition(ncond,$NRTslot1PredicateList) => predicateBitRef(ncond,e)
   cond
 
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 8b76009d..9f7de79c 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -35,7 +35,6 @@
 import nlib
 import c_-util
 import debug
-import daase
 
 namespace BOOT
 module lisplib
@@ -52,7 +51,7 @@ NRTgenInitialAttributeAlist(db,attributeList) ==
   alist := [x for x in attributeList | -- throw out constructors
     not symbolMember?(opOf first x,allConstructors())]
   dbAttributes(db) := simplifyAttributeAlist(db,
-    [[a,:b] for [a,b] in applySubst($pairlis,alist) | a isnt 'nothing])
+    [[a,:b] for [a,b] in dbSubstituteFormals(db,alist) | a isnt 'nothing])
 
 simplifyAttributeAlist(db,al) ==
   al is [[a,:b],:r] =>
@@ -109,13 +108,13 @@ makePredicateBitVector(db,pl,e) ==   --called by buildFunctor
       for q in stripOutNonDollarPreds pred repeat firsts := insert(q,firsts)
     else 
       firsts := insert(pred,firsts)
-  firstPl := applySubst($pairlis,reverse! orderByContainment firsts)
-  lastPl  := applySubst($pairlis,reverse! orderByContainment lasts)
+  firstPl := dbSubstituteFormals(db,reverse! orderByContainment firsts)
+  lastPl  := dbSubstituteFormals(db,reverse! orderByContainment lasts)
   firstCode:= 
     ['buildPredVector,0,0,mungeAddGensyms(firstPl,$predGensymAlist)]
   lastCode := augmentPredCode(# firstPl,lastPl)
-  dbPredicates(db) := [:firstPl,:lastPl] --what is stored under 'predicates
-  [dbPredicates db,firstCode,:lastCode]  --$pairlis set by compDefineFunctor1
+  dbPredicates(db) := [:firstPl,:lastPl]
+  [dbPredicates db,firstCode,:lastCode]
 
 augmentPredCode(n,lastPl) ==
   ['%list,:pl] := mungeAddGensyms(lastPl,$predGensymAlist)
@@ -533,7 +532,6 @@ finalizeLisplib(ctor,libName) ==
   opsAndAtts := getConstructorOpsAndAtts(form,kind,mm)
   writeOperations(ctor,first opsAndAtts,$libFile)
   if kind='category then
-     $pairlis : local := pairList(form,$FormalMapVariableList)
      $NRTslot1PredicateList : local := []
      NRTgenInitialAttributeAlist(db,rest opsAndAtts)
   writeSuperDomain(ctor,dbSuperDomain db,$libFile)