From 91e29dea40e9ca5a2d7d566bdc91c9542492ac14 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 30 Oct 2011 20:09:18 +0000
Subject: 	* interp/define.boot (compDefineCategory2): Compute dual
 signature 	early on. 	* interp/database.boot (modemapsFromCategory):
 Take a first 	argument as a DB.  Tidy.  Adjust caller.

---
 src/interp/database.boot | 11 +++++------
 src/interp/define.boot   | 10 +++++-----
 2 files changed, 10 insertions(+), 11 deletions(-)

(limited to 'src/interp')

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]
 
-- 
cgit v1.2.3