aboutsummaryrefslogtreecommitdiff
path: root/src/interp/i-eval.boot
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2008-03-03 12:10:04 +0000
committerdos-reis <gdr@axiomatics.org>2008-03-03 12:10:04 +0000
commit44867f29f1b266f6a285a54202abec370c28e7d7 (patch)
treec45c9a19fccd994f48c4c02b07c4d30274df182b /src/interp/i-eval.boot
parentbd371dff087150c946a48a34299aabc893580ffe (diff)
downloadopen-axiom-44867f29f1b266f6a285a54202abec370c28e7d7.tar.gz
* interp/i-analy.boot (bottomUp): Don't record constructor
instantiations representations in interactive environments. * interp/i-eval.boot (evaluateFormAsType): New. (evaluateType): Use it. (evaluateType1): Tidy. * interp/i-output.boot (output): Tidy. * interp/i-object.boot ($genValue): Define here. * interp/sys-dirver.boot ($verbose): Rename from $verboseInterpreter. * interp/i-map.boot (genMapCode): Propagate $verbose renaming. * interp/slam.boot (compileRecurrenceRelation): Likewise.
Diffstat (limited to 'src/interp/i-eval.boot')
-rw-r--r--src/interp/i-eval.boot62
1 files changed, 36 insertions, 26 deletions
diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot
index 0eb5a136..156caec9 100644
--- a/src/interp/i-eval.boot
+++ b/src/interp/i-eval.boot
@@ -149,37 +149,47 @@ evaluateType form ==
op='Record =>
[op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]]
op='Enumeration => form
- evaluateType1 form
+ evaluateFormAsType form
constructor? form =>
ATOM form => evaluateType [form]
throwEvalTypeMsg("S2IE0003",[form,form])
+ evaluateFormAsType form
+
+++ `form' used in a context where a type (domain or category) is
+++ expected. Attempt to fully evaluate it. Error if the resulting
+++ value is not a type. When successful, the result is the reified
+++ canonical form of the type.
+evaluateFormAsType form ==
+ form is [op,:args] and constructor? op => evaluateType1 form
+ t := mkAtree form
+ -- ??? Maybe we should be more careful about generalized types.
+ bottomUp t is [m] and (m in $LangSupportTypes or isCategoryForm(m,$e)) =>
+ objVal getValue t
throwEvalTypeMsg("S2IE0004",[form])
-evaluateType1 form ==
- --evaluates the arguments passed to a constructor
- [op,:argl]:= form
- constructor? op =>
- null (sig := getConstructorSignature form) =>
- throwEvalTypeMsg("S2IE0005",[form])
- [.,:ml] := sig
- ml := replaceSharps(ml,form)
- # argl ^= #ml => throwEvalTypeMsg("S2IE0003",[form,form])
- for x in argl for m in ml for argnum in 1.. repeat
- typeList := [v,:typeList] where v() ==
- categoryForm?(m) =>
- m := evaluateType MSUBSTQ(x,'_$,m)
- evalCategory(x' := (evaluateType x), m) => x'
- throwEvalTypeMsg("S2IE0004",[form])
- m := evaluateType m
- GETDATABASE(opOf m,'CONSTRUCTORKIND) = 'domain and
- (tree := mkAtree x) and putTarget(tree,m) and ((bottomUp tree) is [m1]) =>
- [zt,:zv]:= z1:= getAndEvalConstructorArgument tree
- (v' := coerceOrRetract(z1,m)) => objValUnwrap v'
- throwKeyedMsgCannotCoerceWithValue(zv,zt,m)
- if x = $EmptyMode then x := $quadSymbol
- throwEvalTypeMsg("S2IE0006",[makeOrdinal argnum,m,form])
- [op,:NREVERSE typeList]
- throwEvalTypeMsg("S2IE0007",[op])
+++ evaluates the arguments passed to the constructor `op'.
+++ Note: only constructor instantiations go here.
+evaluateType1 (form is [op,:argl]) ==
+ null (sig := getConstructorSignature form) =>
+ throwEvalTypeMsg("S2IE0005",[form])
+ [.,:ml] := sig
+ ml := replaceSharps(ml,form)
+ # argl ^= #ml => throwEvalTypeMsg("S2IE0003",[form,form])
+ for x in argl for m in ml for argnum in 1.. repeat
+ typeList := [v,:typeList] where v() ==
+ categoryForm?(m) =>
+ m := evaluateType MSUBSTQ(x,'_$,m)
+ evalCategory(x' := (evaluateType x), m) => x'
+ throwEvalTypeMsg("S2IE0004",[form])
+ m := evaluateType m
+ GETDATABASE(opOf m,'CONSTRUCTORKIND) = 'domain and
+ (tree := mkAtree x) and putTarget(tree,m) and ((bottomUp tree) is [m1]) =>
+ [zt,:zv]:= z1:= getAndEvalConstructorArgument tree
+ (v' := coerceOrRetract(z1,m)) => objValUnwrap v'
+ throwKeyedMsgCannotCoerceWithValue(zv,zt,m)
+ if x = $EmptyMode then x := $quadSymbol
+ throwEvalTypeMsg("S2IE0006",[makeOrdinal argnum,m,form])
+ [op,:nreverse typeList]
throwEvalTypeMsg(msg, args) ==
$noEvalTypeMsg => spadThrow()