DIRECTORY AMBridge USING [FHFromTV, GetWorld, GFHFromTV, IsRemote, Loophole, PointerFromTV, RemoteFHFromTV, RemoteGFHFromTV, SetTVFromLC, SomeRefFromTV, TVForReadOnlyReferent, TVForReferent, TVToCardinal, TVToInteger, TVToLC, TVToLI, TVToReal], AMBridgeExtras USING [AssignNew], AMTypes USING [Apply, Class, Copy, Domain, Error, First, GroundStar, IndexToTV, IndexToType, IsComputed, IsOverlaid, Last, Length, NameToIndex, NComponents, New, Next, Range, Referent, Tag, TVEqual, TVSize, TVStatus, TVToType, TVType, TypeClass, TypeToName, UnderType, VariableType, Variant], AtomsPrivate USING [GetAtom], BBApply USING [ApplyProcToRecord, CalculateRecordSize], BBContext USING [Context, ContextForGlobalFrame, GlobalFrameSearch, RecordSearch, StackSearch], BBEmptyReturn USING [TheEmptyReturn], BBEval USING [AbortProc, EvalHead, EvalHeadRep, HelpDefault, HelpFatal, HelpId, HelpSelector, HelpWrongType, RopeOrTV, Tree], BBEvalQuote USING [EvalQuoteProc, Lookup], BBEvalUtil USING [EnumeratedValueFromRope, EvalRecord, FirstComponent, LocalCoerce, LocalUnderTypeAndClass, Momma, NewInt, NewReal, NewType, SafeAssign, TestAbort, TreeToRope, UnderTypeAndClass, UnderWear, WorldFromHead], BBSafety USING [Mother], BBUrpEval USING [UrpFatal, UrpId, UrpSelector, UrpWrongType], PPLeaves USING [HTIndex, LTIndex], PPTree USING [Handle, Link, NodeName], Real USING [FRem], Rope USING [Flatten, Match, ROPE, Size], RTBasic USING [nullType, TV, Type], RTMiniModel USING [AcquireIRInstance, AcquireIRType], RTSymbolDefs USING [SymbolTableBase, symbolIndexForTYPE], RTSymbolOps USING [AcquireType], RTSymbols USING [GetTypeSymbols, ReleaseSTB], SymTab USING [Create, Fetch, Ref, Store], WorldVM USING [LocalWorld, World]; BBEvalImpl: CEDAR MONITOR IMPORTS AMBridge, AMBridgeExtras, AMTypes, AtomsPrivate, BBApply, BBContext, BBEmptyReturn, BBEvalQuote, BBEvalUtil, BBSafety, BBUrpEval, Real, Rope, RTMiniModel, RTSymbolOps, RTSymbols, SymTab, WorldVM EXPORTS BBEval, BBEvalUtil SHARES BBEval = BEGIN OPEN BBEval, BBEvalUtil, BBUrpEval, AMBridge, AMTypes; CARD: TYPE = LONG CARDINAL; Id: TYPE = REF IdRep; IdRep: TYPE = RECORD [name: ROPE, value: TV]; LORA: TYPE = LIST OF REF; Node: TYPE = PPTree.Handle; ROPE: TYPE = Rope.ROPE; TV: TYPE = RTBasic.TV; Type: TYPE = RTBasic.Type; nullType: Type = RTBasic.nullType; empty: TV _ BBEmptyReturn.TheEmptyReturn[]; stackSearchDepth: INTEGER _ 8; 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: PUBLIC TV _ NIL; symtab: SymTab.Ref _ NIL; tvWorldInit: BOOL _ FALSE; tvWorldInitMsg: ROPE _ NIL; -- reason for failure to init (if any) CantHandleRemote: ERROR = CODE; EnsureInit: ENTRY PROC = { ENABLE UNWIND => NULL; inner: PROC = TRUSTED { IF symtab = NIL THEN symtab _ SymTab.Create[151, TRUE]; true _ TVForReadOnlyReferent[NEW[BOOL _ TRUE]]; false _ TVForReadOnlyReferent[NEW[BOOL _ FALSE]]; NilTV _ TVForReadOnlyReferent[NEW[REF _ NIL]]; [] _ symtab.Store["TRUE", true]; [] _ symtab.Store["FALSE", false]; underLORA _ AMTypes.UnderType[underLORA]; underPROC _ AMTypes.UnderType[underPROC]; underREF _ AMTypes.UnderType[underREF]; underBOOL _ AMTypes.UnderType[underBOOL]; underTYPE _ AMTypes.UnderType[underTYPE]; underCARD _ AMTypes.UnderType[underCARD]; tvWorldInit _ TRUE; }; IF NOT tvWorldInit THEN tvWorldInitMsg _ BBSafety.Mother[inner]; }; GetSymTab: PUBLIC PROC RETURNS [SymTab.Ref] = { EnsureInit[]; RETURN [symtab] }; NewEvalHead: PUBLIC PROC [ context: BBContext.Context, helpFatal: HelpFatal, helpWrongType: HelpWrongType _ NIL, helpId: HelpId _ NIL, helpSelector: HelpSelector _ NIL, helpDefault: HelpDefault _ NIL, data: REF _ NIL, specials: SymTab.Ref _ NIL, globalContext: BBContext.Context _ NIL, abortProc: AbortProc _ NIL] RETURNS [EvalHead] = { RETURN [ NEW [ EvalHeadRep_ [ context: context, helpFatal: helpFatal, helpWrongType: helpWrongType, helpId: helpId, helpSelector: helpSelector, helpDefault: helpDefault, data: data, specials: specials, globalContext: globalContext, abortProc: abortProc]]] }; 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, target]]; 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]]; }; GentleRef: PROC [tv: TV] RETURNS [ref: REF _ NIL] = TRUSTED { IF AMBridge.IsRemote[tv] THEN ERROR CantHandleRemote; SELECT UnderWear[tv, head, node].class FROM nil => ref _ NIL; ref, list, rope, atom => ref _ LOOPHOLE[TVToLC[tv]]; ENDCASE => ref _ SomeRefFromTV[tv]; RETURN [ref] }; Listify: PROC [tv: TV] RETURNS [LORA] = TRUSTED { RETURN [LIST[GentleRef[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 _ ForceType[tv1, head, son1]; SELECT LocalUnderTypeAndClass[type, head, node].class FROM cardinal => RETURN [symtab.Fetch["CARD"].val]; integer => RETURN [symtab.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, restClass] _ UnderWear[rest, head, node]; IF restClass = nil THEN GO TO forRef; IF restUnder = underLORA THEN EXIT; rest _ LocalCoerce [head, listTree, rest, underLORA, 0, "invalid list"]; ENDLOOP; top.rest _ NARROW[GentleRef[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, 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; eachClass: Class _ UnderWear[each, head, node].class; eachCard: CARD; swap: BOOL _ kind = min; -- if each > best, then swap _ NOT swap IF eachClass = subrange THEN { groungHog: PROC = TRUSTED { eachUnder _ AMTypes.GroundStar[eachUnder]; eachClass _ AMTypes.TypeClass[eachUnder]; }; Momma[groungHog, head, node, "GroundStar"]; }; 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].tv]; uminus, abs => RETURN [EvalUnop[son1, kind, head, target]]; all => RETURN [EvalArray[son1, head, target, node, TRUE]]; addr => { tv: TV _ SubEval0[son1]; lp: LONG POINTER _ NIL; lp _ PointerFromTV[tv ! AMTypes.Error => CONTINUE]; 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"; GO TO fatal}; uparrow => RETURN[SafeReferent[SubEval0[son1], head, node]]; lengthen, mwconst, clit, llit => GO TO evalSon; size, typecode, first, last => { type: Type _ ForceType[SubEval0[son1], head, node]; SELECT kind FROM size => { rtnRef _ NEW[CARDINAL _ BBApply.CalculateRecordSize[type]]; GO TO forRef}; typecode => RETURN[NewType[type]]; first => RETURN [First[type]]; last => RETURN [Last[type]] ENDCASE => ERROR}; loophole => { IF son2 # NIL THEN target _ ForceType[SubEval0[son2], head, node]; RETURN [LocalLoophole[head, node, SubEval[son1, target], target]]; }; nil => RETURN [NilTV]; new => { world: WorldVM.World _ BBEvalUtil.WorldFromHead[head]; IF world # WorldVM.LocalWorld[] THEN GO TO notRemote ELSE { son3: Tree _ IF nSons > 2 THEN node.son[3] ELSE NIL; repType: Type _ ForceType[SubEval0[son2], head, node]; rtn: TV _ IF son3 = NIL THEN NIL ELSE SubEval[son3, repType]; ref: REF _ NIL; innerNew: PROC = TRUSTED { IF son3 = NIL THEN rtn _ AMTypes.New[type: repType, world: world] ELSE rtn _ AMTypes.Copy[rtn]; ref _ AMBridge.SomeRefFromTV[rtn]; rtnRef _ NEW[REF _ ref]; }; Momma[innerNew, head, node, "NEW"]; GO TO forRef; }; }; atom => { name: ROPE _ TreeToRope[son1]; atom: ATOM _ AtomsPrivate.GetAtom [name.Flatten[IF Rope.Match["$*", name] THEN 1 ELSE 0]]; IF atom = NIL THEN { errmsg _ "invalid atom"; GO TO fatal}; rtnRef _ NEW[ATOM _ atom]; GO TO forRef}; length => { tv: TV _ SubEval0[son1]; type,under: Type; class: Class; DO [type,under,class] _ UnderWear[tv, head, son1]; SELECT class FROM descriptor, longDescriptor, rope => RETURN [NewInt[AMTypes.Length[tv]]]; ENDCASE => tv _ UrpWrongType[head, son1, tv, target, "not a descriptor"]; ENDLOOP }; ENDCASE => GO TO 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 UnderWear[rtn, head, tree].class = 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, ltype, lclass] _ UnderWear[lval, head, left]; IF target = nullType THEN target _ ttype; rval _ EvalNoProps[right, head, ltype]; [, rtype, rclass] _ UnderWear[rval, head, right]; SELECT kind FROM relE, relN => SELECT lclass FROM subrange, cardinal, integer, character, longInteger, longCardinal, real, unspecified => -- these values must be arithmetic op _ minus ENDCASE => { inner: PROC = TRUSTED {eq _ TVEqual[lval, rval]}; lc1,lc2: CARD _ 0; eq: BOOL _ FALSE; {ENABLE ANY => GO TO tryLong; eq _ TVToLC[lval] = TVToLC[rval]; EXITS tryLong => Momma[inner, head, parent, "equal test"]}; 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, alclass] _ UnderWear[lval, head, left]; rval _ ForceArithmetic[rval, head, right]; [, artype, arclass] _ UnderWear[rval, head, right]; 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; tab: SymTab.Ref _ IF head.specials = NIL THEN symtab ELSE head.specials; inner: PROC = TRUSTED { gf, lf: TV _ NIL; IF target # nullType THEN { val _ EnumeratedValueFromRope[name, target]; IF val # NIL THEN {ok _ TRUE; RETURN}}; IF head.context # NIL THEN { [gf, lf, val] _ BBContext.StackSearch[head.context, name, TRUE, stackSearchDepth]; IF gf # NIL OR lf # NIL THEN {ok _ TRUE; RETURN}}; [gf, lf, val] _ BBContext.StackSearch [head.globalContext, name, TRUE, stackSearchDepth]; IF gf # NIL OR lf # NIL THEN {ok _ TRUE; RETURN}; }; DO IF name.Size[] = 0 THEN UrpFatal[head, parent, "invalid name"]; [ok, val] _ tab.Fetch[name]; IF ok THEN RETURN; IF tab # symtab THEN { [ok, val] _ symtab.Fetch[name]; IF ok THEN RETURN}; IF NOT Rope.Match["*&*", name] THEN { Momma[inner, head, name, "lookup"]; 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; }; LookupTryIR: PROC [name: ROPE, head: EvalHead, target: Type, parent: Tree] RETURNS [val: TV _ NIL, IRfound: BOOL _ FALSE] = TRUSTED { ok: BOOL _ FALSE; tab: SymTab.Ref _ IF head.specials = NIL THEN symtab ELSE head.specials; inner: PROC = TRUSTED { gf, lf: TV _ NIL; IF target # nullType THEN { val _ EnumeratedValueFromRope[name, target]; IF val # NIL THEN {ok _ TRUE; RETURN}}; IF head.context # NIL THEN { [gf, lf, val] _ BBContext.StackSearch[head.context, name, TRUE, stackSearchDepth]; IF gf # NIL OR lf # NIL THEN {ok _ TRUE; RETURN}}; [gf, lf, val] _ BBContext.StackSearch [head.globalContext, name, TRUE, stackSearchDepth]; IF gf # NIL OR lf # NIL THEN {ok _ TRUE; RETURN}; }; DO IF name.Size[] = 0 THEN UrpFatal[head, parent, "invalid name"]; [ok, val] _ tab.Fetch[name]; IF ok THEN RETURN; IF tab # symtab THEN { [ok, val] _ symtab.Fetch[name]; IF ok THEN RETURN}; IF NOT Rope.Match["*&*", name] THEN { val _ TryForIRInstance[name, head, parent]; IF val # NIL THEN {IRfound _ TRUE; RETURN}; Momma[inner, head, name, "lookup"]; 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, target: Type] 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]] }; TryForIRInstance: PROC [irName: ROPE, head: EvalHead, parent: Tree] RETURNS [irTV: TV _ NIL] = { inner: PROC = TRUSTED { world: WorldVM.World = BBEvalUtil.WorldFromHead[head]; irTV _ RTMiniModel.AcquireIRInstance[ irName, world ! ANY -- Should be: AMTypes.Error -- => CONTINUE]; IF irTV = NIL THEN { irt: Type = RTMiniModel.AcquireIRType[irName, world ! AMTypes.Error => GO TO none]; irTV _ CopyToGivenWorld[world, TVForType[irt], TRUE]; EXITS none => {}; }; }; Momma[inner, head, parent, "interface lookup"]; }; EvalDot: PROC [left, right, parent: Tree, head: EvalHead, target: Type, useDotNotation: BOOL _ FALSE] RETURNS [tv: TV _ NIL, procTV: TV _ NIL] = TRUSTED { name: ROPE _ TreeToRope[right]; record: TV _ NIL; lname: ROPE _ TreeToRope[left]; lnSize: INT _ lname.Size[]; recTV, irTV: TV _ NIL; msg: ROPE _ NIL; IRfound: BOOL _ FALSE; SELECT TRUE FROM lnSize # 0 => [record, IRfound] _ LookupTryIR[lname, head, nullType, left]; ENDCASE => record _ EvalNoProps[left, head, nullType]; FOR i: NAT IN [1..100] DO fatal: ROPE _ NIL; inner: PROC = TRUSTED { [recTV, tv] _ BBContext.RecordSearch[record, name]; IF IRfound THEN SELECT UnderClass[AMTypes.TVType[tv]] FROM procedure, error, signal, program, port => IF AMBridge.TVToLC[tv] = 0 THEN fatal _ "NIL procedure from interface"; ENDCASE; }; innerSearch: PROC = TRUSTED { modName: REF ROPE _ NEW[ROPE _ NIL]; recType: Type _ AMTypes.TVType[record]; tv _ NIL; [] _ AMTypes.TypeToName[recType, modName]; IF modName^ = NIL THEN SELECT UnderClass[recType] FROM rope => modName^ _ "Rope"; atom => modName^ _ "Atom"; list => modName^ _ "List"; ENDCASE => RETURN; irTV _ TryForIRInstance[modName^, head, parent]; IF irTV # NIL THEN { [irTV, tv] _ BBContext.RecordSearch[irTV, name]; }; IF irTV = NIL THEN { [irTV, tv] _ BBContext.GlobalFrameSearch[head.context, modName^, name]; }; SELECT UnderClass[AMTypes.TVType[tv]] FROM procedure => IF AMBridge.TVToLC[tv] = 0 THEN fatal _ "NIL procedure from interface"; ENDCASE => tv _ NIL; }; irTV _ recTV _ NIL; Momma[inner, head, parent, "selection"]; IF fatal # NIL THEN UrpFatal[head, parent, fatal]; IF useDotNotation AND recTV = NIL THEN { Momma[innerSearch, head, parent, "dotNotation"]; IF fatal # NIL THEN UrpFatal[head, parent, fatal]; IF tv # NIL THEN { RETURN [record, tv]; }; }; IF recTV = NIL THEN { correct: RopeOrTV _ UrpSelector[head, parent, name, record, target, "selection failed"]; WITH c: correct SELECT FROM both => {FixHti[right, name _ c.rope]; tv _ c.tv; EXIT}; rope => FixHti[right, name _ c.rope]; tv => {tv _ c.tv; EXIT}; ENDCASE; LOOP}; SELECT UnderWear[tv, head, parent].class FROM union => { IF OverlaidOrComputed[AMTypes.TVType[tv]] THEN UrpFatal[head, parent, "Can't handle OVERLAID or COMPUTED"]; tv _ Variant[tv]}; ENDCASE; RETURN [tv] ENDLOOP; }; ForceArithmetic: PROC [val: TV, head: EvalHead, parent: Tree] RETURNS [rtn: TV] = TRUSTED { oops: BOOL _ FALSE; inner: PROC = TRUSTED { ref: REF _ NIL; int: INT _ 0; type: Type _ TVType[rtn]; ground: Type _ GroundStar[type]; class: 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 => oops _ TRUE }; rtn _ StripSingleComponentRecord[val, head, parent]; Momma[inner, head, parent, "arithmetic"]; IF oops THEN UrpFatal[head, parent, "not a number"] }; StripSingleComponentRecord: PROC [tv: TV, head: EvalHead, parent: Tree, max: NAT _ 100] RETURNS [rtn: TV] = TRUSTED { inner: PROC = TRUSTED { THROUGH [0..max) DO type, under: Type; class: Class; [type, under, class] _ UnderWear[rtn, head, parent]; IF (class # record AND class # structure) THEN EXIT; IF NComponents[under] # 1 THEN EXIT; rtn _ FirstComponent[rtn]; ENDLOOP; }; rtn _ tv; Momma[inner, head, parent]; }; ForceBoolean: PROC [tv: TV, head: EvalHead, parent: Tree] RETURNS [BOOL] = TRUSTED { rtn: TV _ tv; DO rtn _ StripSingleComponentRecord[rtn, head, parent]; IF AMTypes.UnderType[AMTypes.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 }; ForceType: PROC [tv: TV, head: EvalHead, parent: Tree] RETURNS [type: Type] = TRUSTED { rtn: TV _ tv; DO type, under: Type; class: Class; [type, under, class] _ UnderWear[rtn, head, parent]; IF class = type THEN RETURN [AMTypes.TVToType[rtn]]; IF under = underTYPE THEN RETURN [LOOPHOLE[AMBridge.TVToCardinal[rtn]]]; UrpFatal[head, parent, "not a TYPE"]; ENDLOOP }; EvalApply: PROC [proc, args: Tree, head: EvalHead, target: Type, parent: Tree] RETURNS [rtn: TV _ NIL] = TRUSTED { pval, firstArg: TV _ NIL; ptype: Type; pclass: Class; triesLeft: INTEGER _ 32; procName: ROPE _ TreeToRope[proc]; IF procName # NIL THEN { proc: BBEvalQuote.EvalQuoteProc _ NIL; data: REF _ NIL; [proc, data] _ BBEvalQuote.Lookup[procName]; IF proc # NIL THEN { -- we got it, now its not our job anymore! RETURN [proc[head, parent, target, data]]; }; }; WITH proc SELECT FROM node: Node => IF node.name = dot THEN { [firstArg, pval] _ EvalDot[node[1], node[2], node, head, underPROC, TRUE]; IF pval = NIL THEN {pval _ firstArg; firstArg _ NIL}; } ELSE pval _ EvalNoProps[proc, head, underPROC]; ENDCASE => pval _ EvalNoProps[proc, head, underPROC]; DO TestAbort[head, parent]; [, ptype, pclass] _ UnderWear[pval, head, parent]; IF (triesLeft _ triesLeft - 1) < 0 THEN UrpFatal[head, proc, "too many indirections"]; IF pval = NIL AND proc = NIL THEN SELECT LocalUnderTypeAndClass[target, head, parent].class 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 => { getArgsType: PROC = TRUSTED { argsType _ AMTypes.UnderType[AMTypes.Domain[ptype]]; rtnsType _ AMTypes.UnderType[AMTypes.Range[ptype]]; }; argsRec: TV _ NIL; argsType, rtnsType: Type; IF pval = NIL OR AMBridge.TVToLC[pval] = 0 THEN UrpFatal[head, parent, "NIL procedure?"]; Momma[getArgsType, head, parent, "arguments type"]; IF argsType = nullType THEN { IF args # NIL THEN UrpFatal[head, parent, "too many arguments given, 0 expected"]} ELSE { argsRec _ BBEvalUtil.EvalRecord[ args, head, argsType, parent, firstArg, AMBridge.GetWorld[pval]]; }; rtn _ BBApply.ApplyProcToRecord[pval, argsRec]; IF rtnsType = nullType THEN RETURN [empty]; rtn _ StripSingleComponentRecord[rtn, head, parent, 1]; RETURN}; record, structure => -- try to get the array/sequence part, then loop pval _ LastComponent[pval, head, parent]; union => IF NOT OverlaidOrComputed[ptype] THEN { pval _ AMTypes.Variant[pval]; LOOP} ELSE { ENABLE AMTypes.Error => GO TO foo; index: CARDINAL = AMTypes.NameToIndex[ptype, TreeToRope[args]]; IF index = 0 THEN GO TO foo; ptype _ AMTypes.IndexToType[ptype, index]; RETURN [AMBridge.Loophole[pval, ptype]]; EXITS foo => UrpFatal[head, parent, "invalid tag"]; }; ref, pointer, longPointer => -- try to get the referent, then loop pval _ SafeReferent[pval, head, parent]; basePointer => { relPtr: TV _ EvalNoProps[args, head, nullType]; inner: PROC = TRUSTED { rtn _ AMTypes.Referent[relPtr, pval]; }; Momma[inner, head, parent, "relative dereference"]; RETURN; }; array, sequence, descriptor, longDescriptor => { domain: Type; index: TV _ NIL; inner1: PROC = TRUSTED { SELECT pclass FROM descriptor, longDescriptor => ptype _ AMTypes.Range[ptype]; ENDCASE; domain _ AMTypes.Domain[ptype]; }; inner2: PROC = TRUSTED { rtn _ AMTypes.Apply[pval, index]; }; Momma[inner1, head, parent, "subscripting"]; index _ EvalNoProps[args, head, domain]; index _ LocalCoerce[head, parent, index, domain, 0, "invalid index type"]; Momma[inner2, head, parent, "subscripting"]; RETURN; }; type => { tval: Type _ AMTypes.TVToType[pval]; tunder: Type; tclass: Class; name: ROPE _ TreeToRope[args]; [tunder, tclass] _ LocalUnderTypeAndClass[tval, head, parent]; 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; innerOnion: PROC = TRUSTED { [onion, onionClass] _ AMTypes.VariableType[tval]; IF onionClass = union THEN { index: CARDINAL _ AMTypes.NameToIndex[ onion, name ! AMTypes.Error => GO TO notHere]; IF index # 0 THEN boundTV _ TVForType[AMTypes.IndexToType[onion, index]]; EXITS notHere => {}; }; }; Momma[innerOnion, head, parent, "constructor"]; IF boundTV # NIL THEN RETURN [boundTV]; }; 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 _ nil; getInfo: PROC = TRUSTED { underClass _ UnderClass[target]; IF underClass # array THEN RETURN; range _ AMTypes.Range[target]; first _ AMTypes.First[domain _ AMTypes.Domain[target]]; last _ AMTypes.Last[domain]; firstLI _ AMBridge.TVToLI[first]; lastLI _ AMBridge.TVToLI[last]; elements _ lastLI - firstLI + 1; new _ AMTypes.New[type: target, world: BBEvalUtil.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; }; BBEvalUtil.Momma[getInfo, head, parent, "array constructor"]; IF underClass # array THEN UrpFatal[head, parent, "target not an array"]; 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]; inner: PROC = TRUSTED { elemTV _ AMTypes.Apply[new, each]; AMBridgeExtras.AssignNew[elemTV, valueTV]; each _ AMTypes.Next[each]; }; BBEvalUtil.Momma[inner, head, parent, "array constructor"]; ENDLOOP; }; EvalAssign: PROC [left, right: Tree, head: EvalHead, target: Type, parent: Tree] RETURNS [TV] = TRUSTED { lval, rval: TV _ NIL; name: ROPE _ TreeToRope[left]; nameSize: INT _ name.Size[]; tab: SymTab.Ref _ IF head.specials = NIL THEN symtab ELSE head.specials; IF Rope.Match["*&*", name] THEN { lval _ rval _ EvalNoProps[right, head, target]; -- default to no copy IF lval = empty THEN RETURN [empty]; WHILE rval # NIL DO type, under: Type; class: Class; safeCase: PROC = TRUSTED { lval _ rval; SELECT class FROM globalFrame => { IF TreeToRope[right] # NIL THEN head.globalContext _ BBContext.ContextForGlobalFrame[rval]; }; localFrame, sequence, nil, any, union => { } ENDCASE => IF TVStatus[rval] # const AND rval # empty THEN lval _ AMTypes.Copy[rval]; }; [type, under, class] _ UnderWear[rval, head, parent]; Momma[safeCase, head, parent, "assign"]; EXIT ENDLOOP; IF nameSize > 1 THEN [] _ tab.Store[name, lval]; [] _ tab.Store["&", lval]; [] _ symtab.Store["&&", lval]; RETURN [lval]}; IF left # NIL THEN { lval _ EvalNoProps[left, head, target]; target _ UnderWear[lval, head, left].type}; rval _ EvalNoProps[right, head, target]; IF left = NIL THEN RETURN [empty]; RETURN [DoAssign[lval, rval, head, target, parent]] }; DoAssign: PROC [lhs, rhs: TV, head: EvalHead, target: Type, parent: Tree] RETURNS [TV] = { fullType, ltype, rtype: Type; lclass, rclass: Class; msg: ROPE _ NIL; [fullType, ltype, lclass] _ UnderWear[lhs, head, parent]; [, rtype, rclass] _ UnderWear[rhs, head, parent]; IF ltype # rtype THEN rhs _ LocalCoerce[head, parent, rhs, fullType]; msg _ SafeAssign[lhs, rhs, head, parent]; IF msg # NIL THEN UrpFatal[head, parent, msg]; RETURN [rhs] }; LocalLoophole: PROC [head: EvalHead, parent: Tree, current: TV, target: Type] RETURNS [tv: TV _ NIL] = TRUSTED { innerLoophole: PROC = TRUSTED { type: Type _ TVType[current]; under, tunder: Type; class, tclass: Class; isRemote: BOOL _ AMBridge.IsRemote[current]; [tunder, tclass] _ UnderTypeAndClass[target]; [under, class] _ UnderTypeAndClass[type]; IF under = tunder THEN {tv _ current; RETURN}; SELECT class FROM globalFrame => { IF isRemote THEN lc _ AMBridge.RemoteGFHFromTV[current].gfh ELSE lc _ LOOPHOLE[AMBridge.GFHFromTV[current], CARDINAL]; GO TO common}; localFrame => { IF isRemote THEN lc _ AMBridge.RemoteFHFromTV[current].fh ELSE lc _ LOOPHOLE[AMBridge.FHFromTV[current], CARDINAL]; GO TO common}; ENDCASE; IF current = NIL THEN current _ NilTV ELSE current _ CopyToImpliedWorld[head, current, TRUE]; tv _ AMBridge.Loophole[current, target ! AMTypes.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]; GO TO common}; EXITS common => SetTVFromLC[tv _ New[target], lc] }; lc: CARD _ 0; IF target = nullType THEN target _ underCARD; Momma[innerLoophole, head, parent, "LOOPHOLE"]; }; SafeReferent: PROC [ref: TV, head: EvalHead, parent: Tree] RETURNS [referent: TV _ NIL] = TRUSTED { type, under: Type; class: Class; msg: ROPE _ NIL; innerReferent: PROC = TRUSTED { IF AMBridge.TVToLC[ref] = 0 THEN { msg _ "can't dereference NIL"; RETURN}; SELECT UnderClass[AMTypes.Range[under]] FROM unspecified => {msg _ "unspecified range"; RETURN}; ENDCASE; referent _ AMTypes.Referent[ref]; }; DO ref _ StripSingleComponentRecord[ref, head, parent]; [type, under, class] _ UnderWear[ref, head, parent]; SELECT class FROM pointer, longPointer, basePointer, ref, list, nil => { Momma[innerReferent, head, parent, "dereference"]; 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, noCopyIfSameWorld: BOOL _ FALSE] RETURNS [ntv: TV _ NIL] = TRUSTED { ntv _ CopyToGivenWorld[BBEvalUtil.WorldFromHead[head], tv, noCopyIfSameWorld]; }; CopyToGivenWorld: PROC [world: WorldVM.World, tv: TV, noCopyIfSameWorld: BOOL _ FALSE] RETURNS [ntv: TV _ NIL] = TRUSTED { IF world = AMBridge.GetWorld[tv] THEN { ntv _ IF noCopyIfSameWorld THEN tv ELSE AMTypes.Copy[tv]; RETURN}; { tag: TV _ NIL; type: Type _ AMTypes.TVType[tv]; SELECT AMTypes.VariableType[type].c FROM union, sequence => tag _ AMTypes.Tag[AMTypes.IndexToTV[tv, AMTypes.NComponents[type]]]; ENDCASE; ntv _ AMTypes.New[type: type, world: world, tag: tag]; IF AMTypes.TVSize[tv] <= 2 AND AMBridge.TVToLC[tv] = AMBridge.TVToLC[ntv] THEN RETURN; -- no assignment necessary AMBridgeExtras.AssignNew[ntv, tv]}; }; UnderClass: PROC [type: Type] RETURNS [Class] = TRUSTED { RETURN [AMTypes.TypeClass[AMTypes.UnderType[type]]]; }; OverlaidOrComputed: PROC [type: Type] RETURNS [BOOL] = TRUSTED { type _ AMTypes.UnderType[type]; RETURN [AMTypes.IsComputed[type] OR AMTypes.IsOverlaid[type]]; }; LastComponent: PROC [tv: TV, head: EvalHead, parent: Tree] RETURNS [comp: TV] = TRUSTED { inner: PROC = TRUSTED { comp _ AMTypes.IndexToTV[tv, AMTypes.NComponents[AMTypes.TVType[tv]]]; }; Momma[inner, head, parent, "last component"]; }; TVForType: PROC [type: Type] RETURNS [ntv: TV _ NIL] = TRUSTED { stb: RTSymbolDefs.SymbolTableBase = RTSymbols.GetTypeSymbols[type].stb; { ENABLE UNWIND => RTSymbols.ReleaseSTB[stb]; ntv _ AMBridge.Loophole[ tv: AMBridge.TVForReferent[NEW[CARDINAL _ type]], type: RTSymbolOps.AcquireType[stb, LOOPHOLE[RTSymbolDefs.symbolIndexForTYPE]]]; RTSymbols.ReleaseSTB[stb]; }; }; END. �BBEvalImpl.mesa Russ Atkinson, July 1, 1983 4:33 pm Paul Rovner, March 4, 1983 4:58 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 should degrade gracefully. 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 raise conciousness to the real level NOTE: TVEqual is too generous about types At this point the values must be arithmetic. Lookup evaluates the identifier and return the value. We have a special case for &id, since those identifiers have funny semantics. We MAY try to use an interface record, based on tryIR. If correction occurs, the parent is corrected. This routine performs dynamic lookup in the stack. The constants of an enumerated type take precedence over variables in the stack. The local environment takes precedence over the global environment, but there is no point in searching it if it is NIL. Even if the global context is NIL, we still need to search it. Otherwise, we will not find stuff in the local global environment, since it is conventional that the NIL context means use the default local context. try the default table Lookup evaluates the identifier and return the value. We have a special case for &id, since those identifiers have funny semantics. We will try to use an interface record if it seems reasonable. If correction occurs, the parent is corrected. This routine performs dynamic lookup in the stack. The constants of an enumerated type take precedence over variables in the stack. The local environment takes precedence over the global environment, but there is no point in searching it if it is NIL. Even if the global context is NIL, we still need to search it. Otherwise, we will not find stuff in the local global environment, since it is conventional that the NIL context means use the default local context. try the default table "repairs" the tree IFF it is an hti leaf return the literal as a TV Try for the interface type, then make a TV for it if useDotNotation & the dot notation wins where the other loses then procTV will be the procedure, and tv the first argument; otherwise, procTV = NIL, and arg is the selection First, try to acquire the left-hand side as a TV, either through lookup or full eval. Now we have a good guy for the left side, try for the selection keep trying, possibly correcting innerSearch tries to determine if there is an interface for the record object. First try the interface. Well, the module is not an interface, so try a global frame search Perhaps it is a dot notation kludge glory be! a dotNotation procedure! maybe a callback procedure can help us? 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. Now look at the proc expr to see if it might be dot notation (like r.Fetch[0]) Could be dot notation, so try this special hack 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 possibly we are trying to bind a variant type it is really a variant record type binder! try to get the value designated This procedure discovers the domain of the array, saving the low and high bounds, and creates a new TV for the array, but does not initialize it. a local debug var, so no checking necessary; we copy to avoid problems with unretained frames set the default search context if right hand side is simple dont try to copy these Now left MUST be a TV returns coercion of value to new value of given type be especially nice to frames go for broke ��/]��J��#�#J��"�"�J��k � �� J��J�� J��J�� J��*�7�� J�O�J��%��J�p�J��*��J��J�� J�� .�=J�� "J��&J��J��(J��#J��$�5J�� '�9J�� J�� -J��)J��"J��J��J��J��2�>J��J��J��J� �� -J� ��J��J��J��J��"�"��J�J�� J��"�+J��J�J��9�9J��J��J��J��J��J��J�J� � ��.J� ��1J�J��@�@J��J��J��J��J�J��J�J�� J��c&�BJ�J��J�J��J��n ��J��J��J�� 7J��/J��1J��.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�J�J��J�J��J��*��;J� �� J�� %��J��(�GJ��$�8J��=J��3J��J�J��J� �+��NJ��J��J�"J��$J� � �� 4J� � �� 4� ��AJ��#�)J�� 4J��%�+J�� 4J��#�)J�� =J��5��!��+J�� J�� 4J��#�J��J��1J��J�� 6J��5�;J��J��!�!�%J��.�4��J��J� �� .�J��J��J��J��)�/��J��J��(�(��0��:J��.J��,J��J��J��J��-�3�� J�#J�#J��(�1J�� (J�� J�J�7J��%J��#�J�5�J��J��)J�� J�J��J��J� �� !�� %J��&J��J�� 5J�J��J��J�(�J�� J�� J��!�!J��J� �� /J��)J�� 1��J��0��'J��6�<��J��3�9�� J�J�J�� J��J�2J��J� ��=J��J�J�5J�� J��'�A��J��*�*J��)�)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��.�4��J��&�,��J��&��3�� J��J��J��)��3�� !J�� &J� � �� +�J�!J�� J��+�1�� J�� J��3�3�� J�� &�;J�� J��J��J�� J�� J��/�/�J��<�BJ��J�� J��,�,J��J��.�.J��6�6��J�� J� � �� 4J��6�6J� ��=J�� J��/�3J��J��"�"J�� J��J��#�#J�� J��J�� J��!J��8��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��)��1J��$�$J��,��J��J��J��J��J��J��J�� J��J��J��J�J�� J�VJ��#J�J��J�*J�(J�� J�'J�5J��)J�'J�1�� J�B��"�7J� ��J��)�)J��1J�� J�� J�!��J�*��J�� J�� %��J�&J�� J��J��,�,J�J�)J�2J�*J�3��*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��-�8J��#J��J��J� ��H��J��2�2J��J��P�P��J��,�,J� ��'�J��w�w��J��:��RJ��2�J��%�%J��3�J��1J��J��(�?J�J��J��J�J��%J�#J��J��J�M��J��4��>J��#J��J�J�J��J�� "J�J��)�)��J��"��&J��J�,��J��*�*J��$�*J��J�J��J��N�N�� J��/�/J��D��JJ��5J��J��+�/��J��.�5��J��-�-J�J�2��!��'J�/J�� !J��3�3��4��>J�� )�8J��*�EJ��0�7�J�� J�4J�3J��J�� J��/J�)�J�3��J�?�� J��A�A�J��J��/�/J�� +J��7�7J��0�EJ�)��J��5�5�� J��#��J��%�%J��"J��0�?J��J��*�*J��"�(J��.�3J��%�BJ�(��J��%�/��J�%J��J�3J��J��0J� J��J�;J��J�J��J�!J��J�,J�(J�JJ�,J��J�� J�$J� J�J��J�>�� )J��'�-��J��D�D��J��-�-J�J�J�� J��1�1��J��J�� "��J��*�*J��7�7�J��J��J��J��/�/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�� J��J�� J��"J��J��7�7J��J��!�!J��J�� J��G�G��J�� J��6�6J��J��J��J��=�=��J��.�.�J�� J��.�.�� J��J�� U��J��"�"J��*�*J�J��J��;�;J��J�J�� J��?��XJ��J��J�� J� ��H��!J��]�]J��0��EJ�� $��J�J� �� J��J��;�;��J�;�J��*�*J��J�� /J��J��J�5J�(J��J��J��0J�J�J�� J��J��'�'J�+�J�(J�� "J��-�3J�J��J��-��KJ�J�J��J�9J�1��J�/�J�)J��.J��J�J�� J��(��9J��"J��4�4��J�J�J�J�� ,J�-J�)J��.��J�� J��+�/J��:�J�� J��)�-J��9�J�� J��J��J��-��7�J��:��DJ��4J�0��J��J��J�� J��+�+�J��J�� J��-J�/J�J��J�� PJ�J� J��"J��'��"��,J��+��3J��J�!J��J��4�4J�4��6�6J�2J��.J��J��J��J��J�7J�J��J��9J��#J��N�NJ�J��J��?J��#��'J��9J��J��J� ��(�J��D�D�J��J�6��+�IJ��(�J��#�#�J�J�� 9J��.�4J�J�� @J��J��>J�J�� J� �� E��J��F�FJ��J��-�-J�J�� @J��G�G��-��J�� 1J��#��$�O�J��J��J�J��J��J�J�J��^�g