aboutsummaryrefslogtreecommitdiff
path: root/src/interp
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
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')
-rw-r--r--src/interp/i-analy.boot5
-rw-r--r--src/interp/i-eval.boot62
-rw-r--r--src/interp/i-map.boot4
-rw-r--r--src/interp/i-object.boot3
-rw-r--r--src/interp/i-output.boot2
-rw-r--r--src/interp/slam.boot2
-rw-r--r--src/interp/sys-driver.boot13
-rw-r--r--src/interp/trace.boot2
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()