
    <<Attr3a.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, April 14, 1986 2:01:05 pm PST>>

    DIRECTORY
        A3: TYPE USING [DefaultForm, LhsMode],
        Alloc: TYPE USING [Notifier],
        P3: TYPE USING [phraseNP, voidAttr, CompleteRecord, CopyTree, Initialization, RPush, UpdateTreeAttr, VariantUnionType],
        Symbols: TYPE USING [Base, Type, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, SENull, ISENull, lG, lZ, typeANY, seType, ctxType, 
        mdType],
        SymbolOps: TYPE USING [CtxEntries, CtxLevel, FindExtension, NormalType, TypeLink, TypeRoot, UnderType, VisibleCtxEntries],
        Tree: TYPE USING [Base, Link, Null, Scan, treeType],
        TreeOps: TYPE USING [PushSe, PopTree, PushNode, PushProperList, PushTree, OpName, ScanList];

    Attr3a: PROGRAM
        IMPORTS P3, SymbolOps, TreeOps
        EXPORTS A3 = {
        OPEN TreeOps, SymbolOps, Symbols, A: A3;

        tb: Tree.Base;    -- tree base address (local copy)
        seb: Symbols.Base;    -- se table base address (local copy)
        ctxb: Symbols.Base;    -- context table base address (local copy)
        mdb: Symbols.Base;    -- module table base address (local copy)

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


    <<type mappings>>

    BaseType: PUBLIC PROC[type: Type] RETURNS[Type] = {
    sei: CSEIndex = UnderType[type];
    RETURN[
    WITH t: seb[sei] SELECT FROM
    subrange => BaseType[t.rangeType],
    long, real => BaseType[t.rangeType],
    ENDCASE => type]
    };

        CanonicalType: PUBLIC PROC[type: Type] RETURNS[Type] = {
            sei: CSEIndex = UnderType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                subrange => CanonicalType[t.rangeType],
                record =>
                    IF Bundling[sei] # 0
                        THEN CanonicalType[Unbundle[LOOPHOLE[sei, RecordSEIndex]]]
                        ELSE type,
                ENDCASE => type]
            };

        TargetType: PUBLIC PROC[type: Type] RETURNS[target: Type] = {
            sei: CSEIndex = UnderType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                subrange => TargetType[t.rangeType],
                ENDCASE => type]
            };

        Unbundle: PUBLIC PROC[record: RecordSEIndex] RETURNS[Type] = {
            RETURN[seb[ctxb[seb[record].fieldCtx].seList].idType]};


    <<type predicates>>

        AccessMode: PUBLIC PROC[type: Type] RETURNS[A.LhsMode] = {
            nType: CSEIndex = NormalType[type];
            RETURN[WITH t: seb[nType] SELECT FROM
                ref => SELECT TRUE FROM
                    t.readOnly => $none,
                    t.counted => $counted,
                    ENDCASE => $uncounted,
                arraydesc => IF t.readOnly THEN $none ELSE $uncounted,
                relative => AccessMode[t.offsetType],
                ENDCASE => $none]
            };

        AssignableType: PUBLIC PROC[type: Type, safe: BOOL] RETURNS[BOOL] = {
            sei: CSEIndex = UnderType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                mode, definition, any, nil, sequence => FALSE,
                record => t.hints.assignable AND (~safe OR ~t.hints.variant),
                union => --t.hints.assignable AND-- ~safe,
                array => AssignableType[UnderType[t.componentType], safe],
                transfer => t.mode # port, 
                opaque => t.lengthKnown,
                ENDCASE => TRUE]
            };

        Bundling: PUBLIC PROC[type: CSEIndex] RETURNS[nLevels: CARDINAL] = {
            next: Type;
            ctx: CTXIndex;
            nLevels _ 0;
            DO
                IF type = SENull THEN EXIT;
                WITH t: seb[type] SELECT FROM
                    record => {
                        IF ~t.hints.unifield THEN EXIT;
                        ctx _ t.fieldCtx;
                        WITH c: ctxb[ctx] SELECT FROM
                            included => {
                                IF t.hints.privateFields AND ~mdb[c.module].shared THEN EXIT;
                                IF ~c.complete THEN P3.CompleteRecord[LOOPHOLE[type, RecordSEIndex]];
                                IF ~c.complete THEN EXIT};
                            ENDCASE;
                        IF CtxEntries[ctx] # 1 OR t.hints.variant THEN EXIT;
                        nLevels _ nLevels + 1;
                        next _ Unbundle[LOOPHOLE[type, RecordSEIndex]]};
                    ENDCASE => EXIT;
                type _ UnderType[next];
                ENDLOOP;
            RETURN};

        ComponentType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
            sei: CSEIndex = UnderType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                mode, any, nil => FALSE,
                record => 
                    IF t.hints.variant THEN
                        SELECT seb[P3.VariantUnionType[sei]].typeTag FROM    -- force copying now
                            sequence => FALSE,
                            ENDCASE => TRUE
                    ELSE TRUE,
                opaque => t.lengthKnown,
                ENDCASE => TRUE]
            };

        IdentifiedType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
            sei: CSEIndex = UnderType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                mode, definition, any, nil, union, sequence => FALSE,
                record => 
                    IF t.hints.variant AND ~t.hints.comparable THEN
                        SELECT seb[P3.VariantUnionType[sei]].typeTag FROM    -- force copying now
                            sequence => FALSE,
                            ENDCASE => TRUE
                    ELSE TRUE,
                opaque => t.lengthKnown,
                ENDCASE => TRUE]
            };

        IndexType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
            sei: CSEIndex = UnderType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                basic => t.ordered,
                enumerated => t.ordered,
                subrange => IndexType[t.rangeType],
                long =>  IndexType[t.rangeType],
                ENDCASE => FALSE]
            };

        NewableType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
            sei: CSEIndex = UnderType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                mode, any, nil => FALSE,
                opaque => t.lengthKnown,
                ENDCASE => TRUE]
            };

        NullableType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
            sei: CSEIndex = NormalType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                ref, transfer, arraydesc, zone => TRUE,
                ENDCASE => FALSE]
            };

        OrderedType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
            sei: CSEIndex = UnderType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                basic => t.ordered,
                enumerated => t.ordered,
                ref => t.ordered,
                relative => OrderedType[t.offsetType],
                subrange => OrderedType[t.rangeType],
                long, real => OrderedType[t.rangeType],
                ENDCASE => FALSE]
            };

        PermanentType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
            sei: CSEIndex = UnderType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                record => CtxLevel[t.fieldCtx] = lG,
                ENDCASE => FALSE]
            };

        VarType: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
            sei: CSEIndex = NormalType[type];
            RETURN[WITH t: seb[sei] SELECT FROM
                ref => t.var,
                ENDCASE => FALSE]
            };


    <<defaults>>

        Default: PUBLIC PROC[type: Type] RETURNS[form: A.DefaultForm _ $none] = {
            next: Type;
            FOR s: Type _ type, next DO
                WITH se: seb[s] SELECT FROM
                    id => {
                        sei: ISEIndex = LOOPHOLE[s];

                        TestOption: Tree.Scan = {
                            IF OpName[t] = $void THEN {IF form = $none THEN form _ $void}
                            ELSE form _ $nonVoid};

                        IF seb[sei].extended THEN {ScanList[FindExtension[sei].tree, TestOption]; EXIT};
                        next _ seb[sei].idInfo};
                    cons =>
                        WITH t: se SELECT FROM
                            ref => {IF t.counted THEN form _ $nonVoid; EXIT};
                            array => next _ t.componentType;
                            record => {IF t.hints.default THEN form _ $nonVoid; EXIT};
                            transfer => {form _ $nonVoid; EXIT};
                            long => next _ t.rangeType;
                            zone => {IF t.counted THEN form _ $nonVoid; EXIT};
                            ENDCASE => EXIT;
                    ENDCASE => ERROR;
                ENDLOOP;
            RETURN};

        DefaultInit: PUBLIC PROC[type: Type] RETURNS[v: Tree.Link] = {
            next: Type;
            subType: CSEIndex _ UnderType[type];
            recordTail: Tree.Link _ Tree.Null;
            tagId: ISEIndex _ ISENull;
            v _ Tree.Null;
            FOR s: Type _ type, next DO
                WITH se: seb[s] SELECT FROM
                    id => {
                        sei: ISEIndex = LOOPHOLE[s];

                        CopyNonVoid: Tree.Scan = {
                            IF OpName[t] # $void AND v = Tree.Null THEN v _ P3.CopyTree[t]};

                        SELECT TRUE FROM
                            (seb[sei].extended AND recordTail = Tree.Null) => {
                                ScanList[FindExtension[sei].tree, CopyNonVoid]; GO TO copy};
                            (DiscrimId[sei] AND tagId = ISENull) => tagId _ sei;
                            ENDCASE;
                        next _ seb[sei].idInfo};
                    cons =>
                        WITH t: se SELECT FROM
                            ref =>
                                IF t.counted THEN {PushTree[Tree.Null]; PushNode[nil, 1]; GO TO eval}
                                ELSE GO TO none;
                            array =>
                                IF Default[t.componentType] = nonVoid THEN {
                                    PushTree[Tree.Null]; PushNode[all, 1]; GO TO eval}
                                ELSE GO TO none;
                            record =>
                                IF t.hints.default OR recordTail # Tree.Null THEN {
                                    n: CARDINAL;
                                    P3.CompleteRecord[LOOPHOLE[s]];
                                    n _ VisibleCtxEntries[t.fieldCtx];
                                    FOR i: CARDINAL IN [1..n] DO
                                        PushTree[IF i # n THEN Tree.Null ELSE recordTail] ENDLOOP;
                                    PushProperList[n];  recordTail _ Tree.Null;
                                    IF tagId = ISENull THEN {PushTree[Tree.Null]; PushNode[apply, -2]; GO TO eval}
                                    ELSE {
                                        PushSe[tagId];  tagId _ ISENull;
                                        PushNode[apply,-2];   recordTail _ PopTree[];
                                        next _ TypeLink[s];  subType _ UnderType[next]}
                                    }
                                ELSE GO TO none;
                            transfer => {
                                PushTree[Tree.Null]; PushNode[nil, 1]; GO TO eval};
                            zone =>
                                IF t.counted THEN {PushTree[Tree.Null]; PushNode[nil, 1]; GO TO eval}
                                ELSE GO TO none;
                            long => next _ t.rangeType;
                            ENDCASE => GO TO none;
                    ENDCASE => ERROR;
                REPEAT
                    none => {v _ Tree.Null; P3.phraseNP _ none; P3.RPush[subType, P3.voidAttr]};
                    copy => P3.RPush[subType, IF v=Tree.Null THEN P3.voidAttr ELSE P3.UpdateTreeAttr[v]];
                    eval => v _ P3.Initialization[PopTree[], TargetType[subType]];
                ENDLOOP;
            RETURN};

        DiscrimId: PROC[sei: ISEIndex] RETURNS[BOOL] = INLINE {
            RETURN[CtxLevel[seb[sei].idCtx] = lZ AND TypeLink[sei] # SENull]};


        Voidable: PUBLIC PROC[type: Type] RETURNS[BOOL] = {
            next: Type;
            FOR s: Type _ type, next DO
                WITH se: seb[s] SELECT FROM
                    id => {
                        sei: ISEIndex = LOOPHOLE[s];
                        IF seb[sei].extended THEN RETURN[VoidItem[FindExtension[sei].tree]];
                        next _ seb[sei].idInfo};
                    cons =>
                        WITH t: se SELECT FROM
                            ref => RETURN[~t.counted];
                            array => next _ t.componentType;
                            record => RETURN[t.hints.voidable];
                            union => RETURN[t.hints.voidable];
                            long => next _ t.rangeType;
                            zone => RETURN[~t.counted];
                            ENDCASE => RETURN[TRUE];
                    ENDCASE => ERROR;
                ENDLOOP
            };

        VoidItem: PUBLIC PROC[t: Tree.Link] RETURNS[void: BOOL] = {
            TestVoid: Tree.Scan = {IF OpName[t] = $void THEN void _ TRUE};
            void _ FALSE;  ScanList[t, TestVoid];  RETURN};


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

        }.