aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog14
-rw-r--r--src/interp/g-cndata.boot12
-rw-r--r--src/interp/i-code.boot6
-rw-r--r--src/interp/i-coerce.boot2
-rw-r--r--src/interp/i-eval.boot6
-rw-r--r--src/interp/i-funsel.boot4
-rw-r--r--src/interp/i-map.boot2
-rw-r--r--src/interp/i-object.boot23
-rw-r--r--src/interp/i-spec2.boot8
-rw-r--r--src/testsuite/interpreter/eval-dep-type.input1
10 files changed, 60 insertions, 18 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 9d80866f..c358d8b4 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,19 @@
2008-05-17 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/i-object.boot (wrapped2Quote): Reomve.
+ (getValueNormalForm): New.
+ * interp/i-code.boot (intCodeGenCOERCE): Use it.
+ * interp/i-coerce.boot (coerceIntByMap): Likewise.
+ * interp/i-eval.boot (getArgValue): Likewise.
+ (getArgValue2): Likewise.
+ * interp/i-funsel.boot (selectMms): Likewise.
+ * interp/i-map.boot (rewriteMap): Likewise.
+ * interp/i-spec2.boot (IFcodeTran): Likewise.
+ (evalLET): Likewise.
+ (upreturn): Likewise.
+ * interp/g-cndata.boot (isConstructorName): New.
+ * testsuite/interpreter/eval-dep-type.input: New.
+
* interp/format.boot (form2String1): Handle PAREN.
* interp/g-cndata.boot (condUnabbrev): Handle homogeneous varargs
for constructors taking tuples.
diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot
index 83c363b8..ee0f44a4 100644
--- a/src/interp/g-cndata.boot
+++ b/src/interp/g-cndata.boot
@@ -243,6 +243,18 @@ condUnabbrev(op,arglist,argtypes,modeIfTrue) ==
[newArg for arg in arglist for type in argtypes] where newArg() ==
categoryForm?(type) => unabbrev1(arg,modeIfTrue)
arg
+
+++ returns true if `op' is the name of a constructor.
+++ Note: From this function point of view, a symbol names a
+++ constructor if it is either a builtin constructor, or it is
+++ known to the global database as designating a constructor. In
+++ particular neither the category frame, nor the normal frame
+++ are consulted. Consequently, this functions is not appropriate
+++ for use in the compiler.
+isConstructorName op ==
+ op in $BuiltinConstructorNames
+ or getConstructorAbbreviationFromDB op
+
--% Code Being Phased Out
diff --git a/src/interp/i-code.boot b/src/interp/i-code.boot
index 99894ae4..f229578e 100644
--- a/src/interp/i-code.boot
+++ b/src/interp/i-code.boot
@@ -63,18 +63,18 @@ intCodeGenCOERCE(triple,t2) ==
val is ['THROW,label,code] =>
if label is ['QUOTE, l] then label := l
null($compilingMap) or (label ^= mapCatchName($mapName)) =>
- objNew(['THROW,label,wrapped2Quote objVal
+ objNew(['THROW,label,getValueNormalForm
intCodeGenCOERCE(objNew(code,t1),t2)],t2)
-- we have a return statement. just send it back as is
objNew(val,t2)
val is ['PROGN,:code,lastCode] =>
- objNew(['PROGN,:code,wrapped2Quote objVal
+ objNew(['PROGN,:code,getValueNormalForm
intCodeGenCOERCE(objNew(lastCode,t1),t2)],t2)
val is ['COND,:conds] =>
objNew(['COND,
- :[[p,wrapped2Quote objVal intCodeGenCOERCE(objNew(v,t1),t2)]
+ :[[p,getValueNormalForm intCodeGenCOERCE(objNew(v,t1),t2)]
for [p,v] in conds]],t2)
-- specially handle subdomain
diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot
index c86ebf13..233a3b91 100644
--- a/src/interp/i-coerce.boot
+++ b/src/interp/i-coerce.boot
@@ -1078,7 +1078,7 @@ coerceIntByMap(triple,t2) ==
fn = function Undef => NIL
-- now compile a function to do the coercion
code := ['SPADCALL,['CONS,["function","coerceIntByMapInner"],MKQ [u1,:u2]],
- wrapped2Quote objVal triple,MKQ fun]
+ getValueNormalForm triple,MKQ fun]
-- and apply the function
val := CATCH('coerceFailure,timedEvaluate code)
(val = $coerceFailure) => NIL
diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot
index eed39efe..d8284829 100644
--- a/src/interp/i-eval.boot
+++ b/src/interp/i-eval.boot
@@ -278,12 +278,12 @@ sideEffectedArg?(t,sig,opName) ==
getArgValue(a, t) ==
atom a and not VECP a =>
t' := coerceOrRetract(getBasicObject a,t)
- t' and wrapped2Quote objVal t'
+ t' and getValueNormalForm t'
v := getArgValue1(a, t) => v
alt := altTypeOf(objMode getValue a, a, nil) =>
t' := coerceInt(getValue a, alt)
t' := coerceOrRetract(t',t)
- t' and wrapped2Quote objVal t'
+ t' and getValueNormalForm t'
nil
getArgValue1(a,t) ==
@@ -293,7 +293,7 @@ getArgValue1(a,t) ==
objValUnwrap(t') is ['MAP,:.] =>
getMappingArgValue(a,t,m)
t' := coerceOrRetract(t',t)
- t' and wrapped2Quote objVal t'
+ t' and getValueNormalForm t'
systemErrorHere '"getArgValue"
getArgValue2(a,t,se?,opName) ==
diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot
index e0b841d9..6e3c5549 100644
--- a/src/interp/i-funsel.boot
+++ b/src/interp/i-funsel.boot
@@ -75,7 +75,7 @@ selectMms(op,args,$declaredMode) ==
((isSharpVarWithNum(n) and opMode) or (val and opMode)) and
opMode is ['Mapping,:ta] =>
imp :=
- val => wrapped2Quote objVal val
+ val => getValueNormalForm val
n
[[['local,:ta], imp , NIL]]
@@ -101,7 +101,7 @@ selectMms(op,args,$declaredMode) ==
putTarget(tree,['Mapping,tar,:types1])
bottomUp tree
val := getValue tree
- [[['local,:rest objMode val], wrapped2Quote objVal val, NIL]]
+ [[['local,:rest objMode val], getValueNormalForm val, NIL]]
if (n = 'map) and (first types1 = $AnonymousFunction)
then
diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot
index 0da27dee..f5ad2a2e 100644
--- a/src/interp/i-map.boot
+++ b/src/interp/i-map.boot
@@ -552,7 +552,7 @@ rewriteMap(op,opName,argl) ==
arglCode := ['LIST,:[argCode for arg in argl for argName in
$FormalMapVariableList]] where argCode() ==
['putValueValue,['mkAtreeNode,MKQ argName],
- objNewCode(['wrap,wrapped2Quote(objVal getValue arg)],
+ objNewCode(['wrap,getValueNormalForm getValue arg],
getMode arg)]
putValue(op,objNew(['rewriteMap1,MKQ opName,arglCode,MKQ sig],
CAR sig))
diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot
index 7db445dc..5cbcd2ca 100644
--- a/src/interp/i-object.boot
+++ b/src/interp/i-object.boot
@@ -94,10 +94,6 @@ unwrap x ==
x is ["WRAPPED",:y] => y
x
-wrapped2Quote x ==
- x is ["WRAPPED",:y] => MKQ y
- x
-
quote2Wrapped x ==
x is ["QUOTE",y] => wrap y
x
@@ -106,6 +102,25 @@ removeQuote x ==
x is ["QUOTE",y] => y
x
+++ returns the normal form of `obj''s value, suitable for use as
+++ argument to a (library) function call.
+getValueNormalForm obj ==
+ val := objVal obj
+ atom val => val
+ [op,:argl] := val
+ op = "WRAPPED" => MKQ argl
+ IDENTP op and isConstructorName op => instantiationNormalForm(op,argl)
+ -- what else can it be? Don't know; leave it alone.
+ val
+
+instantiationNormalForm(op,argl) ==
+ [op,:[normalVal for arg in argl]] where normalVal() ==
+ atom arg => arg
+ [h,:t] := arg
+ IDENTP h and isConstructorName h => instantiationNormalForm(h,t)
+ MKQ arg
+
+
-- addQuote x ==
-- NUMBERP x => x
-- ['QUOTE,x]
diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot
index 755d8f98..c1189335 100644
--- a/src/interp/i-spec2.boot
+++ b/src/interp/i-spec2.boot
@@ -280,7 +280,7 @@ IFcodeTran(code,m,m1) ==
code isnt ["COND",[p1,a1],[''T,a2]] =>
m = $Void => code
code' := coerceInteractive(objNew(quote2Wrapped code,m1),m) =>
- wrapped2Quote objVal code'
+ getValueNormalForm code'
throwKeyedMsgCannotCoerceWithValue(quote2Wrapped code,m1,m)
a1:=IFcodeTran(a1,m,m1)
a2:=IFcodeTran(a2,m,m1)
@@ -508,14 +508,14 @@ evalLET(lhs,rhs) ==
get(getUnname lhs,'autoDeclare,$env) =>
v:=
$genValue => v
- objNew(wrapped2Quote objVal v,objMode v)
+ objNew(getValueNormalForm v,objMode v)
evalLETput(lhs,v)
t1:= objMode v
t2' := (t2 := getMode lhs)
value:=
t1 = t2 =>
$genValue => v
- objNew(wrapped2Quote objVal v,objMode v)
+ objNew(getValueNormalForm v,objMode v)
if isPartialMode t2 then
if EQCAR(t1,'Symbol) and $declaredMode then
t1:= getMinimalVarMode(objValUnwrap v,$declaredMode)
@@ -985,7 +985,7 @@ upreturn t ==
val' := getArgValue(val, $mapTarget)
m := $mapTarget
else
- val' := wrapped2Quote objVal getValue val
+ val' := getValueNormalForm getValue val
m := computedMode val
cn := mapCatchName $mapName
$mapReturnTypes := insert(m, $mapReturnTypes)
diff --git a/src/testsuite/interpreter/eval-dep-type.input b/src/testsuite/interpreter/eval-dep-type.input
new file mode 100644
index 00000000..4f4279a4
--- /dev/null
+++ b/src/testsuite/interpreter/eval-dep-type.input
@@ -0,0 +1 @@
+reify OrderedVariableList [x,y]
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 04:56:21 +0000