
    <<TypePack.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Satterthwaite, February 17, 1983 4:51 pm>>
        <<Rovner, July 6, 1983 1:42 pm>>
    <<Russ Atkinson (RRA) January 31, 1985 1:15:53 pm PST>>

    DIRECTORY
        ConvertUnsafe USING [SubString, EqualSubStrings],
        SymbolTable USING [Base],
        Symbols USING [Name, SEIndex, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, MDIndex, nullName, MDNull, OwnMdi, ISENull, 
        RecordSENull, StandardContext, typeANY, typeTYPE],
        Types 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 StandardContext 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: 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.unpainted THEN
                                    ~t2.unpainted AND  EqContexts[[type1.stb, t1.valueCtx], [type2.stb, t2.valueCtx]]
                                ELSE
                                    t2.unpainted 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]]};

        }.