
    <<TypePack.mesa>>
        <<Copyright  1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, June 18, 1986 10:54:56 am PDT>>
        <<Rovner, July 6, 1983 1:42 pm>>
    <<Russ Atkinson (RRA) January 31, 1985 1:15:53 pm PST>>
        <<Sweet June 4, 1986 9:44:22 am PDT>>

    DIRECTORY
        ConvertUnsafe: TYPE USING [SubString, EqualSubStrings],
        SymbolTable: TYPE USING [Base],
        Symbols: TYPE USING [Name, SEIndex, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, MDIndex, nullName, MDNull, OwnMdi, ISENull, 
        RecordSENull, FirstStandardCtx, LastStandardCtx, typeANY, typeTYPE],
        Types: TYPE USING [Handle];

    TypePack: PROGRAM IMPORTS ConvertUnsafe EXPORTS Types = {
        OPEN Symbols;

    <<internal utilities>>

        NameHandle: TYPE = RECORD[
            stb: SymbolTable.Base,
            name: Name];

        EqualIds: PROC[id1, id2: NameHandle] RETURNS[BOOL] = {
            OPEN b1: id1.stb, b2: id2.stb;
            ss1, ss2: ConvertUnsafe.SubString;
            IF id1 = id2 THEN RETURN[TRUE];
            ss1 _ b1.SubStringForName[id1.name];  ss2 _ b2.SubStringForName[id2.name];
            RETURN[ConvertUnsafe.EqualSubStrings[ss1, ss2]]};


        CTXHandle: TYPE = RECORD[
            stb: SymbolTable.Base,
            ctx: CTXIndex];

        EqContexts: PROC[context1, context2: CTXHandle] RETURNS[BOOL] = {
            OPEN b1: context1.stb, b2: context2.stb;
            ctx1, ctx2: CTXIndex;
            mdi1, mdi2: MDIndex;
            IF context1 = context2 THEN RETURN[TRUE];
            IF context1.ctx IN [FirstStandardCtx .. LastStandardCtx] THEN
                RETURN[context1.ctx = context2.ctx];    -- predefined types
            WITH c1: b1.ctxb[context1.ctx] SELECT FROM
                simple => {mdi1 _ OwnMdi; ctx1 _ context1.ctx};
                included => {mdi1 _ c1.module; ctx1 _ c1.map};
                ENDCASE => ERROR;
            WITH c2: b2.ctxb[context2.ctx] SELECT FROM
                simple => {mdi2 _ OwnMdi; ctx2 _ context2.ctx};
                included => {mdi2 _ c2.module; ctx2 _ c2.map};
                ENDCASE => ERROR;
            RETURN[ctx1 = ctx2 AND b1.mdb[mdi1].stamp = b2.mdb[mdi2].stamp]};

        OpaqueValue: PUBLIC PROC[type: Types.Handle, base: SymbolTable.Base]
            RETURNS[val: Types.Handle] = {
            OPEN b1: type.stb;
            val _ type;        -- the default
            WITH t1: b1.seb[type.sei] SELECT FROM
                opaque => {
                    mdi1: MDIndex = WITH c1: b1.ctxb[b1.seb[t1.id].idCtx] SELECT FROM
                        included => c1.module,
                        imported => b1.ctxb[c1.includeLink].module,
                        ENDCASE => OwnMdi;
                    mdi2: MDIndex = base.FindMdi[b1.mdb[mdi1].stamp];
                    IF mdi2 # MDNull AND base.mdb[mdi2].exported THEN {
                        ss: ConvertUnsafe.SubString;
                        sei2: ISEIndex;
                        ss _ b1.SubStringForName[b1.seb[t1.id].hash];
                        sei2 _ base.SearchContext[base.FindString[ss], base.mainCtx];
                        IF sei2 # ISENull
                            AND base.seb[sei2].idType = typeTYPE AND base.seb[sei2].public THEN
                                val _ [base, base.UnderType[sei2]]}};
                ENDCASE;
            RETURN};


    <<type relations>>

        Equivalent: PUBLIC PROC[type1, type2: Types.Handle] RETURNS[BOOL] = {
            RETURN[type1 = type2 OR EqualTypes[type1, type2
                ! Resolved => {RESUME[FALSE]}; Matched => {RESUME[FALSE]}] ]
            };

        Matched: SIGNAL[m1, m2: Types.Handle] RETURNS[BOOL] = CODE;

        EqualTypes: PROC[type1, type2: Types.Handle] RETURNS[BOOL] = {
            OPEN b1: type1.stb, b2: type2.stb;
            IF type1 = type2 OR type1.sei = typeANY OR type2.sei = typeANY THEN RETURN[TRUE];
            IF (b1.seb[type1.sei].typeTag = opaque) # (b2.seb[type2.sei].typeTag = opaque) THEN {
                type1 _ OpaqueValue[type1, type2.stb]; type2 _ OpaqueValue[type2, type1.stb]};
            RETURN[WITH t1: b1.seb[type1.sei] SELECT FROM
                basic =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        basic => t1.code = t2.code,
                        ENDCASE => FALSE,
                enumerated =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        enumerated =>
                            IF t1.painted THEN
                                t2.painted AND  EqContexts[[type1.stb, t1.valueCtx], [type2.stb, t2.valueCtx]]
                            ELSE
                                ~t2.painted AND MatchConstants[[type1.stb, t1.valueCtx], [type2.stb, t2.valueCtx]],
                        ENDCASE => FALSE,
                record =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        record =>
                            IF t1.painted THEN
                                t2.painted AND EqContexts[[type1.stb, t1.fieldCtx], [type2.stb, t2.fieldCtx]]
                            ELSE
                                ~t2.painted AND t1.argument = t2.argument AND (
                                    (SIGNAL Matched[type1, type2])
                                        OR
                                    MatchFields[
                                        [type1.stb, LOOPHOLE[type1.sei]], [type2.stb, LOOPHOLE[type2.sei]]
                                            ! Matched => {IF m1 = type1 AND m2 = type2 THEN RESUME[TRUE]}
                                        ]),
                        ENDCASE => FALSE,
                ref =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        ref =>
                            (t1.counted = t2.counted) AND (t1.var = t2.var)
                                AND (t1.readOnly = t2.readOnly) AND (t1.ordered = t2.ordered)
                                AND Equal[[type1.stb, t1.refType], [type2.stb, t2.refType]],
                        ENDCASE => FALSE,
                array =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        array =>
                            t1.packed = t2.packed 
                                AND Equal[[type1.stb, t1.componentType], [type2.stb, t2.componentType]]
                                AND Equal[[type1.stb, t1.indexType], [type2.stb, t2.indexType]],
                        ENDCASE => FALSE,
                arraydesc =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        arraydesc =>
                            t1.readOnly = t2.readOnly
                                AND Equal[[type1.stb, t1.describedType], [type2.stb, t2.describedType]],
                        ENDCASE => FALSE,
                transfer =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        transfer =>
                            (t1.mode = t2.mode) AND (t1.safe = t2.safe)
                                AND EqualTypes[[type2.stb, t2.typeIn], [type1.stb, t1.typeIn]]
                                AND EqualTypes[[type1.stb, t1.typeOut], [type2.stb, t2.typeOut]],
                        ENDCASE => FALSE,
                union =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        union => EqContexts[[type1.stb, t1.caseCtx], [type2.stb, t2.caseCtx]],
                        ENDCASE => FALSE,
                sequence =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        sequence =>
                            t1.packed = t2.packed AND t1.controlled = t2.controlled 
                                AND Equal[[type1.stb, t1.componentType], [type2.stb, t2.componentType]]
                                AND MatchTags[[type1.stb, t1.tagSei], [type2.stb, t2.tagSei]],
                        ENDCASE => FALSE,
                relative =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        relative =>
                            Equal[[type1.stb, t1.baseType], [type2.stb, t2.baseType]] 
                                AND
                            Equal[[type1.stb, t1.offsetType], [type2.stb, t2.offsetType]],
                        ENDCASE => FALSE,
                opaque =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        opaque =>
                            EqContexts[[type1.stb, b1.seb[t1.id].idCtx], [type2.stb, b2.seb[t2.id].idCtx]] 
                                AND
                            EqualIds[[type1.stb, b1.seb[t1.id].hash], [type2.stb, b2.seb[t2.id].hash]],
                        ENDCASE => FALSE,
                zone =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        zone => (t1.mds = t2.mds AND t1.counted = t2.counted),
                        ENDCASE => FALSE,
                subrange =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        subrange =>
                            Equal[[type1.stb, t1.rangeType], [type2.stb, t2.rangeType]]
                                AND 
                                    (~t1.filled OR ~t2.filled
                                        OR (t1.origin = t2.origin AND t1.empty = t2.empty
                                            AND (t1.empty OR t1.range = t2.range))),
                        ENDCASE => FALSE,
                long =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM
                        long => Equal[[type1.stb, t1.rangeType], [type2.stb, t2.rangeType]],
                        ENDCASE => FALSE,
                real =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM real => TRUE, ENDCASE => FALSE,
                any =>
                    WITH t2: b2.seb[type2.sei] SELECT FROM any => TRUE, ENDCASE => FALSE,
                nil => type1.sei = type2.sei,
                ENDCASE => FALSE]
            };

        SEHandle: TYPE = RECORD[
            stb: SymbolTable.Base,
            sei: SEIndex];

        Resolved: SIGNAL[se1, se2: SEHandle] RETURNS[BOOL] = CODE;

        Equal: PROC[type1, type2: SEHandle] RETURNS[BOOL] = {
            OPEN b1: type1.stb, b2: type2.stb;
            RETURN[
                type1 = type2
                    OR
                (IF b1.seb[type1.sei].seTag = id AND b2.seb[type2.sei].seTag = id
                    THEN
                        ((SIGNAL Resolved[type1, type2])
                            OR
                            EqualTypes[ [type1.stb, b1.UnderType[type1.sei]],
                                [type2.stb, b2.UnderType[type2.sei]]
                                ! Resolved => {IF se1 = type1 AND se2 = type2 THEN RESUME[TRUE]}])
                    ELSE
                EqualTypes[
                    [type1.stb, b1.UnderType[type1.sei]], [type2.stb, b2.UnderType[type2.sei]]]) ]
            };


        Assignable: PUBLIC PROC[typeL, typeR: Types.Handle] RETURNS[BOOL] = {
            OPEN bL: typeL.stb, bR: typeR.stb;
            ENABLE {Resolved => {RESUME[FALSE]}; Matched => {RESUME[FALSE]}};
            IF typeL = typeR OR typeL.sei = typeANY OR typeR.sei = typeANY THEN
                RETURN[TRUE];
            RETURN[
                FreeAssignable[typeL, typeR, $val]
                    OR
                (SELECT typeL.stb.TypeForm[typeL.sei] FROM
                    record, opaque => ConformingVariant[typeL, typeR]
                    ENDCASE => FreeAssignable[FullRangeType[typeL], FullRangeType[typeR], $val])]
            };


        Mode: TYPE = {val, ref};

        FreeAssignable: PROC[typeL, typeR: Types.Handle, mode: Mode] RETURNS[BOOL] = {
            OPEN bL: typeL.stb, bR: typeR.stb;
            IF typeL = typeR OR typeL.sei = typeANY OR typeR.sei = typeANY THEN
                RETURN[TRUE];
            IF (bL.seb[typeL.sei].typeTag = opaque) # (bR.seb[typeR.sei].typeTag = opaque) THEN {
                typeL _ OpaqueValue[typeL, typeR.stb]; typeR _ OpaqueValue[typeR, typeL.stb]};
            RETURN[WITH tR: bR.seb[typeR.sei] SELECT FROM
                record =>
                    WITH tL: bL.seb[typeL.sei] SELECT FROM
                        record =>
                            IF (tL.painted OR tR.painted) THEN Equivalent[typeL, typeR]
                            ELSE
                                tL.argument = tR.argument AND (
                                    (SIGNAL Matched[typeL, typeR])
                                        OR
                                    CheckFields[
                                        [typeL.stb, LOOPHOLE[typeL.sei]], [typeR.stb, LOOPHOLE[typeR.sei]], mode
                                            ! Matched => {IF m1 = typeL AND m2 = typeR THEN RESUME[TRUE]}
                                        ]),
                        ENDCASE => FALSE,
                ref =>
                    WITH tL: bL.seb[typeL.sei] SELECT FROM
                        ref =>
                            (tL.counted = tR.counted) AND (tL.var = tR.var) AND
                                (~tL.ordered OR tR.ordered) AND
                                (~tR.readOnly OR tL.readOnly) AND
                                (SELECT bL.TypeForm[tL.refType] FROM
                                    record, opaque =>
                                        ConformingVariant[    -- assumes immutability
                                            [typeL.stb, bL.UnderType[tL.refType]], 
                                            [typeR.stb, bR.UnderType[tR.refType]]]
                                            OR
                                        (tL.readOnly
                                            AND Conformable[[typeL.stb, tL.refType], [typeR.stb, tR.refType], $ref]),
                                    any => TRUE,
                                    ENDCASE =>
                                        IF ~tL.readOnly THEN
                                            Equivalent[
                                                [typeL.stb, bL.UnderType[tL.refType]], 
                                                [typeR.stb, bR.UnderType[tR.refType]]]
                                        ELSE Conformable[[typeL.stb, tL.refType], [typeR.stb, tR.refType], $ref])
                        ENDCASE => FALSE,
                array =>
                    WITH tL: bL.seb[typeL.sei] SELECT FROM
                        array =>
                            tL.packed = tR.packed 
                                AND Equivalent[
                                    [typeL.stb, bL.UnderType[tL.indexType]], 
                                    [typeR.stb, bR.UnderType[tR.indexType]]]
                                AND (
                                    IF tL.packed THEN
                                        Equivalent[
                                            [typeL.stb, bL.UnderType[tL.componentType]], 
                                            [typeR.stb, bR.UnderType[tR.componentType]]]
                                    ELSE Conformable[
                                        [typeL.stb, tL.componentType], [typeR.stb, tR.componentType], mode])
                        ENDCASE => FALSE,
                arraydesc =>
                    WITH tL: bL.seb[typeL.sei] SELECT FROM
                        arraydesc =>
                            (tL.readOnly OR ~tR.readOnly)
                                AND Covering[
                                    [typeL.stb, bL.UnderType[tL.describedType]], 
                                    [typeR.stb, bR.UnderType[tR.describedType]]],
                        ENDCASE => FALSE,
                transfer =>
                    WITH tL: bL.seb[typeL.sei] SELECT FROM
                        transfer =>
                            (tL.mode = tR.mode OR (tL.mode = error AND tR.mode = signal))
                                AND (~tL.safe OR tR.safe)
                                AND (FreeAssignable[[typeR.stb, tR.typeIn], [typeL.stb, tL.typeIn], mode]
                                    OR bL.TypeForm[tL.typeIn] = any)
                                AND (FreeAssignable[[typeL.stb, tL.typeOut], [typeR.stb, tR.typeOut], mode]
                                    OR bL.TypeForm[tL.typeOut] = any),
                        ENDCASE => FALSE,
                relative =>
                    WITH tL: bL.seb[typeL.sei] SELECT FROM
                        relative =>
                            Equivalent[
                                [typeL.stb, bL.UnderType[tL.baseType]], 
                                [typeR.stb, bR.UnderType[tR.baseType]]]
                                AND FreeAssignable[
                                    FullRangeType[[typeL.stb, bL.UnderType[tL.offsetType]]], 
                                    FullRangeType[[typeR.stb, bR.UnderType[tR.offsetType]]],
                                    mode],
                        ENDCASE => FALSE,
                subrange =>
                    FreeAssignable[FullRangeType[typeL], FullRangeType[typeR], mode]
                        AND
                            (WITH tL: bL.seb[typeL.sei] SELECT FROM
                                subrange =>
                                    ~tL.filled OR ~tR.filled
                                        OR (tL.origin = tR.origin
                                            AND (tR.empty OR (~tL.empty AND tL.range >= tR.range))),
                                ENDCASE => (~tR.filled OR tR.origin = 0)),
                long =>
                    WITH tL: bL.seb[typeL.sei] SELECT FROM
                        long =>
                            FreeAssignable[
                                FullRangeType[[typeL.stb, bL.UnderType[tL.rangeType]]], 
                                FullRangeType[[typeR.stb, bR.UnderType[tR.rangeType]]],
                                mode],
                        real => bR.UnderType[tR.rangeType] = typeANY,
                        ENDCASE => FALSE,
                real =>
                    WITH tL: bL.seb[typeL.sei] SELECT FROM
                        real => TRUE,
                        long => bL.UnderType[tL.rangeType] = typeANY,
                        ENDCASE => FALSE,
                ENDCASE => Equivalent[typeL, typeR]]
            };

        Conformable: PROC[type1, type2: SEHandle, mode: Mode] RETURNS[BOOL] = {
            OPEN b1: type1.stb, b2: type2.stb;
            RETURN[
                type1 = type2
                    OR
                (IF b1.seb[type1.sei].seTag = id AND b2.seb[type2.sei].seTag = id THEN
                    ((SIGNAL Resolved[type1, type2])
                        OR
                        FreeAssignable[ [type1.stb, b1.UnderType[type1.sei]],
                            [type2.stb, b2.UnderType[type2.sei]],
                            mode
                            ! Resolved => {IF se1 = type1 AND se2 = type2 THEN RESUME[TRUE]}])
                    ELSE
                        FreeAssignable[ [type1.stb, b1.UnderType[type1.sei]],
                            [type2.stb, b2.UnderType[type2.sei]],
                            mode]) ]
            };

        ConformingVariant: PROC[typeL, typeR: Types.Handle] RETURNS[BOOL] = {
            OPEN bL: typeL.stb, bR: typeR.stb;
            RETURN[
                Equivalent[typeL, typeR]
                    OR
                (WITH tR: bR.seb[typeR.sei] SELECT FROM
                    record =>
                        WITH tV: tR SELECT FROM
                            linked => ConformingVariant[typeL, [typeR.stb, bR.UnderType[tV.linkType]]],
                            ENDCASE => FALSE,
                    ENDCASE => FALSE)]
            };


    <<auxiliary predicates>>

        RecordHandle: TYPE = RECORD[
            stb: SymbolTable.Base,
            sei: RecordSEIndex];

        MatchFields: PROC[rec1, rec2: RecordHandle] RETURNS[BOOL] = {
            OPEN b1: rec1.stb, b2: rec2.stb;
            sei1, sei2: ISEIndex;
            IF rec1.sei = RecordSENull OR rec2.sei = RecordSENull THEN RETURN[rec1.sei = rec2.sei];
            IF EqContexts[[rec1.stb, b1.seb[rec1.sei].fieldCtx], [rec2.stb, b2.seb[rec2.sei].fieldCtx]] THEN
                RETURN[TRUE];
            sei1 _ b1.FirstCtxSe[b1.seb[rec1.sei].fieldCtx];
            sei2 _ b2.FirstCtxSe[b2.seb[rec2.sei].fieldCtx];
            UNTIL sei1 = ISENull OR sei2 = ISENull DO
                IF ~(Equal[[rec1.stb, b1.seb[sei1].idType], [rec2.stb, b2.seb[sei2].idType]] AND
                    EqualIds[[rec1.stb, b1.seb[sei1].hash], [rec2.stb, b2.seb[sei2].hash]])
                    THEN RETURN[FALSE];
                sei1 _ b1.NextSe[sei1];  sei2 _ b2.NextSe[sei2];
                ENDLOOP;
            RETURN[sei1 = sei2]};

        CheckFields: PROC[rec1, rec2: RecordHandle, mode: Mode] RETURNS[BOOL] = {
            OPEN b1: rec1.stb, b2: rec2.stb;
            sei1, sei2: ISEIndex;
            checkIds: BOOL;
            IF rec1.sei = RecordSENull OR rec2.sei = RecordSENull
                THEN RETURN[rec1.sei = rec2.sei];
            IF EqContexts[[rec1.stb, b1.seb[rec1.sei].fieldCtx], [rec2.stb, b2.seb[rec2.sei].fieldCtx]]
                THEN RETURN[TRUE];
            checkIds _ ~(b1.seb[rec1.sei].hints.unifield OR b2.seb[rec2.sei].hints.unifield);
            sei1 _ b1.FirstCtxSe[b1.seb[rec1.sei].fieldCtx];
            sei2 _ b2.FirstCtxSe[b2.seb[rec2.sei].fieldCtx];
            UNTIL sei1 = ISENull OR sei2 = ISENull DO
                IF ~Conformable[[rec1.stb, b1.seb[sei1].idType], [rec2.stb, b2.seb[sei2].idType], mode]
                    OR (checkIds AND
                        b1.seb[sei1].hash # nullName AND b2.seb[sei2].hash # nullName AND
                        ~EqualIds[[rec1.stb, b1.seb[sei1].hash], [rec2.stb, b2.seb[sei2].hash]])
                        THEN RETURN[FALSE];
                sei1 _ b1.NextSe[sei1];  sei2 _ b2.NextSe[sei2];
                ENDLOOP;
            RETURN[sei1 = sei2]};

        MatchConstants: PROC [context1, context2: CTXHandle] RETURNS [BOOL] = {
            OPEN b1: context1.stb, b2: context2.stb;
            sei1, sei2: ISEIndex;
            IF EqContexts[context1, context2] THEN RETURN[TRUE];
            sei1 _ b1.FirstCtxSe[context1.ctx];
            sei2 _ b2.FirstCtxSe[context2.ctx];
            UNTIL sei1 = ISENull OR sei2 = ISENull DO
                IF ~EqualIds[[context1.stb, b1.seb[sei1].hash], [context2.stb, b2.seb[sei2].hash]]
                    THEN RETURN[FALSE];
                sei1 _ b1.NextSe[sei1];  sei2 _ b2.NextSe[sei2];
                ENDLOOP;
            RETURN[sei1 = sei2]};

        ISEHandle: TYPE = RECORD[
            stb: SymbolTable.Base,
            sei: ISEIndex];

        MatchTags: PROC[tag1, tag2: ISEHandle] RETURNS[BOOL] = {
            OPEN b1: tag1.stb, b2: tag2.stb;
            RETURN[
                EqualIds[[tag1.stb, b1.seb[tag1.sei].hash], [tag2.stb, b2.seb[tag2.sei].hash]] AND
                Equal[[tag1.stb, b1.seb[tag1.sei].idType], [tag2.stb, b2.seb[tag2.sei].idType]]]
            };


        Covering: PROC[typeL, typeR: Types.Handle] RETURNS[BOOL] = {
            OPEN bL: typeL.stb, bR: typeR.stb;
            IF typeL = typeR THEN RETURN[TRUE];
            RETURN[WITH tL: bL.seb[typeL.sei] SELECT FROM
                array =>
                    WITH tR: bR.seb[typeR.sei] SELECT FROM
                        array =>
                            tL.packed = tR.packed
                                AND Equivalent[
                                    [typeL.stb, bL.UnderType[tL.componentType]], 
                                    [typeR.stb, bR.UnderType[tR.componentType]]]
                                AND Conformable[[typeL.stb, tL.indexType], [typeR.stb, tR.indexType], $val],
                        ENDCASE => FALSE,
                ENDCASE => Equivalent[typeL, typeR]]
            };

        FullRangeType: PROC[type: Types.Handle] RETURNS[Types.Handle] = {
            OPEN b: type.stb;
            sei, next: CSEIndex;
            FOR sei _ type.sei, next DO
                WITH b.seb[sei] SELECT FROM
                    subrange => next _ b.UnderType[rangeType];
                    ENDCASE => EXIT; 
                ENDLOOP;
            RETURN[[type.stb, sei]]};

        }.

