aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog7
-rw-r--r--src/interp/database.boot11
-rw-r--r--src/interp/define.boot10
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]