aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/i-funsel.boot20
1 files changed, 12 insertions, 8 deletions
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