
    <<LichenCleandown.Mesa>>
        <<Last tweaked by Mike Spreitzer on August 4, 1988 3:17:08 pm PDT>>

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

    LichenCleandown: CEDAR PROGRAM
        IMPORTS AbSets, BiRelBasics, BiRelImplementor, BiRels, IntStuff, IO, LichenDataOps, LichenDataStructure, Rope, SetBasics
        =

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

    Break: SIGNAL ~ CODE;

    ArraySite: TYPE ~ REF ArraySitePrivate;
    ArraySitePrivate: TYPE ~ RECORD [d: Design, a: Array, ai: Int2];

    breakCTN: ROPE _ NIL;

    UndistinguishPorts: PROC [d: Design, pacify: IO.STREAM _ NIL] RETURNS [report: BiRel--cell type name 
        done: Set--of CellTye-- ~ Sets.CreateHashSet[d.eSpace];
        WorkOnCT: PROC [ctv: Sets.Value] RETURNS [BOOL] ~ {
            ct: CellType ~ NARROW[ctv.VA];
            insts: Set ~ ct.CtInsts[];
            arrays: Set ~ ct.CtArrays[];
            callingTypes: Set ~ d.cct[i].Image[insts].Union[arrays];
            IF NOT done.AddElt[ctv] THEN RETURN [FALSE];
            IF callingTypes.Scan[WorkOnCT].found THEN ERROR;
            IF TRUE THEN {
                unorg: BOOL ~ ct.asu#NIL;
                DO
                    doomedPorts: Set ~ Sets.CreateHashSet[d.eSpace];
                    doomedWires: Set ~ Sets.CreateHashSet[d.eSpace];
                    ports: Set ~ ct.TopParts[p];
                    FindPowerBus: PROC [pv: Sets.Value] RETURNS [BOOL] ~ {
                        p: Port ~ NARROW[pv.VA];
                        name: SteppyName ~ ct.BestPName[p];
                        IF name.grade.power AND NOT d.Atomic[p] THEN {
                            IF unorg AND NOT doomedWires.AddElt[ct.asu.exports.ApplyA[p].Val] THEN ERROR;
                            IF NOT doomedPorts.AddA[p] THEN ERROR;
                            d _ d};
                        RETURN [FALSE]};
                    IF ports.Scan[FindPowerBus].found THEN ERROR;
                    IF doomedPorts.Empty THEN EXIT;
                    IF d.arrayElt.HasMapA[ct, rightToLeft] THEN ERROR--not implemented--;
                    IF ct.asArray#NIL THEN IF ct.asArray.dumrep.apToWire.Image[doomedPorts].NonEmpty THEN ERROR --not implemented--;
                    IF pacify#NIL THEN {
                        pacify.PutF["Deleting power bus ports %g", [rope[doomedPorts.FormatSet[length: INT.LAST]]]];
                        IF unorg THEN pacify.PutF[" and wires %g", [rope[doomedWires.FormatSet[length: INT.LAST]]]];
                        pacify.PutF[" of cell type %g.\n\n", [rope[ct.ACtName]]]};
                    DeletePorts[ct, doomedPorts, TRUE, TRUE, pacify];
                    IF unorg THEN DeleteWires[ct, doomedWires, TRUE];
                    ENDLOOP;
                };
            IF ct.asu=NIL AND ct.asArray=NIL THEN RETURN [FALSE];
            {
            classes: Set--of set of port-- ~ Sets.CreateHashSet[];
            refdclasses: Set--of set of port-- ~ Sets.CreateHashSet[];
            ports: Set ~ ct.TopParts[p];
            RefineByConns: PROC [conns: Fn--port 
                CheckClass: PROC [cv: Sets.Value] RETURNS [BOOL] ~ {
                    class: Set ~ Sets.VS[cv];
                    wires: Set ~ conns.Image[class];
                    nWires: NAT ~ wires.Size[IS.two].EN;
                    fudge: NAT _ 0;
                    AddByWire: PROC [wv: Sets.Value] RETURNS [BOOL] ~ {
                        nc: Set ~ conns.Mapping[wv, rightToLeft].Intersection[class];
                        SELECT nc.Size[IS.two] FROM
                            IS.zero => ERROR;
                            IS.one => RETURN [FALSE];
                            ENDCASE => IF NOT classes.AddElt[nc.CreateHashCopy[].SV] THEN ERROR;
                        RETURN [FALSE]};
                    IF mayMiss OR NOT d.Atomic[wires.AnElt.MA] THEN {
                        missed: Set ~ class.Difference[conns.SetOn[left]];
                        IF missed.NonEmpty THEN fudge _ 1 ELSE fudge _ 0}
                    ELSE IF NOT class.Subset[conns.SetOn[left]] THEN ERROR;
                    SELECT nWires + fudge FROM
                        0 => ERROR;
                        1 => {
                            IF nWires=0 THEN IF NOT classes.RemElt[cv] THEN ERROR;
                            RETURN [FALSE]};
                        ENDCASE => NULL;
                    IF NOT classes.RemElt[cv] THEN ERROR;
                    IF wires.Scan[AddByWire].found THEN ERROR;
                    RETURN [FALSE]};
                IF classes.Scan[CheckClass].found THEN ERROR;
                RETURN};
            SeeInst: PROC [civ: Sets.Value] RETURNS [BOOL] ~ {
                ci: CellInstance ~ NARROW[civ.VA];
                RefineByConns[ci.conns, FALSE];
                RETURN [FALSE]};
            SeeArray: PROC [actv: Sets.Value] RETURNS [BOOL] ~ {
                act: CellType ~ NARROW[actv.VA];
                a: Array ~ act.asArray;
                as: ArraySite ~ NEW [ArraySitePrivate _ [d, a, ALL[0]]];
                conns: Fn ~ [arrayConnsClass, as];
                FOR x: INT IN [0 .. a.size2[X]) DO FOR y: INT IN [0 .. a.size2[Y]) DO
                    as.ai _ [x, y];
                    RefineByConns[conns, TRUE];
                    ENDLOOP ENDLOOP;
                RETURN [FALSE]};
            RefineClass: PROC [cv: Sets.Value] RETURNS [BOOL] ~ {
                org: Set ~ Sets.VS[cv];
                toNew: InvFn--ROPE _ port-- ~ BiRels.CreateHashReln[spaces: [SetBasics.ropes[FALSE], d.eSpace], functional: [FALSE, TRUE], 
                mappable: ALL[TRUE] ];
                crs: Set--of ROPE-- ~ toNew.SetOn[left];
                PerPort: PROC [pv: Sets.Value] RETURNS [BOOL] ~ {
                    p: Port ~ NARROW[pv.VA];
                    name: SteppyName ~ ct.BestPName[p];
                    lr: ROPE ~ name.LastRope[];
                    cr: ROPE ~ IF name.grade.power THEN IF vddRopes.HasMemA[lr] THEN "vdd" ELSE IF gndRopes.HasMemA[lr] THEN "gnd" ELSE ERROR ELSE 
                    lr.Substr[len: lr.Index[s2: "_%"]];
                    toNew.AddNewAA[cr, p];
                    RETURN [FALSE]};
                Movit: PROC [v: Sets.Value] RETURNS [BOOL] ~ {
                    subclass: Set ~ toNew.Mapping[v].CreateHashCopy[];
                    IF subclass.Trivial THEN RETURN [FALSE];
                    IF NOT refdclasses.AddElt[subclass.SV] THEN ERROR;
                    RETURN [FALSE]};
                IF org.Scan[PerPort].found THEN ERROR;
                IF crs.NonTrivial THEN {
                    IF pacify#NIL THEN pacify.PutF["Refine %g of %g.\n\n", [rope[org.FormatSet[length: INT.LAST, order: ct.nameOrder[p]]]], 
                    [rope[ct.ACtName]]];
                    IF crs.Scan[Movit].found THEN ERROR;
                    }
                ELSE IF NOT refdclasses.AddElt[cv] THEN ERROR;
                RETURN [FALSE]};
            MergeClass: PROC [cv: Sets.Value] RETURNS [BOOL] ~ {
                eqPorts: Set ~ Sets.VS[cv];
                theWire: Wire _ NIL;
                IF ct.asArray#NIL THEN {
                    IF NOT eqPorts.Subset[d.isAtomic] THEN ERROR;
                    {eqWires: Set ~ ct.asArray.dumrep.apToWire.Image[eqPorts].CreateHashCopy[];
                    balkWires: Set ~ TryToMergeDumbWires[d, ct, eqWires];
                    balkPorts: Set ~ ct.asArray.dumrep.apToWire.Image[balkWires, rightToLeft].CreateHashCopy[];
                    IF balkPorts.NonEmpty THEN {
                        [] _ eqPorts.RemSet[balkPorts];
                        IF pacify#NIL THEN pacify.PutF["Not mergePs %g of %g.\n\n", [rope[balkPorts.FormatSet[length: INT.LAST, order: ct.nameOrder[p]]]], 
                        [rope[ct.ACtName]]];
                        IF eqPorts.Trivial THEN RETURN [FALSE];
                        };
                    }};
                IF pacify#NIL THEN pacify.PutF["MergePs %g of %g.\n\n", [rope[eqPorts.FormatSet[length: INT.LAST, order: ct.nameOrder[p]]]], 
                [rope[ct.ACtName]]];
                report.AddNewAA[ct.ACtName, ct.fullName[p].Image[eqPorts].CreateHashCopy.Refify];
                IF ct.asu#NIL THEN {
                    eqWires: Set ~ ct.asu.exports.Image[eqPorts].CreateHashCopy[];
                    [] _ MergeWireSet[d, eqWires, TRUE];
                    };
                [] _ MergePorts[ct, eqPorts];
                RETURN [FALSE]};
            IF ports.Trivial THEN RETURN [FALSE];
            IF ct=d.root THEN {
                vddClass: Set ~ Sets.CreateHashSet[d.eSpace];
                gndClass: Set ~ Sets.CreateHashSet[d.eSpace];
                ClassifyPort: PROC [pv: Sets.Value] RETURNS [BOOL] ~ {
                    p: Port ~ NARROW[pv.VA];
                    name: SteppyName ~ ct.BestPName[p];
                    IF NOT name.grade.power THEN RETURN [FALSE];
                    SELECT TRUE FROM
                        vddNames.HasMember[SnV[name]] => IF NOT vddClass.AddElt[pv] THEN ERROR;
                        gndNames.HasMember[SnV[name]] => IF NOT gndClass.AddElt[pv] THEN ERROR;
                        ENDCASE => ERROR;
                    RETURN [FALSE]};
                IF ports.Scan[ClassifyPort].found THEN ERROR;
                IF vddClass.NonTrivial AND NOT classes.AddElt[vddClass.SV] THEN ERROR;
                IF gndClass.NonTrivial AND NOT classes.AddElt[gndClass.SV] THEN ERROR;
                d _ d}
            ELSE {
                IF NOT classes.AddElt[ports.CreateHashCopy.SV] THEN ERROR;
                IF insts.Scan[SeeInst].found THEN ERROR;
                IF arrays.Scan[SeeArray].found THEN ERROR;
                <<IF classes.Scan[RefineClass].found THEN ERROR;>>
                d _ d};
            IF breakCTN.Equal[ct.ACtName] THEN Break;
            IF classes.Scan[MergeClass].found THEN ERROR;
            RETURN [FALSE]}};
        report _ BiRels.CreateHashReln[spaces: [SetBasics.ropes[TRUE], SetBasics.reps], mappable: [TRUE, FALSE]];
        IF d.cellTypes.Scan[WorkOnCT].found THEN ERROR;
        RETURN};

    <<CountMentions: PROC [elt: Port, classes: Set] RETURNS [n: INT] ~ {
        PerClass: PROC [cv: Sets.Value] RETURNS [BOOL] ~ {
            class: Set ~ Sets.VS[cv];
            IF class.HasMemA[elt] THEN n _ n + 1;
            RETURN [FALSE]};
        n _ 0;
        IF classes.Scan[PerClass].found THEN ERROR;
        RETURN};

    FindDifference: PROC [d: Design, p1, p2: Port, recurse: BOOL] RETURNS [cells: Set--of Cell--] ~ {
        Work: PROC [p1, p2: Port] ~ {
            ct: CellType ~ d.PCct[p1];
            IF ct # d.PCct[p2] THEN ERROR;
            IF ct=d.root THEN {IF NOT cells.AddA[ct] THEN ERROR; RETURN};
            {class: Seq--of Port-- ~ CreateSeq[len: 2, oneToOne: TRUE, dense: TRUE, rightSpace: d.eSpace];
            CheckConns: PROC [conns: Fn--port 
                wires: Seq ~ class.Compose[conns];
                SELECT wires.Size[IS.two] FROM
                    IS.zero => ERROR;
                    IS.one => RETURN;
                    IS.two => IF recurse THEN {
                        exp1: Port ~ NARROW[export.InvApply[wires.ApplyI[0].Val].MDA];
                        exp2: Port ~ NARROW[export.InvApply[wires.ApplyI[1].Val].MDA];
                        IF exp1#NIL AND exp2#NIL THEN {
                            IF exp1#exp1 THEN Work[exp1, exp2];
                            RETURN};
                        recurse _ recurse};
                    ENDCASE => ERROR;
                [] _ cells.AddA[cell];
                RETURN};
            SeeInst: PROC [civ: Sets.Value] RETURNS [BOOL] ~ {
                ci: CellInstance ~ NARROW[civ.VA];
                cct: CellType ~ d.CiCct[ci];
                CheckConns[ci.conns, cct.asu.exports, ci, cct];
                RETURN [FALSE]};
            SeeArray: PROC [actv: Sets.Value] RETURNS [BOOL] ~ {
                act: CellType ~ NARROW[actv.VA];
                a: Array ~ act.asArray;
                as: ArraySite ~ NEW [ArraySitePrivate _ [d, a, ALL[0]]];
                conns: Fn ~ [arrayConnsClass, as];
                FOR x: INT IN [0 .. a.size2[X]) DO FOR y: INT IN [0 .. a.size2[Y]) DO
                    as.ai _ [x, y];
                    CheckConns[conns, a.dumrep.apToWire, act, act];
                    ENDLOOP ENDLOOP;
                RETURN [FALSE]};
            class.AddNewIA[0, p1];
            class.AddNewIA[1, p2];
            IF ct.CtInsts[].Scan[SeeInst].found THEN ERROR;
            IF ct.CtArrays[].Scan[SeeArray].found THEN ERROR;
            RETURN}};
        cells _ Sets.CreateHashSet[d.eSpace];
        Work[p1, p2];
        RETURN};>>

    arrayConnsClass: BiRels.BiRelClass ~ BiRelImplementor.CreateClass[
        cp: [
            HasPair: ArrayConnsHasPair,
            ScanRestriction: ArrayConnsScanRestriction,
            Spaces: ArrayConnsSpaces,
            functional: [TRUE, FALSE],
            mutability: readonly],
        dirable: ALL[TRUE], restrictable: ALL[any]];

    ArrayConnsSpaces: PROC [br: BiRel] RETURNS [BiRels.SpacePair] ~ {
        as: ArraySite ~ NARROW[br.data];
        RETURN [[as.d.eSpace, as.a.dumrep.dwSpace]]};

    ArrayConnsHasPair: PROC [br: BiRel, pair: BiRels.Pair] RETURNS [BOOL] ~ {
        as: ArraySite ~ NARROW[br.data];
        dw: DumbWire ~ NARROW[pair[right].VA];
        RETURN dw.eps.HasPair[[pair[left], I2V[as.ai]]]};

    ArrayConnsScanRestriction: PROC [br: BiRel, sets: BiRels.SetPair, Test: BiRels.Tester, lo: BiRels.LexOrder] RETURNS [mp: 
    BiRels.MaybePair _ BiRels.noMaybePair] ~ {
        as: ArraySite ~ NARROW[br.data];
        caiv: Sets.Value ~ IV[ComposeAI[as.a, as.ai]];
        lo _ lo.EnRelSP[[as.d.eSpace, as.a.dumrep.dwSpace]].CanonizeLOForScan[[TRUE, FALSE], IF sets[right]#nilSet AND sets[left]=nilSet 
        THEN right ELSE left];
        SELECT lo.first FROM
            left => {
                epToWire: Fn--elt port 
                Outer: PROC [ov: Sets.Value] RETURNS [BOOL] ~ {
                    mf: Sets.MaybeValue ~ epToWire.Apply[ov];
                    IF NOT mf.found THEN RETURN [FALSE];
                    {cai2dw: Fn ~ BiRels.VB[mf.it];
                    mw: Sets.MaybeValue ~ cai2dw.Apply[caiv];
                    IF NOT mw.found THEN RETURN [FALSE];
                    mp.it _ [ov, mw.it];
                    mp.found _ Test[mp.it];
                    RETURN [mp.found]}};
                IF sets[left]=nilSet THEN sets[left] _ epToWire.SetOn[left];
                [] _ sets[left].Scan[Outer, lo.sub[left]];
                RETURN};
            right => {
                it: BOOL ~ sets[left]#nilSet;
                Outer: PROC [ov: Sets.Value] RETURNS [BOOL] ~ {
                    dw: DumbWire ~ NARROW[ov.VA];
                    Inner: PROC [iv: Sets.Value] RETURNS [BOOL] ~ {
                        IF it AND NOT sets[left].HasMember[iv] THEN RETURN [FALSE];
                        mp.it _ [iv, ov];
                        mp.found _ Test[mp.it];
                        RETURN [mp.found]};
                    [] _ dw.eps.ScanMapping[caiv, Inner, rightToLeft, lo.sub[left]];
                    RETURN [mp.found]};
                IF sets[right]=nilSet THEN sets[right] _ as.a.dumrep.wires;
                [] _ sets[right].Scan[Outer, lo.sub[right]];
                RETURN};
            ENDCASE => ERROR};

    END.