aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2008-11-18 18:03:21 +0000
committerdos-reis <gdr@axiomatics.org>2008-11-18 18:03:21 +0000
commite8fa0a31f5e1ec2f3269cd2cd5cd18a78fd60a4a (patch)
tree0cc962f9987ca386384cf131e2f49bdc8a0e4d18 /src/interp
parent8af9359051b3b2493ef3b9d06b8fe26f2a645a06 (diff)
downloadopen-axiom-e8fa0a31f5e1ec2f3269cd2cd5cd18a78fd60a4a.tar.gz
* interp/nrunfast.boot (resolveNiladicConstructors): New.
(newHasTest): Use it to handle signature export test. * testsuite/interpreter/has.input: New.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/nrunfast.boot22
1 files changed, 22 insertions, 0 deletions
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 2f419f37..b7ee04da 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -591,6 +591,19 @@ lazyDomainSet(lazyForm,thisDomain,slot) ==
name := CAR form
setShellEntry(thisDomain,slot,slotDomain)
+
+++ `type' is a type form constructed by the new parser.
+++ Return a type form where all niladic constructors are
+++ resolved to constructor calls. Note: it is assumed that no
+++ such resolution has already occured.
+resolveNiladicConstructors type ==
+ atom type =>
+ IDENTP type and niladicConstructorFromDB type => [type]
+ type
+ for args in tails rest type repeat
+ rplac(first args, resolveNiladicConstructors first args)
+ type
+
--=======================================================
-- HasCategory/Attribute
--=======================================================
@@ -637,6 +650,15 @@ newHasTest(domform,catOrAtt) ==
null isAtom and constructor? op =>
domain := eval mkEvalable domform
newHasCategory(domain,catOrAtt)
+ catOrAtt is [":",op,type] =>
+ sig :=
+ type is ["Mapping",:sig'] =>
+ for ts in tails sig' repeat
+ rplac(first ts, resolveNiladicConstructors first ts)
+ sig'
+ -- a constant; make it look like op: () -> type
+ [resolveNiladicConstructors type]
+ HasSignature(evalDomain domform, [op,sig])
newHasAttribute(eval mkEvalable domform,catOrAtt)
lazyMatchAssocV(x,auxvec,catvec,domain) == --new style slot4