
<<LichenData4Impl.Mesa>>
    <<Last tweaked by Mike Spreitzer on October 20, 1987 8:06:17 pm PDT>>

    DIRECTORY LichenArrayStuff, Collections, LichenDataOps, LichenDataStructure, IntFunctions, IntStuff, LichenNavigation, 
    PairCollections, Rope, StructuredStreams, UnparserBuffer, ViewerIO;

    LichenData4Impl: CEDAR PROGRAM
        IMPORTS LichenArrayStuff, Collections, LichenDataOps, LichenDataStructure, IntFunctions, LichenNavigation, PairCollections
        =

    BEGIN OPEN LichenArrayStuff, LichenDataOps, LichenDataStructure, Colls:Collections, PairColls:PairCollections, Ints:IntStuff, 
    IntFns:IntFunctions, SS:StructuredStreams, UB:UnparserBuffer;

    Set: TYPE ~ LichenDataStructure.Set;
    Function: TYPE ~ LichenDataStructure.Function;
    OneToOne: TYPE ~ LichenDataStructure.OneToOne;
    Seq: TYPE ~ LichenDataStructure.Seq;

    Thing: TYPE ~ REF ANY --actually UNION [Port, Wire]--;
    Wirism: TYPE ~ REF ANY --actually UNION [Vertex, DumbWire]--;

    ReOrderDesign: PROC [d: Design] ~ {
        desiredPerm: Relation--Wirism 
        portDesires: Function--Port 
        delayedVerts: Set--of Vertex-- ~ Colls.CreateHashSet[];
        delayedPorts: Set--of Port-- ~ Colls.CreateHashSet[];
        arrayWireArray: Function--DumbWire 
        StartCellType: PROC [val: REF ANY] ~ {
            ct: CellType ~ NARROW[val];
            WorkOnPort: PROC [port: Port] RETURNS [doKids, moreSibs: BOOL _ TRUE] ~ {
                IF port.FirstChildPort[]=NIL THEN RETURN;
                {desire: Permutation ~ DesiredPerm[port, LichenNavigation.portToChildren, LichenNavigation.bestPortShortName];
                IF desire.IsIdentitySubset[] THEN RETURN;
                {refDesire: REF ANY ~ desire.Refify;
                delay: BOOL _ FALSE;
                CheckInstance: PROC [ci: CellInstance] ~ {
                    v: Vertex ~ FindTopEdge[ci, port].v;
                    allMe: BOOL ~ AllForPort[v, port];
                    IF NOT allMe THEN delay _ TRUE;
                    RETURN};
                CheckArray: PROC [act: CellType] ~ {
                    a: Array ~ act.asArray;
                    CheckOtherPort: PROC [other: Port] ~ {IF other#port THEN delay _ TRUE};
                    EnumerateConnectedEltPorts[a, port, CheckOtherPort];
                    RETURN};
                DelayInstance: PROC [ci: CellInstance] ~ {
                    v: Vertex ~ FindTopEdge[ci, port].v;
                    [] _ delayedVerts.AddElt[v];
                    [] _ desiredPerm.AddPair[[v, refDesire]];
                    RETURN};
                DelayArray: PROC [act: CellType] ~ {
                    a: Array ~ act.asArray;
                    DelayArrayWire: PROC [dw: DumbWire] ~ {
                        [] _ arrayWireArray.AddPair[[dw, a]];
                        [] _ desiredPerm.AddPair[[dw, refDesire]];
                        RETURN};
                    EnumerateDumbWiresForPort[a, port, DelayArrayWire];
                    RETURN};
                ct.EnumerateInstances[CheckInstance, TRUE];
                ct.EnumerateArrays[CheckArray];
                IF delay THEN {
                    ct.EnumerateInstances[DelayInstance, TRUE];
                    ct.EnumerateArrays[DelayArray];
                    IF NOT delayedPorts.AddElt[port] THEN ERROR;
                    Store[portDesires, [port, refDesire]]}
                ELSE PermutePort[port, desire, TRUE];
                RETURN}}};
            WorkOnWire: PROC [wire: Wire] RETURNS [doKids, moreSibs: BOOL _ TRUE] ~ {
                IF wire.FirstChildWire[]=NIL THEN RETURN;
                {desire: Permutation ~ DesiredPerm[wire, LichenNavigation.wireToChildren, LichenNavigation.bestVertexShortName];
                IF desire.IsIdentitySubset[] THEN RETURN;
                {refDesire: REF ANY ~ desire.Refify;
                delay: BOOL ~ NOT AllForPort[wire];
                IF delay THEN {
                    [] _ delayedVerts.AddElt[wire];
                    [] _ desiredPerm.AddPair[[wire, refDesire]];
                    }
                ELSE PermuteWire[wire, desire];
                RETURN}}};
            [] _ EnumeratePort[ct.port, WorkOnPort];
            IF ct.asUnorganized#NIL THEN [] _ ct.asUnorganized.internalWire.EnumerateWire[WorkOnWire];
            RETURN};
        DoDelayedPort: PROC [val: REF ANY] ~ {
            port: Port ~ NARROW[val];
            ct: CellType ~ PortCCT[port];
            allSame: BOOL _ TRUE;
            desire: Permutation ~ IntFns.DeRef[portDesires.Apply[port].val];
            CheckInstance: PROC [ci: CellInstance] ~ {
                v: Vertex ~ FindTopEdge[ci, port].v;
                perms: Set ~ desiredPerm.Mapping[v];
                size: INT ~ perms.Size[2];
                IF size=0 THEN ERROR;
                IF size>1 THEN allSame _ FALSE;
                RETURN};
            CheckArray: PROC [act: CellType] ~ {
                a: Array ~ act.asArray;
                CheckArrayWire: PROC [dw: DumbWire] ~ {
                    perms: Set ~ desiredPerm.Mapping[dw];
                    size: INT ~ perms.Size[2];
                    IF size=0 THEN ERROR;
                    IF size>1 THEN allSame _ FALSE;
                    RETURN};
                EnumerateDumbWiresForPort[a, port, CheckArrayWire];
                RETURN};
            ct.EnumerateInstances[CheckInstance, TRUE];
            ct.EnumerateArrays[CheckArray];
            IF allSame
                THEN PermutePort[port, desire, FALSE]
                ELSE Log["Port %g not permuted", LIST[port]];
            RETURN};
        DoDelayedWire: PROC [val: REF ANY] ~ {
            wire: Wire ~ NARROW[val];
            ct: CellType ~ wire.containingCT;
            perms: Set ~ desiredPerm.Mapping[wire];
            size: INT ~ perms.Size[2];
            IF size=0 THEN ERROR;
            IF size>1 THEN {
                Log["%g perms desired for wire %g", LIST[NEW [INT _ size], wire]];
                RETURN};
            {desire: Permutation ~ IntFns.DeRef[perms.TheElt];
            PermuteWire[wire, desire];
            RETURN}};
        d.cellTypes.Enumerate[StartCellType];
        delayedPorts.Enumerate[DoDelayedPort];
        delayedVerts.Enumerate[DoDelayedWire];
        RETURN};

    AllForPort: PROC [v: Vertex, port: Port _ NIL] RETURNS [allSame: BOOL _ TRUE] ~ {
        CheckEdge: PROC [p: Port, w: Vertex, e: Edge] ~ {
            IF p=NIL THEN ERROR;
            IF port=NIL THEN port_p ELSE IF p#port THEN allSame _ FALSE;
            RETURN};
        v.EnumerateImmediateEdges[CheckEdge, [cellward: TRUE, wireward: FALSE]];
        IF NOT allSame THEN RETURN;
        WITH v SELECT FROM
            ci: CellInstance => NULL;
            im: Intermediary => NULL;
            w: Wire => IF w.containingWire#NIL AND NOT AllForPort[w.containingWire] THEN RETURN [FALSE];
            ENDCASE => ERROR;
        RETURN};

    DesiredPerm: PROC [parent: Thing, ToChildren: OneToOne--Thing     [perm: Permutation] ~ {
        children: Seq--of child Things-- ~ IntFns.DeRef[ToChildren.Apply[parent].val];
        names: Seq--of SteppyName-- ~ children.Compose[right: ToName, rightRestricts: FALSE];
        perm _ IntFns.GradeUp[names, Colls.LexOrdering[NIL, LIST[nameStepSpace.SpaceOrdering]]];
        RETURN};

    PermutePort: PROC [port: Port, perm: Permutation, doConnections: BOOL] ~ {
        oldKids: Seq ~ IntFns.DeRef[LichenNavigation.portToChildren.Apply[port].val] .CreateSimpleCopy;
        n: INT ~ oldKids.Size;
        prev: Port _ NIL;
        index: INT _ 0;
        FixElt: PROC [pair: IntFns.IVPair] ~ {
            newIndex: INT ~ pair.left;
            oldIndex: INT ~ NARROW[pair.right, REF INT]^;
            kid: Port ~ NARROW[oldKids.Apply[oldIndex].val];
            IF index#newIndex THEN ERROR;
            kid.prev _ prev;
            IF prev#NIL THEN prev.next _ kid ELSE port.firstChild _ kid;
            prev _ kid;
            index _ index+1;
            RETURN};
        FixInstance: PROC [ci: CellInstance] ~ {
            v: Vertex ~ FindTopEdge[ci, port].v;
            PermuteVertex[v, perm];
            };
        perm.Enumerate[FixElt];
        IF index#n THEN ERROR;
        prev.next _ NIL;
        port.lastChild _ prev;
        IF doConnections THEN port.PortCCT.EnumerateInstances[FixInstance, TRUE];
        RETURN};

    PermuteWire: PROC [wire: Wire, perm: Permutation] ~ {
        oldKids: Seq ~ IntFns.DeRef[LichenNavigation.wireToChildren.Apply[wire].val] .CreateSimpleCopy;
        n: INT ~ oldKids.Size;
        prev: Wire _ NIL;
        index: INT _ 0;
        FixElt: PROC [pair: IntFns.IVPair] ~ {
            newIndex: INT ~ pair.left;
            oldIndex: INT ~ NARROW[pair.right, REF INT]^;
            kid: Wire ~ NARROW[oldKids.Apply[oldIndex].val];
            IF index#newIndex THEN ERROR;
            kid.prev _ prev;
            IF prev#NIL THEN prev.next _ kid ELSE wire.firstChild _ kid;
            prev _ kid;
            index _ index+1;
            RETURN};
        perm.Enumerate[FixElt];
        IF index#n THEN ERROR;
        prev.next _ NIL;
        wire.lastChild _ prev;
        RETURN};

    PermuteVertex: PROC [v: Vertex, perm: Permutation] ~ {
        WITH v SELECT FROM
            w: Wire => {PermuteWire[w, perm]; RETURN};
            im: Intermediary => NULL;
            ci: CellInstance => NULL;
            ENDCASE => ERROR;
        {old: Seq--of old Edge-- ~ IntFns.CreateSimple[oneToOne: TRUE, dense: TRUE];
        NoteOldEdge: PROC [p: Port, w: Vertex, e: Edge] ~ {
            IF e.sides[cellward].v#v THEN ERROR;
            old.Append[e];
            RETURN};
        v.EnumerateImmediateEdges[NoteOldEdge, [cellward: FALSE, wireward: TRUE], forward];
        {n: INT ~ old.Size;
        oldFirstWireward: Edge ~ NARROW[old.First[].pair.right];
        lastCellward: Edge ~ oldFirstWireward.sides[cellward].prev;
        prev: Edge _ lastCellward;
        prevSide: GraphDirection _ wireward;
        index: INT _ 0;
        FixElt: PROC [pair: IntFns.IVPair] ~ {
            newIndex: INT ~ pair.left;
            oldIndex: INT ~ NARROW[pair.right, REF INT]^;
            e: Edge ~ NARROW[old.Apply[oldIndex].val];
            IF index#newIndex THEN ERROR;
            e.sides[cellward].prev _ prev;
            IF prev#NIL THEN prev.sides[prevSide].next _ e
            ELSE IF v.firstEdge.sides[cellward].v#v THEN ERROR
            ELSE v.firstEdge _ e;
            prev _ e;
            prevSide _ cellward;
            index _ index+1;
            RETURN};
        IF lastCellward#NIL AND lastCellward.sides[wireward].v#v THEN ERROR;
        perm.Enumerate[FixElt];
        IF index#n OR n=0 THEN ERROR;
        prev.sides[cellward].next _ NIL;
        v.lastEdge _ prev;
        RETURN}}};

    Store: PROC [pc: PairColls.PairColl, pair: PairColls.Pair] ~ {
        lr: BOOL ~ pc.Functional[][leftToRight];
        rl: BOOL ~ pc.Functional[][rightToLeft];
        news: PairColls.NewsPair ~ pc.AddPair[pair, [[NOT lr, TRUE], [NOT rl, TRUE]]];
        IF lr AND news[leftToRight]#new THEN ERROR;
        IF rl AND news[rightToLeft]#new THEN ERROR;
        };

    END.