diff options
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/interp/database.boot | 11 | ||||
| -rw-r--r-- | src/interp/define.boot | 10 |
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] |