aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/i-coerce.boot9
-rw-r--r--src/interp/i-spec2.boot33
2 files changed, 24 insertions, 18 deletions
diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot
index 75b88d46..a46711e0 100644
--- a/src/interp/i-coerce.boot
+++ b/src/interp/i-coerce.boot
@@ -326,15 +326,6 @@ retractByFunction(object,u) ==
-- from a given domain. For example, getConstantFromDomain('(One),S)
-- returns the representation of 1 in the domain S.
-constantInDomain?(form,domainForm) ==
- opAlist := getOperationAlistFromLisplib first domainForm
- key := opOf form
- entryList := LASSOC(key,opAlist)
- entryList is [[., ., ., type]] and type in '(CONST ASCONST) => true
- key = "One" => constantInDomain?(["1"], domainForm)
- key = "Zero" => constantInDomain?(["0"], domainForm)
- false
-
getConstantFromDomain(form,domainForm) ==
isPartialMode domainForm => NIL
opAlist := getOperationAlistFromLisplib first domainForm
diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot
index eb635d72..38c1f021 100644
--- a/src/interp/i-spec2.boot
+++ b/src/interp/i-spec2.boot
@@ -78,15 +78,31 @@ upDEF t ==
--% Handler for package calling and $ constants
-++ Constant `c' is referenced from domain `d'; return its value
+++ Return non-nil if `form' designate a constant defined in the
+++ domain designated by `domainForm'. More specifically, returns:
+++ nil: no such constant
+++ <%Mode>: the type of the constant.
+++ T: too many constants designated by `form'.
+constantInDomain?(form,domainForm) ==
+ opAlist := getOperationAlistFromLisplib first domainForm
+ key := opOf form
+ entryList := [entry for (entry := [.,.,.,k]) in LASSOC(key,opAlist)
+ | k in '(CONST ASCONST)]
+ entryList is [[sig,.,.,.]] => sig.target
+ #entryList > 2 => true
+ key = "One" => constantInDomain?(["1"], domainForm)
+ key = "Zero" => constantInDomain?(["0"], domainForm)
+ nil
+
+++ Constant `c' of `type' is referenced from domain `d'; return its value
++ in the VAT `op'.
-findConstantInDomain(op,c,d) ==
+findConstantInDomain(op,c,type,d) ==
isPartialMode d => throwKeyedMsg("S2IS0020",NIL)
if $genValue then
val := wrap getConstantFromDomain([c],d)
else val := ["getConstantFromDomain",["LIST",MKQ c],MKQ d]
- putValue(op,objNew(val,d))
- putModeSet(op,[d])
+ putValue(op,objNew(val,type))
+ putModeSet(op,[type])
upDollar t ==
-- Puts "dollar" property in atree node, and calls bottom up
@@ -103,13 +119,12 @@ upDollar t ==
if f = $immediateDataSymbol then
f := objValUnwrap coerceInteractive(getValue form,$OutputForm)
if f = '(construct) then f := "nil"
- -- FIXME: The next two cases should be simplified and merged as
- -- we move to general constant definitions.
atom form and (f ^= $immediateDataSymbol) =>
- constantInDomain?([f],t) => findConstantInDomain(op,f,t)
+ type := constantInDomain?([f],t) =>
+ type ^= true => findConstantInDomain(op,f,type,t)
+ -- Ambiguous constant. FIXME: try to narrow before giving up.
+ throwKeyedMsg("S2IB0008h",[c,t])
findUniqueOpInDomain(op,f,t)
- f in '(One Zero true false nil) and constantInDomain?([f],t) =>
- findConstantInDomain(op,f,t)
nargs := #rest form