\documentclass{article} \usepackage{axiom} \begin{document} \title{\$SPAD/src/interp i-intern.boot} \author{The Axiom Team} \maketitle \begin{abstract} \end{abstract} \eject \tableofcontents \eject \begin{verbatim} Internal Interpreter Facilities Vectorized Attributed Trees The interpreter translates parse forms into vats for analysis. These contain a number of slots in each node for information. The leaves are now all vectors, though the leaves for basic types such as integers and strings used to just be the objects themselves. The vectors for the leaves with such constants now have the value of $immediateDataSymbol as their name. Their are undoubtably still some functions that still check whether a leaf is a constant. Note that if it is not a vector it is a subtree. attributed tree nodes have the following form: slot description ---- ----------------------------------------------------- 0 operation name or literal 1 declared mode of variable 2 computed value of subtree from this node 3 modeset: list of single computed mode of subtree 4 prop list for extra things \end{verbatim} \section{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. @ <<*>>= <> SETANDFILEQ($useParserSrcPos, NIL) SETANDFILEQ($transferParserSrcPos, NIL) -- Making Trees mkAtreeNode x == -- maker of attrib tree node v := MAKE_-VEC 5 v.0 := x v mkAtree x == -- maker of attrib tree from parser form mkAtree1 mkAtreeExpandMacros x mkAtreeWithSrcPos(form, posnForm) == posnForm and $useParserSrcPos => pf2Atree(posnForm) transferSrcPosInfo(posnForm, mkAtree form) mkAtree1WithSrcPos(form, posnForm) == transferSrcPosInfo(posnForm, mkAtree1 form) mkAtreeNodeWithSrcPos(form, posnForm) == transferSrcPosInfo(posnForm, mkAtreeNode form) transferSrcPosInfo(pf, atree) == not (pf and $transferParserSrcPos) => atree pos := pfPosOrNopos(pf) pfNoPosition?(pos) => atree -- following is a hack because parser code for getting filename -- seems wrong. fn := lnPlaceOfOrigin poGetLineObject(pos) if NULL fn or fn = '"strings" then fn := '"console" putSrcPos(atree, fn, pfSourceText(pf), pfLinePosn(pos), pfCharPosn(pos)) atree mkAtreeExpandMacros x == -- handle macro expansion. if the macros have args we require that -- we match the correct number of args if x isnt ['MDEF,:.] and x isnt ['DEF,['macro,:.],:.] then atom x and (m := isInterpMacro x) => [args,:body] := m args => 'doNothing x := body x is [op,:argl] => op = 'QUOTE => 'doNothing op = 'where and argl is [before,after] => -- in a where clause, what follows "where" (the "after" parm -- above) might be a local macro, so do not expand the "before" -- part yet x := [op,before,mkAtreeExpandMacros after] argl := [mkAtreeExpandMacros a for a in argl] (m := isInterpMacro op) => [args,:body] := m #args = #argl => sl := [[a,:s] for a in args for s in argl] x := SUBLISNQ(sl,body) null args => x := [body,:argl] x := [op,:argl] x := [mkAtreeExpandMacros op,:argl] x mkAtree1 x == -- first special handler for making attrib tree null x => throwKeyedMsg("S2IP0005",['"NIL"]) VECP x => x atom x => x in '(noBranch noMapVal) => x x in '(nil true false) => mkAtree2([x],x,NIL) x = '_/throwAway => -- don't want to actually compute this tree := mkAtree1 '(void) putValue(tree,objNewWrap(voidValue(),$Void)) putModeSet(tree,[$Void]) tree getBasicMode x => v := mkAtreeNode $immediateDataSymbol putValue(v,getBasicObject x) v IDENTP x => mkAtreeNode x keyedSystemError("S2II0002",[x]) x is [op,:argl] => mkAtree2(x,op,argl) systemErrorHere '"mkAtree1" -- mkAtree2 and mkAtree3 were created because mkAtree1 got so big mkAtree2(x,op,argl) == nargl := #argl (op= '_-) and (nargl = 1) and (INTEGERP CAR argl) => mkAtree1(MINUS CAR argl) op='_: and argl is [y,z] => [mkAtreeNode 'Declare,:argl] op='COLLECT => [mkAtreeNode op,:transformCollect argl] op= 'break => argl is [.,val] => if val = '$NoValue then val := '(void) [mkAtreeNode op,mkAtree1 val] [mkAtreeNode op,mkAtree1 '(void)] op= 'return => argl is [val] => if val = '$NoValue then val := '(void) [mkAtreeNode op,mkAtree1 val] [mkAtreeNode op,mkAtree1 '(void)] op='exit => mkAtree1 CADR argl op = 'QUOTE => [mkAtreeNode op,:argl] op='SEGMENT => argl is [a] => [mkAtreeNode op, mkAtree1 a] z := null argl.1 => nil mkAtree1 argl.1 [mkAtreeNode op, mkAtree1 argl.0,z] op in '(pretend is isnt) => [mkAtreeNode op,mkAtree1 first argl,:rest argl] op = '_:_: => [mkAtreeNode 'COERCE,mkAtree1 first argl,CADR argl] x is ['_@, expr, type] => t := evaluateType unabbrev type t = '(DoubleFloat) and expr is [['_$elt, '(Float), 'float], :args] => mkAtree1 [['_$elt, '(DoubleFloat), 'float], :args] t = '(DoubleFloat) and INTEGERP expr => v := mkAtreeNode $immediateDataSymbol putValue(v,getBasicObject float expr) v t = '(Float) and INTEGERP expr => mkAtree1 ["::", expr, t] typeIsASmallInteger(t) and INTEGERP expr => mkAtree1 ["::", expr, t] [mkAtreeNode 'TARGET,mkAtree1 expr, type] (op='case) and (nargl = 2) => [mkAtreeNode 'case,mkAtree1 first argl,unabbrev CADR argl] op='REPEAT => [mkAtreeNode op,:transformREPEAT argl] op='LET and argl is [['construct,:.],rhs] => [mkAtreeNode 'LET,first argl,mkAtree1 rhs] op='LET and argl is [['_:,a,.],rhs] => mkAtree1 ['SEQ,first argl,['LET,a,rhs]] op is ['_$elt,D,op1] => op1 is '_= => a' := [mkAtreeNode '_=,:[mkAtree1 arg for arg in argl]] [mkAtreeNode 'Dollar,D,a'] [mkAtreeNode 'Dollar,D,mkAtree1 [op1,:argl]] op='_$elt => argl is [D,a] => INTEGERP a => a = 0 => mkAtree1 [['_$elt,D,'Zero]] a = 1 => mkAtree1 [['_$elt,D,'One]] t := evaluateType unabbrev [D] typeIsASmallInteger(t) and SINTP a => v := mkAtreeNode $immediateDataSymbol putValue(v,mkObjWrap(a, t)) v mkAtree1 ["*",a,[['_$elt,D,'One]]] [mkAtreeNode 'Dollar,D,mkAtree1 a] keyedSystemError("S2II0003",['"$",argl, '"not qualifying an operator"]) mkAtree3(x,op,argl) mkAtree3(x,op,argl) == op='REDUCE and argl is [op1,axis,body] => [mkAtreeNode op,axis,mkAtree1 op1,mkAtree1 body] op='has => [mkAtreeNode op, :argl] op='_| => [mkAtreeNode 'AlgExtension,:[mkAtree1 arg for arg in argl]] op='_= => [mkAtreeNode 'equation,:[mkAtree1 arg for arg in argl]] op='not and argl is [["=",lhs,rhs]] => [mkAtreeNode 'not,[mkAtreeNode "=",mkAtree1 lhs,mkAtree1 rhs]] op='in and argl is [var ,['SEGMENT,lb,ul]] => upTest:= null ul => NIL mkLessOrEqual(var,ul) lowTest:=mkLessOrEqual(lb,var) z := ul => ['and,lowTest,upTest] lowTest mkAtree1 z x is ['IF,p,'noBranch,a] => mkAtree1 ['IF,['not,p],a,'noBranch] x is ['RULEDEF,:.] => [mkAtreeNode 'RULEDEF,:CDR x] x is ['MDEF,sym,junk1,junk2,val] => -- new macros look like macro f == or macro f(x) === -- so transform into that format mkAtree1 ['DEF,['macro,sym],junk1,junk2,val] x is ["~=",a,b] => mkAtree1 ['not,["=",a,b]] x is ["+->",funargs,funbody] => if funbody is [":",body,type] then types := [type] funbody := body else types := [NIL] v := collectDefTypesAndPreds funargs types := [:types,:v.1] [mkAtreeNode 'ADEF,[v.0,types,[NIL for a in types],funbody], if v.2 then v.2 else true, false] x is ['ADEF,arg,:r] => r := mkAtreeValueOf r v := null arg => VECTOR(NIL,NIL,NIL) PAIRP arg and rest arg and first arg^= "|" => collectDefTypesAndPreds ['Tuple,:arg] null rest arg => collectDefTypesAndPreds first arg collectDefTypesAndPreds arg [types,:r'] := r at := [fn(x,y) for x in rest types for y in v.1] where fn(a,b) == a and b => if a = b then a else throwMessage '" double declaration of parameter" a or b r := [[first types,:at],:r'] [mkAtreeNode 'ADEF,[v.0,:r],if v.2 then v.2 else true,false] x is ['where,before,after] => [mkAtreeNode 'where,before,mkAtree1 after] x is ['DEF,['macro,form],.,.,body] => [mkAtreeNode 'MDEF,form,body] x is ['DEF,a,:r] => r := mkAtreeValueOf r a is [op,:arg] => v := null arg => VECTOR(NIL,NIL,NIL) PAIRP arg and rest arg and first arg^= "|" => collectDefTypesAndPreds ['Tuple,:arg] null rest arg => collectDefTypesAndPreds first arg collectDefTypesAndPreds arg [types,:r'] := r -- see case for ADEF above for defn of fn at := [fn(x,y) for x in rest types for y in v.1] r := [[first types,:at],:r'] [mkAtreeNode 'DEF,[[op,:v.0],:r],if v.2 then v.2 else true,false] [mkAtreeNode 'DEF,[a,:r],true,false] --x is ['when,y,pred] => -- y isnt ['DEF,a,:r] => -- keyedSystemError("S2II0003",['"when",y,'"improper argument form"]) -- a is [op,p1,:pr] => -- null pr => mkAtree1 ['DEF,[op,["|",p1,pred]],:r] -- mkAtree1 ['DEF,[op,["|",['Tuple,p1,:pr],pred]],:r] -- [mkAtreeNode 'DEF, CDR y,pred,false] --x is ['otherwise,u] => -- throwMessage '" otherwise is no longer supported." z := getBasicMode op => v := mkAtreeNode $immediateDataSymbol putValue(v,getBasicObject op) v atom op => mkAtreeNode op mkAtree1 op [z,:[mkAtree1 y for y in argl]] collectDefTypesAndPreds args == -- given an arglist to a DEF-like form, this function returns -- a vector of three things: -- slot 0: just the variables -- slot 1: the type declarations on the variables -- slot 2: a predicate for all arguments pred := types := vars := NIL junk := IDENTP args => types := [NIL] vars := [args] args is [":",var,type] => types := [type] var is ["|",var',p] => vars := [var'] pred := addPred(pred,p) where addPred(old,new) == null new => old null old => new ['and,old,new] vars := [var] args is ["|",var,p] => pred := addPred(pred,p) var is [":",var',type] => types := [type] vars := [var'] var is ['Tuple,:.] or var is ["|",:.] => v := collectDefTypesAndPreds var vars := [:vars,:v.0] types := [:types,:v.1] pred := addPred(pred,v.2) vars := [var] types := [NIL] args is ['Tuple,:args'] => for a in args' repeat v := collectDefTypesAndPreds a vars := [:vars,first v.0] types := [:types,first v.1] pred := addPred(pred,v.2) types := [NIL] vars := [args] VECTOR(vars,types,pred) mkAtreeValueOf l == -- scans for ['valueOf,atom] not CONTAINED('valueOf,l) => l mkAtreeValueOf1 l mkAtreeValueOf1 l == null l or atom l or null rest l => l l is ['valueOf,u] and IDENTP u => v := mkAtreeNode $immediateDataSymbol putValue(v,get(u,'value,$InteractiveFrame) or objNewWrap(u,['Variable,u])) v [mkAtreeValueOf1 x for x in l] mkLessOrEqual(lhs,rhs) == ['not,['_<,rhs,lhs]] emptyAtree expr == -- remove mode, value, and misc. info from attrib tree VECP expr => $immediateDataSymbol = expr.0 => nil expr.1:= NIL expr.2:= NIL expr.3:= NIL -- kill proplist too? atom expr => nil for e in expr repeat emptyAtree e unVectorize body == -- transforms from an atree back into a tree VECP body => name := getUnname body name ^= $immediateDataSymbol => name objValUnwrap getValue body atom body => body body is [op,:argl] => newOp:=unVectorize op if newOp = 'SUCHTHAT then newOp := '_| if newOp = 'COERCE then newOp := '_:_: if newOp = 'Dollar then newOp := "$elt" [newOp,:unVectorize argl] systemErrorHere '"unVectorize" -- Stuffing and Getting Info putAtree(x,prop,val) == x is [op,:.] => -- only willing to add property if op is a vector -- otherwise will be pushing to deeply into calling structure if VECP op then putAtree(op,prop,val) x null VECP x => x -- just ignore it n := QLASSQ(prop,'((mode . 1) (value . 2) (modeSet . 3))) => x.n := val x.4 := insertShortAlist(prop,val,x.4) x getAtree(x,prop) == x is [op,:.] => -- only willing to get property if op is a vector -- otherwise will be pushing to deeply into calling structure VECP op => getAtree(op,prop) NIL null VECP x => NIL -- just ignore it n:= QLASSQ(prop,'((mode . 1) (value . 2) (modeSet . 3))) => x.n QLASSQ(prop,x.4) putTarget(x, targ) == -- want to put nil modes perhaps to clear old target if targ = $EmptyMode then targ := nil putAtree(x,'target,targ) getTarget(x) == getAtree(x,'target) insertShortAlist(prop,val,al) == pair := QASSQ(prop,al) => RPLACD(pair,val) al [[prop,:val],:al] transferPropsToNode(x,t) == propList := getProplist(x,$env) QLASSQ('Led,propList) or QLASSQ('Nud,propList) => nil node := VECP t => t first t for prop in '(mode localModemap value name generatedCode) repeat transfer(x,node,prop) where transfer(x,node,prop) == u := get(x,prop,$env) => putAtree(node,prop,u) (not (x in $localVars)) and (u := get(x,prop,$e)) => putAtree(node,prop,u) if not getMode(t) and (am := get(x,'automode,$env)) then putModeSet(t,[am]) putMode(t,am) t isLeaf x == atom x --may be a number or a vector getMode x == x is [op,:.] => getMode op VECP x => x.1 m := getBasicMode x => m keyedSystemError("S2II0001",[x]) putMode(x,y) == x is [op,:.] => putMode(op,y) null VECP x => keyedSystemError("S2II0001",[x]) x.1 := y getValue x == VECP x => x.2 atom x => t := getBasicObject x => t keyedSystemError("S2II0001",[x]) getValue first x putValue(x,y) == x is [op,:.] => putValue(op,y) null VECP x => keyedSystemError("S2II0001",[x]) x.2 := y putValueValue(vec,val) == putValue(vec,val) vec getUnnameIfCan x == VECP x => x.0 x is [op,:.] => getUnnameIfCan op atom x => x nil getUnname x == x is [op,:.] => getUnname op getUnname1 x getUnname1 x == VECP x => x.0 null atom x => keyedSystemError("S2II0001",[x]) x computedMode t == getModeSet t is [m] => m keyedSystemError("S2GE0016",['"computedMode",'"non-singleton modeset"]) putModeSet(x,y) == x is [op,:.] => putModeSet(op,y) not VECP x => keyedSystemError("S2II0001",[x]) x.3 := y y getModeOrFirstModeSetIfThere x == x is [op,:.] => getModeOrFirstModeSetIfThere op VECP x => m := x.1 => m val := x.2 => objMode val y := x.aModeSet => (y = [$EmptyMode]) and ((m := getMode x) is ['Mapping,:.]) => m first y NIL m := getBasicMode x => m NIL getModeSet x == x and PAIRP x => getModeSet first x VECP x => y:= x.aModeSet => (y = [$EmptyMode]) and ((m := getMode x) is ['Mapping,:.]) => [m] y keyedSystemError("S2GE0016",['"getModeSet",'"no mode set"]) m:= getBasicMode x => [m] null atom x => getModeSet first x keyedSystemError("S2GE0016",['"getModeSet", '"not an attributed tree"]) getModeSetUseSubdomain x == x and PAIRP x => getModeSetUseSubdomain first x VECP(x) => -- don't play subdomain games with retracted args getAtree(x,'retracted) => getModeSet x y := x.aModeSet => (y = [$EmptyMode]) and ((m := getMode x) is ['Mapping,:.]) => [m] val := getValue x (x.0 = $immediateDataSymbol) and (y = [$Integer]) => val := objValUnwrap val m := getBasicMode0(val,true) x.2 := objNewWrap(val,m) x.aModeSet := [m] [m] null val => y isEqualOrSubDomain(objMode(val),$Integer) and INTEGERP(f := objValUnwrap val) => [getBasicMode0(f,true)] y keyedSystemError("S2GE0016", ['"getModeSetUseSubomain",'"no mode set"]) m := getBasicMode0(x,true) => [m] null atom x => getModeSetUseSubdomain first x keyedSystemError("S2GE0016", ['"getModeSetUseSubomain",'"not an attributed tree"]) atree2EvaluatedTree x == atree2Tree1(x,true) atree2Tree1(x,evalIfTrue) == (triple := getValue x) and objMode(triple) ^= $EmptyMode => coerceOrCroak(triple,$OutputForm,$mapName) isLeaf x => VECP x => x.0 x [atree2Tree1(y,evalIfTrue) for y in x] --% Environment Utilities -- getValueFromEnvironment(x,mode) == -- $failure ^= (v := getValueFromSpecificEnvironment(x,mode,$env)) => v -- $failure ^= (v := getValueFromSpecificEnvironment(x,mode,$e)) => v -- throwKeyedMsg("S2IE0001",[x]) getValueFromEnvironment(x,mode) == $failure ^= (v := getValueFromSpecificEnvironment(x,mode,$env)) => v $failure ^= (v := getValueFromSpecificEnvironment(x,mode,$e)) => v null(v := coerceInt(objNew(x, ['Variable, x]), mode)) => throwKeyedMsg("S2IE0001",[x]) objValUnwrap v getValueFromSpecificEnvironment(id,mode,e) == PAIRP e => u := get(id,'value,e) => objMode(u) = $EmptyMode => systemErrorHere '"getValueFromSpecificEnvironment" v := objValUnwrap u mode isnt ['Mapping,:mapSig] => v v isnt ['MAP,:.] => v v' := coerceInt(u,mode) null v' => throwKeyedMsg("S2IC0002",[objMode u,mode]) objValUnwrap v' m := get(id,'mode,e) => -- See if we can make it into declared mode from symbolic form -- For example, (x : P[x] I; x + 1) if isPartialMode(m) then m' := resolveTM(['Variable,id],m) else m' := m m' and (u := coerceInteractive(objNewWrap(id,['Variable,id]),m')) => objValUnwrap u throwKeyedMsg("S2IE0002",[id,m]) $failure $failure addBindingInteractive(var,proplist,e is [[curContour,:.],:.]) == -- change proplist of var in e destructively u := ASSQ(var,curContour) => RPLACD(u,proplist) e RPLAC(CAAR e,[[var,:proplist],:curContour]) e augProplistInteractive(proplist,prop,val) == u := ASSQ(prop,proplist) => RPLACD(u,val) proplist [[prop,:val],:proplist] getFlag x == get("--flags--",x,$e) putFlag(flag,value) == $e := put ("--flags--", flag, value, $e) get(x,prop,e) == $InteractiveMode => get0(x,prop,e) get1(x,prop,e) get0(x,prop,e) == null atom x => get(QCAR x,prop,e) u:= QLASSQ(x,CAR QCAR e) => QLASSQ(prop,u) (tail:= CDR QCAR e) and (u:= fastSearchCurrentEnv(x,tail)) => QLASSQ(prop,u) nil get1(x,prop,e) == --this is the old get null atom x => get(QCAR x,prop,e) prop="modemap" and $insideCapsuleFunctionIfTrue=true => LASSOC("modemap",getProplist(x,$CapsuleModemapFrame)) or get2(x,prop,e) LASSOC(prop,getProplist(x,e)) or get2(x,prop,e) get2(x,prop,e) == prop="modemap" and constructor? x => (u := getConstructorModemap(x)) => [u] nil nil getI(x,prop) == get(x,prop,$InteractiveFrame) putI(x,prop,val) == ($InteractiveFrame := put(x,prop,val,$InteractiveFrame)) getIProplist x == getProplist(x,$InteractiveFrame) removeBindingI x == RPLAC(CAAR $InteractiveFrame,deleteAssocWOC(x,CAAR $InteractiveFrame)) rempropI(x,prop) == id:= atom x => x first x getI(id,prop) => recordNewValue(id,prop,NIL) recordOldValue(id,prop,getI(id,prop)) $InteractiveFrame:= remprop(id,prop,$InteractiveFrame) remprop(x,prop,e) == u:= ASSOC(prop,pl:= getProplist(x,e)) => e:= addBinding(x,DELASC(first u,pl),e) e e fastSearchCurrentEnv(x,currentEnv) == u:= QLASSQ(x,CAR currentEnv) => u while (currentEnv:= QCDR currentEnv) repeat u:= QLASSQ(x,CAR currentEnv) => u put(x,prop,val,e) == $InteractiveMode and not EQ(e,$CategoryFrame) => putIntSymTab(x,prop,val,e) --e must never be $CapsuleModemapFrame null atom x => put(first x,prop,val,e) newProplist:= augProplistOf(x,prop,val,e) prop="modemap" and $insideCapsuleFunctionIfTrue=true => SAY ["**** modemap PUT on CapsuleModemapFrame: ",val] $CapsuleModemapFrame:= addBinding(x,augProplistOf(x,"modemap",val,$CapsuleModemapFrame), $CapsuleModemapFrame) e addBinding(x,newProplist,e) putIntSymTab(x,prop,val,e) == null atom x => putIntSymTab(first x,prop,val,e) pl0 := pl := search(x,e) pl := null pl => [[prop,:val]] u := ASSQ(prop,pl) => RPLACD(u,val) pl lp := LASTPAIR pl u := [[prop,:val]] RPLACD(lp,u) pl EQ(pl0,pl) => e addIntSymTabBinding(x,pl,e) addIntSymTabBinding(var,proplist,e is [[curContour,:.],:.]) == -- change proplist of var in e destructively u := ASSQ(var,curContour) => RPLACD(u,proplist) e RPLAC(CAAR e,[[var,:proplist],:curContour]) e --% Source and position information -- In the following, src is a string containing an original input line, -- line is the line number of the string within the source file, -- and col is the index within src of the start of the form represented -- by x. x is a VAT. putSrcPos(x, file, src, line, col) == putAtree(x, 'srcAndPos, srcPos_New(file, src, line, col)) getSrcPos(x) == getAtree(x, 'srcAndPos) srcPosNew(file, src, line, col) == LIST2VEC [file, src, line, col] srcPosFile(sp) == if sp then sp.0 else nil srcPosSource(sp) == if sp then sp.1 else nil srcPosLine(sp) == if sp then sp.2 else nil srcPosColumn(sp) == if sp then sp.3 else nil srcPosDisplay(sp) == null sp => nil s := STRCONC('"_"", srcPosFile sp, '"_", line ", STRINGIMAGE srcPosLine sp, '": ") sayBrightly [s, srcPosSource sp] col := srcPosColumn sp dots := col = 0 => '"" fillerSpaces(col, '".") sayBrightly [fillerSpaces(#s, '" "), dots, '"^"] true --% Functions on interpreter objects -- Interpreter objects used to be called triples because they had the -- structure [value, type, environment]. For many years, the environment -- was not used, so finally in January, 1990, the structure of objects -- was changed to be (type . value). This was chosen because it was the -- structure of objects of type Any. Sometimes the values are wrapped -- (see the function isWrapped to see what this means physically). -- Wrapped values are not actual values belonging to their types. An -- unwrapped value must be evaluated to get an actual value. A wrapped -- value must be unwrapped before being passed to a library function. -- Typically, an unwrapped value in the interpreter consists of LISP -- code, e.g., parts of a function that is being constructed. -- RSS 1/14/90 -- These are the new structure functions. mkObj(val, mode) == CONS(mode,val) -- old names mkObjWrap(val, mode) == CONS(mode,wrap val) mkObjCode(val, mode) == ['CONS, MKQ mode,val ] objNew(val, mode) == CONS(mode,val) -- new names as of 10/14/93 objNewWrap(val, mode) == CONS(mode,wrap val) objNewCode(val, mode) == ['CONS, MKQ mode,val ] objSetVal(obj,val) == RPLACD(obj,val) objSetMode(obj,mode) == RPLACA(obj,mode) objVal obj == CDR obj objValUnwrap obj == unwrap CDR obj objMode obj == CAR obj objEnv obj == $NE objCodeVal obj == CADDR obj objCodeMode obj == CADR obj --% Library compiler structures needed by the interpreter -- Tuples and Crosses asTupleNew(size, listOfElts) == CONS(size, LIST2VEC listOfElts) asTupleNew0(listOfElts) == CONS(#listOfElts, LIST2VEC listOfElts) asTupleNewCode(size, listOfElts) == ["asTupleNew", size, ['LIST, :listOfElts]] asTupleNewCode0(listForm) == ["asTupleNew0", listForm] asTupleSize(at) == CAR at asTupleAsVector(at) == CDR at asTupleAsList(at) == VEC2LIST asTupleAsVector at @ \eject \begin{thebibliography}{99} \bibitem{1} nothing \end{thebibliography} \end{document}