
<<LichenChildishTransforms.Mesa>>
    <<Last tweaked by Mike Spreitzer on August 28, 1987 11:17:12 am PDT>>

    DIRECTORY LichenCollections, LichenDataOps, LichenDataStructure, LichenIntFunctions, LichenNavigation, LichenPairCollections, 
    LichenTransforms, LichenTransformsPrivate, RefTab;

    LichenChildishTransforms: CEDAR PROGRAM
        IMPORTS LichenCollections, LichenDataOps, LichenDataStructure, LichenIntFunctions, LichenNavigation, LichenPairCollections, RefTab
        EXPORTS LichenTransforms, LichenTransformsPrivate
        =

    BEGIN OPEN LichenDataStructure, LichenNavigation, LichenTransforms, LichenDataOps, LichenTransformsPrivate, 
    Colls:LichenCollections, PairColls:LichenPairCollections, IntFns:LichenIntFunctions;

    LowerChildren: PUBLIC PROC [design: Design, childType: CellType, sibber: ConstFunction--child     RETURNS [gcs: Seq--role 
        BEGIN
        analysis: Analysis = NEW [AnalysisPrivate _ [
            roles: LAST[NATURAL],
            wag: NEW [WireAnsweringPrivate _ [
                anses: PairColls.CreateHashFn[]
                ]],
            doomedPorts: Colls.CreateHashSet[]
            ]];
        {OPEN analysis;
        oldPort: Port ~ childType.port;
        newPort: Port ~ oldPort;
        first: BOOL _ TRUE;
        dif: BOOL _ FALSE;
        parentTypes: VarSet ~ Colls.CreateHashSet[];
        childrenV: VarSet ~ Colls.CreateHashSet[];
        {SeeInstance: PROC [child: CellInstance] = {
            sibs: Seq--role 
            IF IsMirror[child] THEN ERROR;    --AM2
            IF first THEN {
                roles _ sibs.Size;
                wag.oldSubjConnectionss _ CreateRefSeq[sibs.Size];
                subjTypes _ sibs.Compose[right: instanceType, rightRestricts: FALSE].CreateSimpleCopy[domainFixed: TRUE];
                };
            IF Survey[child.containingCT, child, sibs, analysis, first] THEN dif _ TRUE;
            first _ FALSE;
            };
        EnumerateInstances[childType, SeeInstance, FALSE];
        };
        IF first OR dif THEN RETURN [IntFns.nilIntFn];
        NoteChange[childType];
        gcs _ CreateSeq[oneToOne: TRUE];
        FOR role: NATURAL IN [0 .. roles) DO
            gcs.Append[Instantiate[
                type: NARROW[subjTypes.Apply[role].val],
                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 [pair: PairColls.Pair] = {
            outerWire: Wire = NARROW[pair[left]];
            wa: WireAns = NARROW[pair[right]];
            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;
                RETURN};
            MakeDummy: PROC RETURNS [insideNet: Wire] = {
                IF wa.counterpart # NIL THEN RETURN [wa.counterpart];
                wa.counterpart _ insideNet _ CreateWire[containingCT: childType, copy: outerWire];
                RETURN};
            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
                gc: CellInstance ~ NARROW[gcs.Apply[subjPorts.first.role].val];
                AddEdges[[gc, innerWire], subjPorts.first.port];
                design _ design;
                ENDLOOP;
            RETURN};
        wag.anses.Enumerate[PerTopWire];
        design _ design};>>
        FOR role: NATURAL IN [0 .. roles) DO
            rt: RefTable--subj port 
            gc: CellInstance ~ NARROW[gcs.Apply[role].val];
            PerPort: PROC [gcPort: Port] RETURNS [subs, sibs: BOOL _ TRUE] ~ {
                urWire: Wire ~ NARROW[rt.Fetch[gcPort].val];
                subs _ urWire=NIL;
                IF urWire#NIL THEN {
                    wa: WireAns = GetRPAns[wag, role, gcPort, urWire, FALSE];
                    NewPort: PROC RETURNS [insideNet: Wire] = {
                        SELECT wa.doFrom FROM
                            addPort => {
                                insideNet _ CreateWire[containingCT: childType, copy: urWire];
                                wa.fromPort _ AddPort[[parent: newPort, wire: insideNet]];
                                AddEdge[[childType.asUnorganized.mirror, insideNet], wa.fromPort];
                                };
                            dePort => ERROR;
                            leave, dontAdd => ERROR;
                            ENDCASE => ERROR;
                        RETURN};
                    MakeDummy: PROC RETURNS [insideNet: Wire] = {
                        insideNet _ CreateWire[containingCT: childType, copy: urWire];
                        RETURN};
                    IF wa.counterpart=NIL THEN wa.counterpart _ IF wa.sawBord THEN wa.fromPort.wire ELSE IF wa.sawElse THEN NewPort[] ELSE MakeDummy[];
                    {innerWire: Wire ~ wa.counterpart;
                    AddEdges[[gc, innerWire], gcPort];
                    design _ design;
                    }};
                RETURN};
            ScanPorts[gc.type, PerPort];
            design _ design;
            ENDLOOP;
        CheckCellType[ct: childType, rep: ignore, norm: check, comparable: ignore, instances: FALSE];
        {TweakInstance: PROC [child: CellInstance] = {
            sibs: Seq--role 
            IF IsMirror[child] THEN ERROR;    --AM2
            [] _ childrenV.AddElt[child];
            sibs _ IntFns.DeRef[sibber.Apply[child].val];
            IF sibs.Size # roles THEN ERROR --caller blew it--;
            FOR role: NATURAL IN [0 .. roles) DO
                sib: CellInstance = NARROW[sibs.Apply[role].val];
                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.AddElt[child.containingCT];
            };
        EnumerateInstances[childType, TweakInstance, FALSE]};
        CheckCellTypes[parentTypes.Freeze, ignore, check, ignore];
        }END;

    RaiseGrandchildren: PUBLIC PROC [design: Design, gcs: Seq--role     ConstFunction--child     of gcs[role])--] =
        BEGIN
        analysis: Analysis = NEW [AnalysisPrivate _ [
            roles: gcs.Size,
            subjTypes: gcs.Compose[instanceType].CreateSimpleCopy[oneToOne: TRUE].Freeze,
            wag: NEW [WireAnsweringPrivate _ [
                oldSubjConnectionss: CreateRefSeq[gcs.Size],
                anses: PairColls.CreateHashFn[]
                ]],
            doomedPorts: Colls.CreateHashSet[]
            ]];
        {OPEN analysis;
        addedPorts: VarSet = Colls.CreateHashSet[];
        parentTypes: VarSet = Colls.CreateHashSet[];
        sibberV: VarFunction ~ PairColls.CreateHashFn[];
        childType _ NARROW[gcs.First.pair.right, CellInstance].containingCT;
        typer _ PairColls.CreateSingleton[[childType, subjTypes.Refify], [Colls.refs, Colls.refs]];
        FOR role: NAT IN [0 .. roles) DO
            gc: CellInstance ~ NARROW[gcs.Apply[role].val];
            IF gc.containingCT # childType THEN ERROR;
            ENDLOOP;
        {oldPort: Port ~ childType.port;
        newPort: Port ~ oldPort;
        IF Survey[childType, NIL, gcs, analysis, TRUE] THEN ERROR;
        {DeleteDoomed: PROC [elt: REF ANY] = {
            RemovePort[NARROW[elt]];
            };
        doomedPorts.Enumerate[DeleteDoomed];
        };
        {MaybeAddPort: PROC [pair: PairColls.Pair] ~ {
            wire: Wire ~ NARROW[pair[left]];
            wa: WireAns ~ NARROW[pair[right]];
            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]];
                        [] _ addedPorts.AddElt[wa.fromPort];
                        AddEdge[[childType.asUnorganized.mirror, wire], wa.fromPort]};
                    leave, dontAdd, dePort => NULL;
                    ENDCASE => ERROR;
                };
            };
        wag.anses.Enumerate[MaybeAddPort];
        };
        <<FOR role: NATURAL IN [0 .. roles) DO
            gc: CellInstance = NARROW[gcs[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]];
                            [] _ addedPorts.AddElt[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[gcs.Apply[role].val];
            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: Seq ~ CreateSeq[oneToOne: TRUE, dense: TRUE];
            cons: RefTable--child port 
            IF IsMirror[child] THEN ERROR;    --AM2
            [] _ sibberV.Store[[child, sibs.Refify]];
            FOR role: NATURAL IN [0 .. roles) DO
                gc: CellInstance = NARROW[gcs.Apply[role].val];
                sibs.Append[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.Apply[role].val];
                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.AddElt[child.containingCT];
            };
        EnumerateInstances[childType, FixInstance, FALSE]};
        CheckCellTypes[parentTypes.Freeze, ignore, check, ignore];
        sibber _ sibberV.Freeze[];
        }}END;

    Survey: PUBLIC PROC [parent: CellType, child: Vertex, sibs: Seq--role     [dif: BOOL _ FALSE] = {
        OPEN analysis;
        lwag: WireAnswering = NEW [WireAnsweringPrivate _ [CreateRefSeq[roles], PairColls.CreateHashFn[]]];
        IF sibs.Size # subjTypes.Size THEN {
            Warning["Different number of siblings (%g, rather than %g) at %g", Int[sibs.Size], Int[subjTypes.Size], child];
            dif _ TRUE}
        ELSE FOR role: NATURAL IN [0 .. roles) DO
            sib: CellInstance = NARROW[sibs.Apply[role].val];
            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.Apply[j].Val THEN sawSomeSelf _ lwa.sawSelves[j] _ TRUE;
                            ENDLOOP;
                        IF NOT sawSomeSelf THEN lwa.sawElse _ TRUE;
                        };
                    RETURN};
                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.AddElt[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 .. roles) 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 first THEN {
                    wa.subjPorts _ CONS[[role, gcPort], wa.subjPorts];
                    };
                RETURN};
            IF subjTypes.Apply[role].val # sib.type THEN {
                Warning["%g is a %g, not a %g", sib, sib.type, subjTypes.Apply[role].val];
                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];
                parent _ parent};
            ENDLOOP;
        RETURN};

    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.Apply[wire].DVal];
        IF wa = NIL THEN {
            IF NOT mayChange THEN ERROR;
            wa _ NEW [WireAnsPrivate _ [proto: wire]];
            IF NOT wag.anses.Store[[wire, wa]].new 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.