aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authorGabriel Dos Reis <gdr@axiomatics.org>2016-01-09 21:09:22 -0800
committerGabriel Dos Reis <gdr@axiomatics.org>2016-01-09 21:09:22 -0800
commitea62b3a837416bea218f7a52db80505b8d271dc3 (patch)
treef447656c1c397b881e6114cddb5ff0e3c020d473 /src/interp
parent313768fe3869da54aadd7317179bd35a44f95de3 (diff)
downloadopen-axiom-ea62b3a837416bea218f7a52db80505b8d271dc3.tar.gz
Every use of getDualSignature that does not ensure that builtin
constructors are handled before the call is a bug. This patch fixes most the obvious and glaring places. Hopefully, the remaining cases will be exercised when getDualSignature bypasses the on-disk database mamouth.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/br-con.boot1
-rw-r--r--src/interp/br-op1.boot6
-rw-r--r--src/interp/br-saturn.boot9
-rw-r--r--src/interp/br-search.boot4
-rw-r--r--src/interp/c-doc.boot4
-rw-r--r--src/interp/clammed.boot6
-rw-r--r--src/interp/define.boot11
-rw-r--r--src/interp/i-coerce.boot8
-rw-r--r--src/interp/i-eval.boot2
-rw-r--r--src/interp/i-funsel.boot12
-rw-r--r--src/interp/i-resolv.boot2
-rw-r--r--src/interp/nrunfast.boot23
12 files changed, 52 insertions, 36 deletions
diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot
index 99e9cb34..0951a8f3 100644
--- a/src/interp/br-con.boot
+++ b/src/interp/br-con.boot
@@ -624,6 +624,7 @@ kisValidType typeForm ==
kCheckArgumentNumbers t ==
[conname,:args] := t
+ builtinConstructor? conname => true
cosig := KDR getDualSignature conname
#cosig ~= #args => false
and/[foo for domain? in cosig for x in args] where foo() ==
diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot
index a9c3418d..f36807ba 100644
--- a/src/interp/br-op1.boot
+++ b/src/interp/br-op1.boot
@@ -217,9 +217,9 @@ conform2StringList(form,opFn,argFn,exception) ==
[op1,:args] := form
op := IFCAR tableValue($lowerCaseConTb,op1) or op1
null args => apply(opFn,[op])
- special := op in '(Union Record Mapping)
+ special := builtinConstructor? op
cosig :=
- special => ['T for x in args]
+ special => [true for x in args]
rest getDualSignature op
atypes :=
special => cosig
@@ -261,7 +261,7 @@ dbMapping2StringList [target,:sl] ==
[:sourcePart,'" -> ",:target]
dbOuttran form ==
- if LISTP form then
+ if form is [.,:.] then
[op,:args] := form
else
op := form
diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot
index 98b86cad..fc8bc6b2 100644
--- a/src/interp/br-saturn.boot
+++ b/src/interp/br-saturn.boot
@@ -938,7 +938,9 @@ addParameterTemplates(page, conform) ==
kPageArgs([op,:args],[.,.,:source]) ==
htSaySaturn '"\begin{tabular}{p{.25in}lp{0in}}"
firstTime := true
- coSig := rest getDualSignature op
+ coSig :=
+ builtinConstructor? op => [true for . in args]
+ rest getDualSignature op
for x in args for t in source for pred in coSig repeat
if firstTime then firstTime := false
else
@@ -1253,7 +1255,10 @@ displayDomainOp(htPage,which,origin,op,sig,predicate,
htSaySaturn '"{\em Arguments:}"
htSaySaturnAmpersand()
firstTime := true
- coSig := KDR operationIsConstructor op --check if op is constructor
+ coSig :=
+ builtinConstructor? op => [true for . in args]
+ not constructor? op => nil --check if op is constructor
+ getDualSignature op
for a in args for t in rest $sig repeat
if not firstTime then
htSaySaturn '"\\ "
diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot
index 0b346ed6..cfdbcd2d 100644
--- a/src/interp/br-search.boot
+++ b/src/interp/br-search.boot
@@ -316,7 +316,9 @@ mkGrepPattern1(x,:options) == --called by mkGrepPattern (and grepConstructName?)
conform2OutputForm(form) ==
[op,:args] := form
null args => form
- cosig := rest getDualSignature op
+ cosig :=
+ builtinConstructor? op => [true for . in args]
+ rest getDualSignature op
atypes := getConstructorModemap(op).mmSource
sargl := [fn for x in args for atype in atypes for pred in cosig] where fn() ==
pp [x,atype,pred]
diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot
index b6cc0e66..88d9fa1d 100644
--- a/src/interp/c-doc.boot
+++ b/src/interp/c-doc.boot
@@ -440,12 +440,14 @@ checkIsValidType form == main where
main() ==
form isnt [.,:.] => 'ok
[op,:args] := form
+ op = ":" => args is [.,t] and checkIsValidType t
+ builtinConstructor? op => and/[checkIsValidType t for t in args]
conname := (constructor? op => op; abbreviation? op)
null conname => nil
fn(form,getDualSignature conname)
fn(form,coSig) ==
#form ~= #coSig => form
- or/[null checkIsValidType x for x in rest form for flag in rest coSig | flag]
+ or/[null checkIsValidType x for x in form.args for flag in rest coSig | flag]
=> nil
'ok
diff --git a/src/interp/clammed.boot b/src/interp/clammed.boot
index db1972da..b8988d85 100644
--- a/src/interp/clammed.boot
+++ b/src/interp/clammed.boot
@@ -84,16 +84,16 @@ isValidType form ==
((# args) = (# removeDuplicates args)) => true
false
form is ['Mapping,:mapargs] =>
- null mapargs => nil
+ null mapargs => false
and/[isValidType type for type in mapargs]
form is ['Union,:args] =>
-- check for a tagged union
args and first args is [":",:.] =>
and/[isValidType type for [:.,type] in args]
- null (and/[isValidType arg for arg in args]) => nil
+ null (and/[isValidType arg for arg in args]) => false
((# args) = (# removeDuplicates args)) => true
sayKeyedMsg("S2IR0005",[form])
- nil
+ false
badDoubles := [$QuotientField,:'(Gaussian Complex Polynomial Expression)]
form is [T1, [T2, :.]] and T1 = T2 and member(T1, badDoubles) => nil
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 42bcf4df..de919848 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -2250,17 +2250,16 @@ bootStrapError(functorForm,sourceFile) ==
registerInlinableDomain x ==
x is [ctor,:.] =>
- constructor? ctor =>
- nominateForInlining ctor
- cosig := getDualSignature ctor or return nil
- for a in x.args for t in cosig.source | t and a is [.,:.] repeat
- registerInlinableDomain a
ctor is ":" => registerInlinableDomain third x
ctor is 'Enumeration => nil
builtinFunctorName? ctor =>
for t in x.args repeat
registerInlinableDomain t
- nil
+ constructor? ctor =>
+ nominateForInlining ctor
+ cosig := getDualSignature ctor or return nil
+ for a in x.args for t in cosig.source | t and a is [.,:.] repeat
+ registerInlinableDomain a
nil
compAdd(['add,$addForm,capsule],m,e) ==
diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot
index e6a47b7a..5e4721b6 100644
--- a/src/interp/i-coerce.boot
+++ b/src/interp/i-coerce.boot
@@ -1066,14 +1066,16 @@ coerceIntByMapInner(arg,[u1,:u2]) == coerceOrThrowFailure(arg,u1,u2)
valueArgsEqual?(t1, t2) ==
-- returns true if the object-valued arguments to t1 and t2 are the same
-- under coercion
- coSig := rest getDualSignature first t1
- constrSig := rest getConstructorSignature first t1
+ coSig :=
+ builtinConstructor? t1.op => [true for . in t1.args]
+ getDualSignature(t1.op).source
+ constrSig := getConstructorSignature(t1.op).source
tl1 := replaceSharps(constrSig, t1)
tl2 := replaceSharps(constrSig, t2)
not symbolMember?(nil, coSig) => true
done := false
value := true
- for a1 in rest t1 for a2 in rest t2 for cs in coSig
+ for a1 in t1.args for a2 in t2.args for cs in coSig
for m1 in tl1 for m2 in tl2 while not done repeat
not cs =>
trip := objNewWrap(a1, m1)
diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot
index 7485401e..1432aa8e 100644
--- a/src/interp/i-eval.boot
+++ b/src/interp/i-eval.boot
@@ -60,7 +60,7 @@ mkEvalable form ==
loadIfNecessary op
kind:= getConstructorKindFromDB op
cosig := getDualSignature op =>
- [op,:[val for x in argl for typeFlag in rest cosig]] where val() ==
+ [op,:[val for x in argl for typeFlag in cosig.source]] where val() ==
typeFlag =>
kind = "category" => MKQ x
vector? x => MKQ x
diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot
index 3ece2464..4d1675e7 100644
--- a/src/interp/i-funsel.boot
+++ b/src/interp/i-funsel.boot
@@ -1251,12 +1251,18 @@ coerceTypeArgs(t1, t2, SL) ==
-- if needed.
t1 isnt [con1, :args1] or t2 isnt [con2, :args2] => t2
con1 ~= con2 => t2
- coSig := rest getDualSignature first t1
+ con1 = ":" =>
+ second args1 ~= second args2 => t2
+ [con1,second args1,coerceTypeArgs(third args1,third args2,SL)]
+ con1 = 'Mapping => t2
+ builtinConstructor? con1 =>
+ [con1,:[coerceTypeArgs(u,v,SL) for u in args1 for v in args2]]
+ coSig := getDualSignature(con1).source
and/coSig => t2
csub1 := constructSubst t1
csub2 := constructSubst t2
- cs1 := rest getConstructorSignature con1
- cs2 := rest getConstructorSignature con2
+ cs1 := getConstructorSignature(con1).source
+ cs2 := getConstructorSignature(con2).source
[con1, :
[makeConstrArg(arg1, arg2, constrArg(c1,csub1,SL),
constrArg(c2,csub2,SL), cs)
diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot
index 3ef90e9d..e317de6d 100644
--- a/src/interp/i-resolv.boot
+++ b/src/interp/i-resolv.boot
@@ -341,7 +341,7 @@ resolveTTRed3(t) ==
(and/[member(x,a) for x in b] and "and"/[member(x,b) for x in a]) and a
[(x isnt [.,:.] and x ) or ((not cs and x and not interpOp? x and x)
or resolveTTRed3 x) or return nil
- for x in t for cs in getDualSignature t.op ]
+ for x in t for cs in getDualSignature t.op ] -- FIXME: builtin ctor?
interpOp?(op) ==
cons?(op) and
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index db167138..a2cbd0a3 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -379,17 +379,15 @@ generalizedBuiltinConstructor? s ==
builtinConstructor? s or s is 'QUOTE or s is "[||]"
lazyMatch(source,lazyt,dollar,domain) ==
- lazyt is [op,:argl] and cons? source and op=first source
- and #(sargl := rest source) = #argl =>
+ lazyt is [op,:argl] and source is [=op,:sargl] and #sargl = #argl =>
builtinConstructor? op and first argl is [":",:.] =>
and/[stag = atag and lazyMatchArg(s,a,dollar,domain)
for [.,stag,s] in sargl for [.,atag,a] in argl]
generalizedBuiltinConstructor? op =>
and/[lazyMatchArg(s,a,dollar,domain) for s in sargl for a in argl]
- coSig := getDualSignature op
- null coSig => error ["bad Constructor op", op]
+ coSig := getDualSignature(op).source
and/[lazyMatchArg2(s,a,dollar,domain,flag)
- for s in sargl for a in argl for flag in rest coSig]
+ for s in sargl for a in argl for flag in coSig]
string? source and lazyt is ['QUOTE,=source] => true
integer? source =>
lazyt is ['_#, slotNum] => source = #(domain.slotNum)
@@ -404,17 +402,18 @@ lazyMatch(source,lazyt,dollar,domain) ==
lazyMatchArgDollarCheck(s,d,dollarName,domainName) ==
#s ~= #d => nil
- scoSig := getDualSignature opOf s or return nil
- if opOf s in '(Union Mapping Record) then
- scoSig := [true for x in s]
- and/[fn for x in rest s for arg in rest d for xt in rest scoSig] where
+ scoSig :=
+ s.op in '(Union Mapping Record) => [true for x in s.args]
+ getDualSignature s.op or return nil
+ and/[fn for x in s.args for arg in d.args for xt in scoSig] where
fn() ==
x = arg => true
- x is ['elt,someDomain,opname] => lookupInDomainByName(opname,evalDomain someDomain,arg)
+ x is ['elt,someDomain,opname] =>
+ lookupInDomainByName(opname,evalDomain someDomain,arg)
x is '$ and (arg = dollarName or arg = domainName) => true
x = dollarName and arg = domainName => true
x isnt [.,:.] or arg isnt [.,:.] => false
- xt and first x = first arg =>
+ xt and x.op = arg.op =>
lazyMatchArgDollarCheck(x,arg,dollarName,domainName)
false
@@ -469,7 +468,7 @@ newExpandLocalTypeForm([functorName,:argl],dollar,domain) ==
coSig := getDualSignature functorName or
error ["unknown constructor name", functorName]
[functorName,:[newExpandLocalTypeArgs(a,dollar,domain,flag)
- for a in argl for flag in rest coSig]]
+ for a in argl for flag in coSig.source]]
newExpandLocalTypeArgs(u,dollar,domain,typeFlag) ==
u is '$ => u