
<<LichenChildishTransforms.Mesa>>
<<Last Edited by: Spreitzer, March 25, 1986 4:05:54 pm PST>>

    DIRECTORY LichenDataStructure, LichenDataOps, LichenSetTheory, LichenTransforms;

    LichenChildishTransforms: CEDAR PROGRAM
        IMPORTS LichenDataOps, LichenDataStructure, LichenSetTheory
        EXPORTS LichenTransforms =

        BEGIN OPEN LichenDataStructure, LichenTransforms, LichenDataOps, LichenSetTheory;

        opCount: INT _ 0;

        Analysis: TYPE = REF AnalysisPrivate;
        AnalysisPrivate: TYPE = RECORD [
            roles: NAT,
            gcTypes: RefSeq--role 
            wag: WireAnswering,
            doomedPorts: Set _ CreateHashSet[],
            losses, gains: NAT _ 0
            ];

        WireAnswering: TYPE = REF WireAnsweringPrivate;
        WireAnsweringPrivate: TYPE = RECORD [
            oldGCConnectionss: RefSeq--role 
            anses: Mapper--wire 
            key: REF ANY];

        WireAns: TYPE = REF WireAnsPrivate;
            <<Data for the wire connected to a port of a grandchild.>>
        WireAnsPrivate: TYPE = RECORD [
            proto: Wire,
            key: REF ANY,
            analyzed: BOOL _ FALSE,
            sawSelves: BoolSeq,
            childPort: Port _ NIL,
            gcPorts: PortList _ NIL,
            sawBord: BOOL _ FALSE,
                <<Connected to the child at least once>>
            sawBords: BOOL _ FALSE,
                <<Connected to the child by more than one port.>>
            sawElse: BOOL _ FALSE,
                <<Connected to something other than the child & grandchildren.>>
            child: CellInstance _ NIL,
            counterpart: Wire _ NIL
            ];

        LowerChildren: PUBLIC PROC [design: Design, childType: CellType, sibber: Mapper--child         [gcs: RefSeq--role 
            BEGIN
            analysis: Analysis = NEW [AnalysisPrivate _ [
                roles: LAST[NAT],
                wag: NEW [WireAnsweringPrivate _ [
                    anses: CreateHashMapper[],
                    key: NEW [INT _ opCount _ opCount + 1]]]
                ]];
            {OPEN analysis;
            first: BOOL _ TRUE;
            dif: BOOL _ FALSE;
            oldPort: Port = childType.port;
            newPort: Port;
            parentTypes: Set = CreateHashSet[];
            children _ CreateHashSet[];
            {SeeInstance: PROC [child: CellInstance] = {
                sibs: RefSeq--role 
                IF IsMirror[child] THEN ERROR;    --AM2
                IF first THEN {
                    wag.oldGCConnectionss _ CreateRefSeq[sibs.length];
                    gcTypes _ CreateRefSeq[sibs.length];
                    FOR role: NAT IN [0 .. sibs.length) DO
                        sib: CellInstance = NARROW[sibs[role]];
                        gcTypes[role] _ sib.type;
                        ENDLOOP;
                    };
                IF Survey[child.containingCT, child, sibs, analysis, first] THEN dif _ TRUE;
                first _ FALSE;
                };
            EnumerateInstances[childType, SeeInstance];
            };
            IF first OR dif THEN RETURN [NIL, NIL];
            NoteChange[childType];
            gcs _ CreateRefSeq[gcTypes.length];
            FOR role: NAT IN [0 .. gcs.length) DO
                gcs[role] _ Instantiate[
                    type: NARROW[gcTypes[role]],
                    containingCT: childType];
                ENDLOOP;
            newPort _ oldPort;
            {MaybeDeleteOldChildPort: PROC [cPort: Port, w: Vertex, e: Edge] = {
                wire: Wire = NARROW[w];
                IF doomedPorts.HasMember[cPort] THEN RemoveEdges[e];
                };
            EnumerateTopEdges[childType.asUnorganized.mirror, MaybeDeleteOldChildPort]};
            FOR role: NAT IN [0 .. gcs.length) DO
                PerTopWire: PROC [domain, range: REF ANY] = {
                    outerWire: Wire = NARROW[domain];
                    wa: WireAns = NARROW[range];
                    NewPort: PROC RETURNS [insideNet: Wire] = {
                        SELECT wa.counterpart FROM
                            addPort => {
                                wa.counterpart _ insideNet _ CreateWire[containingCT: childType, copy: outerWire];
                                wa.childPort _ AddPort[[parent: newPort, wire: insideNet]];
                                AddEdge[[childType.asUnorganized.mirror, insideNet], wa.childPort];
                                };
                            dePort => ERROR;
                            # NIL => insideNet _ wa.counterpart;
                            ENDCASE => ERROR;
                        };
                    MakeDummy: PROC RETURNS [insideNet: Wire] = {
                        IF wa.counterpart # NIL THEN RETURN [wa.counterpart];
                        wa.counterpart _ insideNet _ CreateWire[containingCT: childType, copy: outerWire];
                        };
                    innerWire: Wire = IF wa.sawBord THEN wa.childPort.wire ELSE IF wa.sawElse THEN NewPort[] ELSE MakeDummy[];
                    FOR gcPorts: PortList _ wa.gcPorts, gcPorts.rest WHILE gcPorts # NIL DO
                        AddEdges[[NARROW[gcs[role]], innerWire], gcPorts.first];
                        ENDLOOP;
                    };
                wag.anses.EnumerateMapping[PerTopWire];
                ENDLOOP;
            CheckCellType[ct: childType, rep: ignore, norm: check, comparable: ignore, instances: FALSE];
            {TweakInstance: PROC [child: CellInstance] = {
                sibs: RefSeq--role 
                IF IsMirror[child] THEN ERROR;    --AM2
                [] _ UnionSingleton[children, child];
                sibs _ NARROW[sibber.Map[child]];
                IF sibs.length # gcs.length THEN ERROR --caller blew it--;
                FOR role: NAT IN [0 .. sibs.length) DO
                    sib: CellInstance = NARROW[sibs[role]];
                    PerEdge: PROC [gcPort: Port, net: Vertex, e: Edge] = {
                        wa: WireAns = GetRPAns[wag, role, gcPort];
                        IF wa.sawElse AND NOT wa.sawBord THEN {
                            IF wa.child # child THEN {
                                AddEdges[[child, NARROW[net]], wa.childPort];
                                wa.child _ child};
                            };
                        IF NOT (wa.sawElse OR wa.sawBords) THEN DeleteVertex[net] ELSE RemoveEdges[e];
                        };
                    IF sib.containingCT # child.containingCT THEN ERROR --caller blew it--;
                    EnumerateTopEdges[sib, PerEdge];
                    DeleteVertex[sib];
                    ENDLOOP;
                NoteChange[child.containingCT];
                [] _ parentTypes.UnionSingleton[child.containingCT];
                };
            EnumerateInstances[childType, TweakInstance]};
            CheckCellTypes[parentTypes, ignore, check, ignore];
            parentTypes.DestroySet[];
            }END;

        RaiseGrandchildren: PUBLIC PROC [design: Design, gcs: Set--of Vertex--] RETURNS [childType: CellType, sibber: Mapper--child         RefSeq (role 
            BEGIN
            analysis: Analysis = NEW [AnalysisPrivate _ [
                roles: gcs.Size[],
                gcTypes: CreateRefSeq[gcs.Size[]],
                wag: NEW [WireAnsweringPrivate _ [
                    oldGCConnectionss: CreateRefSeq[gcs.Size[]],
                    anses: CreateHashMapper[],
                    key: NEW [INT _ opCount _ opCount + 1]]]
                ]];
            {OPEN analysis;
            gcSeq: RefSeq--role 
            oldPort, newPort: Port;
            addedPorts: Set = CreateHashSet[];
            parentTypes: Set = CreateHashSet[];
            {role: NAT _ 0;
            AssignRole: PROC [elt: REF ANY] = {
                gc: CellInstance = NARROW[elt];
                gcSeq[role] _ gc;
                IF role = 0 THEN childType _ gc.containingCT;
                IF gc.containingCT # childType THEN ERROR;
                role _ role + 1};
            gcs.Enumerate[AssignRole];
            IF role # roles THEN ERROR};
            oldPort _ newPort _ childType.port;
            sibber _ CreateHashMapper[];
            IF Survey[childType, NIL, gcSeq, analysis, TRUE] THEN ERROR;
            {DeleteDoomed: PROC [elt: REF ANY] = {
                RemovePort[NARROW[elt]];
                };
            doomedPorts.Enumerate[DeleteDoomed];
            };
            FOR role: NAT IN [0 .. roles) DO
                gc: CellInstance = NARROW[gcSeq[role]];
                PerEdge: PROC [gcPort: Port, wire: Wire] = {
                    wa: WireAns = GetRPAns[wag, role, gcPort, wire, FALSE];
                    IF NOT wa.analyzed THEN ERROR;
                    IF wa.sawElse AND NOT wa.sawBord THEN {
                        SELECT wa.counterpart FROM
                            addPort => {
                                wa.childPort _ AddPort[[parent: newPort, wire: wire]];
                                [] _ UnionSingleton[addedPorts, wa.childPort];
                                AddEdge[[childType.asUnorganized.mirror, wire], wa.childPort];
                                wa.counterpart _ addedPort};
                            addedPort => NULL;
                            ENDCASE => ERROR;
                        };
                    };
                EnumerateTopConnections[gc, PerEdge];
                ENDLOOP;
            NoteChange[childType];
            FOR role: NAT IN [0 .. roles) DO
                gc: CellInstance = NARROW[gcSeq[role]];
                PerEdge: PROC [gcPort: Port, wire: Wire, e: Edge] = {
                    wa: WireAns = GetRPAns[wag, role, gcPort, wire, FALSE];
                    IF NOT (wa.sawElse OR wa.sawBords) THEN DeleteVertex[wire] ELSE RemoveEdge[e];
                    };
                EnumerateTopEdges[gc, PerEdge];
                DeleteVertex[gc];
                ENDLOOP;
            CheckCellType[ct: childType, rep: ignore, norm: check, comparable: ignore, instances: FALSE];
            {FixInstance: PROC [child: CellInstance] = {
                sibs: RefSeq = CreateRefSeq[roles];
                cons: RefTable--child port 
                IF IsMirror[child] THEN ERROR;    --AM2
                [] _ SetMapping[sibber, child, sibs];
                FOR role: NAT IN [0 .. roles) DO
                    gc: CellInstance = NARROW[gcSeq[role]];
                    sibs[role] _ Instantiate[gc.type, child.containingCT];
                    ENDLOOP;
                {PerConnection: PROC [cPort: Port, net: Vertex, ce: Edge] = {
                    [] _ cons.Store[cPort, net];
                    IF doomedPorts.HasMember[cPort] THEN RemoveEdges[ce];
                    };
                EnumerateTopEdges[child, PerConnection]};
                {LinkToNewPort: PROC [elt: REF ANY] = {
                    cPort: Port = NARROW[elt];
                    outerNet: Wire = CreateWire[containingCT: child.containingCT, copy: ERROR nyet];
                    AddEdges[[child, outerNet], cPort];
                    [] _ cons.Store[cPort, outerNet];
                    };
                addedPorts.Enumerate[LinkToNewPort]};
                FOR role: NAT IN [0 .. roles) DO
                    sib: CellInstance = NARROW[sibs[role]];
                    PerPort: PROC [gcPort: Port] = {
                        wa: WireAns = GetRPAns[wag, role, gcPort];
                        MakeDummyNet: PROC [iNet: Wire] RETURNS [oNet: Wire] = {
                            oNet _ wa.counterpart;
                            IF oNet = NIL OR wa.child # child THEN {
                                oNet _ CreateWire[containingCT: child.containingCT, copy: iNet];
                                wa.counterpart _ oNet;
                                wa.child _ child;
                                };
                            };
                        AddEdge[
                            [sib,
                            IF wa.sawBord OR wa.sawElse
                                THEN NARROW[cons.Fetch[wa.childPort].value]
                                ELSE MakeDummyNet[wa.proto]],
                            gcPort];
                        };
                    EnumeratePorts[sib.type, PerPort];
                    ENDLOOP;
                NoteChange[child.containingCT];
                [] _ parentTypes.UnionSingleton[child.containingCT];
                };
            EnumerateInstances[childType, FixInstance]};
            CheckCellTypes[parentTypes, ignore, check, ignore];
            parentTypes.DestroySet[];
            }END;

        Survey: PROC [parent: CellType, child: Vertex, sibs: RefSeq--role         BOOL _ FALSE] = {
            OPEN analysis;
            lwag: WireAnswering = NEW [WireAnsweringPrivate _ [CreateRefSeq[roles], CreateHashMapper[], wag.key]];
            IF sibs.length # gcTypes.length THEN {
                Warning["Different number of siblings (%g, rather than %g) at %g", Int[sibs.length], Int[gcTypes.length], child];
                dif _ TRUE}
            ELSE FOR role: NAT IN [0 .. roles) DO
                sib: CellInstance = NARROW[sibs[role]];
                SeeConnection: PROC [gcPort: Port, wire: Wire] = {
                    lwa: WireAns = GetRPAns[lwag, role, gcPort, wire, TRUE];
                    wa: WireAns = GetRPAns[wag, role, gcPort, wire, first];
                    SeeBackConnection: PROC [cPort: Port, v: Vertex] = {
                        ci: CellInstance = NARROW[v];
                        bord: BOOL = IF child # NIL THEN ci=child ELSE IsMirror[ci];
                        IF bord THEN {
                            lwa.sawBords _ lwa.sawBord;
                            lwa.sawBord _ TRUE;
                            lwa.childPort _ cPort;
                            }
                        ELSE {sawSomeSelf: BOOL _ FALSE;
                            FOR j: NAT IN [0 .. roles) DO
                                IF ci = sibs[j] THEN sawSomeSelf _ lwa.sawSelves[j] _ TRUE;
                                ENDLOOP;
                            IF NOT sawSomeSelf THEN lwa.sawElse _ TRUE;
                            };
                        };
                    IF first THEN {
                        lwa.gcPorts _ CONS[gcPort, lwa.gcPorts];
                        };
                    IF NOT lwa.analyzed THEN {
                        lwa.analyzed _ TRUE;
                        lwa.sawSelves _ CreateBoolSeq[roles, FALSE];
                        EnumerateTransitiveConnections[wire, SeeBackConnection];
                        IF NOT lwa.sawSelves[role] THEN ERROR;
                        IF first THEN {
                            wa^ _ lwa^;
                            IF wa.sawBord AND NOT (wa.sawElse OR wa.sawBords) THEN {
                                losses _ NoteLoss[wa, losses];
                                IF NOT doomedPorts.UnionSingleton[wa.childPort] THEN ERROR;
                                };
                            IF wa.sawElse AND NOT wa.sawBord THEN gains _ NoteGain[wa, gains];
                            }
                        ELSE {
                            Dif: PROC = {Warning["%g & %g are connected differently than the first pair", child, sib]; dif _ TRUE};
                            IF wa.sawBord # lwa.sawBord THEN Dif[];
                            IF wa.sawBords # lwa.sawBords THEN Dif[];
                            IF wa.sawElse # lwa.sawElse THEN Dif[];
                            FOR j: NAT IN [0 .. sibs.length) DO
                                IF wa.sawSelves[j] # lwa.sawSelves[j] THEN Dif[];
                                ENDLOOP}};
                    };
                IF sib.type # gcTypes[role] THEN {
                    Warning["%g is a %g, not a %g", sib, sib.type, gcTypes[role]];
                    dif _ TRUE}
                ELSE IF sib = child THEN {
                    Warning["Child %g sibbed to itself", child];
                    dif _ TRUE}
                ELSE IF sib.containingCT # parent THEN ERROR
                ELSE {
                    EnumerateTopConnections[sib, SeeConnection];
                    };
                ENDLOOP;
            };

        dePort: Wire = NEW [wire VertexPrivate];
        addPort: Wire = NEW [wire VertexPrivate];
        addedPort: Wire = NEW [wire VertexPrivate];

        GetRPAns: PROC [wag: WireAnswering, role: NAT, gcPort: Port, wire: Wire _ NIL, mayChange: BOOL _ FALSE] RETURNS [wa: WireAns] = {
            kw: Wire;
            rt: RefTable _ NARROW[wag.oldGCConnectionss[role]];
            IF rt = NIL THEN {
                IF NOT mayChange THEN ERROR;
                wag.oldGCConnectionss[role] _ rt _ CreateRefTable[];
                };
            IF wire = NIL THEN {
                wire _ NARROW[rt.Fetch[gcPort].value];
                IF wire = NIL THEN ERROR;
                };
            kw _ NARROW[rt.Fetch[gcPort].value];
            IF kw = NIL THEN {
                IF NOT mayChange THEN ERROR;
                IF NOT rt.Insert[gcPort, kw _ wire] THEN ERROR};
            IF wire # kw THEN ERROR;
            wa _ NARROW[wag.anses.Map[wire]];
            IF wa = NIL OR wa.key # wag.key THEN {
                IF NOT mayChange THEN ERROR;
                wa _ NEW [WireAnsPrivate _ [proto: wire, key: wag.key]];
                IF wag.anses.SetMapping[wire, wa].hadMapping THEN ERROR;
                };
            };

        NoteLoss: PROC [wa: WireAns, oldLosses: CARDINAL] RETURNS [newLosses: CARDINAL] = {
            newLosses _ oldLosses;
            SELECT wa.counterpart FROM
                NIL => {newLosses _ newLosses + 1; wa.counterpart _ dePort};
                dePort => NULL;
                addPort => ERROR;
                ENDCASE => ERROR;
            };

        NoteGain: PROC [wa: WireAns, oldGains: CARDINAL] RETURNS [newGains: CARDINAL] = {
            newGains _ oldGains;
            SELECT wa.counterpart FROM
                NIL => {newGains _ newGains + 1; wa.counterpart _ addPort};
                addPort => NULL;
                dePort => ERROR;
                ENDCASE => ERROR;
            };

        Int: PROC [i: INT] RETURNS [ra: REF ANY] = {ra _ NEW [INT _ i]};

        END.