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 | |
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')
-rw-r--r-- | src/interp/i-analy.boot | 5 | ||||
-rw-r--r-- | src/interp/i-eval.boot | 62 | ||||
-rw-r--r-- | src/interp/i-map.boot | 4 | ||||
-rw-r--r-- | src/interp/i-object.boot | 3 | ||||
-rw-r--r-- | src/interp/i-output.boot | 2 | ||||
-rw-r--r-- | src/interp/slam.boot | 2 | ||||
-rw-r--r-- | src/interp/sys-driver.boot | 13 | ||||
-rw-r--r-- | src/interp/trace.boot | 2 |
8 files changed, 56 insertions, 37 deletions
diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index b4b4226d..a46c6b7a 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -248,6 +248,11 @@ bottomUp t == argModeSetList:= [bottomUp x for x in argl] ms := bottomUpForm(t,op,opName,argl,argModeSetList) + -- If this is a type producing form, then we don't want + -- to store the representation object in the environment. + -- Rather, we want to record the reified canonical form. + if ms is [m] and (m in $LangSupportTypes or isCategoryForm(m,$e)) + then putValue(t,objNew(devaluate objValUnwrap getValue t, m)) -- given no target or package calling, force integer constants to -- belong to tightest possible subdomain 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() diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index 7d0d2b27..882763df 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -710,8 +710,8 @@ genMapCode(op,body,sig,fnName,parms,isRecursive) == op0 := ( n := isSharpVarWithNum op ) => STRCONC('"<argument ",object2String n,'">") op - if $verboseInterprerter then - if $verboseInterprerter and get(op,'isInterpreterRule,$e) then + if $verbose then + if get(op,'isInterpreterRule,$e) then sayKeyedMsg("S2IM0014",[op0,(PAIRP sig =>prefix2String CAR sig;'"?")]) else sayKeyedMsg("S2IM0015",[op0,formatSignature sig]) $whereCacheList := [op,:$whereCacheList] diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot index 07fda0f6..77252919 100644 --- a/src/interp/i-object.boot +++ b/src/interp/i-object.boot @@ -34,6 +34,9 @@ import '"g-util" )package "BOOT" +++ true when the interpreter should evaluate forms to values, as +++ opposed to just generating code to compute values. +$genValue := true ++ true if we are about to generate a function definition $definingMap := false diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index ca2a31d8..f08cf82f 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -1383,7 +1383,7 @@ output(expr,domain) == if $formulaFormat then formulaFormat expr if $texFormat then texFormat expr if $algebraFormat then mathprintWithNumber expr - categoryForm? domain or domain in '((Mode) (Type)) => + categoryForm? domain or domain in '((Mode) (Domain) (Type)) => if $algebraFormat then mathprintWithNumber outputDomainConstructor expr if $texFormat then diff --git a/src/interp/slam.boot b/src/interp/slam.boot index 0bc23423..705f235f 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -241,7 +241,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == ["ELT",["LIST",:initCode],["QSDIFFERENCE",n,sharpArg]]] phrase5:= ['(QUOTE T),['recurrenceError,MKQ op,sharpArg]] ['PROGN,:preset,['COND,phrase1,phrase2,phrase3,phrase4,phrase5]] - if $verboseInterprerter then + if $verbose then sayKeyedMsg("S2IX0001",[op]) compileInteractive computeFunction compileInteractive mainFunction diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot index e6faafe4..9b35d618 100644 --- a/src/interp/sys-driver.boot +++ b/src/interp/sys-driver.boot @@ -48,10 +48,11 @@ $SpadServerName == '"/tmp/.d" ++ true means that the core executable acts as remote server. $SpadServer := false -++ if true, then the interpreter informs about code generation, etc. -$verboseInterprerter := true +++ if true, then the interpreter or compiler should inform about +++ code generation, etc. +$verbose := true -$PrintCompilerMessageIfTrue := true +$PrintCompilerMessageIfTrue := $verbose ++ $options := [] @@ -194,11 +195,11 @@ executeSpadScript(progname,options,file) == $NEWSPAD := true $SPAD := true if getOption(Option '"verbose",%systemOptions()) then - $verboseInterprerter := true + $verbose := true $options := [] $ProcessInteractiveValue := false else - $verboseInterprerter := false + $verbose := false $options := [["quiet"]] $ProcessInteractiveValue := true CATCH($intCoerceFailure, @@ -223,7 +224,7 @@ compileSpadLibrary(progname,options,file) == $SPAD := true $EchoLines := false ECHO_-META : fluid := false - $verboseInterprerter := false + $verbose := false $ProcessInteractiveValue := true CATCH($intTopLevel, CATCH("SpadCompileItem", diff --git a/src/interp/trace.boot b/src/interp/trace.boot index e6ee0e90..d6770d54 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -75,7 +75,7 @@ $lastUntraced := NIL trace l == traceSpad2Cmd l traceSpad2Cmd l == - if l is ['Tuple, l1] then l := l1 + if l is ["Tuple", l1] then l := l1 $mapSubNameAlist:= getMapSubNames(l) trace1 augmentTraceNames(l,$mapSubNameAlist) traceReply() |