diff options
Diffstat (limited to 'src/interp/i-funsel.boot.pamphlet')
| -rw-r--r-- | src/interp/i-funsel.boot.pamphlet | 64 |
1 files changed, 33 insertions, 31 deletions
diff --git a/src/interp/i-funsel.boot.pamphlet b/src/interp/i-funsel.boot.pamphlet index 6e34e518..bea96021 100644 --- a/src/interp/i-funsel.boot.pamphlet +++ b/src/interp/i-funsel.boot.pamphlet @@ -826,25 +826,27 @@ selectMostGeneralMm mmList == for genMmArg in CDAR genMm] => genMm := mm genMm ---------------------> NEW DEFINITION (override in xrun.boot.pamphlet) findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) == - -- looks for a modemap for op with signature args1 -> tar + -- looks for a modemap for op with signature args1 -> tar -- in the domain of computation dc -- tar may be NIL (= unknown) null isLegitimateMode(tar, nil, nil) => nil dcName:= CAR dc - member(dcName,'(Union Record Mapping)) => + member(dcName,'(Union Record Mapping Enumeration)) => -- First cut code that ignores args2, $Coerce and $SubDom -- When domains no longer have to have Set, the hard coded 6 and 7 -- should go. op = '_= => - #args1 ^= 2 or args1.0 ^= dc or args1.1 ^= dc => NIL - tar and tar ^= '(Boolean) => NIL - [[[dc, '(Boolean), dc, dc], 6, [NIL, NIL]]] + #args1 ^= 2 or args1.0 ^= dc or args1.1 ^= dc => NIL + tar and tar ^= '(Boolean) => NIL + [[[dc, '(Boolean), dc, dc], ['(Boolean),'$,'$], [NIL, NIL]]] op = 'coerce => - #args1 ^= 1 or args1.0 ^= dc => NIL - tar and tar ^= $OutputForm => NIL - [[[dc, $OutputForm, dc], 7, [NIL, NIL]]] + #args1 ^= 1 + dcName='Enumeration and (args1.0=$Symbol or tar=dc)=> + [[[dc, dc, $Symbol], ['$,$Symbol], [NIL, NIL]]] + args1.0 ^= dc => NIL + tar and tar ^= $Expression => NIL + [[[dc, $Expression, dc], [$Expression,'$], [NIL, NIL]]] member(dcName,'(Record Union)) => findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) NIL @@ -857,24 +859,22 @@ findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) == q := NIL r := NIL for mm in CDR p repeat - -- CDAR of mm is the signature argument list - if isHomogeneousList CDAR mm then q := [mm,:q] - else r := [mm,:r] + -- CDAR of mm is the signature argument list + if isHomogeneousList CDAR mm then q := [mm,:q] + else r := [mm,:r] q := allOrMatchingMms(q,args1,tar,dc) for mm in q repeat - mm:= subCopy(mm,SL) - fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) + fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) r := reverse r else r := CDR p r := allOrMatchingMms(r,args1,tar,dc) if not fun then -- consider remaining modemaps for mm in r repeat - mm:= subCopy(mm,SL) - fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) + fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) if not fun and $reportBottomUpFlag then sayMSG concat ['" -> no appropriate",:bright op,'"found in", - :bright prefix2String dc] + :bright prefix2String dc] fun allOrMatchingMms(mms,args1,tar,dc) == @@ -897,38 +897,41 @@ isHomogeneousList y == "and"/[x = z for x in CDR y] NIL ---------------------> NEW DEFINITION (override in xrun.boot.pamphlet) -findFunctionInDomain1(mm,op,tar,args1,args2,SL) == +findFunctionInDomain1(omm,op,tar,args1,args2,SL) == + dc:= CDR (dollarPair := ASSQ('$,SL)) + -- need to drop '$ from SL + mm:= subCopy(omm, SL) -- tests whether modemap mm is appropriate for the function -- defined by op, target type tar and argument types args $RTC:local:= NIL -- $RTC is a list of run-time checks to be performed - dc:= CDR ASSQ('$,SL) + [sig,slot,cond,y] := mm - if CONTAINED('_#, sig) or CONTAINED('construct, sig) then + [osig,:.] := omm + osig := subCopy(osig, SUBSTQ(CONS('$,'$), dollarPair, SL)) + if CONTAINED('_#, sig) or CONTAINED('construct,sig) then sig := [replaceSharpCalls t for t in sig] matchMmCond cond and matchMmSig(mm,tar,args1,args2) and EQ(y,'Subsumed) and -- hmmmm: do Union check in following because (as in DP) -- Unions are subsumed by total modemaps which are in the -- mm list in findFunctionInDomain. - y := 'ELT -- if subsumed fails try it again + y := 'ELT -- if subsumed fails try it again not $SubDom and CAR sig isnt ['Union,:.] and slot is [tar,:args] and - (f := findFunctionInDomain(op,dc,tar,args,args,NIL,NIL)) => f - EQ(y,'ELT) => [[CONS(dc,sig),slot,nreverse $RTC]] - EQ(y,'CONST) => [[CONS(dc,sig),slot,nreverse $RTC]] --- EQ(y,'ASCONST) => [[CONS(dc,sig),slot,nreverse $RTC]] + (f := findFunctionInDomain(op,dc,tar,args,args,NIL,NIL)) => f + EQ(y,'ELT) => [[CONS(dc,sig),osig,nreverse $RTC]] + EQ(y,'CONST) => [[CONS(dc,sig),osig,nreverse $RTC]] + EQ(y,'ASCONST) => [[CONS(dc,sig),osig,nreverse $RTC]] y is ['XLAM,:.] => [[CONS(dc,sig),y,nreverse $RTC]] sayKeyedMsg("S2IF0006",[y]) NIL ---------------------> NEW DEFINITION (override in xrun.boot.pamphlet) findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) == - -- looks for a modemap for op with signature args1 -> tar + -- looks for a modemap for op with signature args1 -> tar -- in the domain of computation dc -- tar may be NIL (= unknown) dcName:= CAR dc - not MEMQ(dcName,'(Record Union)) => NIL + not MEMQ(dcName,'(Record Union Enumeration)) => NIL fun:= NIL -- cat := constructorCategory dc makeFunc := GETL(dcName,"makeFunctionList") or @@ -952,12 +955,11 @@ findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) == impls and SL:= constructSubst dc for mm in impls repeat - mm:= subCopy(mm,SL) fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) if not fun and $reportBottomUpFlag then sayMSG concat ['" -> no appropriate",:bright op,'"found in", - :bright prefix2String dc] + :bright prefix2String dc] fun matchMmCond(cond) == |