
<<LichenSplitMerge.Mesa>>
    <<Last tweaked by Mike Spreitzer on April 29, 1987 2:53:03 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;

    PortPair: TYPE = REF PortPairPrivate;
    PortPairPrivate: TYPE = RECORD [from, to: Port];

    ArrayWireAns: TYPE = REF ArrayWireAnsPrivate;
        <<Data for the wire connected to a port of a vertex to be moved.>>
    ArrayWireAnsPrivate: TYPE = RECORD [
        proto: ArrayWire,
        analyzed: BOOL _ FALSE,
        fromPort: Port _ NIL,
            <<A border port found, if any.>>
        toPort: Port _ NIL,
            <<The border port created on the splinter cell type.>>
        sawBord: BOOL _ FALSE,
            <<Connected to the border at least once>>
        sawBords: BOOL _ FALSE,
            <<Connected to the border by more than one port.>>
        sawElse: BOOL _ FALSE
            <<Connected to something other than the border & subjects.>>
        ];

    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 
        toRole: Mapper--fizzee 
        addedFromPorts: Set--of Port of from-- ~ CreateHashSet[];
        addedToPorts: Set--of Port of to-- ~ CreateHashSet[];
        nameParts: LOLORA _ NIL;
        toName: 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;
            IF NOT toRole.PutMapping[v, NEW [INT _ i]] THEN ERROR;
            i _ i + 1;
            };
        fizz.Enumerate[PerElt];
        IF i # cs.length THEN ERROR;
        };
        IF NOT from.designs.HasMember[design] THEN ERROR;
        IF from.firstInstance # NIL THEN ERROR nyet--we only split arrays--;
        nameParts _ CONS[Select[nameReln, 1, from.otherPublic], nameParts];
        toName _ RopeCrossCat[nameParts];
        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]];
                    [] _ UnionSingleton[addedFromPorts, wa.fromPort];
                    AddEdge[[from.asUnorganized.mirror, wire], wa.fromPort]};
                leave, dePort => NULL;
                ENDCASE => ERROR;
            SELECT wa.doTo FROM
                addPort => {
                    wa.toPort _ AddPort[[parent: to.port, wire: wa.counterpart]];
                    [] _ UnionSingleton[addedToPorts, wa.toPort];
                    AddEdge[[to.asUnorganized.mirror, wa.counterpart], wa.toPort]};
                ignore => NULL;
                ENDCASE => ERROR;
            };
        wag.anses.EnumerateMapping[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;
        {SplitArray: PROC [fromArrayCT: CellType] ~ {
            fa: Array ~ fromArrayCT.asArray;
            faName: ROPE ~ NARROW[Asserting.FnVal[nameReln, fromArrayCT.otherPublic]];
            taName: ROPE ~ faName.Cat["#", toName];
            toArrayCT: CellType ~ CreateArray[design, taName, NIL, to, fa.size, fa.jointsPeriod, GetBorders[fa], NIL, NIL];
            ta: Array ~ toArrayCT.asArray;
            toNewGroup: Mapper--group of fa 
            toOldGroup: Mapper--group of ta 
            toNewTie: Mapper--tie of ta 
            toFromPort: Mapper--port of ta 
            tpToWire: Mapper--port of ta 
            doomedArrayPorts: Set--of port of fa-- ~ CreateHashSet[];
            toAns: Mapper--ArrayWire of from 
            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 ~ IF tg.ports # NIL THEN tg.ports.first.wire ELSE fg.ports.first.wire;
                IF fp=NIL OR tp=NIL THEN ERROR;
                SELECT toFromPort.Map[tp] FROM
                    NIL => IF NOT toFromPort.PutMapping[tp, fp] THEN ERROR;
                    fp => NULL;
                    ENDCASE => ERROR;
                IF w=NIL THEN ERROR;
                [] _ tpToWire.PutMapping[tp, w];
                }};
            IF IsIncompleteArray[fromArrayCT] THEN ERROR;
            IF ta.groupingParmses # fa.groupingParmses THEN ERROR;
            IF fromArrayCT.firstArray # NIL THEN ERROR nyet--we only split one level of arraying--;
            {MaybeAddGroup: 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 => MakeGroupsForPort[fa, wa.fromPort];
                    leave => NULL;
                    dePort => UnrolePort[fa, wa.fromPort];
                    ENDCASE => ERROR;
                SELECT wa.doTo FROM
                    addPort => IF wa.fromPort=NIL THEN ERROR;
                    ignore => NULL;
                    ENDCASE => ERROR;
                };
            wag.anses.EnumerateMapping[MaybeAddGroup];
            };
            {PromoteAnswers: PROC [domain, range: REF ANY] ~ {
                wire: Wire ~ NARROW[domain];
                wa: WireAns ~ NARROW[range];
                PerPort: PROC [p: Port--of from--] ~ {
                    EnumerateGroupsContainingPort[fa, p, PerGroup];
                    };
                PerGroup: PROC [gi2: Nat2, gi: NATURAL, g: Group] ~ {
                    EnumerateArrayWiresContainingGroup[fa, gi2, gi, g, PerAW, TRUE];
                    };
                PerAW: PROC [aw: ArrayWire] ~ {
                    awa: ArrayWireAns _ NARROW[toAns.Map[aw]];
                    ExploreGroup: PROC [gi2: Nat2, gi: NATURAL, g: Group, membership: BoolSeq--group instance index 
                        FOR pl: PortList _ g.ports, pl.rest WHILE pl # NIL DO
                            ep: Port--of from-- ~ pl.first;
                            wa: WireAns ~ NARROW[wag.anses.Map[ep.wire]];
                            IF ep.wire=NIL THEN ERROR;
                            IF wa.sawElse THEN awa.sawElse _ TRUE;
                            ENDLOOP;
                        };
                    IF awa=NIL AND NOT toAns.PutMapping[aw, awa _ NEW [ArrayWireAnsPrivate _ [aw]]] THEN ERROR;
                    IF NOT awa.analyzed THEN RETURN;
                    awa.analyzed _ TRUE;
                    IF (awa.sawBord _ aw.ports.Size[]>0) THEN awa.fromPort _ NARROW[aw.ports.PickOne[]];
                    awa.sawBords _ aw.ports.Size[] > 1;
                    EnumerateGroupsOfArrayWire[fa, aw, ExploreGroup];
                    };
                IF NOT wa.analyzed THEN ERROR;
                IF wa.counterpart=NIL THEN ERROR;
                EnumeratePortsForWire[wire, PerPort];
                domain _ domain};
            wag.anses.EnumerateMapping[PromoteAnswers];
            };
            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;
                    IF NOT toOldGroup.PutMapping[tg, fg] THEN ERROR;
                    FOR pl: PortList _ fg.ports, pl.rest WHILE pl # NIL DO
                        fp: Port ~ NARROW[pl.first];
                        fw: Wire ~ fp.wire;
                        wa: WireAns ~ NARROW[wag.anses.Map[fw]];
                        IF fw=NIL THEN ERROR;
                        IF wa # NIL THEN {
                            tp: Port ~ wa.toPort;
                            SELECT wa.doTo FROM
                                addPort => AddPortToGroup[ta, gi, tp, tg, FALSE];
                                ignore => NULL;
                                ENDCASE => ERROR;
                            SELECT wa.doFrom FROM
                                dePort => RemovePortFromGroup[fa, gi, fp, fg];
                                leave, addPort => NULL;
                                ENDCASE => ERROR;
                            };
                        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.EnumerateMapping[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];
            {FixInstance: PROC [fci: CellInstance] ~ {
                parentCT: CellType ~ fci.containingCT;
                tci: CellInstance ~ Instantiate[toArrayCT, parentCT];
                ConnectChildren: PROC [parent: Port, do: BOOL] RETURNS [done: BOOL] ~ {
                    done _ FALSE;
                    FOR tp: Port _ FirstChildPort[parent], NextChildPort[tp] WHILE tp # NIL DO
                        IF toFromPort.Map[tp] # NIL THEN done _ TRUE;
                        ENDLOOP;
                    IF done OR do THEN {
                        FOR tp: Port _ FirstChildPort[parent], NextChildPort[tp] WHILE tp # NIL DO
                            fp: Port--of fa-- ~ NARROW[toFromPort.Map[tp]];
                            IF fp # NIL THEN {
                                w: Wire ~ FindTransitiveConnection[fci, fp];
                                IF w=NIL THEN ERROR;
                                AddEdges[[tci, w], tp];
                                }
                            ELSE IF NOT ConnectChildren[tp, FALSE] THEN {
                                w: Wire ~ CreateWire[containingCT: parentCT, copy: NARROW[tpToWire.Map[tp]]];
                                AddEdges[[tci, w], tp];
                                };
                            ENDLOOP;
                        };
                    };
                [] _ ConnectChildren[toArrayCT.port, TRUE];
                UnlinkPorts[fci, doomedArrayPorts];
                IF pairs.PutOTOMapping[fci, tci]#[TRUE, TRUE] THEN ERROR;
                };
            EnumerateInstances[fromArrayCT, FixInstance];
            };
            {PerDoomedArrayPort: PROC [ra: REF ANY] ~ {
                p: Port--of fromArrayCT-- ~ NARROW[ra];
                RemovePort[p];
                };
            doomedArrayPorts.Enumerate[PerDoomedArrayPort];
            };
            };
        from.EnumerateArrays[SplitArray];
        };
        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 => NULL;
                dePort => RemovePort[wa.fromPort];
                ENDCASE => ERROR;
            IF NOT (wa.sawElse OR wa.sawBords) THEN DeleteVertex[wire];
            domain _ domain;
            };
        wag.anses.EnumerateMapping[KillWireAndPort];
        };
        to _ to;
        }};

    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;
        };

    PortPairEqual: PROC [key1, key2: REF ANY] RETURNS [BOOL] --RefTab.EqualProc-- ~ {
        pp1: PortPair ~ NARROW[key1];
        pp2: PortPair ~ NARROW[key2];
        RETURN [pp1^ = pp2^];
        };

    HashPortPair: PROC [key: REF ANY] RETURNS [CARDINAL] -- RefTab.HashProc-- ~ {
        pp: PortPair ~ NARROW[key];
        RETURN [HashRefI[pp.from] + HashRefI[pp.to]]};

    END.