<> <> <> <> <> DIRECTORY A3: TYPE USING [AssignableType, BodyForTree, Bundling, CanonicalType, Default, DefaultInit, LongPath, OperandInternal, OperandLevel, OperandLhs, OperandType, PermanentType, TargetType, TypeForTree, Unbundle, VarType, Voidable, VoidItem], Alloc: TYPE USING [Notifier], ComData: TYPE USING [interface, mainCtx, ownSymbols, seAnon, textIndex, typeCONDITION, typeStringBody], Copier: TYPE USING [SEToken, nullSEToken, CtxNext, TokenHash, TokenValue], Log: TYPE USING [Error, ErrorHti, ErrorN, ErrorNode, ErrorNodeOp, ErrorSei, ErrorTree, ErrorTreeOp], P3: TYPE USING [Attr, emptyAttr, fullAttr, voidAttr, NPUse, MergeNP, SetNP, And, ArrangeKeys, CatchPhrase, ClusterId, CompleteRecord, CopyTree, DiscriminatedType, EnterComposite, Exp, FieldId, ForceType, InterfaceId, MainIncludedCtx, MiscXfer, PopCtx, PushCtx, RAttr, Rhs, RPop, RPush, RType, Shared, Span, SearchCtxList, SelectVariantType, SequenceField, UpdateTreeAttr, VariantUnionType, VoidExp, XferForFrame], P3S: TYPE USING [ImplicitInfo, SelfInfo, currentBody, currentScope, implicit, safety], Symbols: TYPE USING [Base, HTIndex, Type, ISEIndex, CSEIndex, ArraySEIndex, RecordSEIndex, ContextLevel, CTXIndex, CBTIndex, TransferMode, HTNull, ISENull, nullType, CSENull, RecordSENull, CTXNull, CBTNull, lG, typeANY, typeTYPE, bodyType, ctxType, seType], SymbolOps: TYPE USING [ArgCtx, ConstantId, CtxLevel, EqTypes, FindExtension, FirstCtxSe, FirstVisibleSe, NextSe, NextVisibleSe, NormalType, RCType, ReferentType, TransferTypes, TypeForm, TypeRoot, UnderType, VisibleCtxEntries, XferMode], Tree: TYPE USING [Base, Index, Link, Map, NodeName, Scan, Null, treeType], TreeOps: TYPE USING [FreeNode, FreeTree, GetHash, GetNode, ListHead, ListLength, ListTail, MakeList, MakeNode, MarkShared, NthSon, OpName, PopTree, PushHash, PushList, PushNode, PushProperList, PushSe, PushTree, ScanList, SetAttr, SetInfo, UpdateList], Types: TYPE USING [SymbolTableBase, Assignable, OpaqueValue]; Pass3Xa: PROGRAM IMPORTS A3, Copier, Log, P3, P3S, SymbolOps, TreeOps, Types, dataPtr: ComData EXPORTS P3, P3S = { OPEN SymbolOps, Symbols, TreeOps, A3, P3; tb: Tree.Base; -- tree base address (local copy) seb: Base; -- se table base address (local copy) ctxb: Base; -- context table base address (local copy) bb: Base; -- body table base address (local copy) own: Types.SymbolTableBase; ExpANotify: PUBLIC Alloc.Notifier = { <> seb _ base[seType]; ctxb _ base[ctxType]; bb _ base[bodyType]; tb _ base[Tree.treeType]; own _ dataPtr.ownSymbols}; <> phraseNP: PUBLIC NPUse; <> KeyedList: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] = { RETURN[OpName[ListHead[t]] = item]}; PopKeyList: PROC[nItems: CARDINAL] RETURNS[t: Tree.Link] = { t _ MakeList[nItems]; IF t = Tree.Null AND nItems # 0 THEN {PushTree[t]; PushProperList[1]; t _ PopTree[]}; RETURN}; CheckLength: PUBLIC PROC[t: Tree.Link, length: INTEGER] = { n: INTEGER = ListLength[t]; SELECT n FROM = length => NULL; > length => Log.ErrorN[listLong, n-length]; < length => Log.ErrorN[listShort, length-n]; ENDCASE}; ContextComplete: PROC[ctx: CTXIndex] RETURNS[BOOL] = { RETURN[WITH ctxb[ctx] SELECT FROM simple => TRUE, included => complete, ENDCASE => FALSE]}; CheckScope: PUBLIC PROC[t: Tree.Link, type: Type] RETURNS[v: Tree.Link] = { SELECT XferMode[type] FROM $proc, $signal, $error => SELECT OperandLevel[t] FROM global => v _ t; local => {Log.ErrorTree[scopeFault, t]; v _ t}; ENDCASE => { PushTree[t]; PushNode[proccheck, 1]; SetInfo[type]; v _ PopTree[]}; ENDCASE => v _ t; RETURN}; KeyForHash: PROC[hti: HTIndex] RETURNS[HTIndex] = { RETURN[IF hti = HTNull THEN seb[dataPtr.seAnon].hash ELSE hti]}; HashForSe: PROC[sei: ISEIndex] RETURNS[HTIndex] = { RETURN[IF sei = ISENull THEN HTNull ELSE KeyForHash[seb[sei].hash]]}; PadList: PROC[record: RecordSEIndex, expList: Tree.Link] RETURNS[Tree.Link] = { ctx: CTXIndex = seb[record].fieldCtx; sei: ISEIndex _ FirstVisibleSe[ctx]; added: BOOL _ FALSE; nFields: CARDINAL _ 0; PushField: Tree.Map = { PushTree[t]; nFields _ nFields + 1; sei _ NextSe[sei]; RETURN[Tree.Null]}; [] _ FreeTree[UpdateList[expList, PushField]]; UNTIL sei = ISENull DO IF ~seb[sei].extended AND (seb[record].argument OR Default[seb[sei].idType] = none) THEN EXIT; PushTree[Tree.Null]; added _ TRUE; nFields _ nFields + 1; sei _ NextSe[sei]; ENDLOOP; IF added THEN PushProperList[nFields] ELSE PushList[nFields]; RETURN[PopTree[]]}; FieldDefault: PUBLIC PROC[sei: ISEIndex] RETURNS[v: Tree.Link] = { CheckOption: Tree.Scan = {IF OpName[t] # void THEN v _ CopyTree[t]}; v _ Tree.Null; ScanList[FindExtension[sei].tree, CheckOption]; RPush[seb[sei].idType, IF v=Tree.Null THEN voidAttr ELSE UpdateTreeAttr[v]]; RETURN}; FieldVoid: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Link] = { [] _ FreeTree[t]; phraseNP _ none; RPush[typeANY, voidAttr]; RETURN[Tree.Null]}; MatchFields: PUBLIC PROC[ record: RecordSEIndex, expList: Tree.Link, init: BOOL _ FALSE, scopeCheck: BOOL _ TRUE] RETURNS[val: Tree.Link] = { nFields: CARDINAL; ctx: CTXIndex; sei: ISEIndex; attr: Attr _ fullAttr; exitNP: NPUse _ none; EvaluateField: Tree.Map = { subAttr: Attr; type: Type; IF sei # ISENull AND ~(seb[sei].public OR init OR Shared[ctx]) THEN Log.ErrorSei[privateId, sei]; SELECT TRUE FROM (t = Tree.Null) => v _ SELECT TRUE FROM (sei = ISENull) => FieldVoid[t], (seb[sei].extended) => FieldDefault[sei], (seb[record].argument) => FieldVoid[t], ENDCASE => DefaultInit[seb[sei].idType]; (OpName[t] = void) => v _ FieldVoid[t]; ENDCASE => { target: Type = TargetType[IF sei=ISENull THEN typeANY ELSE seb[sei].idType]; v _ IF init THEN Initialization[t, target] ELSE Rhs[t, target]}; subAttr _ RAttr[]; type _ RType[]; RPop[]; IF v = Tree.Null AND ~(IF seb[sei].extended THEN VoidItem[FindExtension[sei].tree] ELSE Voidable[seb[sei].idType]) THEN Log.ErrorSei[elision, sei]; IF scopeCheck AND P3S.safety = checked THEN IF TypeForm[type] = $transfer THEN v _ CheckScope[v, type]; attr _ And[attr, subAttr]; exitNP _ MergeNP[exitNP][phraseNP]; sei _ NextSe[sei]; RETURN}; IF record = RecordSENull THEN {CheckLength[expList, 0]; sei _ ISENull} ELSE { CompleteRecord[record]; IF ~ContextComplete[seb[record].fieldCtx] THEN { IF seb[record].hints.privateFields THEN Log.Error[noAccess]; sei _ ISENull} ELSE { ctx _ seb[record].fieldCtx; IF KeyedList[expList] THEN { sei: ISEIndex; started: BOOL _ FALSE; NextKey: PROC RETURNS[HTIndex] = { SELECT TRUE FROM ~started => {sei _ FirstVisibleSe[ctx]; started _ TRUE}; (sei # ISENull) => sei _ NextVisibleSe[sei]; ENDCASE; RETURN[HashForSe[sei]]}; OmittedValue: PROC RETURNS[t: Tree.Link] = { IF ~seb[sei].extended AND (seb[record].argument OR Default[seb[sei].idType] = none) THEN { Log.ErrorHti[omittedKey, seb[sei].hash]; t _ [symbol[dataPtr.seAnon]]} ELSE t _ Tree.Null; RETURN}; nFields _ ArrangeKeys[expList, NextKey, OmittedValue]; expList _ PopKeyList[nFields]} ELSE { nFields _ VisibleCtxEntries[ctx]; IF ListLength[expList] < nFields THEN expList _ PadList[record, expList]; CheckLength[expList, nFields]}; sei _ FirstVisibleSe[ctx]}}; val _ UpdateList[expList, EvaluateField]; RPush[record, attr]; phraseNP _ exitNP; RETURN}; Dereference: PROC[t: Tree.Link, type: Type, long: BOOL] RETURNS[Tree.Link] = { PushTree[t]; PushNode[uparrow, 1]; SetInfo[type]; SetAttr[2, long]; RETURN[PopTree[]]}; ClusterCtx: PROC[ctx: CTXIndex] RETURNS[CTXIndex] = { RETURN[WITH c: ctxb[ctx] SELECT FROM simple => IF dataPtr.interface THEN dataPtr.mainCtx ELSE CTXNull, included => MainIncludedCtx[c.module], ENDCASE => CTXNull]}; ClusterForType: PROC[type: Type] RETURNS[CTXIndex] = { subType: CSEIndex = UnderType[type]; RETURN[WITH t: seb[subType] SELECT FROM enumerated => ClusterCtx[t.valueCtx], record => IF ~t.argument THEN ClusterCtx[t.fieldCtx] ELSE CTXNull, ref => ClusterForType[t.refType], relative => ClusterForType[t.offsetType], subrange => ClusterForType[t.rangeType], long => ClusterForType[t.rangeType], opaque => seb[t.id].idCtx, ENDCASE => CTXNull] }; <> Initialization: PUBLIC PROC[t: Tree.Link, type: Type] RETURNS[v: Tree.Link] = { SELECT TypeForm[type] FROM $record => IF OpName[t] = apply THEN {Construct[GetNode[t], LOOPHOLE[type], TRUE]; v _ t} ELSE v _ Rhs[t, type]; $union => IF OpName[t] = apply THEN { subType: CSEIndex = UnderType[TypeForTree[NthSon[t, 1]]]; WITH seb[subType] SELECT FROM record => {Construct[GetNode[t], LOOPHOLE[subType], TRUE]; v _ t}; ENDCASE => v _ Rhs[t, type]} ELSE v _ Rhs[t, type]; $array => IF OpName[t] = all THEN {All[GetNode[t], type, TRUE]; v _ t} ELSE v _ Rhs[t, type]; ENDCASE => v _ Rhs[t, type]; RETURN}; Assignment: PUBLIC PROC[node: Tree.Index] = { OPEN tb[node]; lhsType, rhsType: Type; attr: Attr; saveNP: NPUse; son[1] _ Exp[son[1], typeANY]; saveNP _ phraseNP; lhsType _ RType[]; attr _ RAttr[]; RPop[]; son[2] _ Rhs[son[2], TargetType[lhsType]]; rhsType _ RType[]; attr _ And[RAttr[], attr]; RPop[]; attr.noAssign _ FALSE; phraseNP _ MergeNP[phraseNP][saveNP]; RPush[rhsType, attr]; IF ~AssignableType[lhsType, P3S.safety=checked] THEN { IF P3S.safety=checked AND AssignableType[lhsType, FALSE] THEN Log.ErrorTreeOp[unsafeOp, son[1], assignx] ELSE Log.ErrorTreeOp[missingOp, son[1], assignx]}; SELECT TypeForm[lhsType] FROM $transfer => IF P3S.safety = checked THEN son[2] _ CheckScope[son[2], rhsType]; $union => IF ~Types.Assignable[ [own, DiscriminatedType[typeANY, son[1]]], [own, DiscriminatedType[typeANY, son[2]]]] THEN Log.ErrorTree[typeClash, son[2]]; $sequence => Log.ErrorTreeOp[missingOp, son[2], assignx]; ENDCASE; tb[node].attr1 _ FALSE; SELECT OperandLhs[son[1]] FROM counted => SELECT RCType[lhsType] FROM simple => {tb[node].attr2 _ TRUE; tb[node].attr3 _ FALSE}; composite => { tb[node].attr2 _ tb[node].attr3 _ TRUE; EnterComposite[lhsType, son[2], FALSE]}; ENDCASE => tb[node].attr2 _ FALSE; none => Log.ErrorTree[nonLHS, son[1]]; ENDCASE => tb[node].attr2 _ FALSE}; implicitRecord: PUBLIC RecordSEIndex; Extract: PUBLIC PROC[node: Tree.Index] = { OPEN tb[node]; type: Type; attr: Attr; ctx: CTXIndex; sei: ISEIndex; nL, nR: CARDINAL; saveImplicit: P3S.ImplicitInfo = P3S.implicit; saveRecord: RecordSEIndex = implicitRecord; saveNP: NPUse; PushItem: Tree.Map = {PushTree[t]; RETURN[Tree.Null]}; Extractor: PROC[t: Tree.Link] RETURNS[BOOL] = INLINE { RETURN[OpName[t] = apply AND NthSon[t, 1] = Tree.Null]}; AssignItem: Tree.Map = { saveType: Type = P3S.implicit.type; IF sei # ISENull AND ~seb[sei].public AND ~Shared[ctx] THEN Log.ErrorSei[privateId, sei]; IF t = Tree.Null THEN v _ Tree.Null ELSE { P3S.implicit.type _ IF sei = ISENull THEN typeANY ELSE UnderType[seb[sei].idType]; IF Extractor[t] THEN { subNode: Tree.Index = GetNode[t]; PushTree[tb[subNode].son[2]]; tb[subNode].son[2] _ Tree.Null; FreeNode[subNode]; PushTree[Tree.Null]; v _ MakeNode[extract, 2]; Extract[GetNode[v]]} ELSE { PushTree[t]; PushTree[Tree.Null]; v _ MakeNode[assign, 2]; Assignment[GetNode[v]]}; attr _ And[RAttr[], attr]; saveNP _ MergeNP[saveNP][phraseNP]; RPop[]}; sei _ NextSe[sei]; P3S.implicit.type _ saveType; RETURN}; P3S.implicit.tree _ son[2] _ ExtractorRhs[son[2]]; type _ RType[]; P3S.implicit.attr _ attr _ RAttr[]; RPop[]; saveNP _ phraseNP; IF type = nullType THEN {nR _ 0; sei _ ISENull} ELSE { rSei: CSEIndex = UnderType[TypeRoot[type]]; WITH seb[rSei] SELECT FROM record => { CompleteRecord[LOOPHOLE[rSei, RecordSEIndex]]; IF ContextComplete[fieldCtx] THEN { implicitRecord _ LOOPHOLE[rSei, RecordSEIndex]; ctx _ fieldCtx; sei _ FirstVisibleSe[ctx]; nR _ VisibleCtxEntries[ctx]} ELSE {Log.Error[noAccess]; type _ typeANY; nR _ 0; sei _ ISENull}}; ENDCASE => { Log.ErrorTree[typeClash, son[2]]; type _ typeANY; nR _ 0; sei _ ISENull}}; IF KeyedList[son[1]] AND nR # 0 THEN { sei: ISEIndex; started: BOOL _ FALSE; NextKey: PROC RETURNS[HTIndex] = { SELECT TRUE FROM ~started => {sei _ FirstVisibleSe[ctx]; started _ TRUE}; (sei # ISENull) => sei _ NextVisibleSe[sei]; ENDCASE; RETURN[HashForSe[sei]]}; FillNull: PROC RETURNS[Tree.Link] = {RETURN[Tree.Null]}; nL _ ArrangeKeys[son[1], NextKey, FillNull]} ELSE { nL _ ListLength[son[1]]; son[1] _ FreeTree[UpdateList[son[1], PushItem]]; IF nL > nR AND type # typeANY THEN Log.ErrorN[listLong, nL-nR]; THROUGH (nL .. nR] DO PushTree[Tree.Null] ENDLOOP; nL _ MAX[nL, nR]}; PushTree[UpdateList[MakeList[nR], AssignItem]]; PushNode[exlist, 1]; SetInfo[type]; son[1] _ PopTree[]; RPush[type, attr]; phraseNP _ saveNP; P3S.implicit _ saveImplicit; implicitRecord _ saveRecord}; ExtractorRhs: PROC[t: Tree.Link] RETURNS[v: Tree.Link] = INLINE { SELECT OpName[t] FROM apply => { node: Tree.Index = Apply[GetNode[t], typeANY, FALSE]; tb[node].info _ RType[]; v _ [subtree[node]]}; signalx, errorx, joinx, startx => { PushTree[MiscXfer[GetNode[t], typeANY]]; SetInfo[RType[]]; v _ PopTree[]}; ENDCASE => v _ Exp[t, typeANY]; RETURN}; self: PUBLIC P3S.SelfInfo; Dot: PUBLIC PROC[node: Tree.Index, target: Type] RETURNS[Tree.Index] = { IF DotExpr[node].selfAppl THEN { saveSelf: P3S.SelfInfo = self; v: Tree.Link = tb[node].son[2]; self _ [tree: tb[node].son[1], type: RType[], attr: RAttr[], np: phraseNP]; RPop[]; tb[node].son[1] _ tb[node].son[2] _ Tree.Null; FreeNode[node]; node _ GetNode[Exp[ApplyToSelf[v, Tree.Null, Tree.Null], target]]; self _ saveSelf}; RETURN[node]}; DotExpr: PROC[node: Tree.Index] RETURNS[selfAppl: BOOL _ FALSE] = { OPEN tb[node]; type, lType, rType: Type; sei: ISEIndex; fieldHti: HTIndex = GetHash[son[2]]; attr: Attr; nDerefs: CARDINAL _ 0; son[1] _ Exp[son[1], typeANY]; type _ lType _ RType[]; attr _ RAttr[]; RPop[]; <> DO nType: CSEIndex = NormalType[type]; WITH t: seb[nType] SELECT FROM record => { nHits: CARDINAL; [nHits, sei] _ FieldId[fieldHti, LOOPHOLE[nType, RecordSEIndex]]; SELECT nHits FROM 0 => { matched: BOOL; [matched, sei] _ ClusterId[fieldHti, ClusterForType[type]]; IF matched AND XferMode[seb[sei].idType] # $none THEN { name _ cdot; selfAppl _ TRUE; attr2 _ FALSE; son[2] _ [symbol[sei]]; rType _ lType; attr.const _ ConstantId[sei]; EXIT}; IF Bundling[nType] = 0 THEN GOTO nomatch}; 1 => { long: BOOL _ LongPath[son[1]]; counted: BOOL _ TRUE; WHILE lType # type DO -- rederive path, update tree subType: CSEIndex = NormalType[lType]; WITH s: seb[subType] SELECT FROM ref => { long _ (TypeForm[lType] = $long); lType _ s.refType; IF ~(s.counted OR PermanentType[s.refType]) THEN counted _ FALSE; IF nDerefs > 1 OR lType # type THEN { son[1] _ Dereference[son[1], lType, long]; nDerefs _ nDerefs-1}}; record => { lType _ Unbundle[LOOPHOLE[subType, RecordSEIndex]]; son[1] _ ForceType[son[1], lType]}; opaque => { lType _ Types.OpaqueValue[[own, nType], own].sei; son[1] _ ForceType[son[1], lType]}; ENDCASE; ENDLOOP; IF nDerefs = 0 THEN name _ dollar; attr2 _ long; IF ~attr.const AND ConstantId[sei] THEN {name _ cdot; attr.const _ TRUE}; IF P3S.safety = checked AND ~counted THEN Log.ErrorNodeOp[unsafeOp, node, uparrow]; son[2] _ [symbol[sei]]; rType _ seb[sei].idType; EXIT}; ENDCASE => GOTO ambiguous; type _ Unbundle[LOOPHOLE[nType, RecordSEIndex]]}; opaque, enumerated, relative => { matched: BOOL; [matched, sei] _ ClusterId[fieldHti, ClusterForType[nType]]; IF matched AND XferMode[seb[sei].idType] # $none THEN { name _ cdot; selfAppl _ TRUE; attr2 _ FALSE; son[2] _ [symbol[sei]]; rType _ lType; attr.const _ ConstantId[sei]; EXIT}; IF TypeForm[nType] # $opaque THEN GOTO nomatch; type _ Types.OpaqueValue[[own, nType], own].sei; IF type = nType THEN GOTO nomatch}; ref => { IF (nDerefs _ nDerefs+1) > 63 THEN GOTO nomatch; type _ t.refType; attr.const _ FALSE}; definition, transfer => IF ([sei: sei]_InterfaceId[fieldHti, InterfaceCtx[nType, son[1]]]).found THEN { name _ cdot; son[2] _ [symbol[sei]]; attr2 _ FALSE; rType _ type _ seb[sei].idType; attr.const _ ConstantId[sei]; IF VarType[type] OR ( ctxb[seb[sei].idCtx].ctxType = imported AND ~dataPtr.interface AND TypeForm[type] = $ref) THEN { rType _ ReferentType[type]; son[2] _ Dereference[son[2], rType, FALSE]}; EXIT} ELSE GOTO nomatch; mode => { subType: CSEIndex; rType _ TypeForTree[tb[node].son[1]]; subType _ NormalType[rType]; WITH t: seb[subType] SELECT FROM enumerated => IF ([sei: sei]_SearchCtxList[fieldHti, t.valueCtx]).found THEN name _ cdot ELSE GOTO nomatch; record => { sei _ SelectVariantType[subType, fieldHti]; rType _ typeTYPE; name _ discrimTC}; ENDCASE => GOTO nomatch; son[2] _ [symbol[sei]]; attr2 _ FALSE; attr.const _ TRUE; EXIT}; ENDCASE => GOTO nomatch; REPEAT nomatch => { son[2] _ [symbol[dataPtr.seAnon]]; IF son[1] # son[2] AND fieldHti # HTNull THEN Log.ErrorHti[unknownField, fieldHti]; rType _ typeANY; attr _ emptyAttr}; ambiguous => { Log.ErrorHti[ambiguousId, fieldHti]; son[2] _ [symbol[dataPtr.seAnon]]; rType _ typeANY; attr _ emptyAttr}; ENDLOOP; tb[node].info _ rType; RPush[rType, attr]; RETURN}; Apply: PUBLIC PROC[node: Tree.Index, target: Type, mustXfer: BOOL] RETURNS[Tree.Index] = { opType, type: Type; attr: Attr; leftNP: NPUse; long: BOOL; nDerefs: CARDINAL _ 0; indirect: BOOL _ FALSE; string, desc: BOOL _ FALSE; saveSelf: P3S.SelfInfo = self; ForceDirect: PROC = { IF indirect THEN { tb[node].son[1] _ Dereference[tb[node].son[1], opType, long]; attr.const _ FALSE}; indirect _ FALSE}; IF tb[node].son[1] # Tree.Null THEN { IF OpName[tb[node].son[1]] = dot AND ~tb[node].attr1 THEN node _ DotApply[node] ELSE { sei: CSEIndex = UnderType[target]; WITH t: seb[sei] SELECT FROM union => { PushCtx[t.caseCtx]; tb[node].son[1] _ Exp[tb[node].son[1], typeANY]; PopCtx[]}; ENDCASE => tb[node].son[1] _ Exp[tb[node].son[1], typeANY]; }; opType _ RType[]; attr _ RAttr[]; leftNP _ phraseNP; RPop[]; IF opType = typeTYPE THEN type _ TypeForTree[tb[node].son[1]]} ELSE { opType _ typeTYPE; SELECT TypeForm[target] FROM $record => type _ TypeRoot[target]; $array => type _ target; ENDCASE => {type _ nullType; Log.ErrorNode[noTarget, node]}}; long _ LongPath[tb[node].son[1]]; <> DO { OPEN tb[node]; nType: CSEIndex = NormalType[opType]; WITH t: seb[nType] SELECT FROM mode => { subType: CSEIndex = NormalType[type]; ForceDirect[]; SELECT TypeForm[NormalType[type]] FROM $record => Construct[node, LOOPHOLE[subType, RecordSEIndex]]; $array => RowCons[node, LOOPHOLE[subType, ArraySEIndex]]; $enumerated, $basic => { temp: Tree.Link = son[1]; IF UniOperand[node] THEN son[2] _ Rhs[son[2], TargetType[type]]; attr _ And[RAttr[], attr]; phraseNP _ MergeNP[leftNP][phraseNP]; RPop[]; son[1] _ son[2]; son[2] _ temp; name _ check; RPush[type, attr]}; ENDCASE => ApplyError[node, type # nullType]; EXIT}; transfer => { mode: TransferMode = t.mode; OpName: ARRAY TransferMode OF Tree.NodeName = [ proc: callx, port: portcallx, signal: signalx, error: errorx, process: joinx, program: startx, none: apply]; ForceDirect[]; SELECT mode FROM proc => IF ~P3S.currentBody.lockHeld AND OperandInternal[son[1]] THEN Log.ErrorTree[internalCall, son[1]]; program => IF BodyForTree[son[1]] # CBTNull THEN Log.ErrorTree[typeClash, son[1]]; port => IF long THEN Log.ErrorTree[longPath, son[1]]; ENDCASE; IF t.typeIn = CSENull THEN son[2] _ MatchFields[RecordSENull, son[2], FALSE, FALSE] ELSE WITH in: seb[t.typeIn] SELECT FROM record => son[2] _ IF attr1 THEN Rhs[son[2], t.typeIn] ELSE MatchFields[LOOPHOLE[t.typeIn], son[2], FALSE, mode=program]; ENDCASE => { Log.ErrorTreeOp[missingOp, son[1], apply]; son[2] _ MatchFields[RecordSENull, son[2], FALSE, FALSE]}; name _ OpName[mode]; attr _ And[RAttr[], attr]; phraseNP _ MergeNP[leftNP][phraseNP]; RPop[]; IF P3S.safety = checked THEN IF ~(t.safe OR mode = error) OR mode = port OR mode = process THEN Log.ErrorNode[unsafeOperation, node]; IF mode = proc THEN attr _ CheckInline[node, attr] ELSE {attr.noXfer _ attr.noAssign _ FALSE; phraseNP _ SetNP[phraseNP]}; attr.const _ FALSE; RPush[t.typeOut, attr]; EXIT}; array => { ForceDirect[]; IF UniOperand[node] THEN tb[node].son[2] _ Rhs[tb[node].son[2], TargetType[t.indexType]]; attr _ And[RAttr[], attr]; phraseNP _ MergeNP[leftNP][phraseNP]; RPop[]; RPush[t.componentType, attr]; name _ SELECT TRUE FROM string => seqindex, desc => dindex, ENDCASE => index; attr2 _ long; IF mustXfer THEN {opType _ ForceXfer[node]; mustXfer _ FALSE} -- to avoid looping ELSE EXIT}; sequence => { ForceDirect[]; IF UniOperand[node] THEN tb[node].son[2] _ Rhs[tb[node].son[2], TargetType[seb[t.tagSei].idType]]; attr _ And[RAttr[], attr]; phraseNP _ MergeNP[leftNP][phraseNP]; RPop[]; RPush[t.componentType, attr]; name _ seqindex; attr2 _ long; IF mustXfer THEN {opType _ ForceXfer[node]; mustXfer _ FALSE} -- to avoid looping ELSE EXIT}; arraydesc => { ForceDirect[]; long _ (TypeForm[opType] = $long); opType _ t.describedType; attr.const _ FALSE; desc _ TRUE; IF P3S.safety = checked THEN Log.ErrorNode[unsafeOperation, node]}; ref => { subType: CSEIndex; SELECT TRUE FROM t.basing => { ForceDirect[]; IF UniOperand[node] THEN tb[node].son[2] _ Rhs[tb[node].son[2], typeANY]; attr _ And[RAttr[], attr]; phraseNP _ MergeNP[leftNP][phraseNP]; subType _ UnderType[CanonicalType[RType[]]]; RPop[]; WITH r: seb[subType] SELECT FROM relative => { IF ~Types.Assignable[[own, UnderType[r.baseType]], [own, UnderType[opType]]] THEN Log.ErrorTree[typeClash, son[1]]; type _ r.resultType}; ENDCASE => { type _ typeANY; IF subType # typeANY THEN Log.ErrorTree[typeClash, son[2]]}; subType _ NormalType[type]; attr1 _ (TypeForm[subType] = $arraydesc); attr2 _ (TypeForm[opType] = $long OR TypeForm[type] = $long); WITH r: seb[subType] SELECT FROM ref => type _ r.refType; arraydesc => type _ r.describedType; ENDCASE; attr.const _ FALSE; RPush[type, attr]; name _ reloc; IF P3S.safety = checked THEN Log.ErrorNode[unsafeOperation, node]; IF mustXfer THEN {opType _ ForceXfer[node]; mustXfer _ FALSE} -- to avoid looping ELSE EXIT}; ENDCASE => { subType _ UnderType[t.refType]; attr.const _ FALSE; WITH r: seb[subType] SELECT FROM record => IF CtxLevel[r.fieldCtx] = lG THEN { ForceDirect[]; opType _ XferForFrame[r.fieldCtx]; IF opType = nullType THEN GOTO fail; son[1] _ ForceType[son[1], opType]} ELSE GOTO deRef; ENDCASE => GOTO deRef; EXITS deRef => { IF (nDerefs _ nDerefs+1) > 63 THEN GOTO fail; IF indirect THEN ForceDirect[]; IF P3S.safety = checked AND ~(t.counted OR PermanentType[t.refType]) THEN Log.ErrorNodeOp[unsafeOp, node, uparrow]; indirect _ TRUE; long _ (TypeForm[opType] = $long); opType _ t.refType}}}; record => { rSei: RecordSEIndex = LOOPHOLE[nType]; sei: ISEIndex = SequenceField[rSei]; SELECT TRUE FROM (sei # ISENull) => { PushSe[sei]; opType _ seb[sei].idType; PushTree[son[1]]; PushNode[IF indirect THEN dot ELSE dollar, -2]; SetInfo[opType]; SetAttr[2, long]; son[1] _ PopTree[]; indirect _ FALSE}; (rSei = dataPtr.typeStringBody) => { textSei: ISEIndex = NextSe[NextSe[FirstVisibleSe[seb[rSei].fieldCtx]]]; PushSe[textSei]; attr.const _ FALSE; string _ TRUE; opType _ seb[textSei].idType; PushTree[son[1]]; PushNode[IF indirect THEN dot ELSE dollar, -2]; SetInfo[opType]; SetAttr[2, long]; son[1] _ PopTree[]; indirect _ FALSE}; (rSei = dataPtr.typeCONDITION) => { ForceDirect[]; IF son[2] # Tree.Null THEN Log.ErrorN[listLong, ListLength[son[2]]]; RPush[nullType, attr]; name _ wait; phraseNP _ SetNP[phraseNP]; EXIT}; (Bundling[rSei] # 0) => { ForceDirect[]; opType _ Unbundle[rSei]; son[1] _ ForceType[son[1], opType]}; ENDCASE => GOTO fail}; opaque => { opType _ Types.OpaqueValue[[own, nType], own].sei; IF EqTypes[opType, nType] THEN GOTO fail; son[1] _ ForceType[son[1], opType]}; ENDCASE => GOTO fail; } REPEAT fail => ApplyError[node, opType#typeANY OR nDerefs#0]; ENDLOOP; IF tb[node].nSons > 2 THEN { saveNP: NPUse = phraseNP; SELECT tb[node].name FROM callx, portcallx, signalx, errorx, startx, fork, joinx, wait, apply => NULL; ENDCASE => Log.Error[misplacedCatch]; [] _ CatchPhrase[tb[node].son[3]]; phraseNP _ MergeNP[saveNP][phraseNP]}; IF tb[node].attr1 THEN SELECT tb[node].name FROM callx, portcallx, signalx, errorx, startx, fork, joinx, apply => NULL; reloc => NULL; ENDCASE => Log.ErrorTreeOp[missingOp, tb[node].son[1], apply]; IF RType[] = nullType THEN tb[node].name _ SELECT tb[node].name FROM callx => call, portcallx => portcall, signalx => signal, errorx => error, startx => start, joinx => join, ENDCASE => tb[node].name; self _ saveSelf; RETURN[node]}; UniOperand: PROC[node: Tree.Index] RETURNS[unit: BOOL] = { unit _ (ListLength[tb[node].son[2]] = 1); IF ~unit THEN { CheckLength[tb[node].son[2], 1]; tb[node].son[2] _ UpdateList[tb[node].son[2], VoidExp]; RPush[typeANY, emptyAttr]} ELSE IF KeyedList[tb[node].son[2]] THEN Log.Error[keys]}; ApplyError: PROC[node: Tree.Index, warn: BOOL] = { IF warn THEN Log.ErrorTree[noApplication, tb[node].son[1]]; tb[node].son[2] _ UpdateList[tb[node].son[2], VoidExp]; RPush[typeANY, emptyAttr]}; ForceXfer: PROC[node: Tree.Index] RETURNS[opType: Type] = { opType _ RType[]; RPop[]; IF tb[node].nSons > 2 THEN Log.Error[misplacedCatch]; PushTree[tb[node].son[1]]; PushTree[tb[node].son[2]]; PushNode[tb[node].name, 2]; SetInfo[opType]; SetAttr[2, tb[node].attr2]; SetAttr[1, tb[node].attr1]; tb[node].attr1 _ FALSE; tb[node].son[1] _ PopTree[]; tb[node].son[2] _ Tree.Null; tb[node].name _ apply; RETURN}; DotApply: PROC[node: Tree.Index] RETURNS[Tree.Index] = { subNode: Tree.Index = GetNode[tb[node].son[1]]; IF DotExpr[subNode].selfAppl THEN { op: Tree.Link = tb[subNode].son[2]; args: Tree.Link = tb[node].son[2]; catch: Tree.Link; tb[node].son[2] _ Tree.Null; IF tb[node].nSons > 2 THEN {catch _ tb[node].son[3]; tb[node].son[3] _ Tree.Null} ELSE catch _ Tree.Null; self _ [tree:tb[subNode].son[1], type:RType[], attr:RAttr[], np:phraseNP]; tb[subNode].son[1] _ tb[subNode].son[2] _ Tree.Null; RPop[]; FreeNode[node]; node _ GetNode[ApplyToSelf[op, args, catch]]; tb[node].son[1] _ Exp[tb[node].son[1], typeANY]}; RETURN[node]}; ApplyToSelf: PROC[op, args, catch: Tree.Link] RETURNS[Tree.Link] = { n: CARDINAL _ 1; PushArg: Tree.Map = {PushTree[t]; n _ n+1; RETURN[Tree.Null]}; PushTree[op]; IF KeyedList[args] THEN { sei: ISEIndex = FirstCtxSe[ArgCtx[TransferTypes[OperandType[op]].typeIn]]; PushHash[IF sei # ISENull THEN seb[sei].hash ELSE HTNull]; PushNode[self, 0]; PushNode[item, 2]} ELSE PushNode[self, 0]; args _ FreeTree[UpdateList[args, PushArg]]; PushList[n]; IF catch = Tree.Null THEN PushNode[apply, 2] ELSE {PushTree[catch]; PushNode[apply, 3]}; SetInfo[dataPtr.textIndex]; SetAttr[1, FALSE]; RETURN[PopTree[]]}; Construct: PROC[node: Tree.Index, type: RecordSEIndex, init: BOOL _ FALSE] = { OPEN tb[node]; cType: CSEIndex _ type; attr: Attr; t: Tree.Link; son[2] _ MatchFields[type, son[2], init]; attr _ RAttr[]; RPop[]; WITH r: seb[type] SELECT FROM linked => {name _ union; cType _ VariantUnionType[r.linkType]}; ENDCASE => { name _ construct; IF r.hints.variant AND (t_ListTail[son[2]]) # Tree.Null THEN cType _ DiscriminatedType[type, t]}; info _ cType; RPush[cType, attr]}; RowCons: PROC[node: Tree.Index, aType: ArraySEIndex] = { OPEN tb[node]; componentType: Type = seb[aType].componentType; iType: CSEIndex = UnderType[seb[aType].indexType]; cType: Type = TargetType[componentType]; attr: Attr _ fullAttr; exitNP: NPUse _ none; MapValue: Tree.Map = { type: Type; subAttr: Attr; v _ SELECT TRUE FROM (t = Tree.Null) => DefaultInit[componentType], (OpName[t] = void) => FieldVoid[t], ENDCASE => Rhs[t, cType]; subAttr _ RAttr[]; type _ RType[]; RPop[]; IF v = Tree.Null THEN VoidComponent[componentType]; IF P3S.safety = checked AND TypeForm[type] = $transfer THEN v _ CheckScope[v, type]; exitNP _ MergeNP[exitNP][phraseNP]; attr _ And[attr, subAttr]; RETURN}; IF KeyedList[son[2]] OR (son[2] = Tree.Null AND TypeForm[TargetType[iType]] = $enumerated) THEN { keyType: CSEIndex = UnderType[TargetType[iType]]; vCtx: CTXIndex; first, last, i: Copier.SEToken; hti: HTIndex; NextKey: PROC RETURNS[HTIndex] = { IF i = last THEN hti _ HTNull ELSE { i _ IF i = Copier.nullSEToken THEN first ELSE Copier.CtxNext[vCtx, i]; hti _ KeyForHash[Copier.TokenHash[vCtx, i]]}; RETURN[hti]}; OmittedValue: PROC RETURNS[t: Tree.Link] = { IF Default[componentType] # none THEN t _ Tree.Null ELSE {Log.ErrorHti[omittedKey, hti]; t _ [symbol[dataPtr.seAnon]]}; RETURN}; WITH t: seb[keyType] SELECT FROM enumerated => { vCtx _ t.valueCtx; [first, last] _ Span[iType]; IF first # Copier.nullSEToken AND last # Copier.nullSEToken AND Copier.TokenValue[vCtx, first] <= Copier.TokenValue[vCtx, last] THEN { i _ Copier.nullSEToken; son[2] _ PopKeyList[ArrangeKeys[son[2], NextKey, OmittedValue]]} ELSE Log.Error[keys]}; ENDCASE => Log.Error[keys]}; son[2] _ UpdateList[son[2], MapValue]; name _ rowcons; info _ aType; RPush[aType, attr]; phraseNP _ exitNP}; All: PUBLIC PROC[node: Tree.Index, target: Type, init: BOOL _ FALSE] = { OPEN tb[node]; t: Tree.Link = son[1]; l: CARDINAL = ListLength[t]; attr: Attr; SELECT l FROM 0, 1 => { sei: CSEIndex = UnderType[target]; WITH a: seb[sei] SELECT FROM array => { cType: Type = TargetType[a.componentType]; type: Type; son[1] _ SELECT TRUE FROM (t = Tree.Null) => --IF init THEN-- DefaultInit[a.componentType], (OpName[t] = void) => FieldVoid[t], ENDCASE => Rhs[t, cType]; type _ RType[]; attr _ RAttr[]; RPop[]; IF son[1] = Tree.Null THEN VoidComponent[a.componentType]; IF P3S.safety = checked AND TypeForm[type] = $transfer THEN son[1] _ CheckScope[son[1], type]; attr.const _ FALSE}; ENDCASE => { Log.ErrorNode[noTarget, node]; son[1] _ VoidExp[son[1]]; attr _ emptyAttr}}; ENDCASE => { Log.ErrorN[listLong, l-1]; son[1] _ UpdateList[son[1], VoidExp]; attr _ emptyAttr}; info _ target; RPush[target, attr]}; VoidComponent: PUBLIC PROC[type: Type] = { IF ~Voidable[type] THEN Log.ErrorSei[elision, IF seb[type].seTag = id THEN LOOPHOLE[type] ELSE dataPtr.seAnon]}; CheckInline: PROC[node: Tree.Index, attr: Attr] RETURNS[Attr] = { bti: CBTIndex = BodyForTree[tb[node].son[1]]; IF bti = CBTNull THEN { P3S.currentBody.noXfers _ attr.noXfer _ FALSE; attr.noAssign _ FALSE; phraseNP _ SetNP[phraseNP]} ELSE { IF ~bb[bti].inline THEN P3S.currentBody.noXfers _ attr.noXfer _ FALSE ELSE WITH body: bb[bti].info SELECT FROM Internal => { SELECT OpName[tb[node].son[1]] FROM dot, dollar => Log.ErrorTree[misusedInline, tb[node].son[1]]; ENDCASE; PushTree[tb[node].son[1]]; PushTree[[subtree[index: body.thread]]]; PushNode[thread, 2]; SetAttr[1, FALSE]; SetInfo[P3S.currentScope]; tb[node].son[1] _ PopTree[]; body.thread _ node; MarkShared[[subtree[node]], TRUE]; tb[node].attr3 _ --attr.noXfer AND-- attr.noAssign; IF ~bb[bti].noXfers THEN P3S.currentBody.noXfers _ attr.noXfer _ FALSE}; ENDCASE => ERROR; IF ~bb[bti].hints.safe THEN { attr.noAssign _ FALSE; phraseNP _ SetNP[phraseNP]}}; RETURN[attr]}; InterfaceCtx: PUBLIC PROC[type: CSEIndex, v: Tree.Link] RETURNS[ctx: CTXIndex] = { WITH t: seb[type] SELECT FROM definition => ctx _ t.defCtx; transfer => { bti: CBTIndex = BodyForTree[v]; ctx _ IF bti = CBTNull OR t.mode # program THEN CTXNull ELSE bb[bti].localCtx}; ENDCASE => ctx _ CTXNull; RETURN}; }.