
    <<Pass3Xa.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 17, 1986 2:51:21 pm PDT>>
        <<Donahue, 10-Dec-81 11:23:00>>
        <<Russ Atkinson (RRA) March 6, 1985 10:45:48 pm PST>>

    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,  
        SetType, 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, FromBti, FromType, 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, FromLoc, 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 = {
            <<called by allocator whenever table area is repacked>>
            seb _ base[seType];  ctxb _ base[ctxType];
            bb _ base[bodyType];
            tb _ base[Tree.treeType];
            own _ dataPtr.ownSymbols};

    <<parameter reference bookkeeping>>

        phraseNP: PUBLIC NPUse;

    <<expression list manipulation>>

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


    <<operators>>

        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];  SetType[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 _ FromType[RType[]];  v _ [subtree[node]]};
                    signalx, errorx, joinx, startx => {
                        PushTree[MiscXfer[GetNode[t], typeANY]];  SetType[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[];
            <<N.B. failure is avoided only by EXITing the following loop>>
            DO
                nType: CSEIndex = NormalType[type];
                WITH t: seb[nType] SELECT FROM
                    record => {
                        nHits: NAT;
                        [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 _ FromType[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]];
            <<dereferencing/deproceduring loop>>
            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];
                                SetType[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];
                                SetType[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];  SetType[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[FromLoc[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 _ FromType[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 _ FromType[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 _ FromType[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[FromBti[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};

        }.

