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 [GetInterfaceRecord, AcquireIRType],
AMModel USING [Context, ContextWorld, ContextClass, MostRecentNamedContext, RootContext],
AMModelBridge USING [FrameFromContext, IRFromContext],
AMTypes USING
[Apply, Assign, AssignNew, Class, Copy, Domain, Error, First, GroundStar, IndexToTV, IndexToType, IsComputed, IsOverlaid, Last, Length, NameToIndex, NComponents, New, Next, Range, Referent, Size, TVEqual, TVStatus, TVToType, TVType, TypeClass, UnderClass, UnderType, VariableType, Variant, GetEmptyTV, TV],
BackStop USING [Call, ResumeBackStop, SuspendBackStop],
EvalQuote USING [EvalQuoteProc, Lookup],
InterpreterOps USING [EvalHead, RopeOrTV, Ruminant, Tree, TreeToName],
InterpreterPrivate USING
[EnumeratedValueFromRope, EvalRecord, LocalCoerce, NewInt, NewReal, NewType, TestAbort, UnderTypeAndClass, RecordSearch],
BBUrpEval USING [UrpFatal, UrpId, UrpSelector, UrpWrongType],
PPLeaves USING [HTIndex, LTIndex],
PPTree USING [Handle, Link, NodeName],
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, AMModel, AMModelBridge, AMTypes, BackStop, InterpreterOps, InterpreterPrivate, EvalQuote, BBUrpEval, Real, Rope, AMMiniModel, SymTab, UserProfile, WorldVM
EXPORTS InterpreterOps, InterpreterPrivate
= BEGIN OPEN AMBridge, AMTypes, InterpreterOps, InterpreterPrivate, BBUrpEval, SafeStorage;

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


empty: TV _ GetEmptyTV[];

underLORA: Type _ CODE[LORA];
underPROC: Type _ CODE[PROC];
underREF: Type _ CODE[REF];
underBOOL: Type _ CODE[BOOL];
underTYPE: Type _ CODE[Type];
underCARD: Type _ CODE[CARD];

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;
inner: INTERNAL PROC = TRUSTED {
TVForUnderType: PROC [under: Type] RETURNS [TV] = TRUSTED {
RETURN [AMBridge.TVForReadOnlyReferent[NEW[Type _ UnderType[under]]]]
}; 
lag: TV _ NIL;
true _ TVForReadOnlyReferent[NEW[BOOL _ TRUE]];
false _ TVForReadOnlyReferent[NEW[BOOL _ FALSE]];
NilTV _ TVForReadOnlyReferent[NEW[REF _ NIL]];
underLORA _ UnderType[underLORA];
underPROC _ UnderType[underPROC];
underREF _ UnderType[underREF];
underBOOL _ UnderType[underBOOL];
underTYPE _ UnderType[underTYPE];
underCARD _ UnderType[underCARD];
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["CARD", TVForUnderType[CODE[CARD]], " ... the TYPE"];
DoRegisterTV["CARDINAL", TVForUnderType[CODE[CARDINAL]], " ... the TYPE"];
DoRegisterTV["CHAR", lag _ TVForUnderType[CODE[CHAR]], " ... the TYPE"];
DoRegisterTV["CHARACTER", lag, " ... the TYPE"];
DoRegisterTV["INT", TVForUnderType[CODE[INT]], " ... the TYPE"]; 
DoRegisterTV["INTEGER", TVForUnderType[CODE[INTEGER]], " ... the TYPE"]; 
DoRegisterTV["PROC", TVForUnderType[CODE[PROC]], " ... the TYPE: PROC"]; 
DoRegisterTV[
"PROCANY",
TVForUnderType[CODE[PROC ANY RETURNS ANY]],
" ... the TYPE: PROC ANY RETURNS ANY"
]; 
DoRegisterTV["PROCESS", TVForUnderType[CODE[PROCESS]], " ... the TYPE: PROCESS"]; 
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
}; 

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]]};

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];
ENDCASE => GO TO NYI;
};
apply =>
RETURN [EvalApply[son1, son2, head, target, node]];
cons => {
elemTree: Tree _ ListElem[son2, 1];
listTree: Tree _ ListElem[son2, 2];
top: LORA _ Listify[SubEval[elemTree, underREF]];
rest: TV _ SubEval[listTree, underLORA];
rtnRef _ NEW[LORA _ top];
DO restUnder: Type;
restClass: Class;
restUnder _ AMTypes.UnderType[AMTypes.TVType[rest]];
restClass _ AMTypes.TypeClass[restUnder];
IF restClass = nil THEN GOTO forRef;
IF restUnder = underLORA THEN EXIT;
rest _ LocalCoerce[head, listTree, rest, underLORA, 0, "invalid list"];
ENDLOOP;
top.rest _ NARROW[AMBridge.TVToRef[rest], LORA];
GO TO forRef};
listcons => {
elems: Tree _ son2;
pos: CARDINAL _ 1;
top, last: LORA _ NIL;
IF elems = NIL THEN RETURN [NIL];
WITH elems SELECT FROM
n: Node =>
IF n.name = list THEN
FOR i: CARDINAL IN [1..n.sonLimit) DO
etv: TV _ SubEval[n.son[i], underREF];
elist: LORA _ Listify[etv];
IF top = NIL THEN top _ elist ELSE last.rest _ elist;
last _ elist
ENDLOOP
ENDCASE;
IF top = NIL THEN
top _ Listify[SubEval[elems, underREF]];
rtnRef _ NEW[LORA _ top];
GO TO forRef};
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 [EvalBinop[son1, son2, kind, head, target--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};
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 _ IF son3 = NIL THEN NIL ELSE SubEval[son3, repType];
ref: REF _ NIL;
IF son3 = NIL
THEN rtn _ New[type: repType, world: world]
ELSE rtn _ Copy[rtn];
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]
}; 

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];
IF TypeClass[UnderType[TVType[rtn]]] = real THEN {
real: REAL _ LOOPHOLE[AMBridge.TVToLC[rtn]];
SELECT kind FROM
abs => real _ ABS[real];
uminus => real _ -real;
ENDCASE => ERROR;
RETURN [NewReal[real]];
};
int _ TVToLI[rtn];
SELECT kind FROM
abs => int _ ABS[int];
uminus => int _ -int;
ENDCASE => ERROR;
rtn _ NewInt[int];
}; 

EvalBinop: 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 _ TVType[lval];
ltype _ UnderType[ttype];
lclass _ TypeClass[ltype];
IF target = nullType THEN target _ ttype;
rval _ EvalNoProps[right, head, ltype];
rtype _ UnderType[TVType[rval]];
rclass _ TypeClass[rtype];
SELECT kind FROM
relE, relN =>
SELECT lclass FROM
subrange, cardinal, integer, character, longInteger, longCardinal,
real, unspecified => -- these values must be arithmetic
op _ minus
ENDCASE => {
eq: BOOL _ TVEqual[lval, rval];
IF kind = relN THEN eq _ NOT eq;
RETURN [IF eq THEN true ELSE false];
};
relL, relGE, relG, relLE => op _ minus
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];
IF alclass = real OR arclass = real THEN {
-- raise conciousness to the real level
lreal: REAL _ TVToReal[lval];
rreal: REAL _ TVToReal[rval];
IF lclass # real THEN lreal _ TVToLI[lval];
IF rclass # real THEN rreal _ TVToLI[rval];
SELECT op 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;
SELECT kind FROM
relE => rtnBit _ lreal = 0.0;
relN => rtnBit _ lreal # 0.0;
relL => rtnBit _ lreal < 0.0;
relGE => rtnBit _ lreal >= 0.0;
relG => rtnBit _ lreal > 0.0;
relLE => rtnBit _ lreal <= 0.0;
ENDCASE => RETURN [NewReal[lreal]];
IF rtnBit THEN RETURN [true] ELSE RETURN [false];
};
{
lint: INT _ TVToLI[lval];
rint: INT _ TVToLI[rval];
SELECT op FROM
plus => lint _ lint + rint;
minus => lint _ lint - rint;
times => lint _ lint * rint;
div => lint _ lint / rint;
mod => lint _ lint MOD rint;
min => lint _ MIN[lint, rint];
max => lint _ MAX[lint, rint]
ENDCASE => ERROR;
SELECT kind FROM
relE => rtnBit _ lint = 0;
relN => rtnBit _ lint # 0;
relL => rtnBit _ lint < 0;
relGE => rtnBit _ lint >= 0;
relG => rtnBit _ lint > 0;
relLE => rtnBit _ lint <= 0;
ENDCASE => RETURN [NewInt[lint]];
IF rtnBit THEN RETURN [true] ELSE RETURN [false];
}
}; 

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 _ InterpreterPrivate.RecordSearch
		[AMModelBridge.FrameFromContext[head.context], name];
IF val # NIL THEN {ok _ TRUE; RETURN};
IF UserProfile.Boolean["Interpreter.SearchTheWorld", FALSE]
THEN inner[AMModel.RootContext[WorldFromHead[head]]];
};
interface => {
val _ InterpreterPrivate.RecordSearch
		[AMModelBridge.IRFromContext[head.context], name];
IF val # NIL THEN {ok _ TRUE; RETURN};
IF UserProfile.Boolean["Interpreter.SearchTheWorld", FALSE]
THEN inner[AMModel.RootContext[WorldFromHead[head]]];
};
ENDCASE => ERROR;
};  -- end inner

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 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;
};  -- end Lookup

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;
IF lName = NIL
THEN record _ EvalNoProps[left, head, nullType]
ELSE record _ Lookup[lName, head, nullType, left];
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
};   -- end EvalDot

ForceArithmetic: PROC
[val: TV, head: EvalHead, parent: Tree] RETURNS [rtn: TV] = TRUSTED {
type: Type;
ground: Type;
class: Class;
rtn _ StripSingleComponentRecord[val];
type _ TVType[rtn];
ground _ GroundStar[type];
class _ TypeClass[ground];
SELECT class FROM
real =>
IF type # ground THEN rtn _ NewReal[TVToReal[rtn]];
cardinal, character, unspecified =>
rtn _ NewInt[TVToCardinal[rtn]];
integer =>
rtn _ NewInt[TVToInteger[rtn]];
longCardinal =>
rtn _ NewInt[LOOPHOLE[TVToLC[rtn], INT]];
longInteger =>
IF type # ground THEN rtn _ NewInt[TVToLI[rtn]]
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
}; 

EvalApply: PROC
[proc, args: Tree, head: EvalHead, target: Type, parent: Tree]
RETURNS [rtn: TV _ NIL] = 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 {
-- we got it, now its not our job anymore!
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 => {
argsRec: TV _ NIL;
argsType, rtnsType: Type;
IF pval = NIL OR AMBridge.TVToLC[pval] = 0 THEN
UrpFatal[head, parent, "NIL procedure?"];
argsType _ UnderType[Domain[ptype]];
rtnsType _ UnderType[Range[ptype]];
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]];
SIGNAL BackStop.SuspendBackStop;
rtn _ AMEvents.Apply[pval, argsRec];
SIGNAL BackStop.ResumeBackStop;
IF rtnsType = nullType THEN RETURN [empty];
rtn _ StripSingleComponentRecord[rtn, 1];
RETURN};
record, structure => -- try to get the array/sequence part, then loop
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 => -- try to get the referent, then loop
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 => -- well, try for the constructor
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  --it is a variant record type binder
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];
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];
};

EnsureInit[];

END.




@EvaluateImpl.mesa
Russ Atkinson, October 5, 1983 5:02 pm
Paul Rovner, December 12, 1983 1:03 pm
**** 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
{
tv: TV _ SubEval0[son1];
lp: LONG POINTER _ NIL;
lp _ PointerFromTV[tv];
IF lp # NIL THEN
{rtnRef _ NEW[LONG POINTER _ lp];
GO TO forRef};
IF (rtnRef _ GentleRef[tv]) # NIL THEN
{rtnRef _ NEW[REF _ rtnRef]; GO TO forRef};
errmsg _ "could not get address";
GOTO fatal;
};
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
raise conciousness to the real level
At this point the values must be arithmetic.
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.

... 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.
Try to get the right stuff.
First try for a registered EvalQuoteProc.
Until we get to definitely applicable or not.
This is a target-typed record or array constructor.
if a normal variant record, bind the variant and loop
now try to bind the specified variant
possibly a variant record type binder, possibly a record constructor
we are trying either to construct a record or to bind a variant type
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
�Ê)ñ˜š
œ™Jš
œ&™&Jš
œ&™&—J˜š
Ïk	˜	šœ	�˜Jš
Ϝ
˜ú
—Jšœ	�œ	˜Jšœ�œ%˜6Jšœ�œL˜YJšœ�œ#˜6šœ�˜
Jš
œ²˜²—Jšœ	�œ)˜7Jšœ
�œ˜(Jšœ�œ2˜Fšœ�˜Jš
œy˜y—Jšœ
�œ.˜=Jšœ	�œ˜"Jšœ�œ˜&Jšœ�œ˜Jšœ�œ�œ˜7Jšœ�œ˜#Jšœ�œ4˜@Jšœ�œ˜Jšœ�œ˜"J˜—šœ�œ
�˜š
�˜Jš
Ϩ
˜®
—Jš�œ#˜*šœ�œ
�œO˜[J˜—š
œ™Jš�œ�œ�œ
�œ
˜Jš
�œ�œ�œ
�œ
�œ˜Jšœ�œ˜Jš�œ�œ�œ
˜—J˜Jš
œ ™ ˜Jšœ�œ˜J˜Jš
œ9™9Jšœ�œ
�œ˜Jšœ�œ
�œ˜Jšœ�œ
�œ˜Jšœ�œ
�œ˜Jšœ�œ˜Jšœ�œ
�œ˜J˜Jš	œ
�œ�œ
�œ�œ˜.Jš	œ�œ�œ
�œ�œ˜1J˜Jš
œZ™ZJšœ�œ�œ
˜Jšœ�œ�œ
˜Jšœ�œ�œ
˜J˜Jš
œ,˜,Jš
œ(˜(J˜Jšœ
�œ�œ
˜Jšœ�œ�œÏc&˜BJ˜Jš
œ™—J˜š
Ïnœ�œ
�œ
�œ�œ˜'Jš�œ
�œ
�œ˜%Jš�œ˜Jš
œ˜J˜—šŸœ�œ
�œ
�œ˜6Jš�œ
�œ
�œ˜%Jš�œ˜Jš
œ˜J˜—šŸœ�œ
�œ
�œ˜<Jš�œ
�œ
�œ˜%Jš�œ˜Jš
œ˜J˜—šŸ
œ�œ
�˜Jšœ�œ�œ�œ˜AJš�œ�œ
�œ,˜>Jš�œ	�œ
�œ˜1J˜J˜—šŸ
œ�œ
�œ˜Jš
œ»
™»
Jš�œ
�œ�œ
˜šœ�
œ�œ˜ š
Ÿœ�œ�œ�œ�œ˜;Jš�œ!�œ˜EJ˜—Jšœ�œ�œ
˜Jšœ�œ
�œ�œ˜/Jšœ�œ
�œ�œ˜1Jšœ�œ
�œ�œ˜.J˜!J˜!J˜J˜!J˜!J˜!Jš
œ,˜,Jš
œ.˜.Jšœ$�œ
�œ˜CJšœ*�œ
�œ˜IJš
œ/˜/Jšœ$�œ
�œ˜BJšœ(�œ
�œ˜JJšœ*�œ
�œ˜HJš
œ0˜0Jšœ#�œ
�œ˜AJšœ'�œ
�œ˜IJšœ$�œ
�œ˜Iš
œ
˜
Jš
œ
˜
Jšœ�œ
�œ
�œ
�œ
�œ˜+Jš
œ%˜%Jš
œ˜—Jšœ'�œ
�œ˜RJšœ#�œ
�œ˜JJšœ$�œ
�œ˜CJšœ$�œ
�œ˜CJšœ�œ
˜J˜—Jš�œ
�œ
�œ'˜>J˜J˜—šŸœ�˜Jšœ*�œ�œ˜;Jš
�œ�œ
�œ
�œ�œ˜ Jš�œ
�œ
�œ˜%š�œ�œ
�˜Jšœ�œ(˜GJšœ�œ�œ$˜8Jšœ�œ˜5Jšœ�œ˜3Jš�œ�˜—J˜J˜—šŸœ�˜Jš	œ+�œ�œ�œ�œ˜NJšœ�œ�œ
˜Jšœ�œ�œ
˜J˜"Jšœ�œ˜$Jš	œ
�œ�œ
�œ
�œ
˜4Jš	œ
�œ�œ
�œ
�œ
˜4š
Ÿœ�œ�œ�œ�œ˜AJš�œ#˜)Jš
œ˜—š
Ÿœ�œ�œ�œ�œ˜4Jš�œ%˜+Jš
œ˜—š
Ÿœ�œ�œ�œ�œ˜4Jš�œ#˜)Jš
œ˜—šŸœ�œ�œ�œ�œ�œ˜1Jš�œ�œ˜#J˜—š
Ÿœ�œ�œ�œ�œ˜6Jš�œ5˜;J˜—J˜Jš
œ™šœ
�œ�˜Jš
œ!™!˜%Jš�œ.˜4—š
œ˜Jšœ�œ˜š�œ
�œ�˜Jš	œ�œ�œ
�œ
�œ
˜.—Jš�œ˜J˜—J™š
œ˜Jš�œ)˜/—š
œ˜Jšœ�œ˜Jš
œ˜š�œ�˜Jšœ�œ"˜4Jšœ�œ!˜2Jš�œ�œ
�œ
�œ
˜—Jš
œ˜—Jš
œ™˜Jš�œ-˜3—˜	J˜#J˜#Jšœ�œ(˜1Jšœ�œ ˜(Jšœ	�œ
�œ˜š�œ˜J˜Jš
œ4˜4Jš
œ)˜)Jš�œ�œ
�œ˜$Jš�œ�œ
�œ
˜#J˜GJš�œ
˜—Jšœ�œ�œ˜0Jš�œ
�œ	˜—˜
J˜Jšœ�œ˜Jšœ�œ�œ
˜Jš
�œ	�œ
�œ
�œ�œ˜!š�œ�œ
�˜˜
š�œ�˜š�œ�œ
�œ�˜%Jšœ�œ˜&Jšœ�œ˜Jš�œ�œ
�œ
�œ˜5J˜Jš
�˜———Jš�œ
˜—š�œ�œ
�˜J˜(—Jšœ	�œ
�œ˜Jš�œ
�œ	˜—š
œ˜Jš
œ!™!Jšœ�œ˜Jš
�œ�œ
�œ�œ
�œ	˜/Jš�œ�œ�œ
�œ˜)Jš�œ�œ�œ�œ	˜1—˜Jš�œ�œ�œ�œ˜0—˜'Jš�œ@˜F—˜Jš�œ3˜9—˜
J˜J˜Jšœ
�œ˜Jšœ�œ
˜š�œ�œ
�˜J˜2Jš�œ˜—š�œ�œ
�œ�˜Jš	œ�œ�œ
�œ�œ˜=Jšœ�œ˜Jš
œ*˜*Jš
œ(˜(Jšœ
�œ
˜Jšœ�œž'˜Aš�œ�œ˜Jš
œ"˜"Jš
œ!˜!J˜—š�œ�˜š
œ&˜&Jš
œ!˜!Jš�œ�œ˜:š�œ�˜š
œ˜Jš�œ�œ�œ˜,J˜—š
œ˜š	�œ
�œ�œ�œ�˜:Jšœ�œ˜—J˜—š
œ	˜	Jšœ�œ
ž˜.Jš
�œ�œ�œ�œ�œ˜8J˜—Jšœ�œ
˜Jš�œ�œ
�œ˜—J˜—š
œ˜Jš
œ!˜!š�œ�˜š
œ˜Jš
œ%™%Jš�œ�œ�œ˜,J˜—Jšœ�œ
˜Jš�œ�œ
�œ˜—J˜—š
œ˜Jšœ	�œ˜%Jšœ�œ
˜Jš�œ�œ˜8š�œ�˜š
œ˜Jš�œ
�œ�œ�œ˜<—š
œ˜Jš
�œ�œ�œ�œ�œ˜:—š
œ	˜	Jšœ�œž˜-Jš
�œ�œ�œ�œ�œ˜8J˜—Jšœ�œ
˜Jš�œ�œ
�œ˜—J˜—š
œ	˜	Jšœ�œ
˜Jš
œ!˜!Jšœ�œ˜š�œ�˜Jš
œ$˜$Jšœ�œ�œ˜2Jšœ�œ˜&Jšœ�œ
�œ˜Jš�œ�œ
�œ˜—Jš�œ�œ�œ˜,Jš�œ�œ˜!J˜—Jš�œ�œ
�œ˜—š�œ�œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜—Jš�œ
˜—Jš�œ
˜š
�˜Jš
œ:˜:Jš
œ<˜<—Jš
œ˜—˜Jš�œ+˜1—˜Jš�œ&˜,—˜Jš�œ&�œ˜3—š	œ�œ
�œ
�œ#�œ	˜Rš
œ
™
Jšœ�œ™Jšœ�œ
�œ�œ
™Jš
œ™š�œ�œ
�™šœ
�œ
�œ
�œ™!Jš�œ
�œ	™——š�œ�œ
�™&Jš	œ
�œ
�œ�œ
�œ	™+—J™!Jš�œ™—Jš
œ™—˜
Jš�œ+˜1—˜ Jš�œ
�œ	˜—˜ Jš
œ&˜&š�œ�˜š
œ	˜	Jšœ	�œ
�œ˜$Jš�œ
�œ	˜—˜Jš�œ˜—˜Jš�œ˜—˜Jš�œ
˜—Jš�œ�œ˜——š
œ
˜
Jš�œ�œ
�œ#˜5Jš�œ<˜BJ˜—Jšœ�œ	˜š
œ˜Jš
œ,™,Jš
œ™Jš
œ.™.Jš
œ+˜+š�œ˜Jš�œ
�œ
˜š�œ˜Jš	œ
�œ�œ
�œ
�œ
˜4Jš
œ)˜)Jš
œ�œ�œ�œ
�œ
�œ
�œ˜=Jšœ�œ�œ
˜š�œ�˜
Jš�œ'˜+Jš�œ˜—Jš
œ"˜"Jšœ	�œ
�œ˜Jš�œ˜Jš
œ˜——Jš
œ˜—š
œ	˜	š�œ�œ
�˜š
œ˜Jš
œ˜Jš�œ
�œ˜
J˜—Jš�œ
˜—Jš
œ˜Jš�œ
�œ˜
—š
œ˜Jšœ�œ˜š
�˜š�œ"�˜,˜#Jš�œ˜—š�œ˜
J˜>——Jš
�˜—J˜—Jš�œ�œ
�˜š
�˜˜
Jš�œ˜—˜	Jš�œ˜—˜J˜—˜J˜3—š�œ˜J˜)———Jš
�˜J˜J˜—šŸœ�œ�œ�œ˜?Jš�œ�œ
�œ˜š�œ�œ
�˜˜
š�œ�œ˜Jš�œ�œ�œ
�œ˜1Jš�œ�œ˜
——Jš�œ
˜—Jš�œ�œ
�œ�œ
�œ�œ
˜-J˜J˜—šŸœ�˜J˜AJš�œ�œ�œ�œ˜#Jš
œ*™*Jšœ�œ˜
Jš
œC˜Cš�œ*�œ˜2Jš
œ$™$Jšœ�œ�œ˜,š�œ�˜Jšœ�œ˜Jš
œ˜Jš�œ�œ
˜—Jš�œ˜J˜—Jš
œ˜š�œ�˜Jšœ
�œ˜Jš
œ˜Jš�œ�œ
˜—Jš
œ˜J˜J˜—šŸ	œ�˜J˜VJš�œ�œ�œ�œ˜#J˜Jšœ�œ�œ
˜J˜*J˜(Jšœ�œ
˜
J˜'J˜J˜J˜Jš�œ�œ˜)J˜'J˜ J˜š�œ�˜˜
š�œ�˜J˜Bšœž"˜7J˜
—š�œ˜Jšœ�œ˜Jš�œ
�œ�œ˜ Jš�œ�œ�œ�œ˜$Jš
œ˜———J˜&Jš�œ˜	J˜—Jš
œ,™,J˜J˜)J˜!J˜J˜*J˜!J˜š�œ�œ�œ˜*Jš
ž'˜'Jšœ�œ˜Jšœ�œ˜Jš�œ�œ˜+Jš�œ�œ˜+š�œ�˜J˜J˜J˜J˜J˜'Jšœ�œ˜!Jšœ�œ˜ Jš�œ�œ
˜—š�œ�˜Jšœ�œ
˜Jšœ�œ
˜Jšœ�œ
˜Jšœ�œ˜Jšœ�œ
˜Jšœ�œ˜Jš�œ˜#—Jš
�œ�œ
�œ�œ
�œ	˜1Jš
œ˜—š
œ
˜
Jšœ�œ˜Jšœ�œ˜š�œ�˜J˜J˜J˜J˜Jšœ�œ˜Jšœ�œ
˜Jšœ�œ˜Jš�œ�œ
˜—š�œ�˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš�œ�œ˜!—Jš
�œ�œ
�œ�œ
�œ	˜1Jš
œ
˜
—J˜J˜—šŸœ�˜Jšœ�œ-˜8š�œ�œ�œ�œ˜#Jš
ϵ
™µ
—Jšœ�œ�œ
˜Jšœ�œ�œ
˜J˜šœ�œ�œ˜2Jš
œC™Cš�œ�œ˜Jš
œ,˜,Jš
�œ�œ
�œ�œ�œ˜&Jš
œ˜—Jš�œ�œ4˜Kš�œ�˜)š
œ
˜
Jš
œ
™
š
œ>˜>Jšœ
�œ�œ�œ˜7—Jš
�œ�œ
�œ�œ�œ˜&Jš
œ™š
œ$˜$Jš
œ2˜2—Jš
�œ�œ
�œ�œ�œ˜&Jšœž)™7š
œ
˜
Jšœ6�œ	˜CJšœ1ž
˜>Jš�œ�œ
˜—J˜Jš
�œ�œ
�œ�œ�œ˜&J˜—š
œ˜š
œ%˜%Jš
œ7˜7—Jš
�œ�œ
�œ�œ�œ˜&š�œ3�œ
˜;Jš�œ1˜5—Jš
œ˜—š
œ˜š
œ%˜%Jš
œ4˜4—Jš
�œ�œ
�œ�œ�œ˜&š�œ3�œ
˜;Jš�œ1˜5—J˜—Jš�œ�œ
˜—Jšœž˜—J˜Jš
œ™š
�˜Jš�œ�œ
�œ
�œ
˜"Jš�œ�œ(˜?Jš�œ�œ�œ
�
œ˜KJš�œ�œ(˜?Jš
œ&˜&Jš�œ�œ
�œ
˜Jš
œ™Jš
œ%˜%Jš�œ�œ
�œ
˜š�œ
�œ�œ˜$Jš
œ˜Jš�œ�œ
�œ
˜J˜—˜Pš�œ�œ
�˜Jšœ4�œ˜<J˜&Jšœ�œ˜Jš
�˜——Jš
œ˜Jš
�˜—Jšœž
˜J˜—šŸœ�œ�œ˜(Jš
œ(™(š�œ�œ
�˜Jš
œ1˜1Jš
�˜—J˜J˜—šŸœ�œ(˜5Jš�œ�œ�œ˜Jš
œ™Jšœ�œ
˜š�œ�œ
�˜Jšœ�œ
�œ
�œ	˜%Jšœ�œ
�œ
�œ
�œ
�œ˜,Jš�œ
˜—Jš�œ˜#J˜J˜—šŸœ�œ:˜GJš�œ�œ�œ�œ˜"Jšœ�œ˜Jšœ�œ˜ Jšœ�œ�œ
˜Jšœ�œ�œ
˜J™Jš
œR™Rš�œ	�˜Jš�œ+˜/Jš�œ.˜2—J™Jš
œ=™=š	�œ�œ
�œ�œž#˜<š
œ2˜2š	œ�œ�œ�œ
�œ˜LJš
œ0™0——š�œ�˜š�œž'˜/š
œ˜Jš
œG˜G—š�œ�œ
�˜Jšœ �œ	˜/Jšœ(ž˜8Jšœ�œ˜š�œ˜
Jš�œ4ž˜O——Jš
œ
˜
—š�œ˜š�œ�˜"š
œ
˜
š�œ˜!Jš�œ=˜A—Jš
œ˜Jš
œ˜—Jš�œ
˜—Jš�œ˜J˜——Jš�œž&˜0—Jš�œ4ž˜OJšœž˜J˜—šŸœ�˜Jš	œ�œ�œ�œ�œ˜Eš
œu™uJ˜J˜
J˜
Jš
œ&˜&J˜J˜J˜š�œ�˜˜Jš�œ�œ˜3—˜#J˜ —˜
J˜—˜Jšœ
�œ�œ˜)—˜Jš�œ�œ˜/—Jš�œ+˜2——J˜J˜—šŸœ�œ�œ�œ˜9Jš�œ�œ�œ˜Jš
œ	˜	š�œ
�˜J˜%J˜!Jš
�œ�œ�œ�œ
�œ
˜PJš
œ˜Jš�œ
˜—J˜J˜—šŸœ�˜Jš	œ�œ �œ�œ�œ˜AJšœ�œ˜
š
�˜Jš
œ™Jš
œ&˜&š�œ#�œ˜+Jšœ�œ˜#Jš�œ�œ
�œ�œ˜&Jš�œ�œ
�œ�œ˜)—J˜?Jš
�˜—J˜J˜—šŸ	œ�˜Jš
œ>˜>Jš�œ�œ�œ�œ˜#Jšœ�œ�œ
˜J˜J˜Jšœ�œ˜Jšœ
�œ˜"J˜Jš
œ)™)š�œ�œ
�œ˜Jšœ �œ
˜$Jšœ�œ�œ
˜Jš
œ9˜9š�œ�œ
�œ˜Jš
ž*˜*Jš�œ$˜*J˜—J˜J˜—Jš
œ*˜*š
�˜Jš
œ-™-J˜J˜ J˜š�œ!�˜'J˜/J˜—š	�œ�œ
�œ�œ
�˜!Jš
œ3™3š�œ�˜Jšœ	�œ)˜8Jšœ�œ*˜EJš�œ0˜7—J˜—š�œ�˜š
œ˜Jšœ	�œ�œ
˜J˜š�œ�œ
�œ�˜/J˜)—J˜$J˜#š�œ˜š�œ˜š�œ�œ
�˜J˜?——š�œ
˜Jš
œL˜L——Jš�œ˜ Jš
œ$˜$Jš�œ˜Jš�œ�œ
�œ	˜+Jš
œ)˜)Jš�œ˜—šœž0˜EJš
œ2˜2—š
œ˜Jš
œ5™5š�œ
�œ˜ š�œ˜Jšœ�œ
˜—š�œ˜Jš
œ%™%Jšœ�œ˜š
œ+˜+Jšœ�œ�œ
�œ˜.—Jš�œ�œ'˜8Jš
œ"˜"Jš�œ"˜(J˜———šœž%˜BJ˜(—š
œ˜Jšœ�œ%˜/J˜Jš�œ
˜J˜—˜0J˜
Jšœ�œ�œ
˜š�œ�˜J˜3Jš�œ
˜—J˜J˜(J˜JJ˜Jš�œ
˜J˜—˜	J˜J˜
J˜Jšœ�œ˜J˜!J˜#š�œ�˜šœ	ž ˜)Jš�œ'˜-—š
œ˜Jš
œD™Dš�œ�œ
�œ˜Jš
œD™DJ˜J˜Jšœ	�œ�œ
˜Jš
œ)˜)š�œ�œ˜Jšœ�œ˜š
œ˜Jšœ�œ�œ
�œ˜.—š�œ�œž$˜7Jš�œ'˜-—J˜—J˜—Jš�œ(˜.Jš
œ˜—š
œ˜Jš
œ™Jš
œ*˜*Jš�œ�œ
�œ
�œ
˜J˜'—Jš�œ*˜5—J˜
—š�œ˜
J˜D——Jš�œ
˜—J˜J˜—šŸ	œ�˜Jšœ>�œ�œ
˜KJš�œ�œ�œ˜#Jš
œ˜Jšœ�œ�œ
˜Jšœ�œ˜Jšœ�œ˜Jšœ�œ˜Jšœ�œ
˜š
œ'˜'Jš
œt™t—Jš�œ�œ/˜IJš
œ˜Jš
œ'˜'Jš
œ˜Jš
œ!˜!Jš
œ˜Jš
œ ˜ Jš
œ4˜4š�œ˜Jš�œ˜š
�˜š�œ�œ
�˜š
œ
˜
š�œ�˜Jš
œ6˜6Jš�œ
˜——Jš�œ
˜———Jš
œ
˜
Jš�œ�œ/˜Hš�œ�œ
�œ
�˜Jšœ�œ�œ
˜Jšœ	�œ�œ�œ
�œ
�œ˜UJš
œ˜Jš
œ˜J˜Jš�œ
˜—J˜J˜—šŸ
œ�˜Jšœ?�œ�œ�œ˜XJšœ�œ�œ
˜Jšœ�œ˜Jšœ
�œ˜Jš�œ�œ
�œ
�œ
˜"š�œ�œ˜ Jš
œN™NJš
œ/˜/Jš�œ�œ
�œ	˜$š�œ�œ
�œ˜š�œ$�˜.š
œ7˜7Jš
œ™J˜
—Jš�œ�œ�œ˜<—Jš
œ˜—Jš�œ�œ&˜:Jš
œ$˜$Jš
œ$™$Jš�œ˜Jš
œ˜—Jš
œ™š�œ�œ
�œ˜Jš
œ'˜'Jš
œ˜—J˜(Jš�œ�œ
�œ
�œ	˜"Jš�œ%˜+J˜J˜—šŸœ�˜Jšœ�œ�œ�œ˜=J˜J˜J˜J˜Jš�œ�œ0˜EJš
œ˜Jš�œ˜J˜J˜—šŸ
œ�œ)�œ˜MJš�œ�œ�œ�œ˜"Jš
œ4™4Jšœ�œ˜
J˜J˜J˜Jšœ
�œ˜,J˜Jš�œ�œ˜-J˜-J˜)Jš�œ�œ�œ˜.J˜š
œ
˜
š�œ�œž˜2š
œ˜š�œ	˜Jš�œ+˜/Jš�œ�œ�œ˜:—Jš�œ	˜
—˜š�œ	˜Jš�œ)˜-Jš�œ�œ�œ˜9—Jš�œ	˜
—Jš�œ
˜—š�œ�˜Jš�œ˜Jš�œ-˜1—Jšœ2�œ˜<Jš�œ�œ
�œ
�œ
˜š�œ�˜˜4J˜0—š�œ˜Jš
œ™Jš
œ˜Jš�œ	˜
——š
�˜Jš
œ+˜+——J˜J˜J˜—šŸœ�œ�œ˜:Jš�œ�œ�œ�œ˜(J˜J˜
Jšœ�œ�œ
˜š
�˜Jš
œ&˜&J˜J˜J˜ š�œ�˜š
œ6˜6š�œ�œ˜"Jšœ�œ˜'—š�œ�˜$Jšœ+�œ˜3Jš�œ
˜—J˜Jš�œ�œ
�œ˜.Jš�œ
˜J˜—Jš�œ�œ
˜—Jš�œ
˜—J˜7J˜J˜—šŸœ�œ�œ
˜1Jš�œ�œ�œ�œ˜#Jšœ�œ�
˜+Jš�œ�œ
�œ˜CJ˜J˜—š
Ÿœ�œ�œ�œ�œ˜@Jš
œ˜Jš�œ�œ˜.J˜J˜—šŸœ
˜Jš�œ�œ�œ�œ˜CJš�œ
�œ�œ
˜Jš
œ%˜%Jš
œ˜J™—šŸœ
˜
Jš�œ
�œ�œ�œ�œ�œ˜KJš
ρ
™Å
Jš�œ
�œ
�œ˜+Jš
œ˜š�œ�œ
�œ˜Jšœ�œ
˜Jšœ�œ
˜	Jš
œ˜Jš
œ,˜,š�œ
˜Jš�œ�œ
�œ&˜Hš�œ˜Jš
œ˜Jš
œD˜DJš
œ˜—Jš
œ˜—Jš
œ!˜!J˜—J˜J˜—šŸ
œ�œ�œ�œ�œ�œ˜VJš
œz™zJš�œ
�œ
�œ˜%Jš�œ
�œ
�œ�œ�œ
�œ
˜DJš
œ(˜(J˜J˜—šŸœ�˜Jšœ�œ�œ�œ�œ�œ˜Wšœ‚
�œ(�œ™»
š
œ™Jš
œ@™@——š
œ&˜&Jš
œ)™)Jšœ
�˜Jšœ�œ
˜Jšœ�œ
˜	Jš
œ,˜,š�œ�œ˜Jšœ�
˜Jš�œ�œ(˜BJšœ�œ�œ˜0J˜—Jš
œ&˜&Jš
œ˜—Jš�œ
�œ
�œ˜%Jš�œ
�œ
�œ˜+Jš
œ$˜$Jš
œ˜J˜—J™
Jš
œ
˜
J˜Jš�œ
˜J˜J˜J˜——…—vÞ®