diff options
author | dos-reis <gdr@axiomatics.org> | 2008-03-03 12:10:04 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2008-03-03 12:10:04 +0000 |
commit | 44867f29f1b266f6a285a54202abec370c28e7d7 (patch) | |
tree | c45c9a19fccd994f48c4c02b07c4d30274df182b /src/interp/i-eval.boot | |
parent | bd371dff087150c946a48a34299aabc893580ffe (diff) | |
download | open-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.boot | 62 |
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() |