aboutsummaryrefslogtreecommitdiff
path: root/src/interp/i-eval.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-11-07 20:54:59 +0000
committerdos-reis <gdr@axiomatics.org>2007-11-07 20:54:59 +0000
commit4edaea6cff2d604009b8f2723a9436b0fc97895d (patch)
treeeb5d3765b2e4f131610571cf5f15eef53419fca0 /src/interp/i-eval.boot.pamphlet
parent45ce0071c30e84b72e4c603660285fa6a462e7f7 (diff)
downloadopen-axiom-4edaea6cff2d604009b8f2723a9436b0fc97895d.tar.gz
remove more pamphlets
Diffstat (limited to 'src/interp/i-eval.boot.pamphlet')
-rw-r--r--src/interp/i-eval.boot.pamphlet475
1 files changed, 0 insertions, 475 deletions
diff --git a/src/interp/i-eval.boot.pamphlet b/src/interp/i-eval.boot.pamphlet
deleted file mode 100644
index ed05090d..00000000
--- a/src/interp/i-eval.boot.pamphlet
+++ /dev/null
@@ -1,475 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp i-eval.boot}
-\author{The Axiom Team}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-\section{License}
-<<license>>=
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
---
--- Redistribution and use in source and binary forms, with or without
--- modification, are permitted provided that the following conditions are
--- met:
---
--- - Redistributions of source code must retain the above copyright
--- notice, this list of conditions and the following disclaimer.
---
--- - Redistributions in binary form must reproduce the above copyright
--- notice, this list of conditions and the following disclaimer in
--- the documentation and/or other materials provided with the
--- distribution.
---
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--- names of its contributors may be used to endorse or promote products
--- derived from this software without specific prior written permission.
---
--- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-@
-<<*>>=
-<<license>>
-
-import '"i-analy"
-)package "BOOT"
-
---% Constructor Evaluation
-
-$noEvalTypeMsg := nil
-
-evalDomain form ==
- if $evalDomain then
- sayMSG concat('" instantiating","%b",prefix2String form,"%d")
- startTimingProcess 'instantiation
- newType? form => form
- result := eval mkEvalable form
- stopTimingProcess 'instantiation
- result
-
-mkEvalable form ==
- form is [op,:argl] =>
- op="QUOTE" => form
- op="WRAPPED" => mkEvalable devaluate argl
- op="Record" => mkEvalableRecord form
- op="Union" => mkEvalableUnion form
- op="Mapping"=> mkEvalableMapping form
- op="Enumeration" => form
- loadIfNecessary op
- kind:= GETDATABASE(op,'CONSTRUCTORKIND)
- cosig := GETDATABASE(op, 'COSIG) =>
- [op,:[val for x in argl for typeFlag in rest cosig]] where val() ==
- typeFlag =>
- kind = 'category => MKQ x
- VECP x => MKQ x
- loadIfNecessary x
- mkEvalable x
- x is ['QUOTE,:.] => x
- x is ['_#,y] => ['SIZE,MKQ y]
- MKQ x
- [op,:[mkEvalable x for x in argl]]
- form=$EmptyMode => $Integer
- IDENTP form and constructor?(form) => [form]
- FBPIP form => BPINAME form
- form
-
-mkEvalableMapping form ==
- [first form,:[mkEvalable d for d in rest form]]
-
-mkEvalableRecord form ==
- [first form,:[[":",n,mkEvalable d] for [":",n,d] in rest form]]
-
-mkEvalableUnion form ==
- isTaggedUnion form =>
- [first form,:[[":",n,mkEvalable d] for [":",n,d] in rest form]]
- [first form,:[mkEvalable d for d in rest form]]
-
-evaluateType0 form ==
- -- Takes a parsed, unabbreviated type and evaluates it, replacing
- -- type valued variables with their values, and calling bottomUp
- -- on non-type valued arguemnts to the constructor
- -- and finally checking to see whether the type satisfies the
- -- conditions of its modemap
- -- However, the input might be an attribute, not a type
- -- $noEvalTypeMsg: fluid := true
- domain:= isDomainValuedVariable form => domain
- form = $EmptyMode => form
- form = "?" => $EmptyMode
- STRINGP form => form
- form = "$" => form
- $expandSegments : local := nil
- form is ['typeOf,.] =>
- form' := mkAtree form
- bottomUp form'
- objVal getValue(form')
- form is [op,:argl] =>
- op='CATEGORY =>
- argl is [x,:sigs] => [op,x,:[evaluateSignature(s) for s in sigs]]
- form
- op in '(Join Mapping) =>
- [op,:[evaluateType arg for arg in argl]]
- op='Union =>
- argl and first argl is [x,.,.] and member(x,'(_: Declare)) =>
- [op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]]
- [op,:[evaluateType arg for arg in argl]]
- op='Record =>
- [op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]]
- op='Enumeration => form
- constructor? op => evaluateType1 form
- NIL
- constructor? form =>
- ATOM form => evaluateType [form]
- throwEvalTypeMsg("S2IE0003",[form,form])
-
-evaluateType form ==
- -- Takes a parsed, unabbreviated type and evaluates it, replacing
- -- type valued variables with their values, and calling bottomUp
- -- on non-type valued arguemnts to the constructor
- -- and finally checking to see whether the type satisfies the
- -- conditions of its modemap
- domain:= isDomainValuedVariable form => domain
- form = $EmptyMode => form
- form = "?" => $EmptyMode
- STRINGP form => form
- form = "$" => form
- $expandSegments : local := nil
- form is ['typeOf,.] =>
- form' := mkAtree form
- bottomUp form'
- objVal getValue(form')
- form is [op,:argl] =>
- op='CATEGORY =>
- argl is [x,:sigs] => [op,x,:[evaluateSignature(s) for s in sigs]]
- form
- op in '(Join Mapping) =>
- [op,:[evaluateType arg for arg in argl]]
- op='Union =>
- argl and first argl is [x,.,.] and member(x,'(_: Declare)) =>
- [op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]]
- [op,:[evaluateType arg for arg in argl]]
- op='Record =>
- [op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]]
- op='Enumeration => form
- evaluateType1 form
- constructor? form =>
- ATOM form => evaluateType [form]
- throwEvalTypeMsg("S2IE0003",[form,form])
- 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])
-
-throwEvalTypeMsg(msg, args) ==
- $noEvalTypeMsg => spadThrow()
- throwKeyedMsg(msg, args)
-
-makeOrdinal i ==
- ('(first second third fourth fifth sixth seventh eighth ninth tenth)).(i-1)
-
-evaluateSignature sig ==
- -- calls evaluateType on a signature
- sig is [ ='SIGNATURE,fun,sigl] =>
- ['SIGNATURE,fun,
- [(t = '_$ => t; evaluateType(t)) for t in sigl]]
- sig
-
---% Code Evaluation
-
--- This code generates, then evaluates code during the bottom up phase
--- of interpretation
-
-splitIntoBlocksOf200 a ==
- null a => nil
- [[first (r:=x) for x in tails a for i in 1..200],
- :splitIntoBlocksOf200 rest r]
-
-evalForm(op,opName,argl,mmS) ==
- -- applies the first applicable function
- for mm in mmS until form repeat
- [sig,fun,cond]:= mm
- (CAR sig) = 'interpOnly => form := CAR sig
- #argl ^= #CDDR sig => 'skip ---> RDJ 6/95
- form:=
- $genValue or null cond =>
- [getArgValue2(x,t,sideEffectedArg?(t,sig,opName),opName) or return NIL
- for x in argl for t in CDDR sig]
- [getArgValueComp2(x,t,c,sideEffectedArg?(t,sig,opName),opName) or return NIL
- for x in argl for t in CDDR sig for c in cond]
- form or null argl =>
- dc:= CAR sig
- form :=
- dc='local => --[fun,:form]
- atom fun =>
- fun in $localVars => ['SPADCALL,:form,fun]
- [fun,:form,NIL]
- ['SPADCALL,:form,fun]
- dc is ["__FreeFunction__",:freeFun] =>
- ['SPADCALL,:form,freeFun]
- fun is ['XLAM,xargs,:xbody] =>
- rec := first form
- xbody is [['RECORDELT,.,ind,len]] =>
- optRECORDELT([CAAR xbody,rec,ind,len])
- xbody is [['SETRECORDELT,.,ind,len,.]] =>
- optSETRECORDELT([CAAR xbody,rec,ind,len,CADDR form])
- xbody is [['RECORDCOPY,.,len]] =>
- optRECORDCOPY([CAAR xbody,rec,len])
- ['FUNCALL,['function , ['LAMBDA,xargs,:xbody]],:TAKE(#xargs, form)]
- dcVector := evalDomain dc
- fun0 :=
- newType? CAAR mm =>
- mm' := first ncSigTransform mm
- ncGetFunction(opName, first mm', rest mm')
- NRTcompileEvalForm(opName,fun,dcVector)
- null fun0 => throwKeyedMsg("S2IE0008",[opName])
- [bpi,:domain] := fun0
- EQ(bpi,function Undef) =>
- sayKeyedMsg("S2IE0009",[opName,formatSignature CDR sig,CAR sig])
- NIL
- if $NRTmonitorIfTrue = true then
- sayBrightlyNT ['"Applying ",first fun0,'" to:"]
- pp [devaluateDeeply x for x in form]
- _$:fluid := domain
- ['SPADCALL, :form, fun0]
- not form => nil
--- not form => throwKeyedMsg("S2IE0008",[opName])
- form='interpOnly => rewriteMap(op,opName,argl)
- targetType := CADR sig
- if CONTAINED('_#,targetType) then targetType := NRTtypeHack targetType
- evalFormMkValue(op,form,targetType)
-
-sideEffectedArg?(t,sig,opName) ==
- opString := SYMBOL_-NAME opName
- (opName ^= 'setelt) and (ELT(opString, #opString-1) ^= char '_!) => nil
- dc := first sig
- t = dc
-
-getArgValue(a, t) ==
- atom a and not VECP a =>
- t' := coerceOrRetract(getBasicObject a,t)
- t' and wrapped2Quote objVal 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'
- nil
-
-getArgValue1(a,t) ==
- -- creates a value for a, coercing to t
- t' := getValue(a) =>
- (m := getMode a) and (m is ['Mapping,:ml]) and (m = t) and
- objValUnwrap(t') is ['MAP,:.] =>
- getMappingArgValue(a,t,m)
- t' := coerceOrRetract(t',t)
- t' and wrapped2Quote objVal t'
- systemErrorHere '"getArgValue"
-
-getArgValue2(a,t,se?,opName) ==
- se? and (objMode(getValue a) ^= t) =>
- throwKeyedMsg("S2IE0013", [opName, objMode(getValue a), t])
- getArgValue(a,t)
-
-getArgValueOrThrow(x, type) ==
- getArgValue(x,type) or throwKeyedMsg("S2IC0007",[type])
-
-getMappingArgValue(a,t,m is ['Mapping,:ml]) ==
- (una := getUnname a) in $localVars =>
- $genValue =>
- name := get(una,'name,$env)
- a.0 := name
- mmS := selectLocalMms(a,name,rest ml, nil)
- or/[mm for mm in mmS |
- (mm is [[., :ml1],oldName,:.] and ml=ml1)] => MKQ [oldName]
- NIL
- una
- mmS := selectLocalMms(a,una,rest ml, nil)
- or/[mm for mm in mmS |
- (mm is [[., :ml1],oldName,:.] and ml=ml1)] => MKQ [oldName]
- NIL
-
-getArgValueComp2(arg, type, cond, se?, opName) ==
- se? and (objMode(getValue arg) ^= type) =>
- throwKeyedMsg("S2IE0013", [opName, objMode(getValue arg), type])
- getArgValueComp(arg, type, cond)
-
-getArgValueComp(arg,type,cond) ==
- -- getArgValue for compiled case. if there is a condition then
- -- v must be data to verify that coerceInteractive succeeds.
- v:= getArgValue(arg,type)
- null v => nil
- null cond => v
- v is ['QUOTE,:.] or getBasicMode v => v
- n := getUnnameIfCan arg
- if num := isSharpVarWithNum n then
- not $compilingMap => n := 'unknownVar
- alias := get($mapName,'alias,$e)
- n := alias.(num - 1)
- keyedMsgCompFailure("S2IE0010",[n])
-
-evalFormMkValue(op,form,tm) ==
- val:=
- u:=
- $genValue => wrap timedEVALFUN form
- form
- objNew(u,tm)
---+
- if $NRTmonitorIfTrue = true then
- sayBrightlyNT ['"Value of ",op.0,'" ===> "]
- pp unwrap u
- putValue(op,val)
- [tm]
-
-failCheck x ==
- x = '"failed" =>
- stopTimingProcess peekTimedName()
- THROW('interpreter,objNewWrap('"failed",$String))
- x = $coerceFailure =>
- NIL
- x
-
---% Some Antique Comments About the Interpreter
-
---EVAL BOOT contains the top level interface to the Scratchhpad-II
---interpreter. The Entry point into the interpreter from the parser is
---processInteractive.
---The type analysis algorithm is contained in the file BOTMUP BOOT,
---and MODSEL boot,
---the map handling routines are in MAP BOOT and NEWMAP BOOT, and
---the interactive coerce routines are in COERCE BOOT and COERCEFN BOOT.
---
---Conventions:
--- All spad values in the interpreter are passed around in triples.
--- These are lists of three items: [value,mode,environment]. The value
--- may be wrapped (this is a pair whose CAR is the atom WRAPPED and
--- whose CDR is the value), which indicates that it is a real value,
--- or unwrapped in which case it needs to be EVALed to produce the
--- proper value. The mode is the type of value, and should always be
--- completely specified (not contain $EmptyMode). The environment
--- is always empty, and is included for historical reasons.
---
---Modemaps:
--- Modemaps are descriptions of compiled Spad function which the
--- interpreter uses to perform type analysis. They consist of patterns
--- of types for the arguments, and conditions the types must satisfy
--- for the function to apply. For each function name there is a list
--- of modemaps in file MODEMAP DATABASE for each distinct function with
--- that name. The following is the list of the modemaps for "*"
--- (multiplication. The first modemap (the one with the labels) is for
--- module mltiplication which is multiplication of an element of a
--- module by a member of its scalar domain.
---
--- This is the signature pattern for the modemap, it is of the form:
--- (DomainOfComputation TargetType <ArgumentType ...>)
--- |
--- | This is the predicate that needs to be
--- | satisfied for the modemap to apply
--- | |
--- V |
--- /-----------/ |
--- ( ( (*1 *1 *2 *1) V
--- /-----------------------------------------------------------/
--- ( (AND (ofCategory *1 (Module *2)) (ofCategory *2 (SimpleRing))) )
--- . CATDEF) <-- This is the file where the function was defined
--- ( (*1 *1 *2 *1)
--- ( (AND (isDomain *2 (Integer)) (ofCategory *1 (AbelianGroup))) )
--- . CATDEF)
--- ( (*1 *1 *2 *1)
--- ( (AND
--- (isDomain *2 (NonNegativeInteger))
--- (ofCategory *1 (AbelianMonoid))) )
--- . CATDEF)
--- ((*1 *1 *1 *1) ((ofCategory *1 (SemiGroup)) ) . CATDEF)
--- )
---
---Environments:
--- Environments associate properties with atoms.
--- (see CUTIL BOOT for the exact structure of environments).
--- Some common properties are:
--- modeSet:
--- During interpretation we build a modeSet property for each node in
--- the expression. This is (in theory) a list of all the types
--- possible for the node. In the current implementation these
--- modeSets always contain a single type.
--- value:
--- Value properties are always triples. This is where the values of
--- variables are stored. We also build value properties for internal
--- nodes during the bottom up phase.
--- mode:
--- This is the declared type of an identifier.
---
--- There are several different environments used in the interpreter:
--- $InteractiveFrame : this is the environment where the user
--- values are stored. Any side effects of evaluation of a top-level
--- expression are stored in this environment. It is always used as
--- the starting environment for interpretation.
--- $e : This is the name used for $InteractiveFrame while interpreting.
--- $env : This is local environment used by the interpreter.
--- Only temporary information (such as types of local variables is
--- stored in $env.
--- It is thrown away after evaluation of each expression.
---
---Frequently used global variables:
--- $genValue : if true then evaluate generated code, otherwise leave
--- code unevaluated. If $genValue is false then we are compiling.
--- $op: name of the top level operator (unused except in map printing)
--- $mapList: list of maps being type analyzed, used in recursive
--- map type anlysis.
--- $compilingMap: true when compiling a map, used to detect where to
--- THROW when interpret-only is invoked
--- $compilingLoop: true when compiling a loop body, used to control
--- nesting level of interp-only loop CATCH points
--- $interpOnly: true when in interpret only mode, used to call
--- alternate forms of COLLECT and REPEAT.
--- $inCOLLECT: true when compiling a COLLECT, used only for hacked
--- stream compiler.
--- $StreamFrame: used in printing streams, it is the environment
--- where local stream variables are stored
--- $declaredMode: Weak type propagation for symbols, set in upCOERCE
--- and upLET. This variable is used to determine
--- the alternate polynomial types of Symbols.
--- $localVars: list of local variables in a map body
--- $MapArgumentTypeList: hack for stream compilation
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}