
    <<LichenCleanup.Mesa>>
        <<Last tweaked by Mike Spreitzer on August 1, 1988 5:16:53 pm PDT>>

    DIRECTORY AbSets, BiRels, IntStuff, IO, LichenDataOps, LichenDataStructure, LichenIntBasics, Rope, SetBasics;

    LichenCleanup: CEDAR PROGRAM
        IMPORTS AbSets, BiRels, IntStuff, IO, LichenDataOps, LichenDataStructure, SetBasics
        EXPORTS LichenDataOps
        =

    BEGIN OPEN IS:IntStuff, LIB:LichenIntBasics, LIB, LichenDataStructure, LichenDataOps, Sets:AbSets;

    ropeSets: Sets.Space ~ Sets.CreateSetSpace[SetBasics.ropes[TRUE]];
    steppySets: Sets.Space ~ Sets.CreateSetSpace[steppyNameSpace];

    CleanDesign: PROC [d: Design, pacify: IO.STREAM _ NIL] RETURNS [losses: ARRAY EClass OF Set--of set of name--] ~ {
        doneUp: Set--of CellTye-- ~ Sets.CreateHashSet[d.eSpace];
        doneDown: Set--of CellTye-- ~ Sets.CreateHashSet[d.eSpace];
        CleanUp1: PROC [ctv: Sets.Value] RETURNS [BOOL] ~ {
            IF NOT doneUp.AddElt[ctv] THEN RETURN [FALSE];
            {ct: CellType ~ NARROW[ctv.VA];
            views: NAT ~ (IF ct.asu#NIL THEN 1 ELSE 0) + (IF ct.asArray#NIL THEN 1 ELSE 0) + (IF ct.asTrans#NIL THEN 1 ELSE 0);
            wires: Set ~ ct.CTParts[w];
            cis: Set ~ ct.Subcells[];
            insts: Set ~ ct.CtInsts[];
            arrays: Set ~ ct.CtArrays[];
            unused: BOOL ~ insts.Empty AND arrays.Empty;
            CheckWire: PROC [wv: Sets.Value] RETURNS [BOOL] ~ {
                IF ct.asu.exports.MappingSize[wv, rightToLeft, IS.two].EN > 1 THEN ERROR;
                RETURN [FALSE]};
            IF views>1 THEN ERROR;
            IF wires.Scan[CheckWire].found THEN ERROR;
            IF ct#d.root AND unused THEN {
                IF pacify#NIL THEN pacify.PutF["DelCT %g unused.\n", [rope[ct.ACtName]]];
                DeleteCellType[ct, pacify]; RETURN [FALSE]};
            {calledTypes: Set ~ IF ct.asu#NIL THEN d.ciType.Image[cis] ELSE IF ct.asArray#NIL THEN d.arrayElt.Mapping[ctv] ELSE emptyRopeSet;
            IF calledTypes.Scan[CleanUp1].found THEN ERROR;
            IF ct.asu#NIL AND cis.Empty THEN {
                IF pacify#NIL THEN pacify.PutF["DelCT %g empty.\n", [rope[ct.ACtName]]];
                DeleteCellType[ct, pacify]; RETURN [FALSE]};
            IF ct.asu#NIL THEN {
                calledTypes: Set ~ d.ciType.Image[cis];
                topPorts: Set ~ ct.TopParts[p];
                CheckWire: PROC [wv: Sets.Value] RETURNS [BOOL] ~ {
                    IF ct.asu.exports.MappingSize[wv, rightToLeft, IS.two].EN > 1 THEN ERROR;
                    RETURN [FALSE]};
                TryPortTree1: PROC [pv: Sets.Value] RETURNS [BOOL] ~ {
                    IF NOT topPorts.HasMember[pv] THEN RETURN [FALSE];
                    {root: Port ~ NARROW[pv.VA];
                    tree: Set ~ d.PWDescendants[root].CreateHashCopy[];
                    exws: Set ~ ct.asu.exports.Image[tree] .Intersection[d.wiresConnectedAtSomeInstance];
                    IF exws.Empty THEN {
                        whyNot: ROPE ~ MayDeletePorts[ct, tree, TRUE, TRUE];
                        IF whyNot#NIL THEN {
                            IF pacify#NIL THEN pacify.PutF["Not DelPT %g 'cause %g.\n", [rope[Describe[d, root, d]]], [rope[whyNot]]];
                            }
                        ELSE {
                            naming: BiRel ~ ct.fullName[p].Intersection[BiRels.CreateProduct[[tree, Sets.CreateFullSet[steppyNameSpace]]]].GenCopy[mappable: 
                            ALL[TRUE], hints: fullNameHints];
                            nameses: Set ~ naming.Collect[].SetOn[right];
                            IF pacify#NIL THEN pacify.PutF["DelPT %g nocon.\n", [rope[Describe[d, root, d]]]];
                            [] _ losses[p].AddSet[nameses];
                            DeletePorts[ct, tree, TRUE, FALSE, pacify]}};
                    RETURN [FALSE]}};
                IF wires.Scan[CheckWire].found THEN ERROR;
                IF topPorts.Scan[TryPortTree1].found THEN ERROR;
                IF wires.Scan[TryWire].found THEN ERROR;
                }
            ELSE IF ct.asArray#NIL THEN {
                et: CellType ~ EltType[ct];
                IF CleanUp1[AV[et]] THEN ERROR};
            RETURN [FALSE]}}};
        TryWire: PROC [wv: Sets.Value] RETURNS [BOOL] ~ {
            w: Wire ~ NARROW[wv.VA];
            IF w.conns.Empty THEN {
                ct: CellType ~ d.WCct[w];
                IF pacify#NIL THEN pacify.PutF["DelW %g nocon.\n", [rope[Describe[d, w, d]]]];
                [] _ losses[w].AddElt[ct.WNames[w].CreateRedBlackCopy[].SV];
                DeleteWires[ct, Sets.CreateSingleA[w, d.eSpace], FALSE]};
            RETURN [FALSE]};
        CleanDown: PROC [ctv: Sets.Value] RETURNS [BOOL] ~ {
            IF NOT doneDown.AddElt[ctv] THEN RETURN [FALSE];
            {ct: CellType ~ NARROW[ctv.VA];
            insts: Set ~ ct.CtInsts[];
            callingTypes: Set ~ d.cct[i].Image[insts].Union[ct.CtArrays[]];
            topPorts: Set ~ ct.TopParts[p];
            TryPortTree2: PROC [pv: Sets.Value] RETURNS [BOOL] ~ {
                IF NOT topPorts.HasMember[pv] THEN RETURN [FALSE];
                {root: Port ~ NARROW[pv.VA];
                tree: Set ~ d.PWDescendants[root].CreateHashCopy[];
                nontrivial: BOOL _ FALSE;
                CheckUse: PROC [cu: CellUse] ~ {
                    IF nontrivial THEN RETURN;
                    WITH cu SELECT FROM
                        act: CellType => {
                            sr: StatRep ~ act.asArray.statrep;
                            dr: DumRep ~ act.asArray.dumrep;
                            IF sr.portEdge[FALSE].Image[tree].Empty AND sr.portEdge[TRUE].Image[tree].Empty AND dr.apToWire.Image[dr.epw.Image[tree], 
                            rightToLeft].Empty THEN d _ d ELSE nontrivial _ TRUE};
                        ci: CellInstance => {
                            interesting: Set ~ ci.conns.Image[tree].Intersection[d.nontriviallyConnectedWires];
                            IF interesting.Empty THEN d _ d ELSE nontrivial _ TRUE};
                        ENDCASE => ERROR;
                    RETURN};
                ct.EnumerateUses[CheckUse];
                IF NOT nontrivial THEN {
                    naming: BiRel ~ ct.fullName[p].Intersection[BiRels.CreateProduct[[tree, Sets.CreateFullSet[steppyNameSpace]]]].GenCopy[mappable: 
                    ALL[TRUE], hints: fullNameHints];
                    nameses: Set ~ naming.Collect[].SetOn[right];
                    IF pacify#NIL THEN pacify.PutF["DelPT %g bu.\n", [rope[Describe[d, root, d]]]];
                    [] _ losses[p].AddSet[nameses];
                    DeletePorts[ct, tree, TRUE, TRUE, pacify]};
                RETURN [FALSE]}};
            IF ct=d.root THEN {
                IF NOT callingTypes.Empty THEN ERROR;
                RETURN [FALSE]};
            IF callingTypes.Scan[CleanDown].found THEN ERROR;
            IF topPorts.Scan[TryPortTree2].found THEN ERROR;
            RETURN [FALSE]}};
        CleanUp2: PROC [ctv: Sets.Value] RETURNS [BOOL] ~ {
            IF NOT doneUp.AddElt[ctv] THEN RETURN [FALSE];
            IF NOT d.cellTypes.HasMember[ctv] THEN RETURN [FALSE];
            {ct: CellType ~ NARROW[ctv.VA];
            ports: Set ~ ct.CTParts[p];
            wires: Set ~ ct.CTParts[w];
            cis: Set ~ ct.Subcells[];
            insts: Set ~ ct.CtInsts[];
            arrays: Set ~ ct.CtArrays[];
            noports, unused: BOOL;
            IF ct.asu#NIL THEN {
                calledTypes: Set ~ d.ciType.Image[cis];
                IF calledTypes.Scan[CleanUp2].found THEN ERROR;
                IF wires.Scan[TryWire].found THEN ERROR;
                IF ct=d.root THEN noports _ FALSE
                ELSE {
                    noSubcells: BOOL ~ cis.Empty;
                    noports _ ports.Empty;
                    IF noSubcells AND NOT noports THEN ERROR;
                    };
                }
            ELSE IF ct.asArray#NIL THEN {
                et: CellType ~ EltType[ct];
                IF CleanUp2[AV[et]] THEN ERROR;
                IF NOT d.cellTypes.HasMemA[et] THEN {
                    IF d.cellTypes.HasMember[ctv] THEN ERROR;
                    IF ct=d.root THEN ERROR;
                    RETURN [FALSE]};
                noports _ ports.Empty}
            ELSE noports _ ports.Empty;
            unused _ insts.Empty AND arrays.Empty;
            IF ct#d.root AND (noports OR unused) THEN {
                cis: Set ~ ct.Subcells[];
                wires: Set ~ ct.CTParts[w];
                subcells: Set ~ ct.Subcells;
                IF pacify#NIL THEN pacify.PutF["DelCT %g np:%g, uu:%g.\n", [rope[ct.ACtName]], [boolean[noports]], [boolean[unused]]];
                [] _ losses[t].AddElt[d.CTNames[ct].CreateHashCopy.SV];
                DeleteCellType[ct, pacify];
                };
            RETURN [FALSE]}};
        losses[t] _ Sets.CreateHashSet[ropeSets];
        FOR ec: EClass IN [p .. t) DO losses[ec] _ Sets.CreateHashSet[steppySets] ENDLOOP;
        IF pacify#NIL THEN pacify.PutRope["Pass 1.\n"];
        [] _ CleanUp1[AV[d.root]];
        IF pacify#NIL THEN pacify.PutRope["Pass 2.\n"];
        IF d.cellTypes.Scan[CleanDown].found THEN ERROR;
        doneUp.Erase[];
        IF pacify#NIL THEN pacify.PutRope["Pass 3.\n"];
        IF d.cellTypes.Scan[CleanUp2].found THEN ERROR;
        RETURN};

    DeleteCellType: PUBLIC PROC [ct: CellType, log: IO.STREAM] ~ {
        d: Design ~ ct.d;
        DeleteArrayOfSelf: PROC [actv: Sets.Value] RETURNS [BOOL] ~ {
            act: CellType ~ NARROW[actv.VA];
            IF log#NIL THEN log.PutF["DelArray[%g, elt gone]\n", [rope[act.ACtName]]];
            DeleteCellType[act, log];
            RETURN [FALSE]};
        IF ct.CtArrays[].CreateHashCopy[].Scan[DeleteArrayOfSelf].found THEN ERROR;
        DeleteInsts[d, ct.CtInsts[].CreateHashCopy[], TRUE];
        IF ct.asu#NIL THEN {
            DeleteInsts[d, ct.Subcells[].CreateHashCopy[], FALSE];
            DeleteWires[ct, ct.CTParts[w].CreateHashCopy[], FALSE];
            }
        ELSE [] _ d.arrayElt.DeleteA[ct];
        DeletePorts[ct, ct.CTParts[p].CreateHashCopy[], FALSE, FALSE, log];
        IF NOT d.cellTypes.RemA[ct] THEN ERROR;
        FOR pc: PartClass IN PartClass DO IF NOT d.cct[pc].MappingEmpty[AV[ct], rightToLeft] THEN ERROR ENDLOOP;
        IF NOT d.ciType.MappingEmpty[AV[ct], rightToLeft] THEN ERROR;
        [] _ d.ctName.DeleteA[ct];
        [] _ d.labelCellTypes.RemA[ct];
        ct^ _ [];
        RETURN};

    DeleteInsts: PUBLIC PROC [d: Design, cis: Set, visitWires: BOOL] ~ {
        NilCI: PROC [civ: Sets.Value] RETURNS [BOOL] ~ {
            FixWire: PROC [wv: Sets.Value] RETURNS [BOOL] ~ {
                w: Wire ~ NARROW[wv.VA];
                [] _ w.conns.Delete[civ, right];
                RETURN [FALSE]};
            ci: CellInstance ~ NARROW[civ.VA];
            cct: CellType ~ d.CiCct[ci];
            IF visitWires THEN IF ci.conns.SetOn[right].Scan[FixWire].found THEN ERROR;
            [] _ cct.fullName[i].Delete[civ];
            ci.conns _ nilBiRel;
            RETURN [FALSE]};
        IF cis.Scan[NilCI].found THEN ERROR;
        [] _ d.ciType.DeleteSet[cis];
        IF d.ciXfm#nilBiRel THEN [] _ d.ciXfm.DeleteSet[cis];
        [] _ d.cct[i].DeleteSet[cis];
        RETURN};

    END.