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

    DIRECTORY LichenDataOps, LichenDataStructure, LichenSetTheory, LichenTransforms, LichenTransformsPrivate;

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

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

        LowerChildren: PUBLIC PROC [design: Design, childType: CellType, sibber: Mapper--child         [gcs: RefSeq--role 
            BEGIN
            analysis: Analysis = NEW [AnalysisPrivate _ [
                roles: LAST[NATURAL],
                wag: NEW [WireAnsweringPrivate _ [
                    anses: CreateHashMapper[]
                    ]],
                doomedPorts: CreateHashSet[]
                ]];
            {OPEN analysis;
            oldPort: Port ~ childType.port;
            newPort: Port ~ oldPort;
            first: BOOL _ TRUE;
            dif: BOOL _ FALSE;
            parentTypes: Set = CreateHashSet[];
            children _ CreateHashSet[];
            {SeeInstance: PROC [child: CellInstance] = {
                sibs: RefSeq--role 
                IF IsMirror[child] THEN ERROR;    --AM2
                IF first THEN {
                    wag.oldSubjConnectionss _ CreateRefSeq[sibs.length];
                    subjTypes _ CreateRefSeq[sibs.length];
                    FOR role: NATURAL IN [0 .. sibs.length) DO
                        sib: CellInstance = NARROW[sibs[role]];
                        subjTypes[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[subjTypes.length];
            FOR role: NATURAL IN [0 .. gcs.length) DO
                gcs[role] _ Instantiate[
                    type: NARROW[subjTypes[role]],
                    containingCT: childType];
                ENDLOOP;
            {MaybeDeleteOldChildPort: PROC [cPort: Port, w: Vertex, e: Edge] = {
                wire: Wire = NARROW[w];
                IF doomedPorts.HasMember[cPort] THEN RemoveEdges[e];
                };
            EnumerateTopEdges[childType.asUnorganized.mirror, MaybeDeleteOldChildPort]};
            {PerTopWire: PROC [domain, range: REF ANY] = {
                outerWire: Wire = NARROW[domain];
                wa: WireAns = NARROW[range];
                NewPort: PROC RETURNS [insideNet: Wire] = {
                    SELECT wa.doFrom FROM
                        addPort => {
                            wa.counterpart _ insideNet _ CreateWire[containingCT: childType, copy: outerWire];
                            wa.fromPort _ AddPort[[parent: newPort, wire: insideNet]];
                            AddEdge[[childType.asUnorganized.mirror, insideNet], wa.fromPort];
                            };
                        dePort => ERROR;
                        leave, dontAdd => IF (insideNet _ wa.counterpart) = NIL THEN ERROR;
                        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.fromPort.wire ELSE IF wa.sawElse THEN NewPort[] ELSE MakeDummy[];
                FOR subjPorts: RoledPortList _ wa.subjPorts, subjPorts.rest WHILE subjPorts # NIL DO
                    AddEdges[[NARROW[gcs[subjPorts.first.role]], innerWire], subjPorts.first.port];
                    ENDLOOP;
                };
            wag.anses.EnumerateMap[PerTopWire];
            };
            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: NATURAL 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.fromPort];
                                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[],
                subjTypes: CreateRefSeq[gcs.Size[]],
                wag: NEW [WireAnsweringPrivate _ [
                    oldSubjConnectionss: CreateRefSeq[gcs.Size[]],
                    anses: CreateHashMapper[]
                    ]],
                doomedPorts: CreateHashSet[]
                ]];
            {OPEN analysis;
            gcSeq: RefSeq--role 
            addedPorts: Set = CreateHashSet[];
            parentTypes: Set = CreateHashSet[];
            {role: NATURAL _ 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: Port ~ childType.port;
            newPort: Port ~ oldPort;
            sibber _ CreateHashMapper[];
            IF Survey[childType, NIL, gcSeq, analysis, TRUE] THEN ERROR;
            {DeleteDoomed: PROC [elt: REF ANY] = {
                RemovePort[NARROW[elt]];
                };
            doomedPorts.Enumerate[DeleteDoomed];
            };
            {MaybeAddPort: PROC [domain, range: REF ANY] ~ {
                wire: Wire ~ NARROW[domain];
                wa: WireAns ~ NARROW[range];
                IF NOT wa.analyzed THEN ERROR;
                IF wa.sawElse AND NOT wa.sawBord THEN {
                    SELECT wa.doFrom FROM
                        addPort => {
                            wa.fromPort _ AddPort[[parent: newPort, wire: wire]];
                            [] _ UnionSingleton[addedPorts, wa.fromPort];
                            AddEdge[[childType.asUnorganized.mirror, wire], wa.fromPort]};
                        leave, dontAdd, dePort => NULL;
                        ENDCASE => ERROR;
                    };
                };
            wag.anses.EnumerateMap[MaybeAddPort];
            };
            <<FOR role: NATURAL 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.doFrom FROM
                            addPort => {
                                wa.doFrom _ addedPort;
                                wa.fromPort _ AddPort[[parent: newPort, wire: wire]];
                                [] _ UnionSingleton[addedPorts, wa.fromPort];
                                AddEdge[[childType.asUnorganized.mirror, wire], wa.fromPort]};
                            addedPort => NULL;
                            leave, dontAdd, dePort => NULL;
                            ENDCASE => ERROR;
                        };
                    };
                EnumerateTopConnections[gc, PerEdge];
                ENDLOOP;>>
            NoteChange[childType];
            FOR role: NATURAL 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
                [] _ sibber.PutMapping[child, sibs];
                FOR role: NATURAL 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: cPort.wire];
                    IF cPort.wire=NIL THEN ERROR;
                    AddEdges[[child, outerNet], cPort];
                    [] _ cons.Store[cPort, outerNet];
                    };
                addedPorts.Enumerate[LinkToNewPort]};
                FOR role: NATURAL 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.fromPort].val]
                                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: PUBLIC PROC [parent: CellType, child: Vertex, sibs: RefSeq--role         [dif: BOOL _ FALSE] = {
            OPEN analysis;
            lwag: WireAnswering = NEW [WireAnsweringPrivate _ [CreateRefSeq[roles], CreateHashMapper[]]];
            IF sibs.length # subjTypes.length THEN {
                Warning["Different number of siblings (%g, rather than %g) at %g", Int[sibs.length], Int[subjTypes.length], child];
                dif _ TRUE}
            ELSE FOR role: NATURAL 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.fromPort _ cPort;
                            }
                        ELSE {sawSomeSelf: BOOL _ FALSE;
                            FOR j: NATURAL 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.subjPorts _ CONS[[role, gcPort], lwa.subjPorts];
                        };
                    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.fromPort] THEN ERROR;
                                };
                            IF wa.sawElse AND NOT wa.sawBord THEN fromGains _ NoteFromGain[wa, fromGains];
                            IF NOT (wa.sawElse OR wa.sawBord) THEN wa.doFrom _ dontAdd;
                            IF wa.sawElse OR wa.sawBord THEN toGains _ NoteToGain[wa, toGains];
                            }
                        ELSE {
                            IF wa.sawBord # lwa.sawBord THEN GOTO Dif;
                            IF wa.sawBords # lwa.sawBords THEN GOTO Dif;
                            IF wa.sawElse # lwa.sawElse THEN GOTO Dif;
                            FOR j: NATURAL IN [0 .. sibs.length) DO
                                IF wa.sawSelves[j] # lwa.sawSelves[j] THEN GOTO Dif;
                                ENDLOOP;
                            EXITS
                                Dif => {Warning["%g is connected differently than at first site", wire]; dif _ TRUE};
                            }};
                    };
                IF sib.type # subjTypes[role] THEN {
                    Warning["%g is a %g, not a %g", sib, sib.type, subjTypes[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;
            };

        GetRPAns: PUBLIC PROC [wag: WireAnswering, role: NATURAL, subjPort: Port, wire: Wire _ NIL, mayChange: BOOL _ FALSE] RETURNS [wa: 
        WireAns] = {
            kw: Wire;
            rt: RefTable _ NARROW[wag.oldSubjConnectionss[role]];
            IF rt = NIL THEN {
                IF NOT mayChange THEN ERROR;
                wag.oldSubjConnectionss[role] _ rt _ CreateRefTable[];
                };
            IF wire = NIL THEN {
                wire _ NARROW[rt.Fetch[subjPort].val];
                IF wire = NIL THEN ERROR;
                };
            kw _ NARROW[rt.Fetch[subjPort].val];
            IF kw = NIL THEN {
                IF NOT mayChange THEN ERROR;
                IF NOT rt.Insert[subjPort, kw _ wire] THEN ERROR};
            IF wire # kw THEN ERROR;
            wa _ NARROW[wag.anses.Map[wire]];
            IF wa = NIL THEN {
                IF NOT mayChange THEN ERROR;
                wa _ NEW [WireAnsPrivate _ [proto: wire]];
                IF NOT wag.anses.PutMapping[wire, wa].newDomain THEN ERROR;
                };
            };

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

        NoteFromGain: PROC [wa: WireAns, oldGains: CARDINAL] RETURNS [newGains: CARDINAL] = {
            newGains _ oldGains;
            SELECT wa.doFrom FROM
                leave => {newGains _ newGains + 1; wa.doFrom _ addPort};
                addPort => NULL;
                dePort, dontAdd => ERROR;
                ENDCASE => ERROR;
            };

        NoteToGain: PROC [wa: WireAns, oldGains: CARDINAL] RETURNS [newGains: CARDINAL] = {
            newGains _ oldGains;
            SELECT wa.doTo FROM
                dontAdd => {newGains _ newGains + 1; wa.doTo _ addPort};
                addPort => NULL;
                ENDCASE => ERROR;
            };

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

        END.