From ea62b3a837416bea218f7a52db80505b8d271dc3 Mon Sep 17 00:00:00 2001 From: Gabriel Dos Reis Date: Sat, 9 Jan 2016 21:09:22 -0800 Subject: 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. --- src/interp/br-con.boot | 1 + src/interp/br-op1.boot | 6 +++--- src/interp/br-saturn.boot | 9 +++++++-- src/interp/br-search.boot | 4 +++- src/interp/c-doc.boot | 4 +++- src/interp/clammed.boot | 6 +++--- src/interp/define.boot | 11 +++++------ src/interp/i-coerce.boot | 8 +++++--- src/interp/i-eval.boot | 2 +- src/interp/i-funsel.boot | 12 +++++++++--- src/interp/i-resolv.boot | 2 +- src/interp/nrunfast.boot | 23 +++++++++++------------ 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 -- cgit v1.2.3