aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2013-05-19 14:16:33 +0000
committerdos-reis <gdr@axiomatics.org>2013-05-19 14:16:33 +0000
commita9f8febec0969527822d333548739eafd5fce99e (patch)
tree28ccf3ede2805bd026973db3069182ca693d43f5
parent0582848626e2b57a4e6d4d7525efd91c5401edf4 (diff)
downloadopen-axiom-a9f8febec0969527822d333548739eafd5fce99e.tar.gz
* interp/define.boot (sourceMatches): New.
(getDollarName): Likewise. (getSignature): Them. Tidy. (setDollarName): New. (compDefineFunctor1): Use it.
-rw-r--r--src/ChangeLog8
-rw-r--r--src/interp/define.boot30
2 files changed, 36 insertions, 2 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index a838d03a..a3edc2f9 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2013-05-19 Gabriel Dos Reis <gdr@integrable-solutions.net>
+
+ * interp/define.boot (sourceMatches): New.
+ (getDollarName): Likewise.
+ (getSignature): Them. Tidy.
+ (setDollarName): New.
+ (compDefineFunctor1): Use it.
+
2013-05-18 Gabriel Dos Reis <gdr@integrable-solutions.net>
* interp/define.boot (getSignature): Third parameter need not be fluid.
diff --git a/src/interp/define.boot b/src/interp/define.boot
index c11a4fbf..df55d0cc 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1424,6 +1424,19 @@ substituteCategoryArguments(argl,catform) ==
argl := substitute("$$","$",argl)
applySubst(pairList($FormalMapVariableList,argl),catform)
+++ Register in the current environment, the variable name for the
+++ current domain. Usually it is $; except when we are compiling
+++ a synthesized package containing category defaults.
+setDollarName(form,env) ==
+ name :=
+ isCategoryPackageName form.op => first form.args
+ '$
+ put('%compilerData,'%dollar,name,env)
+
+++ Retrieve the variable name for the current instantiation.
+getDollarName env ==
+ get('%compilerData,'%dollar,env)
+
compDefineFunctor(df,m,e,fal) ==
$domainShell: local := nil -- holds the category of the object being compiled
$profileCompiler: local := true
@@ -1458,6 +1471,7 @@ compDefineFunctor1(df is ['DEF,form,signature,body],m,$e,$formalArgList) ==
dbCompilerData(db) := makeCompilationData()
dbFormalSubst(db) := pairList(form.args,$FormalMapVariableList)
$e := registerConstructor($op,$e)
+ $e := setDollarName(form,$e)
deduceImplicitParameters(db,$e)
$formalArgList:= [:form.args,:$formalArgList]
-- all defaulting packages should have caching turned off
@@ -2017,13 +2031,25 @@ addDomain(domain,e) ==
if not isCategoryForm(domain,e) and name ~= "Mapping" then
unknownTypeError name
e --is not a functor
-
+
+++ Subroutine of getSignature.
+++ Return true if the given parameter type list `src' is a refinment of
+++ of the seed `pat'.
+sourceMatches?(src,pat) ==
+ repeat
+ src = nil => return pat = nil
+ pat = nil => return src = nil
+ pat.first ~= nil and src.first ~= pat.first => return false
+ src := src.rest
+ pat := pat.rest
getSignature(op,argModeList,e) ==
mmList := get(op,'modemap,e)
+ dollar := getDollarName e
sigl := removeDuplicates
[sig for [[dc,:sig],[pred,:.]] in mmList
- | dc='$ and sig.source = argModeList and knownInfo(pred,e)]
+ | dc=dollar and sourceMatches?(sig.source,argModeList)
+ and knownInfo(pred,e)]
sigl is [sig] => sig
null sigl =>
getXmode(op,e) is ['Mapping,:sig] => sig