
<<LichenSplitMerge.Mesa>>
    <<Last tweaked by Mike Spreitzer on April 30, 1987 1:46:04 pm PDT>>

    DIRECTORY Asserting, LichenArrayStuff, LichenDataOps, LichenDataStructure, LichenSetTheory, LichenTransforms, 
    LichenTransformsPrivate, RefTab, Rope;

    LichenSplitMerge: CEDAR PROGRAM
        IMPORTS Asserting, LichenArrayStuff, LichenDataOps, LichenDataStructure, LichenSetTheory, LichenTransformsPrivate, RefTab, Rope
        EXPORTS LichenTransforms =

    BEGIN OPEN LichenArrayStuff, LichenDataStructure, LichenTransforms, LichenDataOps, LichenSetTheory, LichenTransformsPrivate;

    PortAns: TYPE ~ REF PortAnsPrivate;
    PortAnsPrivate: TYPE ~ RECORD [
        from, to: Port,
        doFrom: PortAction _ leave,
        doTo: PortAction[dontAdd..addPort] _ dontAdd
        ];

    SplitType: PUBLIC PROC [design: Design, fizz: Set--of CellInstance--] RETURNS [from, to: CellType, pairs: OneToOne--instances of 
    from 
        analysis: Analysis ~ NEW [AnalysisPrivate _ [
            roles: fizz.Size[],
            subjTypes: CreateRefSeq[fizz.Size[]],
            wag: NEW [WireAnsweringPrivate _ [
                oldSubjConnectionss: CreateRefSeq[fizz.Size[]],
                anses: CreateHashMapper[]
                ]],
            doomedPorts: CreateHashSet[]
            ]];
        {OPEN analysis;
        cs: RefSeq--role 
        connections: BiRel--port of from 
        nameParts: LOLORA _ NIL;
        toName, subTail: ROPE;
        IF roles=0 THEN Error["Null fission"];
        from _ NIL;
        {i: INT _ 0;
        PerElt: PROC [ra: REF ANY] ~ {v: CellInstance ~ NARROW[ra];
            IF v.type=NIL OR v.containingCT=NIL THEN ERROR;
            IF from=NIL THEN from _ v.containingCT ELSE IF from#v.containingCT THEN Error["Fission of vertices not all having same parent"];
            nameParts _ CONS[Select[nameReln, 1, v.other], nameParts];
            cs[i] _ v;
            subjTypes[i] _ v.type;
            i _ i + 1;
            };
        fizz.Enumerate[PerElt];
        IF i # cs.length THEN ERROR;
        };
        IF NOT from.designs.HasMember[design] THEN ERROR;
        subTail _ RopeCrossCat[nameParts];
        toName _ RopeCrossCat[LIST[Select[nameReln, 1, from.otherPublic], LIST[subTail]]];
        subTail _ Rope.Concat["-", subTail];
        to _ CreateCellType[design: design, cellTypeName: toName, class: NIL, internals: TRUE];
        pairs _ CreateHashOTO[];
        IF Survey[from, NIL, cs, analysis, TRUE] THEN ERROR;
        {MoveWire: PROC [domain, range: REF ANY] ~ {
            wire: Wire ~ NARROW[domain];
            wa: WireAns ~ NARROW[range];
            IF NOT wa.analyzed THEN ERROR;
            IF wa.counterpart # NIL THEN ERROR;
            wa.counterpart _ CreateWire[containingCT: to, copy: wire, other: Asserting.Filter[nameReln, wire.other].about];
            SELECT wa.doFrom FROM
                addPort => {
                    wa.fromPort _ AddPort[[parent: from.port, wire: wire]];
                    AddEdge[[from.asUnorganized.mirror, wire], wa.fromPort]};
                leave, dontAdd, dePort => NULL;
                ENDCASE => ERROR;
            SELECT wa.doTo FROM
                addPort => {
                    wa.toPort _ AddPort[[parent: to.port, wire: wa.counterpart]];
                    IF wa.fromPort=NIL THEN ERROR;
                    IF NOT connections.AddPair[[wa.fromPort, wa.toPort]] THEN ERROR;
                    AddEdge[[to.asUnorganized.mirror, wa.counterpart], wa.toPort]};
                dontAdd => NULL;
                ENDCASE => ERROR;
            };
        wag.anses.EnumerateMap[MoveWire];
        };
        FOR role: NATURAL IN [0 .. roles) DO
            fci: CellInstance ~ NARROW[cs[role]];
            tci: CellInstance ~ Instantiate[fci.type, to, fci.other];
            MoveConnection: PROC [subjPort: Port, fwire: Wire] ~ {
                wa: WireAns = GetRPAns[wag, role, subjPort, fwire, FALSE];
                IF NOT wa.analyzed THEN ERROR;
                AddEdges[[tci, wa.counterpart], subjPort];
                };
            EnumerateTopConnections[fci, MoveConnection];
            ENDLOOP;
        FixArrays[design, from, to, connections, doomedPorts, portToInternalWire, subTail, pairs];
        FixInstances[from, to, connections, doomedPorts, portToInternalWire, pairs];
        FOR i: NATURAL IN [0 .. cs.length) DO
            DeleteVertex[NARROW[cs[i]]];
            ENDLOOP;
        {KillWireAndPort: PROC [domain, range: REF ANY] ~ {
            wire: Wire ~ NARROW[domain];
            wa: WireAns ~ NARROW[range];
            IF NOT wa.analyzed THEN ERROR;
            IF wa.counterpart=NIL THEN ERROR;
            SELECT wa.doFrom FROM
                addPort => NULL;
                leave, dontAdd => NULL;
                dePort => RemovePort[wa.fromPort];
                ENDCASE => ERROR;
            IF NOT (wa.sawElse OR wa.sawBords) THEN DeleteVertex[wire];
            domain _ domain;
            };
        wag.anses.EnumerateMap[KillWireAndPort];
        };
        to _ to;
        }};

    FixArrays: PROC
        [
            design: Design,
            fromAncestorCT, toAncestorCT: CellType,
            eltConnections: BiRel--port of fromAncestorCT 
            doomedFromPorts: Set--of port of fromAncestorCT--,
            eltTPToWire: Mapper--port of toAncestorCT 
            subTail: ROPE--to append to name of from array--,
            pairs: OneToOne--instance of ancestor of from 
        ] ~ {
        SplitArray: PROC [fromArrayCT: CellType] ~ {
            fa: Array ~ fromArrayCT.asArray;
            faName: ROPE ~ NARROW[Asserting.FnVal[nameReln, fromArrayCT.otherPublic]];
            taName: ROPE ~ faName.Cat[subTail];
            toArrayCT: CellType ~ CreateArray[design, taName, NIL, toAncestorCT, fa.size, fa.jointsPeriod, GetBorders[fa], NIL, NIL];
            ta: Array ~ toArrayCT.asArray;
            toNewGroup: Mapper--group of fa 
            toNewTie: Mapper--tie of ta 
            arrayConnections: BiRel--port of fromArrayCT 
            arrayTPToWire: Mapper--port of ta 
            doomedArrayPorts: Set--of port of fa-- ~ CreateHashSet[];
            AddConnection: PROC [fai: ArrayIndex, fg: Group, tai: ArrayIndex, tg: Group] ~ {
                IF fg=NIL OR tg=NIL THEN ERROR;
                {fp: Port ~ GetArrayPortForGroup[fromArrayCT, fa, fai, fg, TRUE];
                tp: Port ~ GetArrayPortForGroup[toArrayCT, ta, tai, tg, TRUE];
                w: Wire ~ NARROW[eltTPToWire.Map[tg.ports.first]];
                oldFps: Set--of port of fromArrayCT-- ~ arrayConnections.BiRelMap[tp, rightToLeft];
                IF fp=NIL OR tp=NIL THEN ERROR;
                IF w=NIL THEN ERROR;
                SELECT TRUE FROM
                    oldFps.Size[]=0 => IF NOT arrayConnections.AddPair[[fp, tp]] THEN ERROR;
                    TheElt[oldFps]=fp => NULL;
                    ENDCASE => ERROR;
                [] _ arrayTPToWire.PutMapping[tp, w];
                }};
            IF IsIncompleteArray[fromArrayCT] THEN ERROR;
            IF ta.groupingParmses # fa.groupingParmses THEN ERROR;
            {UnroleOldPort: PROC [ra: REF ANY] ~ {UnrolePort[fa, NARROW[ra]]};
            doomedFromPorts.Enumerate[UnroleOldPort];
            };
            FOR gi: NATURAL IN [0 .. fa.groupingses.length) DO
                fgs: Groupings ~ NARROW[fa.groupingses[gi]];
                tgs: Groupings ~ NARROW[ta.groupingses[gi]];
                MoveGroup: PROC [ra: REF ANY] ~ {
                    fg: Group ~ NARROW[ra];
                    tg: Group ~ MakeGroup[ta, fg.gi2, tgs];
                    IF NOT toNewGroup.PutMapping[fg, tg] THEN ERROR;
                    FOR pl: PortList _ fg.ports, pl.rest WHILE pl # NIL DO
                        fp: Port ~ NARROW[pl.first];
                        EnGroup: PROC [ra: REF ANY] ~ {
                            tp: Port ~ NARROW[ra];
                            AddPortToGroup[ta, gi, tp, tg, FALSE];
                            };
                        eltConnections.EnumerateMapping[fp, leftToRight, EnGroup];
                        IF doomedFromPorts.HasMember[fp] THEN RemovePortFromGroup[fa, gi, fp, fg];
                        ENDLOOP;
                    ra _ ra;
                    };
                fgs.groups.Enumerate[MoveGroup];
                ENDLOOP;
            {MoveTie: PROC [d: Dim, phase: Nat2, jgi: NATURAL, jgi2: Nat2, j: Joint, tie: Tie] ~ {
                fj: Joint ~ j;
                ftie: Tie ~ tie;
                IF ftie.groups[low]#NIL AND ftie.groups[high]#NIL THEN {
                    tj: Joint ~ GetArrayJoint[ta, d, phase];
                    ttie: Tie ~ NEW [TiePrivate _ [groups: [
                        low: NARROW[toNewGroup.Map[ftie.groups[low]]],
                        high: NARROW[toNewGroup.Map[ftie.groups[high]]]]]];
                    IF ttie.groups[low]=NIL OR ttie.groups[high]=NIL THEN ERROR;
                    AddTie[tj, jgi, ttie];
                    IF NOT toNewTie.PutMapping[ftie, ttie] THEN ERROR;
                    };
                };
            EnumerateTies[fa, MoveTie];
            };
            FlushArrayWires[fa, doomedArrayPorts];
            {ConnectGroup: PROC [domain, range: REF ANY] ~ {
                fg: Group ~ NARROW[domain];
                tg: Group ~ NARROW[range];
                IF tg.gi2#fg.gi2 THEN ERROR;
                IF tg.ports#NIL AND (fg.ports#NIL OR fa.toWire.Fetch[fg].val#NIL) THEN {
                    air: Range2 ~ Gi2ToAir[fa, fg.gi2].air;
                    FOR f: INT IN [air[Foo].min .. air[Foo].maxPlusOne) DO FOR b: INT IN [air[Bar].min .. air[Bar].maxPlusOne) DO
                        ai: ArrayIndex ~ [f, b];
                        IF fg.ports#NIL OR GetArrayPortForGroup[fromArrayCT, fa, ai, fg, FALSE]#NIL THEN AddConnection[ai, fg, ai, tg];
                        ENDLOOP ENDLOOP;
                    };
                };
            toNewGroup.EnumerateMap[ConnectGroup];
            };
            {ConnectTie: PROC [d: Dim, phase: Nat2, jgi: NATURAL, jgi2: Nat2, j: Joint, tie: Tie] ~ {
                ftie: Tie ~ tie;
                ttie: Tie ~ NARROW[toNewTie.Map[ftie]];
                IF ttie#NIL
                    AND ((ttie.groups[low].ports=NIL) # (ttie.groups[high].ports=NIL))
                    AND ((ttie.groups[low].ports=NIL) # (ftie.groups[low].ports=NIL))
                    AND ((ttie.groups[high].ports=NIL) # (ftie.groups[high].ports=NIL))
                    THEN {
                    o: Dim ~ OtherDim[d];
                    toHigh: BOOL ~ ttie.groups[low]=NIL;
                    FOR perp: NATURAL IN [0 .. fa.size[o]) DO FOR para: NATURAL IN [0 .. fa.size[d]-1) DO
                        lai: ArrayIndex ~ ConsInt2[d, para, perp];
                        hai: ArrayIndex ~ Int2Tweak[lai, d, 1];
                        IF toHigh THEN AddConnection[lai, ftie.groups[low], hai, ttie.groups[high]] ELSE AddConnection[lai, ftie.groups[high], hai, 
                        ttie.groups[low]];
                        ENDLOOP ENDLOOP;
                    };
                };
            EnumerateTies[fa, ConnectTie];
            };
            TrimEmptyGroups[fa];
            TrimEmptyGroups[ta];
            FixArrays[design, fromArrayCT, toArrayCT, arrayConnections, doomedArrayPorts, arrayTPToWire, subTail, pairs];
            FixInstances[fromArrayCT, toArrayCT, arrayConnections, doomedArrayPorts, arrayTPToWire, pairs];
            {PerDoomedArrayPort: PROC [ra: REF ANY] ~ {
                p: Port--of fromArrayCT-- ~ NARROW[ra];
                RemovePort[p];
                };
            doomedArrayPorts.Enumerate[PerDoomedArrayPort];
            };
            };
        fromAncestorCT.EnumerateArrays[SplitArray];
        };

    FixInstances: PROC
        [
            fromAncestorCT, toAncestorCT: CellType,
            connections: BiRel--port of fromAncestorCT 
            doomedFromPorts: Set--of port of fromAncestorCT--,
            tpToWire: Mapper--port of toAncestorCT 
            pairs: OneToOne--instance of ancestor of from 
        ] ~ {
        FixInstance: PROC [fci: CellInstance] ~ {
            parentCT: CellType ~ fci.containingCT;
            tci: CellInstance ~ Instantiate[toAncestorCT, parentCT];
            ConnectChildren: PROC [parent: Port, do: BOOL] RETURNS [done: BOOL] ~ {
                done _ FALSE;
                FOR tp: Port _ FirstChildPort[parent], NextChildPort[tp] WHILE tp # NIL DO
                    IF connections.HasMapping[tp, rightToLeft] THEN done _ TRUE;
                    ENDLOOP;
                IF done OR do THEN {
                    FOR tp: Port _ FirstChildPort[parent], NextChildPort[tp] WHILE tp # NIL DO
                        seen: BOOL _ FALSE;
                        PerFrom: PROC [ra: REF ANY] ~ {
                            fp: Port--of fa-- ~ NARROW[ra];
                            w: Wire ~ FindTransitiveConnection[fci, fp];
                            IF seen THEN ERROR ELSE seen _ TRUE;
                            IF w=NIL THEN ERROR;
                            AddEdges[[tci, w], tp];
                            };
                        connections.EnumerateMapping[tp, rightToLeft, PerFrom];
                        IF seen THEN NULL
                        ELSE IF NOT ConnectChildren[tp, FALSE] THEN {
                            w: Wire ~ CreateWire[containingCT: parentCT, copy: NARROW[tpToWire.Map[tp]]];
                            AddEdges[[tci, w], tp];
                            };
                        ENDLOOP;
                    };
                };
            [] _ ConnectChildren[toAncestorCT.port, TRUE];
            UnlinkPorts[fci, doomedFromPorts];
            IF pairs.PutOTOMapping[[fci, tci]]#[TRUE, TRUE] THEN ERROR;
            };
        EnumerateInstances[fromAncestorCT, FixInstance];
        };

    Select: PROC [reln: Asserting.Term, position: NATURAL, from: Assertions] RETURNS [terms: Asserting.Terms] ~ {
        Filter: PROC [assertion: Asserting.Assertion] ~ {
            these: Asserting.Terms _ Asserting.TermsOf[assertion];
            THROUGH [1 .. position) DO these _ these.rest ENDLOOP;
            terms _ CONS[these.first, terms];
            };
        Asserting.EnumerateAssertionsAbout[reln, from, Filter];
        };

    RopeCrossCat: PROC [lolora: LOLORA] RETURNS [ans: ROPE] ~ {
        ans _ NIL;
        FOR lolora _ lolora, lolora.rest WHILE lolora # NIL DO
            lora: LORA _ NARROW[lolora.first];
            subAns: ROPE _ NIL;
            n: NATURAL _ 0;
            FOR lora _ lora, lora.rest WHILE lora # NIL DO
                n _ n + 1;
                SELECT n FROM
                    1 => NULL;
                    2 => subAns _ Rope.Cat["{", subAns, "|"];
                    ENDCASE => subAns _ subAns.Concat["|"];
                subAns _ subAns.Concat[NARROW[lora.first]];
                ENDLOOP;
            IF n > 1 THEN subAns _ subAns.Concat["}"];
            IF ans # NIL THEN ans _ ans.Concat["-"];
            ans _ ans.Concat[subAns];
            ENDLOOP;
        ans _ ans;
        };

    END.