diff options
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/doc/msgs/s2-us.msgs | 3 | ||||
| -rw-r--r-- | src/interp/i-funsel.boot | 20 |
3 files changed, 20 insertions, 8 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 718bff89..348d0fa2 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2008-07-12 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/i-funsel.boot (findUniqueOpInDomain): Use evaluation type + context. + 2008-07-11 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/sys-driver.boot (initializeGlobalState): New. diff --git a/src/doc/msgs/s2-us.msgs b/src/doc/msgs/s2-us.msgs index 4cbe5950..ed450680 100644 --- a/src/doc/msgs/s2-us.msgs +++ b/src/doc/msgs/s2-us.msgs @@ -576,6 +576,9 @@ S2IS0060 the setelt operation. S2IS0061 Unknown type of loop iterator form. +S2IS0061 + There is no operation named %1b with type %2p in the domain or + package %3p. S2IT0001 %1b can have no other options. S2IT0002 diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index 6e3c5549..261f6d94 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -723,22 +723,26 @@ findCommonSigInDomain(opName,dom,nargs) == findUniqueOpInDomain(op,opName,dom) == -- return function named op in domain dom if unique, choose one if not - mmList := ASSQ(opName,getOperationAlistFromLisplib CAR dom) + mmList := ASSQ(opName,getOperationAlistFromLisplib first dom) mmList := subCopy(mmList,constructSubst dom) null mmList => throwKeyedMsg("S2IS0021",[opName,dom]) - if #CDR mmList > 1 then - mm := selectMostGeneralMm CDR mmList - sayKeyedMsg("S2IS0022",[opName,dom,['Mapping,:CAR mm]]) - else mm := CADR mmList + mmList := rest mmList -- ignore the operator name + -- use evaluation type context to narrow down the candidate set + if target := getTarget op then + mmList := [mm for mm in mmList | mm is [=rest target,:.]] + null mmList => throwKeyedMsg("S2IS0061",[opName,target,dom]) + if #mmList > 1 then + mm := selectMostGeneralMm mmList + sayKeyedMsg("S2IS0022",[opName,dom,['Mapping,:first mm]]) + else mm := first mmList [sig,slot,:.] := mm fun := ---+ $genValue => compiledLookupCheck(opName,sig,evalDomain dom) NRTcompileEvalForm(opName, sig, evalDomain dom) - NULL(fun) or NULL(PAIRP(fun)) => NIL - CAR fun = function(Undef) => throwKeyedMsg("S2IS0023",[opName,dom]) + fun=nil or not CONSP fun => nil + first fun = function(Undef) => throwKeyedMsg("S2IS0023",[opName,dom]) binVal := $genValue => wrap fun fun |