* interp/define.boot (compDefineCategory2): Compute dual signature

	early on.
	* interp/database.boot (modemapsFromCategory): Take a first
	argument as a DB.  Tidy.  Adjust caller.

3 files changed, 17 insertions, 11 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index d8220750..690a1a26 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,12 @@
 2011-10-30  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/define.boot (compDefineCategory2): Compute dual signature
+	early on.
+	* interp/database.boot (modemapsFromCategory): Take a first
+	argument as a DB.  Tidy.  Adjust caller.
+
+2011-10-30  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/sys-macros.lisp (MKPF1): Tidy.
 	* interp/sys-constants.boot ($QueryVariables): New.
 	* interp/define.boot ($whreDecls): Remove.
diff --git a/src/interp/database.boot b/src/interp/database.boot
index b68c659b..e24d6a2b 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -179,7 +179,7 @@ getConstructorKind ctor ==
 ++ of operators exported by generic instantiation of the category constructor.
 ++ Note: The structure of the modemaps is that understood by the
 ++ interpreter, but that of the of the compiler.
-modemapsFromCategory(form,body,signature) ==
+modemapsFromCategory(db,form,body,signature) ==
   sl := [["$",:"*1"],:pairList(form.args,rest $PatternVariableList)]
   form := applySubst(sl,form)
   body := applySubst(sl,body)
@@ -187,11 +187,10 @@ modemapsFromCategory(form,body,signature) ==
   opAlist := applySubst(sl,categoryExports $domainShell) or return nil
   nonCategorySigAlist :=
     mkAlistOfExplicitCategoryOps substitute("*1","$",body)
-  domainList :=
-    [[a,m] for a in form.args for m in signature.source |
-      isCategoryForm(m,$EmptyEnvironment)]
-  catPredList := [['ofCategory,:u] for u in [["*1",form],:domainList]]
-  op := form.op
+  catPredList := [['ofCategory,"*1",form],
+    :[['ofCategory,a,m] for a in form.args for m in signature.source
+       for cat? in dbDualSignature(db).source | cat? ]]
+  op := dbConstructor db
   mms := nil
   for (entry:= [[op,sig,:.],pred,sel]) in opAlist |
     listMember?(sig,LASSOC(op,nonCategorySigAlist)) repeat
diff --git a/src/interp/define.boot b/src/interp/define.boot
index e65aec3b..8c8a5562 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1057,8 +1057,10 @@ compDefineCategory2(form,signature,body,m,e,$prefix,$formalArgList) ==
     signature':=
       [signature.target,
         :[getArgumentModeOrMoan(a,$definition,e) for a in argl]]
-    e:= giveFormalParametersValues(argl,e)
- 
+    e := giveFormalParametersValues(argl,e)
+    dbDualSignature(db) :=
+      [true,:[isCategoryForm(t,e) for t in signature'.source]]
+
     -- 3. replace arguments by $1,..., substitute into body,
     --    and introduce declarations into environment
     sargl:= TAKE(# argl, $TriangleVariableList)
@@ -1105,11 +1107,9 @@ compDefineCategory2(form,signature,body,m,e,$prefix,$formalArgList) ==
     $domainShell := eval [op',:[MKQ f for f in sargl]]
     dbConstructorModemap(db) :=
       [[parForm,:parSignature],[buildConstructorCondition db,$op]]
-    dbDualSignature(db) :=
-      [true,:[isCategoryForm(t,e) for t in dbConstructorModemap(db).mmSource]]
     dbPrincipals(db) := getParentsFor(db,$FormalMapVariableList)
     dbAncestors(db) := computeAncestorsOf($form,nil)
-    dbModemaps(db) := modemapsFromCategory([op',:sargl],formalBody,signature')
+    dbModemaps(db) := modemapsFromCategory(db,[op',:sargl],formalBody,signature')
     dbCompilerData(db) := nil
     [fun,$Category,e]