
    <<Pass3I.mesa>>
        <<Copyright  1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 25, 1986 3:51:06 pm PDT>>
        <<Donahue,  8-Dec-81 15:29:30>>
        <<Russ Atkinson (RRA) March 6, 1985 10:42:03 pm PST>>

    DIRECTORY
        A3: TYPE USING [LongPath, MarkedType, OperandType, PermanentType, TypeForTree, VarType],
        Alloc: TYPE USING [Notifier, AddNotify, DropNotify],
        ComData: TYPE USING [interface, moduleCtx, seAnon, switches, table, textIndex, typeAtomRecord],
        Copier: TYPE USING [CompleteContext, Delink, SearchFileCtx],
        Log: TYPE USING [ErrorHti, ErrorSei, ErrorTree, ErrorTreeOp, WarningSei],
        P3: TYPE USING [Attr, fullAttr, voidAttr, mark, MergeNP, phraseNP, And, Exp, FirstId, InterfaceCtx, ItemType, MakeRefType, 
        ResolveType, ResolveValue, RPop, RPush, RType, SetDefaultImport, SetType, VariantUnionType, VoidExp],
        P3S: TYPE USING [currentBody, currentScope, safety],
        SourceMap: TYPE USING [Loc],
        Symbols: TYPE USING [seType, ctxType, mdType, Base, CTXRecord, ExtensionType, MDIndex, HTIndex, Type, ISEIndex, CSEIndex, 
        ArraySEIndex, RecordSEIndex, CTXIndex, IncludedCTXIndex, Closure, HTNull, nullType, ISENull, CSENull, RecordSENull, 
        CTXNull, IncludedCTXNull, lG, lZ, FirstStandardCtx, LastStandardCtx, typeTYPE, typeANY],
        SymbolOps: TYPE USING [ArgCtx, ConstantId, CtxLevel, DecodeCard, DecodeTreeIndex, DecodeType, EncodeCard, EncodeTreeIndex, 
        EnterExtension, FindExtension, FirstCtxSe, FromBti, LinkMode, NextSe, NormalType, RCType, RecordRoot, ReferentType, 
        SearchContext, SetSeLink, ToType, TypeForm, TypeLink, TypeRoot, UnderType],
        SymLiteralOps: TYPE USING [EnterAtom, EnterType],
        Tree: TYPE USING [Base, Index, Link, Map, Scan, Test, Null, nullIndex, treeType],
        TreeOps: TYPE USING [CopyTree, FreeTree, GetHash, GetNode, GetSe, GetTag, ListLength, MarkShared, NthSon, OpName, PopTree, 
        PushTree, PushNode, ScanList, ScanSons, SearchList, SetAttr, SetInfo, ToLoc, UpdateList, UpdateLeaves];

    Pass3I: PROGRAM
        IMPORTS A3, Alloc, Copier, Log, P3, P3S, SymLiteralOps, SymbolOps, TreeOps,  dataPtr: ComData
        EXPORTS P3 = { 
        OPEN SymbolOps, A3, P3, Symbols, TreeOps;

    <<uninitialized variable processing>>

        RefItem: TYPE = RECORD[kind: {seal, rhs, lhs}, sei: ISEIndex];
        RefSeal: RefItem = [kind:seal, sei:ISENull];

        RefSequence: TYPE = RECORD[SEQUENCE length: CARDINAL OF RefItem];
        RefStack: TYPE = REF RefSequence;

        refStack: RefStack;
        refIndex: CARDINAL;

        AdjustRefStack: PROC[n: CARDINAL] = {
            oldStack: RefStack _ refStack;
            refStack _ NEW[RefSequence[n]];
            FOR i: CARDINAL IN [0..refIndex) DO refStack[i] _ oldStack[i] ENDLOOP;
            oldStack _ NIL};

        RecordMention: PUBLIC PROC[sei: ISEIndex] = {
            IF dataPtr.switches['u] AND (DecodeCard[seb[sei].idInfo] = 0 AND ~seb[sei].mark4) THEN {
                IF refIndex >= refStack.length THEN AdjustRefStack[refStack.length + 8];
                refStack[refIndex] _ [kind:rhs, sei:sei];
                refIndex _ refIndex + 1}
            ELSE BumpCount[sei]};

        RecordLhs: PUBLIC PROC[sei: ISEIndex] = {
            key: RefItem;
            IF dataPtr.switches['u] AND (DecodeCard[seb[sei].idInfo] = 0 AND ~seb[sei].mark4) THEN {
                key _ [kind:rhs, sei:sei];
                FOR i: CARDINAL DECREASING IN [0..refIndex) DO
                    SELECT refStack[i] FROM
                        key => {refStack[i].kind _ lhs; EXIT};
                        RefSeal => EXIT;
                        ENDCASE;
                    ENDLOOP
                }
            };

        SealRefStack: PUBLIC PROC = {
            IF refIndex >= refStack.length THEN AdjustRefStack[refStack.length + 8];
            refStack[refIndex] _ RefSeal;  refIndex _ refIndex + 1};

        UnsealRefStack: PUBLIC PROC = {
            ClearRefStack[];    refIndex _ refIndex - 1;
            IF refStack[refIndex] # RefSeal THEN ERROR};

        ClearRefStack: PUBLIC PROC = {
            sei: ISEIndex;
            FOR i: CARDINAL DECREASING IN [0..refIndex) UNTIL refStack[i] = RefSeal DO
                sei _ refStack[i].sei;
                IF refStack[i].kind = rhs
                    AND ~ConstantInit[sei]
                    AND (~dataPtr.interface OR CtxLevel[seb[sei].idCtx] # lG) THEN
                        Log.WarningSei[uninitialized, sei];
                BumpCount[sei];
                refIndex _ refIndex - 1;
                ENDLOOP;
            IF refStack.length > 16 AND refIndex <= 16 THEN AdjustRefStack[16]};

        ConstantInit: PROC[sei: ISEIndex] RETURNS[BOOL] = {
            node: Tree.Index;
            IF seb[sei].constant THEN RETURN[TRUE];
            node _ DecodeTreeIndex[seb[sei].idValue];
            RETURN[seb[sei].immutable
                AND node # Tree.nullIndex AND OpName[tb[node].son[3]] = body]
            };


    <<tables defining the current symbol table>>

        tb: Tree.Base;        -- tree base
        seb: Symbols.Base;        -- se table
        ctxb: Symbols.Base;        -- context table
        mdb: Symbols.Base;        -- module directory base

        IdNotify: Alloc.Notifier = {
            <<called whenever the main symbol table is repacked>>
            tb _ base[Tree.treeType];
            seb _ base[seType];  ctxb _ base[ctxType];  mdb _ base[mdType]};

    <<type table management>>

        EnterType: PUBLIC PROC[type: Type, canonical: BOOL_TRUE] = {
            SymLiteralOps.EnterType[type, canonical];
            CompleteRCType[TypeRoot[type]]};

        CompleteContext: PROC[ctx: CTXIndex] = {
            WITH c: ctxb[ctx] SELECT FROM
                simple =>
                    IF c.copied < $rc THEN {
                        c.copied _ $rc;
                        FOR sei: ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
                            type: Type = seb[sei].idType;
                            CompleteRCType[IF type = typeTYPE THEN sei ELSE TypeRoot[type]];
                            ENDLOOP;
                        };
                included =>
                    IF CtxLevel[ctx] = lZ THEN Copier.CompleteContext[LOOPHOLE[ctx], $rc];
                ENDCASE
            };

        CompleteRCType: PROC[type: Type] = {
            IF RCType[type] # none THEN {
                subType: CSEIndex = UnderType[type];
                WITH t: seb[subType] SELECT FROM
                    record => CompleteContext[t.fieldCtx];
                    array => CompleteRCType[TypeRoot[t.componentType]];
                    union =>  CompleteContext[t.caseCtx];
                    sequence => CompleteRCType[TypeRoot[t.componentType]];
                    ENDCASE => NULL
                }
            };

        EnterStructure: PROC[type: Type] = {EnterType[UnderType[type], TRUE]};

        EnterComposite: PUBLIC PROC[type: Type, t: Tree.Link, init: BOOL] = {
            SELECT OpName[t] FROM
                loophole, cast, safen, pad => {
                    t1: Tree.Link = NthSon[t, 1];
                    EnterComposite[OperandType[t1], t1, init];
                    IF RCType[type] = composite THEN EnterStructure[type]};
                construct =>
                    IF RCType[type] = composite THEN {
                        node: Tree.Index = GetNode[t];
                        EnterFieldTypes[
                            RecordRoot[LOOPHOLE[UnderType[ToType[tb[node].info]]]], tb[node].son[2], init];
                        IF ~init THEN EnterStructure[type]    -- in case constant-folded
                    };
                union => {
                    node: Tree.Index = GetNode[t];
                    EnterFieldTypes[LOOPHOLE[UnderType[GetSe[tb[node].son[1]]]], tb[node].son[2], init]};
                rowcons => {
                    node: Tree.Index = GetNode[t];
                    aSei: ArraySEIndex = LOOPHOLE[UnderType[ToType[tb[node].info]]];
                    cSei: CSEIndex = UnderType[seb[aSei].componentType];

                    EnterElement: Tree.Scan = {EnterComposite[cSei, t, init]};

                    IF RCType[cSei] # none THEN {
                        ScanList[tb[node].son[2], EnterElement];
                        IF ~init THEN EnterStructure[type]}
                    };
                all => {
                    node: Tree.Index = GetNode[t];
                    aSei: ArraySEIndex = LOOPHOLE[UnderType[ToType[tb[node].info]]];
                    cSei: CSEIndex = UnderType[seb[aSei].componentType];
                    IF RCType[cSei] # none THEN {
                        EnterComposite[cSei, NthSon[t, 1], FALSE];
                        IF ~init THEN EnterStructure[type]}
                    };
                ENDCASE =>
                    SELECT TypeForm[type] FROM
                        $union => Log.ErrorTree[unimplemented, t];
                        $sequence => IF t # Tree.Null THEN Log.ErrorTree[unimplemented, t];
                        ENDCASE => IF RCType[type] = composite THEN EnterStructure[type]
            };

        EnterFieldTypes: PROC[rSei: RecordSEIndex, t: Tree.Link, init: BOOL] = {
            sei: ISEIndex _ FirstCtxSe[seb[rSei].fieldCtx];

            EnterField: Tree.Scan = {
                IF sei # ISENull THEN {
                    subType: CSEIndex = UnderType[seb[sei].idType];
                    WITH s: seb[subType] SELECT FROM
                        record => {
                            IF s.hints.variant AND RCType[subType] = composite THEN
                                EnterType[subType, TRUE];
                            EnterComposite[subType, t, init]};
                        ENDCASE => EnterComposite[subType, t, init]};
                sei _ NextSe[sei]};

            ScanList[t, EnterField]};

        EnterMarkedType: PROC[type: Type] = INLINE {
            EnterType[MarkedType[UnderType[type]]]};

        EnterDiscriminator: PROC[t: Tree.Link] = INLINE {    -- guarantee that union is copied
            [] _ VariantUnionType[OpenedType[OperandType[t]]]};

        EnterTags: PROC[type: Type] = INLINE {
            subType: CSEIndex _ OpenedType[type];
            DO
                next: CSEIndex _ UnderType[TypeLink[subType]];
                IF next = CSENull THEN EXIT;
                [] _ VariantUnionType[next];    -- guarantee that union is copied
                subType _ next;
                ENDLOOP
            };


    <<identifier look-up>>

        Id: PUBLIC PROC[hti: HTIndex] RETURNS[val: Tree.Link] = {
            sei: ISEIndex;
            type: Type;
            ctx: CTXIndex;
            baseV: Tree.Link;
            attr: Attr _ voidAttr;
            indirect: BOOL;
            [sei, baseV, indirect] _ FindSe[hti];
            IF sei # ISENull THEN {
                IF baseV = Tree.Null THEN RecordMention[sei] ELSE BumpCount[sei];
                IF ~seb[sei].mark3 THEN ResolveIdType[sei];
                val _ [symbol[index: sei]];  type _ seb[sei].idType;
                ctx _ seb[sei].idCtx;
                SELECT ctxb[ctx].ctxType FROM
                    included => {
                        attr.const _ ConstantId[sei];
                        IF baseV = Tree.Null AND (~attr.const OR ~InterfaceConst[sei]) THEN
                            Log.ErrorSei[notImported, sei]};
                    imported => {
                        IF ~dataPtr.interface AND TypeForm[type] = $ref THEN
                            [val, type] _ DeRef[val, type];
                        attr.const _ FALSE};
                    ENDCASE => {
                        IF ~ConstResolved[sei] THEN ResolveIdValue[sei];
                        attr.const _ seb[sei].constant};
                SELECT TRUE FROM
                    baseV = Tree.Null => {
                        IF ctx = P3S.currentBody.argCtx THEN phraseNP _ ref;
                        IF CtxLevel[ctx] = lZ AND ~attr.const THEN
                            SELECT ctx FROM
                                IN [FirstStandardCtx .. LastStandardCtx], dataPtr.moduleCtx => NULL;
                                ENDCASE => Log.ErrorSei[missingBase, sei]
                        };
                    (~attr.const AND ctxb[ctx].ctxType # imported) => {
                        attr _ And[UpdateTreeAttr[baseV], attr];
                        PushTree[CopyTree[baseV]];  PushTree[val];
                        IF indirect THEN {
                            PushNode[dot, 2]; SetAttr[2, TypeForm[OperandType[baseV]] = $long]}
                        ELSE {PushNode[dollar, 2]; SetAttr[2, LongPath[baseV]]};
                        SetType[type];  val _ PopTree[]};
                    ENDCASE;
                IF VarType[type] THEN [val, type] _ DeRef[val, type, TRUE];
                IF seb[sei].extended THEN attr _ And[UpdateExtension[sei], attr]}
            ELSE {
                attr _ And[UpdateTreeAttr[baseV], attr];  type _ OperandType[baseV];
                IF indirect THEN [val, type] _ DeRef[CopyTree[baseV], type]
                ELSE val _ CopyTree[baseV]};
            RPush[type, attr];
            RETURN};

        DeRef: PROC[t: Tree.Link, type: Type, var: BOOL_FALSE] RETURNS [Tree.Link, Type] = {
            rType: Type = ReferentType[type];
            PushTree[t];
            PushNode[uparrow, 1];
            SetType[rType];  SetAttr[2, TypeForm[type] = $long];  SetAttr[3, var];
            RETURN[PopTree[], rType]};

        UpdateExtension: PROC[sei: ISEIndex] RETURNS[attr: Attr] = {
            t: Tree.Link;
            tag: ExtensionType;
            [tag, t] _ FindExtension[sei];
            IF tag # value THEN attr _ fullAttr
            ELSE {attr _ UpdateTreeAttr[t]; attr.const _ TRUE};
            RETURN};


        FieldId: PUBLIC PROC[hti: HTIndex, type: RecordSEIndex] RETURNS[n: NAT, sei: ISEIndex] = {
            [n, sei] _ SearchRecord[hti, type];
            IF n # 0 THEN {
                IF ~seb[sei].mark3 THEN ResolveIdType[sei];
                IF ~ConstResolved[sei] THEN ResolveIdValue[sei];
                BumpCount[sei]};
            RETURN};

        InterfaceId: PUBLIC PROC[hti: HTIndex, ctx: CTXIndex]
              RETURNS[found: BOOL, sei: ISEIndex] = {
            [found, sei] _ SearchCtxList[hti, ctx];
            IF found  THEN {
                SELECT ctxb[seb[sei].idCtx].ctxType FROM
                    imported => NULL;
                    included =>
                        IF ~ConstantId[sei] OR ~InterfaceConst[sei] THEN Log.ErrorSei[notImported, sei];
                        ENDCASE => {
                            IF ~seb[sei].mark3 THEN ResolveIdType[sei];
                            IF ~ConstResolved[sei] THEN ResolveIdValue[sei]};
                BumpCount[sei]};
            RETURN};

        ClusterId: PUBLIC PROC[hti: HTIndex, ctx: CTXIndex] 
              RETURNS[found: BOOL, sei: ISEIndex] = {
            WITH c: ctxb[ctx] SELECT FROM
                simple => [found, sei] _ SearchCtxList[hti, ctx];
                included => {
                    mdi: MDIndex = c.module;
                    IF mdb[mdi].defaultImport = CTXNull THEN {  -- avoid creating spurious principal imports
                        IF SearchCtxList[hti, ctx].found THEN
                            [found, sei] _ SearchCtxList[hti, DefaultImport[LOOPHOLE[ctx], FALSE]]
                        ELSE {found _ FALSE; sei _ ISENull}}
                    ELSE [found, sei] _ SearchCtxList[hti, mdb[mdi].defaultImport]};
                ENDCASE => {found _ FALSE; sei _ ISENull};
            IF found THEN {
                IF ~seb[sei].mark3 THEN ResolveIdType[sei];
                BumpCount[sei]};
            RETURN};


    <<service routines for above>>

        InterfaceConst: PROC[sei: ISEIndex] RETURNS[BOOL] = INLINE {
            RETURN[SELECT LinkMode[sei] FROM val, ref => FALSE, ENDCASE => TRUE]};

        ConstResolved: PROC[sei: ISEIndex] RETURNS[BOOL] = {
            RETURN[(seb[sei].mark4 OR seb[sei].idValue = EncodeTreeIndex[Tree.nullIndex]) 
                OR ~seb[sei].immutable OR (seb[sei].constant AND ~RootType[sei])]};

        RootType: PROC[sei: ISEIndex] RETURNS[BOOL] = INLINE {
            RETURN[seb[sei].idType = typeTYPE AND TypeLink[sei] = nullType]};


        ResolveIdType: PROC[sei: ISEIndex] = {
            declNode: Tree.Index _ DecodeTreeIndex[seb[sei].idValue];
            IF tb[declNode].attr3 # P3.mark THEN ResolveType[sei]};

        ResolveIdValue: PROC[sei: ISEIndex] = {
            declNode: Tree.Index _ DecodeTreeIndex[seb[sei].idValue];
            IF seb[sei].mark3 AND tb[declNode].attr2 # P3.mark THEN ResolveValue[sei]};


        BumpCount: PUBLIC PROC[sei: ISEIndex] = {
            OPEN seb[sei];
            IF idType # typeTYPE AND (~mark4 OR (ctxb[idCtx].ctxType = imported AND ~constant)) THEN
                idInfo _ EncodeCard[DecodeCard[idInfo] + 1]
            };


    <<keyed-list matching>>

        CompleteRecord: PUBLIC PROC[rSei: RecordSEIndex, depth: Closure_$unit] = {
            ctx: CTXIndex = seb[rSei].fieldCtx;
            WITH ctxb[ctx] SELECT FROM
                simple => NULL;
                included => IF CtxLevel[ctx] = lZ THEN Copier.CompleteContext[LOOPHOLE[ctx], depth];
                ENDCASE
            };

        ArrangeKeys: PUBLIC PROC[
                expList: Tree.Link,
                nextKey: PROC RETURNS[HTIndex],
                omittedValue: PROC RETURNS[Tree.Link]]
              RETURNS[nItems: CARDINAL] = {
            Pair: TYPE = RECORD[key: HTIndex, val: Tree.Link];
            PairList: TYPE = RECORD[SEQUENCE length: CARDINAL OF Pair];
            a: REF PairList;
            n: CARDINAL;
            duplicate: BOOL;

            ListItem: Tree.Map = {
                node: Tree.Index = GetNode[t];
                hti: HTIndex = GetHash[tb[node].son[1]];
                FOR i: CARDINAL IN [0 .. n) DO
                    IF hti = a[i].key THEN GO TO Duplicate;
                    REPEAT
                        Duplicate => {duplicate _ TRUE; v _ t};
                        FINISHED => {
                            a[n] _ [key:hti, val:tb[node].son[2]];  n _ n+1;
                            tb[node].son[2] _ Tree.Null;  v _ FreeTree[t]};
                    ENDLOOP;
                RETURN};

            DuplicateItem: Tree.Scan = {
                IF t # Tree.Null THEN {
                    node: Tree.Index = GetNode[t];
                    Log.ErrorTree[duplicateKey, tb[node].son[1]];
                    tb[node].son[2] _ P3.VoidExp[tb[node].son[2]]}
                };

            key: HTIndex;
            m: CARDINAL;
            n _ ListLength[expList];  nItems _ 0;
            a _ NEW[PairList[n]];
            n _ 0;  duplicate _ FALSE;  expList _ UpdateList[expList, ListItem];  m _ n;
            UNTIL (key _ nextKey[]) = HTNull DO
                FOR i: CARDINAL IN [0 .. n) DO
                    IF key = a[i].key THEN GO TO Found;
                    REPEAT
                        Found => {PushTree[a[i].val]; a[i].key _ HTNull; m _ m-1};
                        FINISHED => PushTree[omittedValue[]];
                    ENDLOOP;
                nItems _ nItems + 1;
                ENDLOOP;
            IF duplicate THEN ScanList[expList, DuplicateItem];
            IF m # 0 THEN
                FOR i: CARDINAL IN [0 .. n) DO
                    IF a[i].key # HTNull THEN {
                        Log.ErrorHti[unknownKey, a[i].key]; [] _ FreeTree[P3.VoidExp[a[i].val]]};
                    ENDLOOP;
            [] _ FreeTree[expList];  a _ NIL;
            RETURN};


    <<service routines for copying/mapping list structure>>

        BindTree: PUBLIC PROC[t: Tree.Link, binding: PROC[ISEIndex] RETURNS[Tree.Link]]
            RETURNS [Tree.Link] = {

            MapTree: Tree.Map = {
                IF t = Tree.Null THEN v _ Tree.Null
                ELSE WITH t SELECT GetTag[t] FROM
                    symbol => v _ binding[index];
                    subtree => {
                        node: Tree.Index = index;
                        v _ SELECT TRUE FROM
                            tb[node].shared =>
                                SELECT tb[node].name FROM
                                    call, callx => MapThreadedTree[t],
                                    ENDCASE => t,
                            ENDCASE => TreeOps.CopyTree[[baseP:@tb, link:t], MapTree]};
                    ENDCASE => v _ t;
                RETURN};

            MapThread: Tree.Map = {
                IF OpName[t] = thread THEN {
                    node: Tree.Index = GetNode[t];
                    PushTree[MapTree[tb[node].son[1]]]; PushTree[Tree.Null];
                    PushNode[thread, 2]; SetAttr[1, FALSE]; SetInfo[FromBti[P3S.currentScope]];
                    v _ PopTree[]}
                ELSE v _ MapTree[t]};

            MapThreadedTree: Tree.Map = {
                sThread: Tree.Index = GetNode[NthSon[t, 1]];
                dThread: Tree.Index;
                v _ TreeOps.CopyTree[[baseP:@tb, link:t], MapThread];
                dThread _ GetNode[NthSon[v, 1]];
                tb[dThread].son[2] _ tb[sThread].son[2];
                tb[sThread].son[2] _ v;  MarkShared[v, TRUE];
                RETURN};

            RETURN[MapTree[t]]};

        IdentityBinding: PROC[sei: ISEIndex] RETURNS[Tree.Link] = {
            RETURN[[symbol[index: sei]]]};

        CopyTree: PUBLIC Tree.Map = {RETURN[BindTree[t, IdentityBinding]]};


    <<attribute completion/updating>>

        EnterRefLits: PROC[node: Tree.Index] = {
            IF node # Tree.nullIndex THEN
            SELECT tb[node].name FROM
                assign, assignx =>
                    IF tb[node].attr2 AND tb[node].attr3 THEN
                        EnterComposite[OperandType[tb[node].son[1]], tb[node].son[2], tb[node].attr1];
                new =>
                    IF tb[node].attr3 THEN {
                        subType: Type = TypeForTree[tb[node].son[2]];
                        EnterType[TypeRoot[subType], FALSE];
                        IF tb[node].son[3] # Tree.Null THEN
                            EnterComposite[UnderType[subType], tb[node].son[3], TRUE]};
                listcons =>
                    IF tb[node].attr3 THEN {
                        rSei: Type = ReferentType[ToType[tb[node].info]];
                        cSei: CSEIndex = UnderType[ItemType[rSei]];

                        EnterElement: Tree.Scan = {EnterComposite[cSei, t, TRUE]};

                        EnterType[TypeRoot[rSei], FALSE];
                        ScanList[tb[node].son[2], EnterElement]};
                ditem => {
                    sei: ISEIndex = FirstId[GetNode[tb[node].son[1]]];
                    UpdateNarrowing[seb[sei].idType, tb[node].attr2, tb[node].attr3]};
                narrow => {
                    IF RCType[ToType[tb[node].info]] = simple THEN {
                        nType: CSEIndex = NormalType[ToType[tb[node].info]];
                        WITH t: seb[nType] SELECT FROM
                            ref => EnterType[t.refType, FALSE];
                            ENDCASE => NULL};
                        UpdateNarrowing[ToType[tb[node].info], tb[node].attr2, tb[node].attr3]};
                istype =>
                    UpdateNarrowing[TypeForTree[tb[node].son[2]], tb[node].attr2, tb[node].attr3];
                atom => {
                    SymLiteralOps.EnterAtom[GetHash[tb[node].son[1]]];
                    EnterType[dataPtr.typeAtomRecord, FALSE]};
                bind, bindx => 
                    IF ~tb[node].attr3 THEN EnterDiscriminator[NthSon[tb[node].son[1], 2]];
                ENDCASE};

        UpdateNarrowing: PROC[type: Type, rtTest, tagTest: BOOL] = {
            IF rtTest THEN EnterMarkedType[type];
            IF tagTest THEN EnterTags[type]};


        UpdateTreeAttr: PUBLIC PROC[t: Tree.Link] RETURNS[attr: Attr] = {
            <<traverses the tree, incrementing reference counts for ids>>

            UpdateAttr: Tree.Scan = {
                WITH t SELECT GetTag[t] FROM
                    symbol => {
                        IF seb[index].idCtx = P3S.currentBody.argCtx THEN
                            phraseNP _ MergeNP[phraseNP][ref];
                        BumpCount[index]};
                    subtree => {
                        node: Tree.Index = index;
                        ScanSons[t, UpdateAttr];
                        EnterRefLits[node];
                        SELECT tb[node].name FROM
                            assign, assignx => {
                                attr.noAssign _ FALSE;  phraseNP _ MergeNP[phraseNP][set]};
                            IN [call..join], IN [callx..joinx] => {    -- conservative
                                P3S.currentBody.noXfers _ attr.noXfer _ FALSE;
                                attr.noAssign _ FALSE;  phraseNP _ MergeNP[phraseNP][set]};
                            new, listcons => P3S.currentBody.noXfers _ attr.noXfer _ FALSE;
                            ENDCASE => NULL};
                    ENDCASE => NULL};

            attr _ fullAttr;  phraseNP _ none;  UpdateAttr[t];
            attr.const _ FALSE;  RETURN};



    <<context stack management>>

        ContextEntry: TYPE = RECORD[
            base: Tree.Link,        -- the basing expr (empty if none)
            indirect: BOOL,        -- true iff basing expr is pointer
            info: SELECT tag: * FROM
                list => [ctx: CTXIndex],        -- a single context
                record => [rSei: RecordSEIndex],    -- a group of contexts
                hash => [ctxHti: HTIndex],    -- a single identifier
                ENDCASE
            ];

        ContextSequence: TYPE = RECORD[SEQUENCE length: NAT OF ContextEntry];
        ContextStack: TYPE = REF ContextSequence;

        ctxStack: ContextStack;
        ctxIndex: INTEGER;
        ContextIncr: CARDINAL = 16;

        ExpandStack: PROC = {
            oldstack: ContextStack _ ctxStack;
            ctxStack _ NEW[ContextSequence[oldstack.length + ContextIncr]];
            FOR i: CARDINAL IN [0 .. oldstack.length) DO ctxStack[i] _ oldstack[i] ENDLOOP;
            oldstack _ NIL};


        PushCtx: PUBLIC PROC[ctx: CTXIndex] = {
            IF (ctxIndex _ ctxIndex+1) >= ctxStack.length THEN ExpandStack[];
            ctxStack[ctxIndex] _ [base:Tree.Null, indirect:FALSE, info:list[ctx]]};

        PushRecordCtx: PUBLIC PROC[rSei: RecordSEIndex, base: Tree.Link, indirect: BOOL] = { 
            IF (ctxIndex _ ctxIndex+1) >= ctxStack.length THEN ExpandStack[];
            ctxStack[ctxIndex] _ [base:base, indirect:indirect, info:record[rSei]]};

        UpdateRecordCtx: PUBLIC PROC[type: RecordSEIndex] = {
            WITH ctxStack[ctxIndex] SELECT FROM
                record => rSei _ type;
                ENDCASE => ERROR
            };

        PushHtCtx: PUBLIC PROC[hti: HTIndex, base: Tree.Link, indirect: BOOL] = {
            IF (ctxIndex _ ctxIndex+1) >= ctxStack.length THEN ExpandStack[];
            ctxStack[ctxIndex] _ [base:base, indirect:indirect, info:hash[hti]]};

        PopCtx: PUBLIC PROC = {ctxIndex _ ctxIndex-1};

        TopCtx: PUBLIC PROC RETURNS[CTXIndex] = {
            RETURN[WITH ctxStack[ctxIndex] SELECT FROM list => ctx, ENDCASE => ERROR]};


    <<primary lookup>>

        FindSe: PUBLIC PROC[hti: HTIndex] RETURNS[ISEIndex, Tree.Link, BOOL] = {
            found: BOOL;
            nHits: NAT;
            sei: ISEIndex;
            FOR i: INTEGER DECREASING IN [0 .. ctxIndex] DO
                WITH s: ctxStack[i] SELECT FROM
                    list => {
                        [found, sei] _ SearchCtxList[hti, s.ctx];
                        IF found THEN GO TO Found};
                    record => {
                        [nHits, sei] _ SearchRecord[hti, s.rSei];
                        SELECT nHits FROM
                            = 1 => GO TO Found;
                            > 1 => GO TO Ambiguous;
                            ENDCASE};
                    hash => IF hti = s.ctxHti THEN {sei _ ISENull; GO TO Found};
                    ENDCASE;
                REPEAT
                    Found => RETURN[sei, ctxStack[i].base, ctxStack[i].indirect];
                    Ambiguous => {
                        Log.ErrorHti[ambiguousId, hti];
                        RETURN[dataPtr.seAnon, Tree.Null, FALSE]};
                    FINISHED => {
                        IF hti # HTNull THEN Log.ErrorHti[unknownId, hti];
                        RETURN[dataPtr.seAnon, Tree.Null, FALSE]};
                ENDLOOP
            };


        SearchCtxList: PUBLIC PROC[hti: HTIndex, ctx: CTXIndex]
            RETURNS [found: BOOL, sei: ISEIndex] = {
            IF ctx = CTXNull THEN RETURN[FALSE, ISENull];
            WITH c: ctxb[ctx] SELECT FROM
                included => {
                    IF c.restricted THEN {
                        sei _ SearchRestrictedCtx[hti, LOOPHOLE[ctx]]; found _ (sei # ISENull)}
                    ELSE {
                        sei _ SearchContext[hti, ctx];
                        SELECT TRUE FROM
                            (sei # ISENull) => found _ TRUE;
                            (~c.closed AND ~c.reset) => [found, sei] _ Copier.SearchFileCtx[hti, LOOPHOLE[ctx]];
                            ENDCASE => found _ FALSE};
                    IF found AND ~seb[sei].public AND ~Shared[ctx]
                        AND sei # dataPtr.seAnon THEN Log.ErrorSei[privateId, sei]};
                imported => {
                    iCtx: IncludedCTXIndex = c.includeLink;
                    sei _ SearchContext[hti, ctx];
                    IF sei # ISENull THEN
                        found _ ~ctxb[iCtx].restricted OR CheckRestrictedCtx[hti, iCtx] # ISENull
                    ELSE {
                        [found, sei] _ SearchCtxList[hti, iCtx];
                        IF found AND  sei # dataPtr.seAnon THEN
                            SELECT LinkMode[sei] FROM
                                val => {MoveSe[sei, ctx]; ImportSe[sei, ctx]};
                                ref => {
                                    MoveSe[sei, ctx];
                                    IF ~dataPtr.interface AND ~VarType[UnderType[seb[sei].idType]] THEN {
                                        seb[sei].idType _ MakeRefType[
                                            cType: seb[sei].idType, readOnly: seb[sei].immutable,
                                            hint: typeANY];
                                        seb[sei].immutable _ TRUE};
                                    ImportSe[sei, ctx]};
                                ENDCASE}};
                ENDCASE => {sei _ SearchContext[hti, ctx]; found _ (sei # ISENull)};
            RETURN};

        MoveSe: PROC[sei: ISEIndex, ctx: CTXIndex] = {
            Copier.Delink[sei];  seb[sei].idCtx _ ctx;
            SetSeLink[sei, ctxb[ctx].seList];  ctxb[ctx].seList _ sei};


    <<import handling>>

        MainIncludedCtx: PUBLIC PROC[mdi: MDIndex] RETURNS[ctx: IncludedCTXIndex] = {
            FOR ctx _ mdb[mdi].ctx, ctxb[ctx].chain UNTIL ctx = CTXNull DO
                IF CtxLevel[ctx] = lG THEN EXIT ENDLOOP;
            RETURN};

        DefaultImport: PROC[iCtx: IncludedCTXIndex, new: BOOL] RETURNS[CTXIndex] = {
            mdi: MDIndex = ctxb[iCtx].module;
            IF mdb[mdi].defaultImport = CTXNull THEN SetDefaultImport[iCtx, new];
            RETURN[mdb[mdi].defaultImport]};


        ImportTree: PROC[t: Tree.Link, importCtx: CTXIndex] RETURNS[Tree.Link] = {
            iCtx: IncludedCTXIndex = WITH c: ctxb[importCtx] SELECT FROM
                imported => c.includeLink,
                ENDCASE => ERROR;

            UpdateBinding: Tree.Map = {
                WITH t SELECT GetTag[t] FROM
                    symbol => {
                        oldSei: ISEIndex = index;
                        oldCtx: CTXIndex = seb[oldSei].idCtx;
                        newSei: ISEIndex;
                        WITH c: ctxb[oldCtx] SELECT FROM
                            included =>
                                IF CtxLevel[oldCtx] # lG OR InterfaceConst[oldSei] THEN newSei _ oldSei
                                ELSE {
                                    mdi: MDIndex = c.module;
                                    saveRestricted: BOOL = c.restricted;
                                    saveShared: BOOL = mdb[mdi].shared;
                                    targetCtx: CTXIndex;
                                    c.restricted _ FALSE;  mdb[mdi].shared _ TRUE;
                                    targetCtx _ IF oldCtx = iCtx
                                        THEN importCtx
                                        ELSE DefaultImport[LOOPHOLE[oldCtx], TRUE];
                                    newSei _ SearchCtxList[seb[oldSei].hash, targetCtx].sei;
                                    mdb[mdi].shared _ saveShared; c.restricted _ saveRestricted};
                            ENDCASE => newSei _ oldSei;
                        v _ [symbol[index: newSei]];
                        IF ~dataPtr.interface AND ctxb[seb[newSei].idCtx].ctxType = imported THEN {
                            type: CSEIndex = UnderType[seb[newSei].idType];
                            WITH s: seb[type] SELECT FROM
                                ref => IF ~s.var THEN [v, ] _ DeRef[v, type];
                                ENDCASE};
                        BumpCount[newSei]};
                    subtree => {
                        node: Tree.Index = index;
                        EnterRefLits[node];
                        v _ UpdateLeaves[t, UpdateBinding]};
                    ENDCASE => v _ t;
                RETURN};

            RETURN[UpdateBinding[t]]};


        ImportCtx: PROC[ctx, importCtx: CTXIndex, level: NAT] = {
            FOR sei: ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = ISENull DO
                ImportSe[sei, importCtx, level] ENDLOOP
            };

        ImportSe: PROC[sei: ISEIndex, importCtx: CTXIndex, level: NAT_0] = {
            t: Tree.Link;
            tag: ExtensionType;
            type: CSEIndex = UnderType[seb[sei].idType];
            IF level = 0 THEN    -- this trick doesn't generalize (really need a marking scheme)
                WITH t: seb[type] SELECT FROM
                    transfer => {
                        ImportCtx[ArgCtx[t.typeIn], importCtx, level+1];
                        ImportCtx[ArgCtx[t.typeOut], importCtx, level+1]};
                    ENDCASE;
            IF seb[sei].extended THEN {
                [tag, t] _ FindExtension[sei];
                EnterExtension[sei, tag, ImportTree[t, importCtx]]}
            };


    <<searching records>>

        SearchRecordSegment: PROC[hti: HTIndex, rSei: RecordSEIndex, suffixed: BOOL]
              RETURNS [nHits: NAT, sei: ISEIndex] = {
            found: BOOL;
            n: NAT;
            match: ISEIndex;
            [found, sei] _ SearchCtxList[hti, seb[rSei].fieldCtx];
            nHits _ IF found THEN 1 ELSE 0;
            IF seb[rSei].hints.variant THEN {
                tSei: CSEIndex = VariantUnionType[rSei];
                WITH t: seb[tSei] SELECT FROM
                    union => {
                        IF ~suffixed AND ~t.controlled AND t.overlaid THEN {
                            [n, match] _ SearchOverlays[hti, t.caseCtx];
                            IF ~found THEN sei _ match;
                            nHits _ nHits + n};
                        IF t.controlled AND seb[t.tagSei].hash = hti THEN {sei _ t.tagSei; nHits _ nHits + 1}};
                    sequence => {
                        IF t.controlled AND seb[t.tagSei].hash = hti THEN {sei _ t.tagSei; nHits _ nHits + 1}};
                    ENDCASE => NULL};
            RETURN};

        SearchOverlays: PROC[hti: HTIndex, ctx: CTXIndex] RETURNS [nHits: NAT, sei: ISEIndex] = {
            WITH ctxb[ctx] SELECT FROM
                included => Copier.CompleteContext[LOOPHOLE[ctx]];
                ENDCASE;
            nHits _ 0;  sei _ ISENull;
            FOR vSei: ISEIndex _ FirstCtxSe[ctx], NextSe[vSei] UNTIL vSei = ISENull DO
                IF seb[vSei].public OR Shared[ctx] THEN {
                    type: Type = DecodeType[seb[vSei].idInfo];
                    WITH r: seb[type] SELECT FROM
                        id => NULL;
                        cons =>
                            WITH r SELECT FROM
                                record => {
                                    n: NAT;
                                    match: ISEIndex;
                                    [n, match] _ SearchRecordSegment[hti, LOOPHOLE[type], FALSE];
                                    IF nHits = 0 THEN sei _ match;
                                    nHits _ nHits + n};
                                ENDCASE => ERROR;
                        ENDCASE};
                ENDLOOP;
            RETURN};

        SearchRecord: PROC[hti: HTIndex, type: RecordSEIndex]
              RETURNS [nHits: NAT, sei: ISEIndex] = {
            rSei: RecordSEIndex _ type;
            suffixed: BOOL _ FALSE;
            UNTIL rSei = RecordSENull DO
                [nHits, sei] _ SearchRecordSegment[hti, rSei, suffixed];
                IF nHits # 0 THEN RETURN;
                rSei _ WITH seb[rSei] SELECT FROM
                    linked => LOOPHOLE[UnderType[linkType]],
                    ENDCASE => RecordSENull;
                suffixed _ TRUE;
                ENDLOOP;
            RETURN[0, ISENull]};


    <<management of restricted contexts>>

        Shared: PUBLIC PROC[ctx: CTXIndex] RETURNS[BOOL] = {
            RETURN[WITH c: ctxb[ctx] SELECT FROM
                included => mdb[c.module].shared,
                imported => Shared[c.includeLink],
                ENDCASE => TRUE]
            };


        CtxRestriction: TYPE = RECORD[ctx: IncludedCTXIndex, list: Tree.Link, linked: BOOL_FALSE];
        CtxIdTable: TYPE = RECORD[SEQUENCE length: CARDINAL OF CtxRestriction];
        ctxIdTable: REF CtxIdTable;


        CtxHash: PROC[ctx: IncludedCTXIndex] RETURNS[CARDINAL] = INLINE {
            RETURN[CARDINAL[(ctx-IncludedCTXNull)/CTXRecord.included.SIZE] MOD ctxIdTable.length]
            };

        MakeIdTable: PUBLIC PROC[nIdLists: CARDINAL] = {
            ctxIdTable _ NEW[CtxIdTable[nIdLists]];
            FOR i: CARDINAL IN [0..nIdLists) DO ctxIdTable[i] _ [IncludedCTXNull, Tree.Null] ENDLOOP};

        EnterIdList: PUBLIC PROC[ctx: IncludedCTXIndex, list: Tree.Link] = {
            i: CARDINAL _ CtxHash[ctx];
            DO
                SELECT ctxIdTable[i].ctx FROM
                    IncludedCTXNull => {ctxIdTable[i] _ [ctx, list]; EXIT};
                    ctx => ctxIdTable[i].linked _ TRUE;
                    ENDCASE;
                IF (i _ i+1) = ctxIdTable.length THEN i _ 0;
                ENDLOOP
            };


        CheckRestrictedCtx: PROC[hti: HTIndex, ctx: IncludedCTXIndex]
            RETURNS [sei: ISEIndex] = {

            TestId: Tree.Test = {
                WITH t SELECT GetTag[t] FROM
                    hash => IF index = hti THEN sei _ dataPtr.seAnon;
                    symbol => IF seb[index].hash = hti THEN sei _ index;
                    ENDCASE;
                RETURN[sei # ISENull]};

            i: CARDINAL _ CtxHash[ctx];
            DO
                IF ctxIdTable[i].ctx = ctx THEN {
                    sei _ ISENull;  SearchList[ctxIdTable[i].list, TestId];
                    IF sei # ISENull OR ~ctxIdTable[i].linked THEN EXIT};
                IF (i _ i+1) = ctxIdTable.length THEN i _ 0;
                ENDLOOP;
            IF sei # ISENull AND seb[sei].idCtx = CTXNull THEN seb[sei].idCtx _ ctx;
            RETURN};

        SearchRestrictedCtx: PROC[hti: HTIndex, ctx: IncludedCTXIndex]
            RETURNS [sei: ISEIndex] = {
            sei _ CheckRestrictedCtx[hti, ctx];
            IF sei # ISENull AND sei # dataPtr.seAnon AND seb[sei].idCtx # ctx THEN {
                [ , sei] _ Copier.SearchFileCtx[hti, ctx];
                seb[sei].public _ TRUE};    -- second copy, access already checked
            RETURN};


        CheckDirectoryIds: Tree.Scan = {

            CheckId: Tree.Scan = {
                WITH t SELECT GetTag[t] FROM
                    symbol => IF seb[index].idCtx = CTXNull THEN Log.WarningSei[unusedId, index];
                    ENDCASE};

            node: Tree.Index = GetNode[t];
            saveIndex: SourceMap.Loc = dataPtr.textIndex;
            dataPtr.textIndex _ ToLoc[tb[node].info];
            ScanList[tb[node].son[3], CheckId];
            dataPtr.textIndex _ saveIndex};



        CheckDisjoint: PUBLIC PROC[ctx1, ctx2: CTXIndex] = {
            hti: HTIndex;
            saveIndex: SourceMap.Loc = dataPtr.textIndex;
            IF ctx1 # CTXNull AND ctx2 # CTXNull THEN
                FOR sei: ISEIndex _ FirstCtxSe[ctx2], NextSe[sei] UNTIL sei = ISENull DO
                    hti _ seb[sei].hash;
                    IF hti # HTNull AND SearchContext[hti, ctx1] # ISENull THEN {
                        IF ~seb[sei].mark3 THEN
                            dataPtr.textIndex _ ToLoc[tb[DecodeTreeIndex[seb[sei].idValue]].info];
                        Log.ErrorHti[duplicateId, hti]};
                    ENDLOOP;
            dataPtr.textIndex _ saveIndex};


    <<basing management>>

        OpenedType: PROC[type: Type] RETURNS[CSEIndex] = {
            subType: CSEIndex = NormalType[type];
            RETURN[UnderType[WITH t: seb[subType] SELECT FROM
                ref => t.refType,
                ENDCASE => type]]
            };

        OpenPointer: PUBLIC PROC[t: Tree.Link, type: Type] RETURNS [Tree.Link, CSEIndex] = {
            nType, rType: CSEIndex;
            nDerefs: CARDINAL _ 0;
            DO
                nType _ NormalType[type];
                WITH p: seb[nType] SELECT FROM
                    ref => {
                        rType _ UnderType[p.refType];
                        IF P3S.safety = checked AND ~(p.counted OR PermanentType[p.refType]) THEN 
                            Log.ErrorTreeOp[unsafeOp, t, uparrow];
                        IF seb[NormalType[rType]].typeTag # ref THEN EXIT;
                        IF (nDerefs _ nDerefs+1) > 63 THEN EXIT};
                    ENDCASE;
                [t, type] _ DeRef[t, type];
                ENDLOOP;
            RETURN[t, rType]};

        BaseTree: PUBLIC PROC[t: Tree.Link, type: Type] RETURNS[val: Tree.Link] = {
            PushTree[t];  PushNode[openx, 1];  SetType[type];  SetAttr[1, FALSE];
            val _ PopTree[];  MarkShared[val, TRUE];  RETURN};

        OpenBase: PUBLIC PROC[t: Tree.Link, hti: HTIndex] RETURNS[v: Tree.Link] = {
            type, vType: Type;
            nType: CSEIndex;

            OpenRecord: PROC[indirect: BOOL] = {
                sei: CSEIndex = UnderType[type];
                WITH seb[sei] SELECT FROM
                    record => {
                        v _ BaseTree[v, vType];
                        IF hti # HTNull THEN PushHtCtx[hti, v, indirect]
                        ELSE PushRecordCtx[LOOPHOLE[sei, RecordSEIndex], v, indirect]};
                    ENDCASE => IF sei # typeANY THEN Log.ErrorTree[typeClash, v]
                };

            v _ Exp[t, typeANY];
            type _ vType _ RType[];  nType _ NormalType[vType];  RPop[];
            SELECT TypeForm[nType] FROM
                $definition, $transfer => {
                    ctx: CTXIndex = InterfaceCtx[nType, v];
                    IF ctx = CTXNull THEN OpenRecord[FALSE]
                    ELSE IF hti # HTNull THEN PushHtCtx[hti, v, FALSE]
                    ELSE PushCtx[ctx]};
                $ref => {
                    [v, type] _ OpenPointer[v, vType];  vType _ OperandType[v];
                    OpenRecord[TRUE]};
                ENDCASE => OpenRecord[FALSE];
            RETURN};


        CloseBase: PUBLIC PROC[t: Tree.Link, hti: HTIndex] = {
            type: Type;

            CloseRecord: PROC = {IF TypeForm[type] = $record THEN PopCtx[]};

            type _ NormalType[OperandType[t]];
            SELECT TypeForm[type] FROM
                $definition => PopCtx[];
                $ref => {type _ ReferentType[type]; CloseRecord[]};
                ENDCASE => CloseRecord[]
            };


    <<initialization/finalization>>

        IdInit: PUBLIC PROC = {
            (dataPtr.table).AddNotify[IdNotify];
            refStack _ NEW[RefSequence[16]];
            refIndex _ 0;
            ctxStack _ NEW[ContextSequence[2*ContextIncr]];
            ctxIndex _ -1};

        IdReset: PUBLIC Tree.Scan = {
            ScanList[t, CheckDirectoryIds];
            ctxIdTable _ NIL;
            ctxStack _ NIL;
            refStack _ NIL;
            (dataPtr.table).DropNotify[IdNotify]};

        }.

