DIRECTORY
AMBridge USING [FHFromTV, GetWorld, GFHFromTV, IsRemote, Loophole, PointerFromTV, RemoteFHFromTV, RemoteGFHFromTV, SetTVFromLC, SomeRefFromTV, TVForReadOnlyReferent, TVForReferent, TVForType, TVToCardinal, TVToInteger, TVToLC, TVToLI, TVToReal, RefFromTV, TVToRef],
AMEvents USING [Apply],
AMMiniModel USING [AcquireIRType, GetInterfaceRecord, GetInterfaceRecordFromType],
AMModel USING [Context, ContextWorld, ContextClass, MostRecentNamedContext, RootContext],
AMModelBridge USING [FrameFromContext, IRFromContext],
AMTypes USING [Apply, Assign, AssignNew, Class, Coerce, Copy, Domain, Error, First, GroundStar, IndexToTV, IndexToType, IsComputed, IsInterface, IsOverlaid, Last, Length, NameToIndex, NComponents, New, Next, Prev, Range, Referent, Size, TVEqual, TVStatus, TVToType, TVType, TypeClass, UnderClass, UnderType, VariableType, Variant, GetEmptyTV, TV],
BackStop USING [Call, ResumeBackStop, SuspendBackStop],
EvalQuote USING [EvalQuoteProc, Lookup, NameClosure],
InterpreterOps USING [EvalHead, RopeOrTV, Ruminant, Tree, TreeToName],
InterpreterPrivate,
BBUrpEval USING [UrpFatal, UrpId, UrpSelector, UrpWrongType],
PPLeaves USING [HTIndex, LTIndex],
PPTree USING [Handle, Link, NodeName],
PPTreeOps,
Real USING [FRem],
Rope USING [Flatten, Match, ROPE, Size, Substr, Fetch],
SafeStorage USING [nullType, Type],
SymTab USING [Create, EachPairAction, Pairs, Fetch, Ref, Store],
UserProfile USING [Boolean],
WorldVM USING [LocalWorld, World];

EvaluateImpl: CEDAR MONITOR
IMPORTS AMBridge, AMEvents, AMMiniModel, AMModel, AMModelBridge, AMTypes, BackStop, BBUrpEval, EvalQuote, InterpreterOps, InterpreterPrivate, PPTreeOps, Real, Rope, SymTab, UserProfile, WorldVM
EXPORTS InterpreterOps, InterpreterPrivate
= BEGIN OPEN AMBridge, AMTypes, InterpreterOps, InterpreterPrivate, BBUrpEval, SafeStorage;

CARD: TYPE = LONG CARDINAL;
LORope: TYPE = LIST OF ROPE; 
LORA: TYPE = LIST OF REF; 
Node: TYPE = PPTree.Handle;
ROPE: TYPE = Rope.ROPE;


empty: TV _ GetEmptyTV[];

underLORope: Type _ CODE[LORope];
underLORA: Type _ CODE[LORA];
underPROC: Type _ CODE[PROC];
underREF: Type _ CODE[REF];
underBOOL: Type _ CODE[BOOL];
underTYPE: Type _ CODE[Type];
underCARD: Type _ CODE[CARD];
underSIGANY: Type _ CODE[SIGNAL ANY RETURNS ANY];

trueCard: CARDINAL _ LOOPHOLE[TRUE, CARDINAL];
falseCard: CARDINAL _ LOOPHOLE[FALSE, CARDINAL]; 

true: TV _ NIL;
false: TV _ NIL;
NilTV: TV _ NIL;

globalSymTab: SymTab.Ref _ SymTab.Create[]; 
helpTable: SymTab.Ref _ SymTab.Create[];

tvWorldInit: BOOL _ FALSE;
tvWorldInitMsg: ROPE _ NIL; -- reason for failure to init (if any)


GetNilTV: PUBLIC PROC RETURNS [TV] =  {
IF NOT tvWorldInit THEN EnsureInit[];
RETURN[NilTV];
};

GetGlobalSymTab: PUBLIC PROC RETURNS [SymTab.Ref] =  {
IF NOT tvWorldInit THEN EnsureInit[];
RETURN[globalSymTab];
};

GetTypeOfSafeStorageDotType: PUBLIC PROC RETURNS [Type] =  {
IF NOT tvWorldInit THEN EnsureInit[];
RETURN[underTYPE];
};

WorldFromHead: PUBLIC PROC [head: EvalHead] RETURNS [world: WorldVM.World _ NIL] = TRUSTED {
IF head # NIL THEN world _ AMModel.ContextWorld[head.context];
IF world = NIL THEN world _ WorldVM.LocalWorld[];
};

EnsureInit: ENTRY PROC = {
ENABLE UNWIND => NULL;
TVForUnderType: PROC [under: Type] RETURNS [TV] = TRUSTED {
RETURN [AMBridge.TVForReadOnlyReferent[NEW[Type _ UnderType[under]]]]
}; 
inner: INTERNAL PROC = TRUSTED {
lag: TV _ NIL;
true _ TVForReadOnlyReferent[NEW[BOOL _ TRUE]];
false _ TVForReadOnlyReferent[NEW[BOOL _ FALSE]];
NilTV _ TVForReadOnlyReferent[NEW[REF _ NIL]];
underLORope _ UnderType[underLORope];
underLORA _ UnderType[underLORA];
underPROC _ UnderType[underPROC];
underREF _ UnderType[underREF];
underBOOL _ UnderType[underBOOL];
underTYPE _ UnderType[underTYPE];
underCARD _ UnderType[underCARD];
underSIGANY _ UnderType[underSIGANY];
DoRegisterTV["TRUE", true, "Boolean value"];
DoRegisterTV["FALSE", false, "Boolean value"];
DoRegisterTV["ATOM", TVForUnderType[CODE[ATOM]], " ... the TYPE"]; 
DoRegisterTV["BOOL", lag _ TVForUnderType[CODE[BOOL]], " ... the TYPE"]; 
DoRegisterTV["BOOLEAN", lag, " ... the TYPE"]; 
DoRegisterTV["CHAR", lag _ TVForUnderType[CODE[CHAR]], " ... the TYPE"];
DoRegisterTV["CHARACTER", lag, " ... the TYPE"];
DoRegisterTV["CARD", TVForUnderType[CODE[CARD]], " ... the TYPE"];
DoRegisterTV["CARDINAL", TVForUnderType[CODE[CARDINAL]], " ... the TYPE"];
DoRegisterTV["INT", TVForUnderType[CODE[INT]], " ... the TYPE"]; 
DoRegisterTV["INTEGER", TVForUnderType[CODE[INTEGER]], " ... the TYPE"]; 
DoRegisterTV["NAT", TVForUnderType[CODE[NAT]], " ... the TYPE"]; 
DoRegisterTV["LORope", TVForUnderType[CODE[NAT]], " ... the TYPE"]; 
DoRegisterTV["LORA", TVForUnderType[underLORA], " ... the TYPE: LIST OF REF ANY"]; 
DoRegisterTV["LORope", TVForUnderType[underLORope], " ... the TYPE: LIST OF ROPE"]; 
DoRegisterTV["PROC", TVForUnderType[underPROC], " ... the TYPE: PROC"]; 
DoRegisterTV[
"PROCANY",
TVForUnderType[CODE[PROC ANY RETURNS ANY]],
" ... the TYPE: PROC ANY RETURNS ANY"
]; 
DoRegisterTV[
"SIGANY",
TVForUnderType[underSIGANY],
" ... the TYPE: SIGNALS ANY"
]; 
DoRegisterTV["PROCESS", TVForUnderType[CODE[PROCESS]], " ... the TYPE: PROCESS"]; 
DoRegisterTV["REAL", TVForUnderType[CODE[REAL]], " ... the TYPE"]; 
DoRegisterTV["REF", TVForUnderType[CODE[REF]], " ... the TYPE: REF ANY"]; 
DoRegisterTV["ROPE", TVForUnderType[CODE[ROPE]], " ... the TYPE"]; 
DoRegisterTV["WORD", TVForUnderType[CODE[WORD]], " ... the TYPE"]; 
tvWorldInit _ TRUE;
};
IF NOT tvWorldInit THEN tvWorldInitMsg _ BackStop.Call[inner];
};

EvalNoProps: PUBLIC PROC [tree: Tree, head: EvalHead, target: Type] RETURNS [TV] = {
IF tree = NIL THEN RETURN [NIL];
IF NOT tvWorldInit THEN EnsureInit[];
WITH tree SELECT FROM
hti: PPLeaves.HTIndex => RETURN [Lookup[hti.name, head, target, tree]];
name: ROPE => RETURN [Lookup[name, head, target, tree]];
lti: PPLeaves.LTIndex => RETURN [EvalLti[lti, head]];
node: Node => RETURN [EvalNode[node, head, target]]
ENDCASE => ERROR
};

EnableBlock: PUBLIC PROC [head: EvalHead, handler: InterpreterPrivate.ErrorHandler, data: REF] = {
IF head.specials # NIL THEN {
new: REF InterpreterPrivate.ErrorHandlerObj _ NEW[InterpreterPrivate.ErrorHandlerObj _ [handler, data]];
[] _ SymTab.Store[head.specials, "?ErrorHandler", new]
};
};

EvalAndNoteSignalling: PROC [tree: Tree, head: EvalHead, target: Type] RETURNS [rtn: TV _ NIL, signalled: BOOL _ FALSE] = {
WITH tree SELECT FROM
node: Node => IF node.name = apply THEN {
nSons: CARDINAL _ node.sonLimit - 1;
son1: Tree _ IF nSons > 0 THEN node.son[1] ELSE NIL;
son2: Tree _ IF nSons > 1 THEN node.son[2] ELSE NIL;
[rtn, signalled] _ EvalApply[son1, son2, head, target, node];
RETURN;
};
ENDCASE;
rtn _ EvalNoProps[tree, head, target];
};

EvalNode: PROC [node: Node, head: EvalHead, target: Type] RETURNS [rtn: TV _ NIL] = TRUSTED {
errmsg: ROPE _ NIL;
rtnRef: REF _ NIL;
kind: PPTree.NodeName = node.name;
nSons: CARDINAL _ node.sonLimit - 1;
son1: Tree _ IF nSons > 0 THEN node.son[1] ELSE NIL;
son2: Tree _ IF nSons > 1 THEN node.son[2] ELSE NIL;
SubEval: PROC [tree: Tree, target: Type] RETURNS [TV] = TRUSTED {
RETURN [EvalNoProps[tree, head, target]];
};
SubEval0: PROC [tree: Tree] RETURNS [TV] = TRUSTED {
RETURN [EvalNoProps[tree, head, nullType]];
};
SubEval1: PROC [tree: Tree] RETURNS [TV] = TRUSTED {
RETURN [EvalNoProps[tree, head, target]];
};
Listify: PROC [tv: TV] RETURNS [LORA] = TRUSTED {
RETURN [LIST[AMBridge.TVToRef[tv]]]
};
EvalBool: PROC [tree: Tree] RETURNS [BOOL] = TRUSTED {
RETURN [ForceBoolean[SubEval[tree, underBOOL], head, tree]]
};

{SELECT kind FROM
assignx, assign, extractx, extract =>
RETURN [EvalAssign[son1, son2, head, target, node]];
if, ifx => {
test: BOOL _ EvalBool[son1];
IF NOT test THEN son2 _ IF nSons > 2 THEN node.son[3] ELSE NIL;
RETURN [SubEval1[son2]];
};
signal, error => {
ans: TV;
signalled: BOOL;
[ans, signalled] _ EvalAndNoteSignalling[son1, head, target];
IF NOT signalled THEN DO
SELECT UnderClass[TVType[ans]] FROM
signal, error => {ans _ DoApply[head, ans, NIL, node, FALSE]; EXIT};
ENDCASE => ans _ UrpWrongType[head, son1, ans, underSIGANY, "not a SIGNAL or ERROR"];
ENDLOOP;
IF kind = error THEN UrpFatal[head, node, "returned from ERROR"];
RETURN [ans];
};
processTC =>
RETURN [Lookup["PROCESS", head, target, node]];
longTC => {
tv1: TV _ SubEval0[son1];
type: Type _ TVToType[tv1];
SELECT UnderClass[type] FROM
cardinal => RETURN [globalSymTab.Fetch["CARD"].val];
integer => RETURN [globalSymTab.Fetch["INT"].val];
ref, atom, rope => RETURN [tv1];
ENDCASE => GO TO NYI;
};
refTC => {
kind: PPTree.NodeName _ anyTC;
WITH son1 SELECT FROM
node1: Node => kind _ anyTC;
ENDCASE;
IF kind # anyTC THEN GO TO NYI;
RETURN [globalSymTab.Fetch["REF"].val];
};
apply =>
RETURN [EvalApply[son1, son2, head, target, node].rtn];
signalx, errorx => {
ans: TV;
signalled: BOOL;
[ans, signalled] _ EvalAndNoteSignalling[son1, head, target];
IF NOT signalled THEN UrpFatal[head, son1, "not a signal call"];
IF kind = errorx THEN UrpFatal[head, node, "returned from ERROR"];
RETURN [ans];
};
syserrorx => {
SIGNAL BackStop.SuspendBackStop;
rtn _ ERROR;
SIGNAL BackStop.ResumeBackStop;
RETURN;
};
cons =>
RETURN [Cons[son2, target, head]];
listcons =>
RETURN [ListCons[son2, target, head]];
or, and => {
bool: BOOL _ EvalBool[son1];
IF kind = and AND NOT bool THEN RETURN [false];
IF kind = or AND bool THEN RETURN [true];
RETURN [IF EvalBool[son2] THEN true ELSE false]};
not =>
RETURN [IF EvalBool[son1] THEN false ELSE true];
relE, relN, relL, relGE, relG, relLE =>
RETURN [EvalRelop[son1, son2, kind, head, underBOOL, node]];
plus, minus, times, div, mod =>
RETURN [EvalBinop[son1, son2, kind, head, target, node]];
min, max => {
bestUnder: Type _ nullType;
bestClass: Class _ nil;
bestCard: CARD _ 0;
listNode: Node _ NIL;
WITH son1 SELECT FROM
n: Node => {listNode _ n; nSons _ n.sonLimit - 1};
ENDCASE => nSons _ 1;
FOR i: NAT IN [1..nSons] DO
arg: Tree _ IF listNode # NIL THEN listNode.son[i] ELSE son1;
each: TV _ SubEval1[arg];
eachUnder: Type _ UnderType[TVType[each]];
eachClass: Class _ TypeClass[eachUnder];
eachCard: CARD;
swap: BOOL _ kind = min;  -- if each > best, then swap _ NOT swap
IF eachClass = subrange THEN {
eachUnder _ GroundStar[eachUnder];
eachClass _ TypeClass[eachUnder];
};
SELECT eachClass FROM
cardinal, longCardinal, character => {
eachCard _ AMBridge.TVToLC[each];
IF eachClass # longCardinal THEN eachClass _ longCardinal;
SELECT bestClass FROM
longCardinal => {
IF eachCard > bestCard THEN swap _ NOT swap;
};
longInteger => {
IF LOOPHOLE[bestCard, INT] < 0 OR eachCard > bestCard THEN
swap _ NOT swap;
};
real => {
real: REAL _ eachCard; -- force the conversion
IF real > LOOPHOLE[bestCard, REAL] THEN swap _ NOT swap;
};
nil => swap _ TRUE;
ENDCASE => GO TO notComparable;
};
enumerated => {
eachCard _ AMBridge.TVToLC[each];
SELECT bestClass FROM
enumerated =>
IF eachCard > bestCard THEN swap _ NOT swap;
nil => swap _ TRUE;
ENDCASE => GO TO notComparable;
};
integer, longInteger =>  {
eachInt: INT _ AMBridge.TVToLI[each];
eachCard _ LOOPHOLE[eachInt];
IF eachClass # longInteger THEN eachClass _ longInteger;
SELECT bestClass FROM
longCardinal =>
IF eachInt > 0 AND eachCard > bestCard THEN swap _ NOT swap;
longInteger =>
IF eachInt > LOOPHOLE[bestCard, INT] THEN swap _ NOT swap;
real => {
real: REAL _ eachInt; -- force the conversion
IF real > LOOPHOLE[bestCard, REAL] THEN swap _ NOT swap;
};
nil => swap _ TRUE;
ENDCASE => GO TO notComparable;
};
real => {
eachReal,bestReal: REAL;
eachCard _ AMBridge.TVToLC[each];
eachReal _ LOOPHOLE[eachCard];
SELECT bestClass FROM
longCardinal => bestReal _ bestCard;
longInteger => bestReal _ LOOPHOLE[bestCard, INT];
real => bestReal _ LOOPHOLE[bestCard];
nil => GO TO noCompare;
ENDCASE => GO TO notComparable;
IF eachReal > bestReal THEN swap _ NOT swap;
EXITS noCompare => {swap _ TRUE};
};
ENDCASE => GO TO notOrdered;
IF swap THEN {
rtn _ each;
bestUnder _ eachUnder;
bestClass _ eachClass;
bestCard _ eachCard};
ENDLOOP;
RETURN;
EXITS
notOrdered => UrpFatal[head, node, "not an ordered type"];
notComparable => UrpFatal[head, node, "incomparable types"];
};
dot =>
RETURN [EvalDot[son1, son2, node, head, target]];
uminus, abs =>
RETURN [EvalUnop[son1, kind, head, target]];
all =>
RETURN [EvalArray[son1, head, target, node, TRUE]];
addr => {
rtnRef _ NEW[LONG POINTER _ PointerFromTV[SubEval0[son1]]];
GOTO forRef;
};
uparrow =>
RETURN[SafeReferent[SubEval0[son1], head, node]];
lengthen, mwconst, clit, llit =>
GO TO evalSon;
size, typecode, first, last => {
type: Type _ TVToType[SubEval0[son1]];
SELECT kind FROM
size => {
rtnRef _ NEW[CARDINAL _ Size[type]];
GO TO forRef};
typecode => RETURN[NewType[type]];
first => RETURN [First[type]];
last => RETURN [Last[type]]
ENDCASE => ERROR;
};
pred, succ => {
tv: TV _ SubEval1[son1];
Discrete: PROC [c: Class] RETURNS [d: BOOL] = CHECKED {
d _ SELECT c FROM
cardinal, longCardinal, integer, longInteger, character, enumerated => TRUE,
ENDCASE => FALSE;
};
DO
SELECT TRUE FROM
Discrete[TypeClass[GroundStar[TVType[tv]]]] => RETURN [(SELECT kind FROM pred => Prev, succ => Next, ENDCASE => ERROR)[tv]];
Discrete[TypeClass[GroundStar[target]]] => tv _ UrpWrongType[head, son1, tv, target, "not SUCC or PRED-able"];
ENDCASE => UrpFatal[head, son1, "can't SUCC or PRED it"];
ENDLOOP;
};
loophole => {
IF son2 # NIL THEN target _ TVToType[SubEval0[son2]];
RETURN [LocalLoophole[head, node, SubEval[son1, target], target]];
};
nil => RETURN [NilTV];
new => {
world: WorldVM.World _ WorldFromHead[head];
IF world # WorldVM.LocalWorld[]
THEN GOTO notRemote
ELSE {
son3: Tree _ IF nSons > 2 THEN node.son[3] ELSE NIL;
repType: Type _ TVToType[SubEval0[son2]];
rtn: TV _ New[type: repType, world: world];
ref: REF _ NIL;
IF son3 # NIL THEN {
init: TV _ SubEval[son3, repType];
init _ LocalCoerce[head, son3, init, repType, 0, "invalid init"];
AMTypes.Assign[rtn, init];
};
ref _ AMBridge.SomeRefFromTV[rtn];
rtnRef _ NEW[REF _ ref];
GOTO forRef;
};
};
atom => {
WITH son1 SELECT FROM
lti: PPLeaves.LTIndex => {
rtnRef _ lti.value;
GO TO forRef;
};
ENDCASE;
errmsg _ "invalid atom";
GO TO fatal};
length => {
tv: TV _ SubEval0[son1];
DO
SELECT TypeClass[UnderType[TVType[tv]]] FROM
descriptor, longDescriptor, rope =>
RETURN [NewInt[Length[tv]]];
ENDCASE =>
tv _ UrpWrongType[head, son1, tv, target, "not a descriptor"];
ENDLOOP
};
ENDCASE => GOTO NYI
EXITS
evalSon =>
RETURN [SubEval1[son1]];
forRef =>
RETURN [TVForReferent[rtnRef]];
fatal =>
UrpFatal[head, node, errmsg];
notRemote =>
UrpFatal[head, node, "not implemented for remote"];
NYI =>
UrpFatal[head, node, "not implemented"]};
ERROR
}; 

ListElem: PROC [tree: Tree, n: CARDINAL _ 1] RETURNS [Tree] = {
IF n = 0 THEN RETURN [tree];
WITH tree SELECT FROM
node: Node =>
IF node.name = list THEN {
IF n IN [1..node.sonLimit) THEN RETURN [node[n]];
RETURN [NIL]}
ENDCASE;
IF n = 1 THEN RETURN [tree] ELSE RETURN [NIL]
}; 

Cons: PROC [args: Tree, target: Type, head: EvalHead] RETURNS [rtn: TV] = {
carTree: Tree _ ListElem[args, 1];
cdrTree: Tree _ ListElem[args, 2];
carTV: TV;
cdrTV: TV _ EvalNoProps[cdrTree, head, target];
listType, consType, carType: Type;
DO
listType _ UnderType[TVType[cdrTV]];
SELECT TypeClass[listType] FROM
list => {NULL; EXIT};
nil => {
target _ UnderType[target];
SELECT TypeClass[target] FROM
list => listType _ target;
ENDCASE => listType _ underLORA;
EXIT};
ENDCASE => cdrTV _ LocalCoerce[head, cdrTree, cdrTV, underLORA, 0, "invalid list"];
ENDLOOP;
consType _ Range[listType];
IF TypeClass[consType] # structure THEN ERROR;
carType _ IndexToType[consType, 1];
carTV _ EvalNoProps[carTree, head, carType];
rtn _ MakeCons[carTV, cdrTV, listType, consType, head];
};

MakeCons: PROC [carTV, cdrTV: TV, listType, consType: Type, head: EvalHead] RETURNS [rtn: TV] = {
consTV: TV _ New[type: consType, world: WorldFromHead[head]];
Assign[IndexToTV[consTV, 1], carTV];
Assign[IndexToTV[consTV, 2], cdrTV];
TRUSTED {rtn _ TVForReferent[NEW [REF ANY _ RefFromTV[consTV]]]};
rtn _ AMTypes.Coerce[rtn, listType];
};

ListCons: PROC [args: Tree, target: Type, head: EvalHead] RETURNS [rtn: TV] = {
listType: Type _ underLORA;
consType, eltType: Type;
last: TV _ NIL;
PerSon: PROC [t: Tree] = {
elt: TV _ EvalNoProps[t, head, eltType];
this: TV _ MakeCons[elt, NilTV, listType, consType, head];
IF last = NIL THEN rtn _ this ELSE Assign[last, this];
last _ IndexToTV[Referent[this], 2];
};
target _ UnderType[target];
SELECT TypeClass[target] FROM
list => listType _ target;
ENDCASE;
consType _ Range[listType];
IF TypeClass[consType] # structure THEN ERROR;
eltType _ IndexToType[consType, 1];
rtn _ NilTV;
WITH args SELECT FROM
node: Node => IF node.name = list THEN {PPTreeOps.ScanSons[args, PerSon]; RETURN};
ENDCASE;
PerSon[args];
};

EvalUnop: PROC [tree: Tree, kind: PPTree.NodeName, head: EvalHead, target: Type] RETURNS [rtn: TV _ NIL] = TRUSTED {
int: INT _ 0;
rtn _ ForceArithmetic[EvalNoProps[tree, head, target], head, tree];
SELECT UnderClass[TVType[rtn]] FROM
real => {
real: REAL _ AMBridge.TVToReal[rtn];
SELECT kind FROM
abs => real _ ABS[real];
uminus => real _ -real;
ENDCASE => ERROR;
RETURN [NewReal[real]];
};
integer, longInteger => {
int: INT _ AMBridge.TVToLI[rtn];
SELECT kind FROM
abs => int _ ABS[int];
uminus => int _ -int;
ENDCASE => ERROR;
RETURN [NewInt[int]];
};
ENDCASE => {
card: CARD _ AMBridge.TVToLC[rtn];
SELECT kind FROM
abs => card _ card;
uminus => card _ -card;
ENDCASE => ERROR;
RETURN [NewCard[card]];
};
}; 

EvalRelop: PROC [left, right: Tree, kind: PPTree.NodeName, head: EvalHead, target: Type, parent: Tree] RETURNS [rtn: TV _ NIL] = TRUSTED {
op: PPTree.NodeName _ kind;
lval, rval: TV _ NIL;
ltype, rtype, ttype, altype, artype: Type;
lclass, rclass, alclass, arclass: Class;
rtnBit: BOOL;
lval _ EvalNoProps[left, head, target];
ttype _ AMTypes.TVType[lval];
ltype _ AMTypes.UnderType[ttype];
lclass _ AMTypes.TypeClass[ltype];
IF lclass = subrange THEN {
ltype _ AMTypes.GroundStar[ltype];
lclass _ AMTypes.TypeClass[ltype];
lval _ AMTypes.Coerce[tv: lval, targetType: ltype];
};
IF target = nullType THEN target _ ttype;
rval _ EvalNoProps[right, head, ltype];
rtype _ AMTypes.UnderType[TVType[rval]];
rclass _ AMTypes.TypeClass[rtype];
IF rclass = subrange THEN {
rtype _ AMTypes.GroundStar[rtype];
rclass _ AMTypes.TypeClass[rtype];
rval _ AMTypes.Coerce[tv: rval, targetType: rtype];
};
SELECT kind FROM
relE, relN => {
SELECT lclass FROM
cardinal, integer, character, longInteger, longCardinal, real, unspecified => {};
ENDCASE => {
eq: BOOL _ TVEqual[lval, rval];
IF kind = relN THEN eq _ NOT eq;
RETURN [IF eq THEN true ELSE false];
};
};
ENDCASE; 


lval _ ForceArithmetic[lval, head, left];
altype _ UnderType[TVType[lval]];
alclass _ TypeClass[altype];
rval _ ForceArithmetic[rval, head, right];
artype _ UnderType[TVType[rval]];
arclass _ TypeClass[artype];
SELECT TRUE FROM
alclass = real, arclass = real => {
lreal: REAL _ TVToReal[lval];
rreal: REAL _ TVToReal[rval];
SELECT kind FROM
relE => rtnBit _ lreal = rreal;
relN => rtnBit _ lreal # rreal;
relL => rtnBit _ lreal < rreal;
relGE => rtnBit _ lreal >= rreal;
relG => rtnBit _ lreal > rreal;
relLE => rtnBit _ lreal <= rreal;
ENDCASE => ERROR;
};
alclass = integer, alclass = longInteger, arclass = integer, arclass = longInteger => {
li: INT _ TVToLI[lval];
ri: INT _ TVToLI[rval];
SELECT kind FROM
relE => rtnBit _ li = ri;
relN => rtnBit _ li # ri;
relL => rtnBit _ li < ri;
relGE => rtnBit _ li >= ri;
relG => rtnBit _ li > ri;
relLE => rtnBit _ li <= ri;
ENDCASE => ERROR;
};
ENDCASE => {
lc: CARD _ TVToLC[lval];
rc: CARD _ TVToLC[rval];
SELECT kind FROM
relE => rtnBit _ lc = rc;
relN => rtnBit _ lc # rc;
relL => rtnBit _ lc < rc;
relGE => rtnBit _ lc >= rc;
relG => rtnBit _ lc > rc;
relLE => rtnBit _ lc <= rc;
ENDCASE => ERROR;
};
IF rtnBit THEN RETURN [true] ELSE RETURN [false];
};

EvalBinop: PROC [left, right: Tree, kind: PPTree.NodeName, head: EvalHead, target: Type, parent: Tree] RETURNS [rtn: TV _ NIL] = TRUSTED {
altype, artype: Type;
alclass, arclass: Class;
lval: TV _ EvalNoProps[left, head, target];
ttype: Type _ AMTypes.TVType[lval];
ltype: Type _ AMTypes.UnderType[ttype];
lclass: Class _ AMTypes.TypeClass[ltype];
rval: TV _ EvalNoProps[right, head, ltype];
rtype: Type _ AMTypes.UnderType[TVType[rval]];
rclass: Class _ AMTypes.TypeClass[rtype];
IF lclass = subrange THEN {
ltype _ AMTypes.GroundStar[ltype];
lclass _ AMTypes.TypeClass[ltype];
lval _ AMTypes.Coerce[tv: lval, targetType: ltype];
};
IF target = nullType THEN target _ ttype;
IF rclass = subrange THEN {
rtype _ AMTypes.GroundStar[rtype];
rclass _ AMTypes.TypeClass[rtype];
rval _ AMTypes.Coerce[tv: rval, targetType: rtype];
};


lval _ ForceArithmetic[lval, head, left];
altype _ UnderType[TVType[lval]];
alclass _ TypeClass[altype];
rval _ ForceArithmetic[rval, head, right];
artype _ UnderType[TVType[rval]];
arclass _ TypeClass[artype];
SELECT TRUE FROM
alclass = real, arclass = real => {
lreal: REAL _ TVToReal[lval];
rreal: REAL _ TVToReal[rval];
SELECT kind FROM
plus => lreal _ lreal + rreal;
minus => lreal _ lreal - rreal;
times => lreal _ lreal * rreal;
div => lreal _ lreal / rreal;
mod => lreal _ Real.FRem[lreal, rreal];
min => lreal _ MIN[lreal, rreal];
max => lreal _ MAX[lreal, rreal]
ENDCASE => ERROR;
RETURN [NewReal[lreal]];
};
alclass = integer, alclass = longInteger, arclass = integer, arclass = longInteger => {
li: INT _ TVToLI[lval];
ri: INT _ TVToLI[rval];
SELECT kind FROM
plus => li _ li + ri;
minus => li _ li - ri;
times => li _ li * ri;
div => li _ li / ri;
mod => li _ li MOD ri;
min => li _ MIN[li, ri];
max => li _ MAX[li, ri]
ENDCASE => ERROR;
RETURN [NewInt[li]];
};
ENDCASE => {
lc: CARD _ TVToLC[lval];
rc: CARD _ TVToLC[rval];
SELECT kind FROM
plus => lc _ lc + rc;
minus => lc _ lc - rc;
times => lc _ lc * rc;
div => lc _ lc / rc;
mod => lc _ lc MOD rc;
min => lc _ MIN[lc, rc];
max => lc _ MAX[lc, rc]
ENDCASE => ERROR;
RETURN [NewCard[lc]];
};
}; 

Lookup: PROC [name: ROPE, head: EvalHead, target: Type, parent: Tree] RETURNS [val: TV _ NIL] = TRUSTED {
ok: BOOL _ FALSE;
useWorldContext: BOOL _ FALSE;

inner: PROC [context: AMModel.Context] = TRUSTED {
IF target # nullType THEN {
val _ EnumeratedValueFromRope[name, target];
IF val # NIL THEN {ok _ TRUE; RETURN};
};
IF useWorldContext THEN context _ AMModel.RootContext[WorldFromHead[head]];
SELECT AMModel.ContextClass[context] FROM
world => {
val _ AMMiniModel.GetInterfaceRecord[name, WorldFromHead[head]
!  Error  => IF reason = notImplemented THEN CONTINUE];
IF val # NIL THEN {ok _ TRUE; RETURN};
val _ AMModelBridge.FrameFromContext[
AMModel.MostRecentNamedContext[name, context]];
IF val # NIL THEN {ok _ TRUE; RETURN};
{
irt: Type = AMMiniModel.AcquireIRType[name ! Error => GOTO return];
val _ CopyToImpliedWorld[head, TVForType[irt]];  -- NOTE Hmm. 
EXITS return => NULL;
};
IF val # NIL THEN {ok _ TRUE; RETURN};
};
prog, proc => {
val _ AMModelBridge.FrameFromContext[head.context];
GO TO valSearch;
};
interface => {
val _ AMModelBridge.IRFromContext[head.context];
GO TO valSearch;
};
ENDCASE => ERROR;
EXITS valSearch => {
val _ InterpreterPrivate.RecordSearch[val, name];
IF val # NIL THEN {ok _ TRUE; RETURN};
IF UserProfile.Boolean["Interpreter.SearchTheWorld", TRUE] THEN
inner[AMModel.RootContext[WorldFromHead[head]]];
};
};

DO
IF head.specials = NIL THEN ERROR;
IF name.Size[] = 0 THEN UrpFatal[head, parent, "invalid name"];
IF name.Fetch[0] = '% THEN {useWorldContext _ TRUE; name _ name.Substr[1]};
IF name.Size[] = 0 THEN UrpFatal[head, parent, "invalid name"];
[ok, val] _ head.specials.Fetch[name];
IF ok THEN {
WITH val SELECT FROM
nc: EvalQuote.NameClosure =>
val _ nc.proc[head: head, nameAsRope: name, nameAsTree: parent, target: target, data: nc.data];
ENDCASE;
RETURN};
[ok, val] _ globalSymTab.Fetch[name];
IF ok THEN RETURN;
IF NOT Rope.Match["&*", name] THEN {
inner[head.context];
IF ok THEN RETURN;
};
{
correct: RopeOrTV _ UrpId[head, parent, name, nullType, target, "undefined"];
WITH c: correct SELECT FROM
both => {val _ c.tv; FixHti[parent, name _ c.rope]; RETURN};
rope => FixHti[parent, name _ c.rope];
tv => {val _ c.tv; RETURN};
ENDCASE;
};
ENDLOOP;
};

FixHti: PROC [tree: Tree, fix: ROPE] = {
WITH tree SELECT FROM
hti: PPLeaves.HTIndex => hti.name _ fix.Flatten[]
ENDCASE
}; 

EvalLti: PROC [lti: PPLeaves.LTIndex, head: EvalHead] RETURNS [TV] = TRUSTED {
val: REF _ lti.value;
WITH val SELECT FROM
rope: ROPE => val _ NEW[ROPE _ rope];
text: REF TEXT => val _ NEW[REF TEXT _ text]
ENDCASE;
RETURN [TVForReadOnlyReferent[val]]
}; 

EvalDot: PROC [left, right, parent: Tree, head: EvalHead, target: Type] RETURNS [tv: TV _ NIL] = TRUSTED {
lName: ROPE _ TreeToName[left];
rName: ROPE _ TreeToName[right];
record: TV _ NIL;
msg: ROPE _ NIL;
world: WorldVM.World _ WorldFromHead[head];
IF lName = NIL
THEN record _ EvalNoProps[left, head, nullType]
ELSE record _ Lookup[lName, head, nullType, left];

IF AMTypes.TypeClass[AMTypes.UnderType[AMTypes.TVType[record]]] = type THEN {
typeValue: Type _ AMTypes.TVToType[record];
IF AMTypes.IsInterface[typeValue] THEN {
temp: TV = AMMiniModel.GetInterfaceRecordFromType[typeValue, world];
IF temp # NIL THEN record _ temp;
};
};

FOR i: NAT IN [1..4] DO  -- keep trying, possibly correcting
tv _ InterpreterPrivate.RecordSearch[record, rName
! AMTypes.Error => IF reason = typeFault OR reason = badName THEN CONTINUE];
IF tv = NIL
THEN {  -- maybe a callback procedure can help?
correct: RopeOrTV
= UrpSelector[head, parent, rName, record, target, "selection failed"];
WITH c: correct SELECT FROM
both => {FixHti[right, c.rope]; RETURN [c.tv]};
rope => FixHti[right, rName _ c.rope];  -- and try again
tv => RETURN [c.tv];
ENDCASE =>
RETURN [InterpreterPrivate.RecordSearch[record, rName]];  -- let failure emerge
}
ELSE {
SELECT UnderClass[TVType[tv]] FROM
union => {
IF OverlaidOrComputed[TVType[tv]]
THEN UrpFatal[head, parent, "Can't handle OVERLAID or COMPUTED"];
tv _ Variant[tv];
};
ENDCASE;
RETURN [tv];
};
ENDLOOP;  -- of keep trying, possibly correcting
RETURN [InterpreterPrivate.RecordSearch[record, rName]];  -- let failure emerge
};

ForceArithmetic: PROC [val: TV, head: EvalHead, parent: Tree] RETURNS [rtn: TV] = TRUSTED {
type: Type _ TVType[rtn _ StripSingleComponentRecord[val]];
ground: Type _ GroundStar[type];
class: Class _ TypeClass[ground];
SELECT class FROM
real =>
IF type # ground THEN rtn _ NewReal[TVToReal[rtn]];
cardinal, character =>
rtn _ NewCard[TVToCardinal[rtn]];
integer =>
rtn _ NewInt[TVToInteger[rtn]];
longCardinal, longPointer, unspecified =>
rtn _ NewCard[TVToLC[rtn]];
longInteger =>
rtn _ NewInt[TVToLI[rtn]];
pointer => {
ptr: LONG POINTER _ LOOPHOLE[TVToCardinal[rtn], POINTER];
rtn _ NewCard[LOOPHOLE[ptr, INT]];
};
ENDCASE => UrpFatal[head, parent, "not a number"];
}; 

StripSingleComponentRecord: PROC [tv: TV, max: NAT _ 100] RETURNS [rtn: TV] = TRUSTED {
rtn _ tv;
THROUGH [0..max) DO
under: Type = UnderType[TVType[rtn]];
class: Class _ UnderClass[under];
IF (class # record AND class # structure) OR (NComponents[under] # 1) THEN EXIT;
rtn _ IndexToTV[rtn, 1];
ENDLOOP;
}; 

ForceBoolean: PROC [tv: TV, head: EvalHead, parent: Tree] RETURNS [BOOL] = TRUSTED {
rtn: TV _ tv;
DO
rtn _ StripSingleComponentRecord[rtn];
IF UnderType[TVType[tv]] = underBOOL THEN {
card: CARDINAL _ TVToCardinal[rtn];
IF card = trueCard THEN RETURN [TRUE];
IF card = falseCard THEN RETURN [FALSE]};
rtn _ UrpWrongType[head, parent, rtn, underBOOL, "not boolean"]
ENDLOOP
}; 

DoApply: PROC [head: EvalHead, proc, args: TV, callTree: Tree, mayCatch: BOOL] RETURNS [rtn: TV] = {
called: BOOL _ FALSE;
CallIt: PROC = TRUSTED {
called _ TRUE;
rtn _ AMEvents.Apply[proc, args];
};
SIGNAL BackStop.SuspendBackStop;
{
IF head.specials # NIL THEN
WITH SymTab.Fetch[head.specials, "?ErrorHandler"].val SELECT FROM
hb: REF InterpreterPrivate.ErrorHandlerObj => {
catch: Tree _ NIL;
IF mayCatch AND PPTreeOps.NSons[callTree] >= 3 THEN
catch _ PPTreeOps.NthSon[callTree, 3];
hb.handler[CallIt, hb.data, callTree, catch, head];
GO TO handled;
};
ENDCASE;
CallIt[];
EXITS handled => {};
};
SIGNAL BackStop.ResumeBackStop;
IF NOT called THEN
UrpFatal[head, callTree, "procedure not called due to client handler error!"];
};

EvalApply: PROC [proc, args: Tree, head: EvalHead, target: Type, parent: Tree] RETURNS [rtn: TV _ NIL, signalled: BOOL _ FALSE] = TRUSTED {
pval: TV _ NIL;
ptype: Type;
pclass: Class;
triesLeft: INTEGER _ 32;
procName: ROPE _ TreeToName[proc];

IF procName # NIL THEN {
proc: EvalQuote.EvalQuoteProc _ NIL;
data: REF _ NIL;
[proc, data] _ EvalQuote.Lookup[head.specials, procName];
IF proc # NIL THEN
RETURN [proc[head, parent, target, data]];
};

pval _ EvalNoProps[proc, head, underPROC];
DO
TestAbort[head, parent];
ptype _ UnderType[TVType[pval]];
pclass _ TypeClass[ptype];
IF (triesLeft _ triesLeft - 1) < 0 THEN
UrpFatal[head, proc, "too many indirections"]; 

IF pval = NIL AND proc = NIL THEN
SELECT UnderClass[target] FROM
array => RETURN [EvalArray[args, head, target, parent]];
record, structure => RETURN [EvalRecord[args, head, target, parent]];
ENDCASE => UrpFatal[head, proc, "invalid constructor"];

SELECT pclass FROM
procedure, signal, error => {
argsRec: TV _ NIL;
argsType, rtnsType: Type;
signalled _ SELECT pclass FROM
procedure => FALSE,
signal, error => TRUE,
ENDCASE => ERROR;
IF pval = NIL OR AMBridge.TVToLC[pval] = 0 THEN
UrpFatal[head, parent, "NIL procedure?"];
argsType _ UnderType[Domain[ptype]];
rtnsType _ SELECT pclass FROM
procedure, signal => UnderType[Range[ptype]],
error => nullType,
ENDCASE => ERROR;
IF argsType = nullType
THEN {
IF args # NIL THEN
UrpFatal[head, parent, "too many arguments given, 0 expected"]}
ELSE 
argsRec _ EvalRecord[args, head, argsType, parent, AMBridge.GetWorld[pval]];
rtn _ DoApply[head, pval, argsRec, parent, TRUE];
IF pclass = error THEN UrpFatal[head, parent, "returned from ERROR"];
rtn _ IF rtnsType = nullType THEN empty ELSE StripSingleComponentRecord[rtn, 1];
RETURN};
record, structure =>
pval _ IndexToTV[pval, NComponents[TVType[pval]]];
union =>
IF NOT OverlaidOrComputed[ptype]
THEN {
pval _ Variant[pval];
LOOP}
ELSE {
index: CARDINAL _ 0;
index _ NameToIndex[ptype, TreeToName[args]
! Error => IF reason = badName THEN CONTINUE];
IF index = 0 THEN UrpFatal[head, parent, "invalid tag"];
ptype _ IndexToType[ptype, index];
RETURN [AMBridge.Loophole[pval, ptype]];
};
ref, pointer, longPointer =>
pval _ SafeReferent[pval, head, parent];
basePointer => {
relPtr: TV _ EvalNoProps[args, head, nullType];
rtn _ Referent[relPtr, pval];
RETURN;
};
array, sequence, descriptor, longDescriptor => {
domain: Type;
index: TV _ NIL;
SELECT pclass FROM
descriptor, longDescriptor => ptype _ Range[ptype];
ENDCASE;
domain _ Domain[ptype];
index _ EvalNoProps[args, head, domain];
index _ LocalCoerce[head, parent, index, domain, 0, "invalid index type"];
rtn _ Apply[pval, index];
RETURN;
};
type => {
tval: Type _ TVToType[pval];
tunder: Type;
tclass: Class;
name: ROPE _ TreeToName[args];
tunder _ AMTypes.UnderType[tval];
tclass _ AMTypes.TypeClass[tunder];
SELECT tclass FROM
array =>
RETURN [EvalArray[args, head, tval, parent]];
record, structure => {
IF name # NIL THEN {
onion: Type;
onionClass: Class;
boundTV: TV _ NIL;
[onion, onionClass] _ VariableType[tval];
IF onionClass = union THEN {
index: CARDINAL _ 0;
index _ NameToIndex[onion, name
! Error => IF reason = badName THEN CONTINUE];
IF index # 0 THEN
RETURN[TVForType[IndexToType[onion, index]]];
};
};
RETURN [EvalRecord[args, head, tval, parent]];
};
enumerated => {
rtn _ EnumeratedValueFromRope[name, tval];
IF rtn # NIL THEN RETURN;
UrpFatal[head, parent, "invalid name"]}
ENDCASE => UrpFatal[head, parent, "not implemented"];
}
ENDCASE =>
pval _ UrpWrongType[head, parent, pval, underPROC, "not applicable"]
ENDLOOP;
}; 

EvalArray: PROC [args: Tree, head: EvalHead, target: Type, parent: Tree, all: BOOL _ FALSE] RETURNS [new: TV _ NIL] = TRUSTED {
domain, range: Type;
first, last, each: TV _ NIL;
elements, firstLI: INT _ 0;
lastLI: INT _ -1;
nGiven: INT _ 1;
listNode: Node _ NIL;
underClass: Class _ UnderClass[target];
IF underClass # array THEN UrpFatal[head, parent, "target not an array"];
range _ Range[target];
first _ First[domain _ Domain[target]];
last _ Last[domain];
firstLI _ AMBridge.TVToLI[first];
lastLI _ AMBridge.TVToLI[last];
elements _ lastLI - firstLI + 1;
new _ New[type: target, world: WorldFromHead[head]];
IF all
THEN nGiven _ elements
ELSE
WITH args SELECT FROM
node: Node =>
SELECT node.name FROM
list => {listNode _ node; nGiven _ node.sonLimit - 1};
ENDCASE;
ENDCASE;
each _ first;
IF elements # nGiven THEN UrpFatal[head, parent, "Wrong # of elements"];
FOR i: INT IN [1..nGiven] DO
elemTV: TV _ NIL;
valueTV: TV _ EvalNoProps[IF listNode # NIL THEN listNode[i] ELSE args, head, range];
elemTV _ Apply[new, each];
AssignNew[elemTV, valueTV];
each _ Next[each];
ENDLOOP;
}; 

EvalAssign: PROC [left, right: Tree, head: EvalHead, target: Type, parent: Tree] RETURNS [TV] = TRUSTED {
lval, rval: TV _ NIL;
name: ROPE _ TreeToName[left];
nameSize: INT _ name.Size[];
IF head.specials = NIL THEN ERROR;
IF Rope.Match["&*", name] THEN {
lval _ rval _ EvalNoProps[right, head, target];
IF lval = empty THEN RETURN [empty];
IF lval # NIL THEN {
SELECT TypeClass[UnderType[TVType[rval]]] FROM
localFrame, globalFrame, sequence, nil, any, union => {
}
ENDCASE => IF TVStatus[rval] # const THEN lval _ Copy[rval];
};
IF nameSize > 1 THEN [] _ head.specials.Store[name, lval];
[] _ head.specials.Store["&", lval];
RETURN [rval];
};
IF left # NIL THEN {
lval _ EvalNoProps[left, head, target];
target _ TVType[lval]};
rval _ EvalNoProps[right, head, target];
IF left = NIL THEN RETURN [empty];
RETURN [DoAssign[lval, rval, head, parent]]
}; 

DoAssign: PROC [lhs, rhs: TV, head: EvalHead, parent: Tree] RETURNS [TV] = {
fullType, ltype, rtype: Type;
fullType _ TVType[rhs];
ltype _ UnderType[fullType];
rtype _ UnderType[TVType[rhs]];
IF ltype # rtype THEN rhs _ LocalCoerce[head, parent, rhs, fullType];
AMTypes.Assign[lhs, rhs];
RETURN [rhs]
}; 

LocalLoophole: PROC [head: EvalHead, parent: Tree, current: TV, target: Type] RETURNS [tv: TV _ NIL] = TRUSTED {
lc: CARD _ 0;
type: Type _ TVType[current];
under, tunder: Type;
class, tclass: Class;
isRemote: BOOL _ AMBridge.IsRemote[current];

IF target = nullType THEN target _ underCARD;
[tunder, tclass] _ UnderTypeAndClass[target];
[under, class] _ UnderTypeAndClass[type];
IF under = tunder THEN {tv _ current; RETURN};

{
SELECT class FROM  -- be especially nice to frames
globalFrame => {
IF isRemote
THEN lc _ AMBridge.RemoteGFHFromTV[current].gfh
ELSE lc _ LOOPHOLE[AMBridge.GFHFromTV[current], CARDINAL];
GOTO common};
localFrame => {
IF isRemote
THEN lc _ AMBridge.RemoteFHFromTV[current].fh
ELSE lc _ LOOPHOLE[AMBridge.FHFromTV[current], CARDINAL];
GOTO common};
ENDCASE;
IF current = NIL
THEN current _ NilTV
ELSE current _ CopyToImpliedWorld[head, current];
tv _ AMBridge.Loophole[current, target ! Error => CONTINUE];
IF tv # NIL THEN RETURN;
SELECT tclass FROM
list, ref, atom, rope, countedZone, uncountedZone =>
tv _ LocalCoerce[head, parent, current, target];
ENDCASE => {
lc _ TVToLC[current];
GOTO common};
EXITS
common => SetTVFromLC[tv _ New[target], lc]
};
};

SafeReferent: PROC [ref: TV, head: EvalHead, parent: Tree] RETURNS [referent: TV _ NIL] = TRUSTED {
type, under: Type;
class: Class;
msg: ROPE _ NIL;
DO
ref _ StripSingleComponentRecord[ref];
type _ TVType[ref];
under _ UnderType[type];
class _ UnderClass[TVType[ref]];
SELECT class FROM
pointer, longPointer, basePointer, ref, list, nil => {
IF AMBridge.TVToLC[ref] = 0 THEN {
msg _ "can't dereference NIL"; RETURN};
SELECT UnderClass[Range[under]] FROM
unspecified => {msg _ "unspecified range"; RETURN};
ENDCASE;
referent _ Referent[ref];
IF msg # NIL THEN UrpFatal[head, parent, msg];
RETURN;
};
ENDCASE => EXIT;
ENDLOOP;
UrpFatal[head, parent, "invalid type for dereference"];
};  

CopyToImpliedWorld: PROC [head: EvalHead, tv: TV] RETURNS [ntv: TV _ NIL] = TRUSTED {
world: WorldVM.World = WorldFromHead[head];
IF world = AMBridge.GetWorld[tv] THEN ntv _ tv ELSE ntv _ Copy[tv];
};

OverlaidOrComputed: PROC [type: Type] RETURNS [BOOL] = TRUSTED {
type _ UnderType[type];
RETURN [IsComputed[type] OR IsOverlaid[type]];
};

RegisterTVEntry: ENTRY PROC [name: ROPE, tv: TV, help: ROPE, symTab: SymTab.Ref] = {
ENABLE UNWIND => NULL;
DoRegisterTV[name, tv, help, symTab];
};
DoRegisterTV: INTERNAL PROC[name: ROPE, tv: TV, help: ROPE, symTab: SymTab.Ref _ NIL] = {
IF symTab = NIL THEN symTab _ globalSymTab;
[] _ symTab.Store[name, tv];
IF help # NIL THEN {
found: BOOL;
sttv: TV;
helpTable: SymTab.Ref;
[found, sttv] _ symTab.Fetch["&HelpSymTab"];
TRUSTED{
IF found THEN helpTable _ LOOPHOLE[AMBridge.RefFromTV[sttv], SymTab.Ref]
ELSE {
helpTable _ SymTab.Create[];
[] _ symTab.Store["&HelpSymTab", AMBridge.TVForReferent[helpTable]];
};
};
[] _ helpTable.Store[name, help];
};
};

RegisterTV: PUBLIC PROC [name: ROPE, tv: TV, help: ROPE _ NIL, symTab: SymTab.Ref] = {
IF NOT tvWorldInit THEN EnsureInit[];
IF symTab = NIL OR name.Size[] = 0 OR name.Fetch[0] # '& THEN ERROR;
RegisterTVEntry[name, tv, help, symTab];
};

EnumerateSymbols: PUBLIC PROC [proc: Ruminant, data: REF _ NIL, symTab: SymTab.Ref _ NIL] RETURNS [stopped: BOOL] = {
localAction: SymTab.EachPairAction = {
helpRope: ROPE _ NIL;
found: BOOL;
sttv: TV;
[found, sttv] _ symTab.Fetch["&HelpSymTab"];
IF found THEN {
helpTab: SymTab.Ref;
TRUSTED{helpTab _ LOOPHOLE[AMBridge.RefFromTV[sttv], SymTab.Ref]};
helpRope _ NARROW[helpTab.Fetch[key].val, ROPE];
};
quit _ proc[key, helpRope, val, data];
};
IF NOT tvWorldInit THEN EnsureInit[];
IF symTab = NIL THEN symTab _ globalSymTab;
stopped _ symTab.Pairs[localAction];
};

NewCard: PROC [card: CARD] RETURNS [TV] = TRUSTED {
RETURN [AMBridge.TVForReadOnlyReferent[NEW[CARD _ card]]];
};

EnsureInit[];

END.



ŒEvaluateImpl.mesa
Copyright c 1984, 1985, 1986 by Xerox Corporation.  All rights reserved.
Spreitzer, May 21, 1985 2:25:14 pm PDT
Russ Atkinson (RRA) January 28, 1986 6:06:32 pm PST
**** Useful types ****
**** Global variables BEGIN ****
these should be undertypes, but that cannot be guaranteed
these should be properly initialized, but that is not guaranteed unless tvWorldInit = TRUE
**** Global variables END ****
EnsureInit tries to get symbols for the debugger.  If the symbols are not available, then the results of evaluation are undefined, but interpreter functionality should degrade gracefully.
START EvalNode HERE
statements (and some expressions)

some funny type constructors
expressions
conditional evaluation AND and OR
really should check for type equality
son1 is the zone, which we completely ignore
son2 is the type
son3 is the initialization expression (if any)
NOTE: no handling of arithmetic faults yet
these values must be arithmetic
At this point the values must be arithmetic.
raise conciousness to the real level
At this point the values must be arithmetic.
raise conciousness to the real level
Lookup evaluates the identifier and returns the value.  We have a special case for &id, since those identifiers have funny semantics.  If correction occurs, the parent is corrected.
The constants of an enumerated type take precedence over variables.
try for an IR
Nope, try for a PROGRAM
Nope, try for the interface type, then make a TV for it
START Lookup HERE
try the global TV table
"repairs" the tree IFF it is an hti leaf
return the literal as a TV

... First, acquire the left-hand side as a TV, either through lookup or full eval.
We have to make a real interface record here, since InterpreterPrivate.RecordSearch can't hack it if the interface type is in a remote world.  If we get an error when dealing with this, we allow it to propagate up.
RRA: It appears that for defnitions modules that don't export anything there is no interface record kept (sigh).  We are currently assuming that the best indication of this is a returned value of NIL and no error indication from AMMiniModel.  This is really a crock!
... Now we have the left side in "record".  Do the selection.
keep failure from emerging as a signal from here
ForceArithmetic forces the given value to be arithmetic; the result is a TV with class = real or class = longInteger.
This extends the address, hopefully the same for all machines
Try to get the right stuff.
At this point we really want to call the procedure.  We give the user a chance to wrap a level of call around our procedure call in order to better interpret catch phrases and the like.
First try for a registered EvalQuoteProc.
we got it, now its not our job anymore!
Until we get to definitely applicable or not.
This is a target-typed record or array constructor.
try to get the array/sequence part, then loop
if a normal variant record, bind the variant and loop
now try to bind the specified variant
try to get the referent, then loop
well, try for the constructor
possibly a variant record type binder, possibly a record constructor
we are trying either to construct a record or to bind a variant type
it is a variant record type binder
try to get the value designated
Discover the domain of the array, save the low and high bounds, and create a new TV for the array (not initialized).
a local debug var: we copy to avoid problems with (unretained) frames as heads
dont try to copy these
[] _ globalSymTab.Store["&&", lval];
Now left MUST be a TV
returns coercion of value to new value of given type
go for broke

Registers the TV under the given name in the global TV table.  It is recommended that the name contain the & character to avoid obscuring variables names.  (it is perfectly OK to have NIL as a TV).
Registers the TV under the given name in the specified SymTab.  The name must start with the & character.  tv = NIL is OK.
Enumerates the symbols in the specified table (in no particular order).  IF symTab = NIL then the global SymTab is used.  Returns TRUE if the client stopped the enumeration, FALSE if not.
Ruminant: TYPE = PROC
[name: ROPE, help: ROPE, tv: TV, data: REF] RETURNS [stop: BOOL]
[key: Key, val: Val] RETURNS [quit: BOOL]
START HERE
Κ2~˜
codeš
œ™Kšœ
Οm
œ=™HK™&K™3K˜š
Οk	˜	Kšœ	žœϋ
˜‰Kšœ	žœ	˜KšœžœA˜RKšœžœL˜YKšœžœ#˜6KšœžœΞ˜ΫKšœ	žœ)˜7Kšœ
žœ&˜5Kšœžœ2˜FKš
œ˜Kšœ
žœ.˜=Kšœ	žœ˜"Kšœžœ˜&Kš
œ
˜
Kšœžœ˜Kšœžœžœ˜7Kšœžœ˜#Kšœžœ4˜@Kšœžœ˜Kšœžœ˜"K˜——
headšœžœ
ž˜KšžœΊ
˜Α
Kšžœ#˜*šœžœ
žœO˜[K˜—š
œ™Kšžœžœžœ
žœ
˜Kš	œžœžœ
žœ
žœ˜Kš
žœžœžœ
žœ
žœ˜Kšœžœ˜Kšžœžœžœ
˜—K˜Kš
œ ™ ˜Kšœžœ˜K˜Kš
œ9™9Kšœžœ	˜!Kšœžœ
žœ˜Kšœžœ
žœ˜Kšœžœ
žœ˜Kšœžœ
žœ˜Kšœžœ˜Kšœžœ
žœ˜Kšœžœ
žœ
žœ
žœ
žœ˜1K˜Kš	œ
žœžœ
žœžœ˜.Kš	œžœžœ
žœžœ˜1K˜Kš
œZ™ZKšœžœžœ
˜Kšœžœžœ
˜Kšœžœžœ
˜K˜Kš
œ,˜,Kš
œ(˜(K˜Kšœ
žœžœ
˜KšœžœžœΟc&˜BK˜Kš
œ™—K˜š
Οnœžœ
žœ
žœžœ˜'Kšžœ
žœ
žœ˜%Kšžœ˜Kš
œ˜K˜—š œžœ
žœ
žœ˜6Kšžœ
žœ
žœ˜%Kšžœ˜Kš
œ˜K˜—š œžœ
žœ
žœ˜<Kšžœ
žœ
žœ˜%Kšžœ˜Kš
œ˜K˜—š 
œžœ
žœžœžœžœ˜\Kšžœžœ
žœ,˜>Kšžœ	žœ
žœ˜1K˜K˜—š 
œžœ
žœ˜Kš
œ»
™»
Kšžœ
žœžœ
˜š
 œžœžœžœžœ˜;Kšžœ!žœ˜EK˜—šœž
œžœ˜ Kšœžœžœ
˜Kšœžœ
žœžœ˜/Kšœžœ
žœžœ˜1Kšœžœ
žœžœ˜.K˜%K˜!K˜!K˜K˜!K˜!K˜!Kš
œ%˜%Kš
œ,˜,Kš
œ.˜.Kšœ$žœ
žœ˜CKšœ*žœ
žœ˜IKš
œ/˜/Kšœ*žœ
žœ˜HKš
œ0˜0Kšœ$žœ
žœ˜BKšœ(žœ
žœ˜JKšœ#žœ
žœ˜AKšœ'žœ
žœ˜IKšœ#žœ
žœ˜AKšœ&žœ
žœ˜DKš
œS˜SKš
œT˜TKš
œH˜Hš
œ
˜
Kš
œ
˜
Kšœžœ
žœ
žœ
žœ
žœ˜+Kš
œ%˜%Kš
œ˜—š
œ
˜
Kš
œ	˜	Kš
œ˜Kš
œ˜Kš
œ˜—Kšœ'žœ
žœ˜RKšœ$žœ
žœ˜CKšœ#žœ
žœ˜JKšœ$žœ
žœ˜CKšœ$žœ
žœ˜CKšœžœ
˜K˜—Kšžœ
žœ
žœ'˜>K˜K˜—š œžœ+žœžœ˜TKš
žœžœ
žœ
žœžœ˜ Kšžœ
žœ
žœ˜%šžœžœ
ž˜Kšœžœ(˜GKšœžœžœ$˜8Kšœžœ˜5Kšœžœ˜3Kšžœž˜—K˜K˜—š œžœ
žœBžœ˜bšžœžœ
žœ˜Kšœžœ&žœ7˜hKš
œ6˜6K˜—K˜K˜—š œžœ,žœžœžœ
žœžœ˜{šžœžœ
ž˜šœžœžœ˜)Kšœžœ˜$Kš	œ
žœžœ
žœ
žœ
˜4Kš	œ
žœžœ
žœ
žœ
˜4Kš
œ=˜=Kšžœ
˜Kš
œ˜—Kšžœ
˜—K˜&K˜K˜—š œžœ,žœžœžœžœ˜]Kšœžœžœ
˜Kšœžœžœ
˜K˜"Kšœžœ˜$Kš	œ
žœžœ
žœ
žœ
˜4Kš	œ
žœžœ
žœ
žœ
˜4š
 œžœžœžœžœ˜AKšžœ#˜)Kš
œ˜—š
 œžœžœžœžœ˜4Kšžœ%˜+Kš
œ˜—š
 œžœžœžœžœ˜4Kšžœ#˜)Kš
œ˜—š œžœžœžœžœžœ˜1Kšžœžœ˜#K˜—š
 œžœžœžœžœ˜6Kšžœ5˜;K˜—K˜Kš
œ™šœ
žœž˜Kš
œ!™!˜%Kšžœ.˜4—š
œ˜Kšœžœ˜Kšžœ
žœžœžœžœ
žœ
žœ
˜?Kšžœ˜Kš
œ˜—˜Kšœžœ
˜Kšœžœ
˜K˜=šžœ
žœžœ
ž˜šžœž˜#Kšœ+žœžœžœ˜DKšžœN˜U—Kšžœ
˜—Kšžœžœ-˜AKšžœ˜
K˜—K™K™š
œ˜Kšžœ)˜/—š
œ˜Kšœžœ˜Kš
œ˜šžœž˜Kšœžœ"˜4Kšœžœ!˜2Kšœžœ˜ Kšžœžœ
žœ
žœ
˜—Kš
œ˜—š
œ
˜
K˜šžœžœ
ž˜K˜Kšžœ
˜—Kš
žœžœ
žœ
žœ
žœ
˜Kšžœ!˜'Kš
œ˜—Kš
œ™˜Kšžœ1˜7—˜Kšœžœ
˜Kšœžœ
˜K˜=Kšžœ
žœžœ+˜@Kšžœžœ-˜BKšžœ˜
K˜—˜Kšžœ˜ Kšœžœ
˜Kšžœ˜Kšžœ
˜K˜—˜Jšžœ˜"—˜Jšžœ ˜&—š
œ˜Kš
œ!™!Kšœžœ˜Kš
žœžœ
žœžœ
žœ	˜/Kšžœžœžœ
žœ˜)Kšžœžœžœžœ	˜1—˜Kšžœžœžœžœ˜0—˜'Kšžœ6˜<—˜Kšžœ3˜9—˜
K˜K˜Kšœ
žœ˜Kšœžœ
˜šžœžœ
ž˜K˜2Kšžœ˜—šžœžœ
žœž˜Kš	œžœžœ
žœžœ˜=Kšœžœ˜Kš
œ*˜*Kš
œ(˜(Kšœ
žœ
˜KšœžœŸ'˜Ašžœžœ˜Kš
œ"˜"Kš
œ!˜!K˜—šžœž˜š
œ&˜&Kš
œ!˜!Kšžœžœ˜:šžœž˜š
œ˜Kšžœžœžœ˜,K˜—š
œ˜š	žœ
žœžœžœž˜:Kšœžœ˜—K˜—š
œ	˜	Kšœžœ
Ÿ˜.Kš
žœžœžœžœžœ˜8K˜—Kšœžœ
˜Kšžœžœ
žœ˜—K˜—š
œ˜Kš
œ!˜!šžœž˜š
œ
˜
Kš
œ%™%Kšžœžœžœ˜,—Kšœžœ
˜Kšžœžœ
žœ˜—K˜—š
œ˜Kšœ	žœ˜%Kšœžœ
˜Kšžœžœ˜8šžœž˜š
œ˜Kšžœ
žœžœžœ˜<—š
œ˜Kš
žœžœžœžœžœ˜:—š
œ	˜	KšœžœŸ˜-Kš
žœžœžœžœžœ˜8K˜—Kšœžœ
˜Kšžœžœ
žœ˜—K˜—š
œ	˜	Kšœžœ
˜Kš
œ!˜!Kšœžœ˜šžœž˜Kš
œ$˜$Kšœžœžœ˜2Kšœžœ˜&Kšœžœ
žœ˜Kšžœžœ
žœ˜—Kšžœžœžœ˜,Kšžœžœ˜!K˜—Kšžœžœ
žœ˜—šžœžœ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—Kšžœ
˜—Kšžœ
˜š
ž˜Kš
œ:˜:Kš
œ<˜<—Kš
œ˜—˜Kšžœ+˜1—˜Kšžœ&˜,—˜Kšžœ&žœ˜3—š
œ	˜	Kšœ	žœ
žœ
žœ"˜;Kšžœ˜Kš
œ˜—˜
Kšžœ+˜1—˜ Kšžœ
žœ	˜—˜ Kš
œ&˜&šžœž˜š
œ	˜	Kšœ	žœ
žœ˜$Kšžœ
žœ	˜—Kšœžœ˜"Kšœ	žœ˜Kšœžœ
˜Kšžœžœ
˜—Kš
œ˜—˜Kšœžœ˜š
 œžœžœžœžœ˜7šœžœž˜KšœGžœ
˜LKšžœžœ
˜—Kš
œ˜—š
ž˜šžœ
žœ
ž˜Kšœ/žœžœžœžœžœ˜|Kš
œn˜nKšžœ2˜9—Kšžœ
˜—K˜—š
œ
˜
Kšžœžœ
žœ#˜5Kšžœ<˜BK˜—Kšœžœ	˜š
œ˜Kš
œ,™,Kš
œ™Kš
œ.™.Kš
œ+˜+šžœ˜Kšžœ
žœ
˜šžœ˜Kš	œ
žœžœ
žœ
žœ
˜4Kš
œ)˜)Kšœžœ$˜+Kšœžœžœ
˜šžœžœ
žœ˜Kšœžœ˜"Kš
œA˜AKš
œ˜K˜—Kš
œ"˜"Kšœ	žœ
žœ˜Kšžœ˜Kš
œ˜——Kš
œ˜—š
œ	˜	šžœžœ
ž˜š
œ˜Kš
œ˜Kšžœ
žœ˜
K˜—Kšžœ
˜—Kš
œ˜Kšžœ
žœ˜
—š
œ˜Kšœžœ˜š
ž˜šžœ"ž˜,˜#Kšžœ˜—šžœ˜
K˜>——Kš
ž˜—K˜—Kšžœžœ
ž˜š
ž˜˜
Kšžœ˜—˜	Kšžœ˜—˜K˜—˜K˜3—šžœ˜K˜)———Kš
ž˜K˜K˜—š œžœžœžœ˜?Kšžœžœ
žœ˜šžœžœ
ž˜˜
šžœžœ˜Kšžœžœžœ
žœ˜1Kšžœžœ˜
——Kšžœ
˜—Kšžœžœ
žœžœ
žœžœ
˜-K˜K˜—š œžœ,žœžœ˜KK˜"K˜"Kšœžœ
˜
Kšœžœ&˜/K˜"š
ž˜K˜$šžœž˜Kšœ	žœžœ˜š
œ˜Kš
œ˜šžœž˜Kš
œ˜Kšžœ˜ —Kšžœ˜—KšžœL˜S—Kšžœ
˜—Kš
œ˜Kšžœ!žœ
žœ
˜.K˜#Kš
œ,˜,K˜7K˜K˜—š
 œžœžœ,žœžœ˜aKšœžœ3˜=K˜$K˜$Kšžœžœžœ
žœ˜AK˜$K˜—K˜š œžœ,žœžœ˜OKš
œ˜K˜Kšœžœžœ
˜š œžœ˜Kšœžœ!˜(Kšœžœ2˜:Kšžœžœ
žœžœ˜6K˜$K˜—Kš
œ˜šžœž˜K˜Kšžœ
˜—K˜Kšžœ!žœ
žœ
˜.K˜#K˜šžœžœ
ž˜Kšœžœžœ$žœ˜RKšžœ
˜—Kš
œ
˜
K˜K˜—š œžœBžœžœžœžœ˜tKš
œ*™*Kšœžœ˜
Kš
œC˜Cšžœž˜#š
œ	˜	Kšœžœ˜$šžœž˜Kšœžœ˜Kš
œ˜Kšžœžœ
˜—Kšžœ˜K˜—˜Kšœžœ˜ šžœž˜Kšœ
žœ˜Kš
œ˜Kšžœžœ
˜—Kšžœ˜K˜—šžœ˜Kšœžœ˜"šžœž˜Kš
œ˜Kš
œ˜Kšžœžœ
˜—Kšžœ˜K˜——K˜K˜—š 	œžœWžœžœžœžœ˜Š
K˜Kšœžœžœ
˜K˜*K˜(Kšœžœ
˜
K˜'Kš
œ˜Kš
œ!˜!Kš
œ"˜"šžœžœ˜Kš
œ"˜"Kš
œ"˜"K•StartOfExpansion*[tv: 
TV, targetType: 
SafeStorage.Type]š
œ3˜3K˜—Kšžœžœ˜)K˜'Kš
œ(˜(Kš
œ"˜"šžœžœ˜Kš
œ"˜"Kš
œ"˜"K–*[tv: 
TV, targetType: 
SafeStorage.Type]š
œ3˜3K˜—šžœž˜˜šžœž˜š
œQ˜QKš
œ™—šžœ˜Kšœžœ˜Kšžœ
žœžœ˜ Kšžœžœžœžœ˜$Kš
œ˜——K˜—Kšžœ˜	K˜—Kš
œ,™,K˜K˜)K˜!K˜K˜*K˜!K˜šžœ
žœ
ž˜š
œ#˜#Kš
œ$™$Kšœžœ˜Kšœžœ˜šžœž˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ!˜!Kš
œ˜Kš
œ!˜!Kšžœžœ
˜—K˜—š
œW˜WKšœžœ˜Kšœžœ˜šžœž˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšžœžœ
˜—K˜—šžœ˜Kšœžœ˜Kšœžœ˜šžœž˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšžœžœ
˜—K˜——Kš
žœžœ
žœžœ
žœ	˜1K˜K˜—š 	œžœWžœžœžœžœ˜Š
K˜K˜Kšœžœ#˜+Kš
œ#˜#Kš
œ'˜'Kš
œ)˜)Kšœžœ#˜+Kš
œ.˜.Kš
œ)˜)šžœžœ˜Kš
œ"˜"Kš
œ"˜"K–*[tv: 
TV, targetType: 
SafeStorage.Type]š
œ3˜3K˜—Kšžœžœ˜)šžœžœ˜Kš
œ"˜"Kš
œ"˜"K–*[tv: 
TV, targetType: 
SafeStorage.Type]š
œ3˜3K˜K˜—Kš
œ,™,K˜K˜)K˜!K˜K˜*K˜!K˜šžœ
žœ
ž˜š
œ#˜#Kš
œ$™$Kšœžœ˜Kšœžœ˜šžœž˜K˜K˜K˜K˜K˜'Kšœžœ˜!Kšœžœ˜ Kšžœžœ
˜—Kšžœ˜K˜—˜WKšœžœ˜Kšœžœ˜šžœž˜K˜K˜K˜K˜Kšœžœ˜Kšœžœ	˜Kšœžœ˜Kšžœžœ
˜—Kšžœ˜K˜—šžœ˜Kšœžœ˜Kšœžœ˜šžœž˜K˜K˜K˜K˜Kšœžœ˜Kšœžœ	˜Kšœžœ˜Kšžœžœ
˜—Kšžœ˜K˜——K˜K˜—š œžœžœ-žœžœžœžœ˜iKš
œ΅
™΅
Kšœžœžœ
˜Kšœžœžœ
˜K˜šœžœžœ˜2Kš
œC™Cšžœžœ˜Kš
œ,˜,Kš
žœžœ
žœžœžœ˜&Kš
œ˜—Kšžœžœ4˜Kšžœž˜)š
œ
˜
Kš
œ
™
š
œ>˜>Kšœ
žœžœžœ˜7—Kš
žœžœ
žœžœžœ˜&Kš
œ™Kš
œU˜UKš
žœžœ
žœžœžœ˜&š
œ
˜
KšœŸ)™7Kšœ6žœ	˜CKšœ1Ÿ
˜>Kšžœžœ
˜K˜—Kš
žœžœ
žœžœžœ˜&K˜—š
œ˜Kš
œ3˜3Kšžœ
žœ˜Kš
œ˜—š
œ˜Kš
œ0˜0Kšžœ
žœ˜K˜—Kšžœžœ
˜—šžœ˜Kš
œ1˜1Kš
žœžœ
žœžœžœ˜&šžœ3žœž˜?Kš
œ0˜0—K˜—Kš
œ˜—K˜Kš
œ™š
ž˜Kšžœžœ
žœ
žœ
˜"Kšžœžœ(˜?Kšžœžœžœ
ž
œ˜KKšžœžœ(˜?Kš
œ&˜&šžœžœ˜šžœžœ
ž˜š
œ˜Kš
œ_˜_—Kšžœ
˜—Jšžœ˜—Kš
œ™Kš
œ%˜%Kšžœžœ
žœ
˜šžœ
žœžœ˜$Kš
œ˜Kšžœžœ
žœ
˜K˜—˜
K˜Mšžœžœ
ž˜Kšœ4žœ˜<K˜&Kšœžœ˜Kš
ž˜—Kš
œ˜—Kš
ž˜—Kš
œ˜K˜—š œžœžœ˜(Kš
œ(™(šžœžœ
ž˜Kš
œ1˜1Kš
ž˜—K˜K˜—š
 œžœ(žœžœžœ˜NKš
œ™Kšœžœ
˜šžœžœ
ž˜Kšœžœ
žœ
žœ	˜%Kšœžœ
žœ
žœ
žœ
žœ˜,Kšžœ
˜—Kšžœ˜#K˜K˜—š œžœ:žœžœžœžœ˜jKšœžœ˜Kšœžœ˜ Kšœžœžœ
˜Kšœžœžœ
˜K˜+K™Kš
œR™Ršžœ	ž˜Kšžœ+˜/Kšžœ.˜2K˜—šžœEžœ˜MK˜+šžœ žœ˜(Kš
œΦ
™Φ
Kšœžœ<˜Dšžœžœ
žœ˜!Kš
œŠ™Š—K˜—K˜—K˜Kš
œ=™=š	žœžœ
žœžœŸ#˜<š
œ2˜2š	œžœžœžœ
žœ˜LKš
œ0™0——šžœž˜šžœŸ'˜/š
œ˜Kš
œG˜G—šžœžœ
ž˜Kšœ žœ	˜/Kšœ(Ÿ˜8Kšœžœ˜šžœ˜
Kšžœ4Ÿ˜O——Kš
œ
˜
—šžœ˜šžœž˜"š
œ
˜
šžœ˜!Kšžœ=˜A—Kš
œ˜Kš
œ˜—Kšžœ
˜—Kšžœ˜K˜——KšžœŸ&˜0—Kšžœ4Ÿ˜OKš
œ˜K˜—š œžœžœžœžœžœ˜[Kš
œu™uKš
œ;˜;K˜ K˜!šžœž˜˜Kšžœžœ˜3—˜K˜!—˜
K˜—˜)Kš
œ˜—˜Kš
œ˜—˜š	œžœ
žœžœžœ˜9Kš
œ=™=—Kšœžœžœ˜"K˜—Kšžœ+˜2—K˜K˜—š œžœžœžœžœžœžœ˜WKš
œ	˜	šžœ
ž˜K˜%K˜!Kš
žœžœžœžœ
žœ
˜PKš
œ˜Kšžœ
˜—K˜K˜—š œžœžœ žœžœžœ˜TKšœžœ˜
š
ž˜Kš
œ™Kš
œ&˜&šžœ#žœ˜+Kšœžœ˜#Kšžœžœ
žœžœ˜&Kšžœžœ
žœžœ˜)—K˜?Kš
ž˜—K˜K˜—š œžœžœžœžœžœ˜dKšœžœžœ
˜š œžœžœ˜Kšœ	žœ
˜Kš
œ!˜!K˜—Kšžœ˜ š
œ
˜
Kš
œΉ
™Ή
šžœžœ
ž˜šžœ2žœ
ž˜Ašœžœ(˜/Kšœžœ
˜šžœ
žœ ž˜3Kš
œ&˜&—Kš
œ3˜3Kšžœ
žœ	˜K˜—Kšžœ
˜——Kš
œ	˜	Kšžœ˜K˜—Kšžœ˜šžœ
žœž˜Kš
œN˜N—K˜K˜—š 	œžœ@žœžœžœ
žœžœžœ˜‹
Kšœžœžœ
˜K˜K˜Kšœžœ˜Kšœ
žœ˜"K˜Kš
œ)™)šžœžœ
žœ˜Kšœ žœ
˜$Kšœžœžœ
˜Kš
œ9˜9šžœžœ
ž˜Kš
œ'™'Kšžœ$˜*—K˜K˜—Kš
œ*˜*š
ž˜Kš
œ-™-K˜K˜ K˜šžœ!ž˜'K˜/K˜—š	žœžœ
žœžœ
ž˜!Kš
œ3™3šžœž˜Kšœ	žœ)˜8Kšœžœ*˜EKšžœ0˜7—K˜—šžœž˜š
œ˜Kšœ	žœžœ
˜K˜šœžœž˜Kšœ
žœ
˜Kšœžœ
˜Kšžœžœ
˜—šžœžœ
žœž˜/K˜)—K˜$šœžœž˜Kš
œ-˜-Kš
œ˜Kšžœžœ
˜—šžœ˜šžœ˜šžœžœ
ž˜K˜?——šžœ
˜Kš
œL˜L——Kšœ+žœ˜1Kšžœžœ/˜EKšœžœžœžœ$˜PKšžœ˜—š
œ˜Kš
œ-™-Kš
œ2˜2—š
œ˜Kš
œ5™5šžœ
žœ˜ šžœ˜Kš
œ˜Kšžœ
˜—šžœ˜Kš
œ%™%Kšœžœ˜š
œ+˜+Kšœžœžœ
žœ˜.—Kšžœžœ'˜8Kš
œ"˜"Kšžœ"˜(K˜———š
œ˜Kš
œ"™"K˜(—š
œ˜Kšœžœ%˜/K˜Kšžœ
˜K˜—˜0K˜
Kšœžœžœ
˜šžœž˜K˜3Kšžœ
˜—K˜K˜(K˜JK˜Kšžœ
˜K˜—˜	K˜K˜
K˜Kšœžœ˜K˜!K˜#šžœž˜š
œ˜Kš
œ™Kšžœ'˜-—š
œ˜Kš
œD™Dšžœžœ
žœ˜Kš
œD™DK˜K˜Kšœ	žœžœ
˜Kš
œ)˜)šžœžœ˜Kšœžœ˜š
œ˜Kšœžœžœ
žœ˜.—šžœž˜Kš
œ"™"Kšžœ'˜-—K˜—K˜—Kšžœ(˜.Kš
œ˜—š
œ˜Kš
œ™Kš
œ*˜*Kšžœžœ
žœ
žœ
˜K˜'—Kšžœ*˜5—K˜
—šžœ˜
K˜D——Kšžœ
˜—K˜K˜—š 	œžœ?žœžœ
žœžœžœ˜Kš
œ˜Kšœžœžœ
˜Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœžœ
˜š
œ'˜'Kš
œt™t—Kšžœžœ/˜IKš
œ˜Kš
œ'˜'Kš
œ˜Kš
œ!˜!Kš
œ˜Kš
œ ˜ Kš
œ4˜4šžœ˜Kšžœ˜š
ž˜šžœžœ
ž˜š
œ
˜
šžœž˜Kš
œ6˜6Kšžœ
˜——Kšžœ
˜———Kš
œ
˜
Kšžœžœ/˜Hšžœžœ
žœ
ž˜Kšœžœžœ
˜Kšœ	žœžœžœ
žœ
žœ˜UKš
œ˜Kš
œ˜K˜Kšžœ
˜—K˜K˜—š
 
œžœ@žœžœžœ˜iKšœžœžœ
˜Kšœžœ˜Kšœ
žœ˜Kšžœžœ
žœ
žœ
˜"šžœžœ˜ Kš
œN™NKš
œ/˜/Kšžœžœ
žœ	˜$šžœžœ
žœ˜šžœ$ž˜.š
œ7˜7Kš
œ™K˜
—Kšžœžœžœ˜<—Kš
œ˜—Kšžœžœ&˜:Kš
œ$˜$Kš
œ$™$Kšžœ˜Kš
œ˜—Kš
œ™šžœžœ
žœ˜Kš
œ'˜'Kš
œ˜—K˜(Kšžœžœ
žœ
žœ	˜"Kšžœ%˜+K˜K˜—š
 œžœžœžœžœ˜LK˜K˜K˜K˜Kšžœžœ0˜EKš
œ˜Kšžœ˜K˜K˜—š 
œžœ)žœžœžœžœžœ˜pKš
œ4™4Kšœžœ˜
K˜K˜K˜Kšœ
žœ˜,K˜Kšžœžœ˜-K˜-K˜)Kšžœžœžœ˜.K˜š
œ
˜
šžœžœŸ˜2š
œ˜šžœ	˜Kšžœ+˜/Kšžœžœžœ˜:—Kšžœ	˜
—˜šžœ	˜Kšžœ)˜-Kšžœžœžœ˜9—Kšžœ	˜
—Kšžœ
˜—šžœž˜Kšžœ˜Kšžœ-˜1—Kšœ2žœ˜<Kšžœžœ
žœ
žœ
˜šžœž˜˜4K˜0—šžœ˜Kš
œ™Kš
œ˜Kšžœ	˜
——š
ž˜Kš
œ+˜+—K˜—K˜K˜—š œžœžœžœžœžœžœ˜cK˜K˜
Kšœžœžœ
˜š
ž˜Kš
œ&˜&K˜K˜K˜ šžœž˜š
œ6˜6šžœžœ˜"Kšœžœ˜'—šžœž˜$Kšœ+žœ˜3Kšžœ
˜—K˜Kšžœžœ
žœ˜.Kšžœ
˜K˜—Kšžœžœ
˜—Kšžœ
˜—K˜7K˜K˜—š œžœžœ
žœžœžœžœ˜UKšœžœž
˜+Kšžœžœ
žœ˜CK˜K˜—š
 œžœžœžœžœ˜@Kš
œ˜Kšžœžœ˜.K˜K˜—š
 œ
žœžœžœžœ˜TKšžœ
žœžœ
˜Kš
œ%˜%Kš
œ˜K™—š œ
ž	œ
žœžœžœžœžœ˜YKš
œΕ
™Ε
Kšžœ
žœ
žœ˜+Kš
œ˜šžœžœ
žœ˜Kšœžœ
˜Kšœžœ
˜	Kš
œ˜Kš
œ,˜,šžœ
˜Kšžœžœ
žœ&˜Hšžœ˜Kš
œ˜Kš
œD˜DKš
œ˜—Kš
œ˜—Kš
œ!˜!K˜—K˜K˜—š 
œžœžœžœžœžœ˜VKš
œz™zKšžœ
žœ
žœ˜%Kšžœ
žœ
žœžœžœ
žœ
˜DKš
œ(˜(K˜K˜—š œžœžœžœžœžœžœ˜ušœ‚
žœ(žœ™»
š
œ™Kš
œ@™@——š
œ&˜&Kš
œ)™)Kšœ
ž˜Kšœžœ
˜Kšœžœ
˜	Kš
œ,˜,šžœžœ˜Kšœž
˜Kšžœžœ(˜BKšœžœžœ˜0K˜—Kš
œ&˜&Kš
œ˜—Kšžœ
žœ
žœ˜%Kšžœ
žœ
žœ˜+Kš
œ$˜$Kš
œ˜K˜—š œžœžœžœžœžœ˜3Kšžœ!žœ
žœ˜:K˜K˜—K™
Kš
œ
˜
K˜Kšžœ
˜K˜K˜K˜——…—“RΦ\