
    <<[Indigo]<Rosemary>Ž>Rosemary.DF=>RoseTypesImpl.Mesa>>
    <<Last Edited by: Spreitzer, May 8, 1985 3:47:46 pm PDT>>

    DIRECTORY AMTypes, Asserting, Basics, BitTwiddling, IO, OrderedSymbolTableRef, PrincOps, Rope, RoseEvents, RoseTypes, VFonts;

    RoseTypesImpl: CEDAR PROGRAM
        IMPORTS BitTwiddling, IO, Rope
        EXPORTS RoseTypes =

    BEGIN OPEN BitTwiddling, RoseTypes;

    Error: PUBLIC ERROR [msg: ROPE, data: REF ANY _ NIL] = CODE;

    Warning: PUBLIC SIGNAL [msg: ROPE, data: REF ANY _ NIL] = CODE;

    Stop: PUBLIC SIGNAL [msg: ROPE, data: REF ANY _ NIL] = CODE;

    UpToInt: ARRAY BOOL OF INT = [FALSE: -1, TRUE: 1];

    Conforming: PUBLIC PROC [t1, t2: NodeType] RETURNS [c: BOOL] = {
        An: PROC [nt: NodeType] RETURNS [flavor: ATOM, length: INTEGER] = {
            WITH nt SELECT FROM
                x: AtomNodeType => {flavor _ x.flavor; length _ 1};
                x: ArrayNodeType => {flavor _ x.element.flavor; length _ x.length};
                ENDCASE => ERROR;
            };
        c _ An[t1] = An[t2];
        };

    Equivalent: PUBLIC PROC [nt1, nt2: NodeType] RETURNS [eq: BOOL] = {
        eq _ nt1 = nt2;
        IF nt1.procs.Equivalent # NIL AND NOT eq THEN eq _ nt1.procs.Equivalent[nt1, nt2];
        IF nt2.procs.Equivalent # NIL AND NOT eq THEN eq _ nt2.procs.Equivalent[nt2, nt1];
        };

    TransduceNeeded: PUBLIC PROC [nt1, nt2: NodeType] RETURNS [needed: BOOL] = {
        IF NOT Conforming[nt1, nt2] THEN ERROR --you shouldn't even be asking--;
        needed _ NOT Equivalent[nt1, nt2];
        IF needed AND nt1.simple = nt2.simple THEN ERROR;
        };

    BothTypes: PUBLIC PROC [nt: NodeType] RETURNS [simple, switch: NodeType] = {
        Get: PROC [get: PROC [NodeType] RETURNS [NodeType]] RETURNS [ont: NodeType] =
            {ont _ IF get # NIL THEN get[nt] ELSE NIL};
        IF nt.simple
            THEN {simple _ nt; switch _ Get[nt.procs.SwitchEquivalent]}
            ELSE {switch _ nt; simple _ Get[nt.procs.SimpleEquivalent]};
        IF simple # NIL AND switch # NIL AND NOT Conforming[simple, switch] THEN ERROR;
        };

    SelectorToRope: PUBLIC PROC [s: Selector] RETURNS [r: ROPE] = {
        r _ WITH s SELECT FROM
            whole => ".whole",
            number => IO.PutFR["[%g]", IO.int[index]],
            range => SELECT count FROM
                <1 => ERROR,
                =1 => IO.PutFR["[%g]", IO.int[first]],
                >1 => IO.PutFR["[%g..%g]", IO.int[first], IO.int[first+(count-1)*UpToInt[up]]],
                ENDCASE => ERROR,
            ENDCASE => ERROR;
        };

    SlotToPtr: PUBLIC PROC [s: Slot, useBryant: BOOL _ FALSE] RETURNS [p: Ptr] =
        TRUSTED BEGIN
        p _ IF useBryant
            THEN WPField[s.cell.realCellStuff.switchIOAsWP, s.cell.realCellStuff.effectivePorts[s.effectivePortIndex].switch]
            ELSE WPField[s.cell.realCellStuff.newIOAsWP, s.cell.realCellStuff.effectivePorts[s.effectivePortIndex].simple];
        END;

    GetIndex: PUBLIC PROC [ports: REF ANY, key: ROPE] RETURNS [index: CARDINAL] = {
        WITH ports SELECT FROM
            p: Ports => {
                FOR i: PortIndex IN [0 .. p.length) DO
                    IF key.Equal[p[i].name] THEN RETURN [i];
                    ENDLOOP;
                };
            ep: EffectivePorts => {
                FOR i: EffectivePortIndex IN [0 .. ep.length) DO
                    IF key.Equal[ep[i].name] THEN RETURN [i];
                    ENDLOOP;
                };
            ENDCASE => ERROR;
        RETURN [notFound];
        };

    END.