
    <<Pass3Xb.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, April 14, 1986 5:10:09 pm PST>>
        <<Donahue,  9-Dec-81 15:32:12>>
        <<Paul Rovner,  September 6, 1983 10:59 pm>>
        <<Russ Atkinson (RRA) March 6, 1985 10:46:55 pm PST>>

    DIRECTORY
        A3: TYPE USING [BaseType, Bundling, CanonicalType, IdentifiedType, IndexType, MarkedType, NewableType, NullableType, OperandInline, 
        OrderedType, PermanentType, TargetType, TypeForTree, Unbundle],
        Alloc: TYPE USING [Notifier],
        ComData: TYPE USING [idATOM, idBOOL, idCARDINAL, idCHAR, idINT, idREAL, idSTRING, idTEXT, interface, ownSymbols, typeAtomRecord, 
        typeCHAR, typeINT],
        LiteralOps: TYPE USING [FindHeapString],
        Log: TYPE USING [Error, ErrorHti, ErrorN, ErrorNode, ErrorNodeOp, ErrorSei, ErrorTree, ErrorTreeOp, ErrorType, Warning],
        P3: TYPE USING [Attr, emptyAttr, fullAttr, voidAttr, NarrowOp, NPUse, BoundNP, MergeNP, SequenceNP, TextForm, phraseNP, AddrOp, 
        All, And, Apply, Assignment, Case, CatchPhrase, ClearRefStack, Cons, Discrimination, Dot, EnterType, Extract, Id, ListCons, 
        MakeLongType, MakeRefType, MiscXfer, Narrowing, New, Range, RecordMention, SealRefStack, SearchCtxList, TextRep, TypeAppl, 
        TypeExp, UnsealRefStack],
        P3S: TYPE USING [ImplicitInfo, implicitRecord, safety, self],
        SymLiteralOps: TYPE USING [EnterAtom, EnterText],
        Symbols: TYPE USING [Base, HTIndex, Type, ISEIndex, CSEIndex, RecordSEIndex, nullType, CSENull, RecordSENull, codeANY, codeCHAR, 
        codeINT, typeANY, ctxType, seType],
        SymbolOps: TYPE USING [ConstantId, EqTypes, NormalType, RCType, TypeForm, TypeRoot, UnderType],
        Tree: TYPE USING [Base, Index, Link, Map, NodeName, Null, NullIndex, treeType],
        TreeOps: TYPE USING [FreeNode, GetHash, GetNode, ListLength, PopTree, PushTree, PushNode, SetAttr, SetInfo, UpdateList],
        Types: TYPE USING [SymbolTableBase, Assignable, Equivalent];

    Pass3Xb: PROGRAM
        IMPORTS
            A3, LiteralOps, Log, P3, P3S, SymLiteralOps, 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)

        own: Types.SymbolTableBase;

        ExpBNotify: PUBLIC Alloc.Notifier = {
            <<called by allocator whenever table area is repacked>>
            seb _ base[seType];  ctxb _ base[ctxType];
            tb _ base[Tree.treeType]};


    <<intermediate result bookkeeping>>

        OperandDescriptor: TYPE = RECORD[
            type: Type,        -- type of operand
            attr: Attr];        -- attributes

        RStack: TYPE = RECORD [SEQUENCE length: NAT OF OperandDescriptor];
        rStack: REF RStack _ NIL;
        rI: INTEGER;            -- index into rStack

        RPush: PUBLIC PROC[type: Type, attr: Attr] = {
            rI _ rI + 1;
            WHILE rI >= rStack.length DO
                newLength: NAT = rStack.length + 16;
                newStack: REF RStack = NEW[RStack[newLength]];
                FOR i: INTEGER IN [0 .. rI) DO newStack[i] _ rStack[i] ENDLOOP;
                rStack _ newStack;
                ENDLOOP;
            rStack[rI] _ [type:type, attr:attr]};

        RPop: PUBLIC PROC = {IF rI < 0 THEN ERROR; rI _ rI-1};

        RType: PUBLIC PROC RETURNS[Type] = {RETURN[rStack[rI].type]};

        RAttr: PUBLIC PROC RETURNS[Attr] = {RETURN[rStack[rI].attr]};

        UType: PUBLIC PROC RETURNS[CSEIndex] = {RETURN[UnderType[rStack[rI].type]]};

        longUnsigned: Type;    -- a hint for mwconst

        textType: ARRAY TextForm OF Type;        -- a hint for text literals

        ExpInit: PUBLIC PROC = {
            implicit _ [type: typeANY, tree: Tree.Null, attr: emptyAttr];
            P3S.implicitRecord _ RecordSENull;
            own _ dataPtr.ownSymbols;    -- make a parameter?
            longUnsigned _ nullType;  textType _ ALL[nullType];
            rStack _ NEW[RStack[32]];
            rI _ -1};

        ExpReset: PUBLIC PROC = {
            IF rStack # NIL THEN rStack _ NIL};


    <<type manipulation>>

        EqualTypes: PROC[type1, type2: Type] RETURNS[BOOL] = {
            RETURN[Types.Equivalent[[own, UnderType[type1]], [own, UnderType[type2]]]]};


        UnresolvedTypes: SIGNAL RETURNS[Type] = CODE;

        BalanceTypes: PROC[type1, type2: Type] RETURNS[type: Type] = {
            sei1: CSEIndex _ UnderType[type1];
            sei2: CSEIndex _ UnderType[type2];
            SELECT TRUE FROM
                (sei1 = sei2), (sei2 = typeANY) => type _ type1;
                (sei1 = typeANY) => type _ type2;
                ENDCASE => {
                    n1: CARDINAL _ Bundling[sei1];
                    n2: CARDINAL _ Bundling[sei2];
                    WHILE n1 > n2 DO
                        type1 _ Unbundle[LOOPHOLE[sei1]]; sei1 _ UnderType[type1]; n1 _ n1-1
                        ENDLOOP;
                    WHILE n2 > n1 DO
                        type2 _ Unbundle[LOOPHOLE[sei2]]; sei2 _ UnderType[type1]; n2 _ n2-1
                        ENDLOOP;
                    <<check bundling>>
                    DO
                        type1 _ TargetType[type1];  sei1 _ UnderType[type1];
                        type2 _ TargetType[type2];  sei2 _ UnderType[type2];
                        SELECT TRUE FROM
                            Types.Assignable[[own, sei1], [own, sei2]] => {type _ type1; EXIT};
                            Types.Assignable[[own, sei2], [own, sei1]] => {type _ type2; EXIT};
                            ENDCASE;
                        IF n1 = 0 THEN GO TO Fail;
                        n1 _ n1-1;
                        type1 _ Unbundle[LOOPHOLE[sei1]];
                        type2 _ Unbundle[LOOPHOLE[sei2]];
                        REPEAT
                            Fail => type _ SIGNAL UnresolvedTypes;
                        ENDLOOP};
            RETURN};

        ForceType: PUBLIC PROC[t: Tree.Link, type: Type] RETURNS[Tree.Link] = {
            PushTree[t];
            IF t = Tree.Null THEN PushNode[cast, 1]
            ELSE WITH t SELECT FROM
                subtree =>
                    SELECT tb[index].name FROM
                        construct, union, rowcons => PushNode[cast, 1];
                        openx => PushNode[cast, 1];
                        ENDCASE;
                ENDCASE => PushNode[cast, 1];
            SetInfo[type];  RETURN[PopTree[]]};


    <<operators>>

        UpArrow: PUBLIC PROC[node: Tree.Index] = {
            type: Type;
            attr: Attr;
            tb[node].son[1] _ Exp[tb[node].son[1], typeANY];
            type _ RType[];  attr _ RAttr[];  RPop[];  attr.const _ FALSE;
            DO
                nType: CSEIndex = NormalType[type];
                WITH t: seb[nType] SELECT FROM
                    ref => {
                        RPush[t.refType, attr];
                        tb[node].attr2 _ (TypeForm[type] = $long);
                        IF P3S.safety = checked AND ~(t.counted OR PermanentType[t.refType]) THEN
                            Log.ErrorNodeOp[unsafeOp, node, uparrow];
                        EXIT};
                    record => {
                        IF Bundling[nType] = 0 THEN GO TO fail;
                        type _ Unbundle[LOOPHOLE[nType, RecordSEIndex]]};
                    ENDCASE => GO TO fail;
                REPEAT
                    fail => {
                        IF type # typeANY THEN Log.ErrorTreeOp[missingOp, tb[node].son[1], uparrow];
                        RPush[typeANY, attr]};
                ENDLOOP
            };


    <<arithmetic expression manipulation>>

        MakeNumeric: PROC[type: Type] RETURNS[Type] = {
            RETURN[SELECT TypeForm[type] FROM
                long => MakeLongType[dataPtr.idINT, type],
                ENDCASE => dataPtr.idINT]
            };

        EvalNumeric: PROC[t: Tree.Link, op: Tree.NodeName_$none] RETURNS[val: Tree.Link] = {
            val _ GenericRhs[t, dataPtr.idINT];
            SELECT NormalType[rStack[rI].type] FROM
                dataPtr.typeINT => NULL;
                typeANY => rStack[rI].type _ MakeNumeric[rStack[rI].type];
                ENDCASE =>
                    IF op # $none THEN Log.ErrorTreeOp[missingOp, val, op]
                    ELSE Log.ErrorTree[typeClash, val];
            RETURN};

        ArithOp: PROC[node: Tree.Index] = {
            OPEN tb[node];
            saveNP: NPUse;
            son[1] _ EvalNumeric[son[1], tb[node].name];  saveNP _ phraseNP;
            son[2] _ EvalNumeric[son[2]]; 
            BalanceAttributes[node];
            rStack[rI-1].attr _ And[rStack[rI-1].attr, rStack[rI].attr];
            IF attr1 THEN rStack[rI-1].attr.const _ FALSE;
            RPop[];  phraseNP _ MergeNP[saveNP][phraseNP]};


        ArithType: PROC[type: Type] RETURNS[CSEIndex] = {
            sei: CSEIndex = NormalType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                relative => NormalType[t.offsetType],
                ENDCASE => sei]
            };

        Plus: PROC[node: Tree.Index] = {
            OPEN tb[node];
            type: CSEIndex;
            lr: BOOL;
            saveNP: NPUse;
            son[1] _ GenericRhs[son[1], typeANY];  saveNP _ phraseNP;
            type _ ArithType[rStack[rI].type];
            IF seb[type].typeTag = ref OR type = dataPtr.typeCHAR THEN {
                IF RCType[type] # none THEN Log.ErrorTreeOp[missingOp, son[1], plus];
                lr _ TRUE; son[2] _ EvalNumeric[son[2]]}
            ELSE {
                SELECT type FROM
                    dataPtr.typeINT, typeANY => NULL;
                    ENDCASE => Log.ErrorTreeOp[missingOp, son[1], plus];
                son[2] _ GenericRhs[son[2], typeANY];
                lr _ FALSE;  type _ ArithType[rStack[rI].type];
                SELECT TRUE FROM
                    type = dataPtr.typeINT, type = dataPtr.typeCHAR => NULL;
                    seb[type].typeTag = ref =>
                        IF RCType[type] # none THEN Log.ErrorTree[typeClash, son[2]];
                    ENDCASE => {
                        IF type # typeANY THEN Log.ErrorTree[typeClash, son[2]];
                        rStack[rI].type _ MakeNumeric[rStack[rI].type]}};
            <<IF P3S.safety = checked AND seb[type].typeTag = ref THEN>>
                <<Log.ErrorNodeOp[unsafeOp, node, plus];>>
            BalanceAttributes[node];
            rStack[rI-1].attr _ And[rStack[rI-1].attr, rStack[rI].attr];
            IF attr1 THEN rStack[rI-1].attr.const _ FALSE;
            IF ~lr THEN rStack[rI-1].type _ rStack[rI].type;
            RPop[];  phraseNP _ MergeNP[saveNP][phraseNP]};

        Minus: PROC[node: Tree.Index] = {
            OPEN tb[node];
            type, lType, rType: CSEIndex;
            lr: BOOL;
            saveNP: NPUse;
            son[1] _ GenericRhs[son[1], typeANY];  saveNP _ phraseNP;
            type _ NormalType[rStack[rI].type]; lType _ ArithType[type];  lr _ TRUE;
            IF seb[lType].typeTag = ref OR lType = dataPtr.typeCHAR THEN {
                IF RCType[lType] # none THEN Log.ErrorTreeOp[missingOp, son[1], minus];
                son[2] _ GenericRhs[son[2], typeANY];  rType _ ArithType[rStack[rI].type];
                SELECT TRUE FROM
                    rType = typeANY => NULL;
                    Types.Equivalent[[own, lType], [own, rType]] => lr _ FALSE;
                    rType = dataPtr.typeINT => NULL;
                    ENDCASE => Log.ErrorTree[typeClash, son[2]]}
            ELSE {
                SELECT type FROM
                    dataPtr.typeINT, typeANY => NULL;
                    ENDCASE => {
                        Log.ErrorTreeOp[missingOp, son[1], minus]; rStack[rI].type _ typeANY};
                son[2] _ EvalNumeric[son[2]]};
            <<IF P3S.safety = checked AND seb[lType].typeTag = ref THEN>>
                <<Log.ErrorNodeOp[unsafeOp, node, minus];>>
            BalanceAttributes[node];
            rStack[rI-1].attr _ And[rStack[rI-1].attr, rStack[rI].attr];
            IF attr1 THEN rStack[rI-1].attr.const _ FALSE;
            IF ~lr THEN rStack[rI-1].type _
                IF attr2 THEN MakeLongType[dataPtr.typeINT, rStack[rI].type] ELSE dataPtr.typeINT;
            RPop[];  phraseNP _ MergeNP[saveNP][phraseNP]};

        UnaryOp: PROC[node: Tree.Index] = {
            IF UniOperand[node] THEN {
                tb[node].son[1] _ EvalNumeric[tb[node].son[1], tb[node].name];  SetAttributes[node];
                IF tb[node].attr1 THEN rStack[rI].attr.const _ FALSE}
            };

        EnumOp: PROC[node: Tree.Index, target: Type] = {
            IF UniOperand[node] THEN {
                tb[node].son[1] _ GenericRhs[tb[node].son[1], target];  SetAttributes[node];
                IF ~IndexType[RType[]] THEN
                    Log.ErrorTreeOp[missingOp, tb[node].son[1], tb[node].name]}
            };

        RelOp: PROC[node: Tree.Index, ordered: BOOL] = {
            OPEN tb[node];
            type, target: Type;
            attr: Attr;
            saveNP: NPUse;
            implicitOp: BOOL;
            son[1] _ GenericRhs[son[1], typeANY];  saveNP _ phraseNP; 
            type _ RType[];  target _ BaseType[type];  attr _ RAttr[];
            implicitOp _ (son[1] = Tree.Null);
            son[2] _ GenericRhs[son[2], target];
            type _ BalanceTypes[target, BaseType[RType[]]
                ! UnresolvedTypes => {
                    Log.ErrorType[typeClash, son[2], [dataPtr.ownSymbols, type]];
                    RESUME[typeANY]}];
            IF (ordered AND ~OrderedType[type]) OR (~ordered AND ~IdentifiedType[type]) THEN
                Log.ErrorTreeOp[missingOp, son[1], name];
            BalanceAttributes[node];
            attr _ And[attr, RAttr[]];
            IF implicitOp AND son[1] # Tree.Null THEN Log.ErrorTree[typeClash, son[2]];
            SELECT TypeForm[type] FROM
                $basic, $enumerated => NULL;
                $transfer => {
                    IF OperandInline[son[1]] THEN Log.ErrorTree[misusedInline, son[1]];
                    IF OperandInline[son[2]] THEN Log.ErrorTree[misusedInline, son[2]];
                    attr.const _ FALSE};
                $real => attr.const _ FALSE;
                ENDCASE;
            RPop[];  RPop[];
            RPush[dataPtr.idBOOL, attr];  phraseNP _ MergeNP[saveNP][phraseNP]};

        In: PROC[node: Tree.Index] = {
            OPEN tb[node];
            type: Type;
            saveNP: NPUse;
            son[1] _ GenericRhs[son[1], typeANY];  saveNP _ phraseNP;
            type _ RType[];
            son[2] _ Range[son[2], CanonicalType[type]];
            [] _ BalanceTypes[BaseType[type], BaseType[RType[]]
                ! UnresolvedTypes => {
                    Log.ErrorType[typeClash, tb[node].son[1], [dataPtr.ownSymbols, RType[]]];
                    RESUME[typeANY]}];
            BalanceAttributes[node];
            rStack[rI-1].attr _ And[rStack[rI-1].attr, rStack[rI].attr];  RPop[];
            rStack[rI].type _ dataPtr.idBOOL;
            phraseNP _ MergeNP[saveNP][phraseNP]};

        BoolOp: PROC[node: Tree.Index] = {
            OPEN tb[node];
            attr: Attr;
            saveNP: NPUse;
            SealRefStack[];
            son[1] _ Rhs[son[1], dataPtr.idBOOL]; attr _ RAttr[]; saveNP _ phraseNP; 
            ClearRefStack[];
            son[2] _ Rhs[son[2], dataPtr.idBOOL]; 
            UnsealRefStack[];
            attr _ And[attr, RAttr[]];
            RPop[];  RPop[];
            RPush[dataPtr.idBOOL, attr]; phraseNP _ SequenceNP[saveNP][phraseNP]};


        Interval: PUBLIC PROC[t: Tree.Link, target: Type, constant: BOOL] = {
            node: Tree.Index = GetNode[t];
            type: Type;
            attr: Attr;
            saveNP: NPUse;
            target _ TargetType[target];
            tb[node].son[1] _ BalancedRhs[tb[node].son[1], target];  saveNP _ phraseNP;
            type _ rStack[rI].type _ CanonicalType[rStack[rI].type];  attr _ RAttr[];
            IF constant AND ~attr.const THEN Log.ErrorTree[nonConstant, tb[node].son[1]];
            tb[node].son[2] _ BalancedRhs[tb[node].son[2], target];  
            rStack[rI].type _ CanonicalType[rStack[rI].type];
            [] _ BalanceTypes[BaseType[type], BaseType[RType[]]
                ! UnresolvedTypes => {Log.ErrorTree[typeClash, tb[node].son[2]]; RESUME[typeANY]}];
            attr _ And[attr, RAttr[]];
            IF constant AND ~RAttr[].const THEN Log.ErrorTree[nonConstant, tb[node].son[2]];
            BalanceAttributes[node];
            IF tb[node].attr1 THEN attr.const _ FALSE;
            phraseNP _ MergeNP[saveNP][phraseNP];
            RPop[]; rStack[rI].attr _ attr};


        BalancedTarget: PROC[target, type: Type] RETURNS[Type] = {
            RETURN[IF target = typeANY
            OR (~EqualTypes[type, target] AND EqTypes[NormalType[type], target])
                THEN TargetType[type]
                ELSE target]
            };

        ResolveTypes: PROC[type1, type2, target: Type, t: Tree.Link] RETURNS[type: Type] = {
            failed: BOOL;
            IF target = typeANY THEN failed _ TRUE
            ELSE {
                ENABLE UnresolvedTypes => {failed _ TRUE; RESUME[typeANY]};
                failed _ FALSE;
                type _ BalanceTypes[BalanceTypes[target, type1], BalanceTypes[target, type2]]};
            IF failed THEN {
                Log.ErrorType[
                    typeClash, t, [dataPtr.ownSymbols, CanonicalType[type1]]];
                type _ typeANY};
            RETURN};

        IfExp: PROC[node: Tree.Index, target: Type] = {
            OPEN tb[node];
            type: Type;
            attr: Attr;
            entryNP, saveNP: NPUse;
            SealRefStack[];
            son[1] _ Rhs[son[1], dataPtr.idBOOL]; 
            attr _ RAttr[];  RPop[];  entryNP _ phraseNP;
            UnsealRefStack[];
            son[2] _ BalancedRhs[son[2], target];
            attr _ And[attr, RAttr[]]; saveNP _ SequenceNP[entryNP][phraseNP];
            type _ RType[];  RPop[];
            target _ BalancedTarget[target, type];
            son[3] _ BalancedRhs[son[3], target];  attr _ And[attr, RAttr[]];
            type _ BalanceTypes[type, RType[]
                ! UnresolvedTypes => {RESUME[ResolveTypes[type, RType[], target, son[3]]]}];
            IF TypeForm[type] = $transfer THEN {
                IF OperandInline[son[2]] THEN Log.ErrorTree[misusedInline, son[2]];
                IF OperandInline[son[3]] THEN Log.ErrorTree[misusedInline, son[3]];
                attr.const _ FALSE};
            phraseNP _ BoundNP[saveNP][SequenceNP[entryNP][phraseNP]];
            RPop[];  RPush[type, attr]};

        SelectExp: PROC[
              node: Tree.Index, target: Type, driver: PROC[Tree.Index, Tree.Map], foldable: BOOL] = {
            type: Type;
            attr: Attr;
            saveNP: NPUse;
            started: BOOL;

            Selection: Tree.Map = {
                subType: Type;
                entryNP: NPUse = phraseNP;
                v _ BalancedRhs[t, target];
                subType _ BalanceTypes[type, RType[]
                    ! UnresolvedTypes => {RESUME[ResolveTypes[type, RType[], target, v]]}];
                IF TypeForm[subType] = $transfer AND OperandInline[v] THEN
                    Log.ErrorTree[misusedInline, v];
                saveNP _ BoundNP[saveNP][SequenceNP[entryNP][phraseNP]];
                IF subType # typeANY THEN type _ subType;
                IF ~started THEN target _ BalancedTarget[target, type];
                attr _ And[attr, RAttr[]];  RPop[];  started _ TRUE;  RETURN};

            type _ typeANY;  attr _ fullAttr;  started _ FALSE;  saveNP _ none;
            driver[node, Selection];  attr _ And[attr, RAttr[]];  RPop[];
            attr.const _ foldable AND attr.const AND tb[node].attr2;
            RPush[type, attr];  phraseNP _ saveNP};


        MinMax: PROC[node: Tree.Index, target: Type] = {
            OPEN tb[node];
            attr: Attr;
            saveNP: NPUse;
            started: BOOL;
            type: Type;

            SubMinMax: Tree.Map = {
                subType: Type;
                v _ BalancedRhs[t, target];
                attr _ And[attr, RAttr[]];  saveNP _ MergeNP[saveNP][phraseNP];
                subType _ BalanceTypes[CanonicalType[RType[]], type 
                    ! UnresolvedTypes => {RESUME[ResolveTypes[subType, type, target, v]]}];
                IF subType # typeANY THEN {
                    IF ~started THEN {
                        IF ~OrderedType[subType] THEN Log.ErrorTreeOp[missingOp, v, name];
                        target _ BalancedTarget[target, subType];  started _ TRUE}
                    ELSE IF ~EqTypes[type, subType] THEN
                        IF ~OrderedType[subType] THEN Log.ErrorTree[typeClash, v];
                    type _ subType};
                RPop[];  RETURN};

            attr _ fullAttr;  saveNP _ none;  started _ FALSE;  type _ typeANY;
            son[1] _ UpdateList[son[1], SubMinMax];
            SELECT TypeForm[type] FROM
                long => {attr1 _ FALSE; attr2 _ TRUE};
                real => {attr1 _ TRUE; attr2 _ FALSE; attr.const _ FALSE};
                ENDCASE => attr1 _ attr2 _ FALSE;
            RPush[type, attr];  phraseNP _ saveNP};


        TypeTest: PROC[node: Tree.Index, from, to: Type] = {
            subType: Type = CanonicalType[from];
            op: NarrowOp = Narrowing[type: subType, target: to];
            SELECT TRUE FROM
                op.error => Log.ErrorTree[typeClash, tb[node].son[1]];
                op.computed => Log.ErrorTree[missingBinding, tb[node].son[1]];
                op.unImpl => Log.Warning[opaqueTest];
                ENDCASE;
            IF ~EqTypes[subType, from] THEN tb[node].son[1] _ ForceType[tb[node].son[1], subType];
            tb[node].attr1 _ op.indirect;
            IF (tb[node].attr2 _ op.rtTest) THEN EnterType[MarkedType[to]];
            tb[node].attr3 _ op.tagTest};


        EndPoint: PROC[node: Tree.Index] = {
            OPEN tb[node];
            type: CSEIndex;
            son[1] _ TypeExp[son[1]];
            type _ UnderType[TypeForTree[son[1]]];
                BEGIN
                WITH seb[type] SELECT FROM
                    basic =>
                        SELECT code FROM
                            codeINT, codeCHAR => NULL;
                            ENDCASE => GO TO fail;
                    enumerated => NULL;
                    relative => IF TypeForm[offsetType] # $subrange THEN GO TO fail;
                    subrange => NULL;
                    long => IF NormalType[rangeType] # dataPtr.typeINT THEN GO TO fail;
                    ENDCASE => GO TO fail;
                EXITS
                    fail => Log.ErrorTreeOp[missingAttr, son[1], name];
                END;
            RPush[type, fullAttr]};


        Unspec: PROC[type: Type] RETURNS[BOOL] = {
            sei: CSEIndex = UnderType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                basic => t.code = codeANY,
                ENDCASE => FALSE]
            };

        SafeForUnspec: PROC[target: Type] RETURNS[BOOL] = {
            RETURN[P3S.safety # checked OR RCType[target] = none]};


        Rhs: PUBLIC PROC[exp: Tree.Link, lhsType: Type] RETURNS[val: Tree.Link] = {
            rhsType: Type;
            lhsSei, rhsSei: CSEIndex;
            val _ Exp[exp, lhsType];  rhsType _ rStack[rI].type;
            lhsSei _ UnderType[lhsType];  rhsSei _ UnderType[rhsType];
            SELECT TRUE FROM
                (lhsSei = rhsSei), Unspec[lhsType] => NULL;
                ENDCASE => {  -- immediate matching is inconclusive
                    UNTIL Types.Assignable[[own, lhsSei], [own, rhsSei]] DO
                        WITH t: seb[rhsSei] SELECT FROM
                            subrange => rhsType _ UnderType[t.rangeType];
                            record => {
                                IF Bundling[rhsSei] = 0 THEN GO TO nomatch;
                                rhsType _ Unbundle[LOOPHOLE[rhsSei, RecordSEIndex]];
                                val _ ForceType[val, IF Unspec[rhsType] THEN typeANY ELSE rhsType]};
                            ref, arraydesc => {
                                SELECT TypeForm[lhsSei] FROM
                                    $long => {
                                        IF ~Types.Assignable[[own, NormalType[lhsSei]], [own, rhsSei]] THEN
                                            GO TO nomatch;
                                        val _ Lengthen[val, MakeLongType[rhsType, lhsType]]};
                                    ENDCASE => GO TO nomatch;
                                rhsType _ lhsType};
                            basic => {
                                IF Unspec[rhsSei] AND SafeForUnspec[lhsSei] THEN
                                    SELECT TypeForm[lhsSei] FROM
                                        $long => val _ Lengthen[val, MakeLongType[typeANY, lhsType]];
                                        ENDCASE
                                ELSE SELECT TypeForm[lhsSei] FROM
                                    $long => {
                                        IF ~Types.Assignable[[own, NormalType[lhsSei]], [own, rhsSei]] THEN
                                            GO TO nomatch;
                                        val _ Lengthen[val, lhsType]};
                                    $real =>
                                        IF rhsSei = dataPtr.typeINT THEN {
                                            val _ Float[val, rhsType, lhsType]; rStack[rI].attr.const _ FALSE} 
                                        ELSE GO TO nomatch;
                                    ENDCASE => GO TO nomatch;
                                rhsType _ lhsType};
                            long => {
                                subType: CSEIndex = NormalType[rhsSei];
                                SELECT TypeForm[lhsSei] FROM
                                    $long =>
                                        SELECT TRUE FROM
                                            Unspec[NormalType[lhsSei]] => {
                                                lhsType _ rhsType;  lhsSei _ UnderType[lhsType]};
                                            Unspec[subType] AND SafeForUnspec[lhsSei] =>
                                                rhsType _ lhsType;
                                            ENDCASE => GO TO nomatch;
                                    $real =>
                                        IF subType = dataPtr.typeINT THEN {
                                            val _ Float[val, rhsType, lhsType];  rStack[rI].attr.const _ FALSE;
                                            rhsType _ lhsType} 
                                        ELSE GO TO nomatch;
                                    $basic, $subrange => {
                                        IF ~Types.Assignable[[own, subType], [own, lhsSei]] THEN
                                            GO TO nomatch;
                                        rhsType _ UnderType[t.rangeType]; val _ Shorten[val, rhsType]};
                                    ENDCASE => GO TO nomatch};
                            ENDCASE => GO TO nomatch;
                        rhsSei _ UnderType[rhsType];
                        REPEAT
                            nomatch => {    -- no coercion is possible
                                Log.ErrorType[typeClash,
                                    IF exp = Tree.Null THEN implicit.tree ELSE val,
                                    [dataPtr.ownSymbols, lhsType]];
                                rhsType _ lhsType};
                        ENDLOOP;
                    rStack[rI].type _ rhsType};
            IF TypeForm[rhsType] = $transfer AND OperandInline[val] THEN
                Log.ErrorTree[misusedInline, val];
            RETURN};


        GenericRhs: PROC[exp: Tree.Link, target: Type] RETURNS[val: Tree.Link] = {
            type: Type;
            val _ Exp[exp, target];  type _ rStack[rI].type;
            <<put value in canonical form>>
            DO
                sei: CSEIndex = UnderType[type];
                WITH t: seb[sei] SELECT FROM
                    subrange => type _ t.rangeType;
                    record => {
                        IF Bundling[sei] = 0 THEN EXIT;
                        type _ Unbundle[LOOPHOLE[sei, RecordSEIndex]];
                        val _ ForceType[val, type]};
                    ENDCASE => EXIT;
                rStack[rI].type _ type;
                ENDLOOP;
            RETURN};

        BalancedRhs: PROC[exp: Tree.Link, target: Type] RETURNS[val: Tree.Link] = {
            type: Type;
            val _ Exp[exp, target];
            SELECT TypeForm[target] FROM
                $long, $real => {
                    type _ CanonicalType[rStack[rI].type];
                    IF type # typeANY AND TypeForm[target] # TypeForm[type]
                        AND EqualTypes[NormalType[target], type] THEN {
                            SELECT TypeForm[target] FROM
                                $long =>
                                    IF TypeForm[type] # $real THEN
                                        val _ Lengthen[val, MakeLongType[type, target]];
                                real => {val _ Float[val, type, target]; rStack[rI].attr.const _ FALSE};
                                ENDCASE;
                            rStack[rI].type _ target}};
                ENDCASE;
            RETURN};


        AttrClass: PROC[type: Type] RETURNS[{short, long, real}] = {
            sei: CSEIndex = UnderType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                long => $long,
                real => $real,
                relative => AttrClass[UnderType[t.offsetType]],
                ENDCASE => $short]
            };

        SetAttributes: PROC[node: Tree.Index] = {
            SELECT AttrClass[rStack[rI].type] FROM
                $long => {tb[node].attr1 _ FALSE; tb[node].attr2 _ TRUE};
                $real => {tb[node].attr1 _ TRUE; tb[node].attr2 _ FALSE};
                ENDCASE => tb[node].attr1 _ tb[node].attr2 _ FALSE
            };

        BalanceAttributes: PROC[node: Tree.Index] = {
            lType, rType: Type;
            lType _ rStack[rI-1].type;  rType _ rStack[rI].type;
            SELECT AttrClass[lType] FROM
                $long => {
                    SELECT AttrClass[rType] FROM
                        $long => {tb[node].attr1 _ FALSE; tb[node].attr2 _ TRUE};
                        $real => {
                            rStack[rI-1].type _ rType;
                            tb[node].son[1] _ Float[tb[node].son[1], lType, rType];
                            rStack[rI-1].attr.const _ FALSE;
                            tb[node].attr1 _ TRUE;  tb[node].attr2 _ FALSE};
                        ENDCASE => {
                            rStack[rI].type _ rType _ MakeLongType[rType, lType];
                            tb[node].son[2] _ Lengthen[tb[node].son[2], rType];
                            tb[node].attr1 _ FALSE;  tb[node].attr2 _ TRUE}};
                $real => {
                    tb[node].attr1 _ TRUE;  tb[node].attr2 _ FALSE;
                    SELECT AttrClass[rType] FROM
                        $real => NULL;
                        ENDCASE => {
                            rStack[rI].type _ lType;
                            tb[node].son[2] _ Float[tb[node].son[2], rType, lType];
                            rStack[rI].attr.const _ FALSE}};
                ENDCASE =>
                    SELECT AttrClass[rType] FROM
                        $long => {
                            rStack[rI-1].type _ lType _ MakeLongType[lType, rType];
                            tb[node].son[1] _ Lengthen[tb[node].son[1], lType];
                            tb[node].attr1 _ FALSE;  tb[node].attr2 _ TRUE};
                        $real => {
                            rStack[rI-1].type _ rType;
                            tb[node].son[1] _ Float[tb[node].son[1], lType, rType];
                            rStack[rI-1].attr.const _ FALSE;
                            tb[node].attr1 _ TRUE;  tb[node].attr2 _ FALSE};
                        ENDCASE => tb[node].attr1 _ tb[node].attr2 _ FALSE
            };

        Lengthen: PROC[t: Tree.Link, target: Type] RETURNS[Tree.Link] = {
            PushTree[t]; PushNode[lengthen, 1]; SetInfo[target]; RETURN[PopTree[]]};

        Shorten: PROC[t: Tree.Link, target: Type] RETURNS[Tree.Link] = {
            PushTree[t]; PushNode[shorten, 1]; SetInfo[target]; RETURN[PopTree[]]};

        Float: PROC[t: Tree.Link, type, target: Type] RETURNS[Tree.Link] = {
            PushTree[IF TypeForm[type] = $long
                THEN t
                ELSE Lengthen[t, MakeLongType[type, typeANY]]];
            SELECT NormalType[type] FROM
                dataPtr.typeINT => {PushNode[float, 1]; SetInfo[target]};
                typeANY => NULL;
                ENDCASE => Log.ErrorTree[typeClash, t];
            RETURN[PopTree[]]};


    <<expressions>>

        implicit: PUBLIC P3S.ImplicitInfo;    -- implied attributes of Tree.Null

        Exp: PUBLIC PROC[exp: Tree.Link, target: Type] RETURNS[val: Tree.Link] = {
            type: Type;
            phraseNP _ none;
            IF exp = Tree.Null THEN {RPush[implicit.type, implicit.attr]; RETURN[Tree.Null]};
            WITH e: exp SELECT FROM
                symbol => {
                    sei: ISEIndex = e.index;
                    attr: Attr;
                    attr.noXfer _ attr.noAssign _ TRUE;  RecordMention[sei];
                    type _ seb[sei].idType;
                    SELECT ctxb[seb[sei].idCtx].ctxType FROM
                        included =>
                            IF ~(attr.const_ConstantId[sei]) THEN Log.ErrorSei[unimplemented, sei];
                        imported => attr.const _ ConstantId[sei];
                        ENDCASE => attr.const _ seb[sei].constant;
                    RPush[type, attr];  val _ exp};
                hash => {
                    sei: CSEIndex = UnderType[target];
                    WITH t: seb[sei] SELECT FROM
                        enumerated => {
                            sei: ISEIndex;
                            IF ([sei: sei] _ SearchCtxList[e.index, t.valueCtx]).found THEN {
                                RPush[target, fullAttr];  val _ [symbol[sei]]}
                            ELSE val _ Id[e.index]};
                        ENDCASE => val _ Id[e.index];
                    };
                literal => {
                    attr: Attr;
                    attr.noXfer _ attr.noAssign _ TRUE;
                    WITH e.index SELECT FROM
                        string => {
                            [val, type] _ StringRef[exp, target];
                            attr.const _ FALSE;
                            IF dataPtr.interface THEN Log.ErrorTree[interfaceString, exp]};
                        ENDCASE => {type _ dataPtr.typeINT; attr.const _ TRUE; val _ exp};
                    RPush[type, attr]};
                subtree => {
                    node: Tree.Index _ e.index;
                    val _ exp;    -- the default
                    SELECT tb[node].name FROM

                        dot => {node _ Dot[node, target]; val _ [subtree[node]]};
                        uparrow => UpArrow[node];

                        apply => {
                            node _ Apply[node, target, FALSE]; val _ [subtree[node]];
                            CheckNonVoid[node, target]};

                        uminus, abs => UnaryOp[node];
                        plus => Plus[node];
                        minus => Minus[node];
                        times, div, mod => ArithOp[node];
                        relE, relN => RelOp[node, FALSE];
                        relL, relGE, relG, relLE => RelOp[node, TRUE];
                        in, notin => In[node];
                        not => tb[node].son[1] _ Rhs[tb[node].son[1], dataPtr.idBOOL];
                        or, and => BoolOp[node];
                        ifx => IfExp[node, target];
                        casex => SelectExp[node, target, Case, TRUE];
                        bindx => SelectExp[node, target, Discrimination, FALSE];
                        assignx => Assignment[node];
                        extractx => {Extract[node]; CheckNonVoid[node, target]};
                        min, max => MinMax[node, target];
                        pred, succ => EnumOp[node, target];
                        addr, base, length, arraydesc => AddrOp[node, target];
                        all => All[node, target];

                        mwconst =>
                            IF tb[node].attr1 THEN RPush[dataPtr.idREAL, fullAttr]
                            ELSE {
                                IF longUnsigned = nullType THEN
                                    longUnsigned _ MakeLongType[dataPtr.idCARDINAL, typeANY];
                                RPush[longUnsigned, fullAttr]};

                        void => RPush[target, voidAttr];
                        clit => RPush[dataPtr.idCHAR, fullAttr];

                        llit => {
                            attr: Attr _ fullAttr;
                            attr.const _ FALSE;  RPush[dataPtr.idSTRING, attr]};

                        atom => {
                            hti: HTIndex = GetHash[tb[node].son[1]];
                            subTarget: CSEIndex = UnderType[target];
                            WITH t: seb[subTarget] SELECT FROM
                                enumerated => {
                                    sei: ISEIndex;
                                    IF ~([sei: sei]_SearchCtxList[hti, t.valueCtx]).found THEN
                                        Log.ErrorHti[unknownId, hti];
                                    tb[node].son[1] _ Tree.Null;  FreeNode[node];  node _ Tree.NullIndex;
                                    val _ [symbol[index: sei]];  RPush[target, fullAttr]};
                                ENDCASE => {
                                    SymLiteralOps.EnterAtom[hti]; EnterType[dataPtr.typeAtomRecord, FALSE];
                                    RPush[dataPtr.idATOM, fullAttr]}};

                        nil => {
                            OPEN tb[node];
                            SELECT TRUE FROM
                                (son[1] # Tree.Null) => {
                                    son[1] _ TypeExp[son[1]];  type _ TypeForTree[son[1]];
                                    IF ~NullableType[type] THEN Log.ErrorTreeOp[missingAttr, son[1], nil]};
                                ~EqTypes[target, typeANY] => {
                                    type _ target;
                                    IF ~NullableType[type] THEN Log.ErrorTree[typeClash, val]};
                                ENDCASE => type _ MakeRefType[typeANY, typeANY];
                            RPush[type, fullAttr]};

                        new => New[node, target];
                        cons => {val _ Cons[node, target];  node _ GetNode[val]};
                        listcons => ListCons[node, target];

                        signalx, errorx, fork, joinx, create, startx => {
                            val _ MiscXfer[node, target];
                            node _ GetNode[val];  CheckNonVoid[node, target]};

                        syserrorx => {
                            RPush[CSENull, emptyAttr]; CheckNonVoid[node, target]};

                        lengthen => {
                            OPEN tb[node];
                            subType: CSEIndex;
                            son[1] _ GenericRhs[
                                son[1],
                                IF TypeForm[target] = $long THEN BaseType[target] ELSE target];
                            subType _ UnderType[TargetType[rStack[rI].type]];
                            IF subType = dataPtr.typeINT
                                OR seb[subType].typeTag = ref
                                OR seb[subType].typeTag = arraydesc
                                OR subType = typeANY THEN rStack[rI].type _ MakeLongType[subType, target]
                            ELSE {
                                Log.ErrorTreeOp[missingOp, son[1], lengthen]; rStack[rI].type _ typeANY}
                            };

                        narrow => {
                            OPEN tb[node];
                            IF son[2] = Tree.Null THEN {
                                IF target = typeANY THEN Log.ErrorNode[noTarget, node];
                                type _ target}
                            ELSE {son[2] _ TypeExp[son[2]];  type _ TypeForTree[son[2]]};
                            son[1] _ Exp[son[1], TargetType[type]];
                            TypeTest[node: node, from: rStack[rI].type, to: type];
                            IF attr3 AND ~attr1 AND son[2] = Tree.Null THEN Log.ErrorNode[noTarget, node];
                            IF RCType[type] = simple THEN {
                                nType: CSEIndex = NormalType[type];
                                WITH t: seb[nType] SELECT FROM
                                    ref => EnterType[t.refType, FALSE];
                                    ENDCASE => NULL};
                            IF tb[node].nSons > 2 THEN [] _ CatchPhrase[tb[node].son[3]];
                            rStack[rI].type _ type;
                            rStack[rI].attr.const _ rStack[rI].attr.noXfer _ FALSE};

                        istype => {
                            OPEN tb[node];
                            son[1] _ Exp[son[1], typeANY];
                            son[2] _ TypeExp[son[2]];
                            TypeTest[node: node, from: RType[], to: TypeForTree[son[2]]];
                            rStack[rI].type _ dataPtr.idBOOL; rStack[rI].attr.const _ FALSE};

                        safen => tb[node].son[1] _ Exp[tb[node].son[1], target];

                        loophole => {
                            OPEN tb[node];
                            son[1] _ Exp[son[1], typeANY];
                            IF TypeForm[RType[]] = $transfer AND OperandInline[son[1]] THEN
                                Log.ErrorTree[misusedInline, son[1]];
                            IF son[2] = Tree.Null THEN {
                                IF target = typeANY THEN Log.ErrorNode[noTarget, node];
                                rStack[rI].type _ target}
                            ELSE {
                                son[2] _ TypeExp[son[2]];
                                rStack[rI].type _ TypeForTree[son[2]]};
                            IF RCType[rStack[rI].type] # none THEN {
                                rStack[rI].attr.const _ FALSE;
                                IF P3S.safety = checked THEN Log.ErrorNodeOp[unsafeOp, node, loophole]}
                            };

                        size => {
                            OPEN tb[node];
                            attr: Attr;
                            son[1] _ TypeAppl[son[1]]; attr _ RAttr[]; RPop[];
                            IF ~NewableType[TypeForTree[son[1]]] THEN
                                Log.ErrorTreeOp[missingAttr, son[1], size];
                            IF son[2] # Tree.Null THEN {
                                saveNP: NPUse = phraseNP;
                                son[2] _ Rhs[son[2], dataPtr.idINT];
                                attr _ And[attr, RAttr[]]; RPop[];
                                phraseNP _ MergeNP[saveNP][phraseNP]};
                            RPush[dataPtr.idINT, attr]};

                        first, last => EndPoint[node];

                        typecode => {
                            tb[node].son[1] _ TypeExp[tb[node].son[1]];
                            EnterType[TypeForTree[tb[node].son[1]], FALSE];
                            RPush[typeANY, fullAttr]};

                        self => {
                            val _ P3S.self.tree;  P3S.self.tree _ Tree.Null;
                            phraseNP _ P3S.self.np;  RPush[P3S.self.type, P3S.self.attr];
                            FreeNode[node];  node _ Tree.NullIndex};

                        cast => {
                            tb[node].son[1] _ Exp[tb[node].son[1], target];
                            rStack[rI].type _ target};

                        ord =>
                            IF UniOperand[node] THEN {
                                tb[node].son[1] _ GenericRhs[tb[node].son[1], typeANY];  SetAttributes[node];
                                IF ~IndexType[RType[]] THEN
                                    Log.ErrorTreeOp[missingOp, tb[node].son[1], ord];
                                rStack[rI].type _ MakeNumeric[RType[]]};

                        val =>
                            IF UniOperand[node] THEN {
                                IF ~IndexType[target] THEN Log.ErrorNode[noTarget, node];
                                tb[node].son[1] _ EvalNumeric[tb[node].son[1]];
                                rStack[rI].type _ target};

                        stringinit => {
                            tb[node].son[2] _ Rhs[tb[node].son[2], dataPtr.idCARDINAL];
                            IF ~RAttr[].const THEN Log.ErrorTree[nonConstant, tb[node].son[2]];
                            RPop[];  RPush[dataPtr.idSTRING, voidAttr]};

                        ENDCASE => 
                            IF tb[node].name = item THEN tb[node].son[2] _ Exp[tb[node].son[2], target]
                            ELSE {Log.Error[unimplemented]; RPush[typeANY, emptyAttr]};

                    IF node # Tree.NullIndex THEN tb[node].info _ rStack[rI].type};
                ENDCASE;
            RETURN};

        CheckNonVoid: PROC[node: Tree.Index, target: Type] = {
            IF rStack[rI].type = nullType THEN
                SELECT tb[node].name FROM
                    error => {tb[node].name _ errorx; rStack[rI].type _ target};
                    errorx, syserrorx => rStack[rI].type _ target;
                    ENDCASE => {Log.ErrorNode[typeClash, node]; rStack[rI].type _ typeANY}
            };

        VoidExp: PUBLIC PROC[exp: Tree.Link] RETURNS[val: Tree.Link] = {
            val _ Exp[exp, typeANY]; RPop[]; RETURN};

        UniOperand: PROC[node: Tree.Index] RETURNS[valid: BOOL] = {
            l: CARDINAL = ListLength[tb[node].son[1]];
            IF ~(valid _ l=1) THEN {
                IF l > 1 THEN Log.ErrorN[listLong, l-1] ELSE Log.ErrorN[listShort, l+1];
                tb[node].son[1] _ UpdateList[tb[node].son[1], VoidExp];
                RPush[typeANY, emptyAttr]};
            RETURN};


    <<overloaded string literals>>

        StringRef: PROC[t: Tree.Link, target: Type] RETURNS[v: Tree.Link, type: Type] = {
            IF RCType[target] = none THEN {type _ dataPtr.idSTRING; v _ t}
            ELSE {
                nType: CSEIndex = NormalType[target];
                rType: Type = WITH t: seb[nType] SELECT FROM
                    ref => t.refType,
                    ENDCASE => dataPtr.idTEXT;
                form: TextForm = TextRep[rType];
                cType: Type = (IF form = text THEN dataPtr.idTEXT ELSE rType);
                type _ textType[form];
                IF type = CSENull THEN {
                    type _ MakeLongType[MakeRefType[cType: cType, hint: nType, counted: TRUE], target];
                    textType[form] _ type};
                EnterType[TypeRoot[cType], FALSE];
                WITH e: t SELECT FROM
                    literal =>
                        WITH e.index SELECT FROM
                            string => {
                                sti _ LiteralOps.FindHeapString[sti, TypeRoot[cType]];
                                SymLiteralOps.EnterText[sti]};
                            ENDCASE;
                    ENDCASE;
                PushTree[t];  PushNode[textlit, 1];
                SetAttr[2, TRUE];  SetInfo[type];  v _ PopTree[]};
            RETURN};

        }.