
    <<LichenDataImplArrays4.Mesa>>
        <<Last tweaked by Mike Spreitzer on May 12, 1989 11:43:41 am PDT>>

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

    LichenDataImplArrays4: CEDAR PROGRAM
        IMPORTS AbSets, BiRels, IO, LichenArrayPrivate, LichenDataOps, LichenDataStructure, LichenIntBasics, SetBasics
        EXPORTS LichenDataStructure, LichenDataOps, LichenArrayPrivate
        =

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

    Trace: PROC [d: Design, org: Port, clip: Set--of CellType-- _ nilSet] RETURNS [p2c, w2c: Fn--PW 
        ports: Set ~ (p2c _ BiRels.CreateHashFn[ALL[d.eSpace]]).SetOn[left];
        wires: Set ~ (w2c _ BiRels.CreateHashFn[ALL[d.eSpace]]).SetOn[left];
        FromPorts: PROC [ct: CellType, ps: Set--of Port--] ~ {
            [] _ p2c.AddSet[BiRels.CreateProduct[[ps, Sets.CreateSingleA[ct, d.eSpace]]]];
            IF clip.HasMemA[ct] THEN RETURN;
            IF ct.asu#NIL THEN FromWires[ct, ct.asu.exports.Image[ps].Difference[wires].CreateHashCopy[]]
            ELSE IF ct.asArray#NIL THEN {
                a: Array ~ ct.asArray;
                dr: DumRep ~ a.dumrep;
                dws: Set ~ dr.apToWire.Image[ports].CreateHashCopy[];
                ect: CellType ~ ct.EltType[];
                eps: BiRel--elt port 
                SeeDumb: PROC [dwv: Sets.Value] RETURNS [BOOL] ~ {
                    dw: DumbWire ~ NARROW[dwv.VA];
                    [] _ eps.AddSet[dw.eps];
                    RETURN [FALSE]};
                IF dws.Scan[SeeDumb].found THEN ERROR;
                {eltPorts: Set ~ eps.SetOn[left];
                cais: Set ~ Sets.IIAsSet[[0, a.size-1]];
                all: BiRel ~ BiRels.CreateProduct[[eltPorts, cais]];
                IF NOT all.Equal[eps] THEN ERROR;
                FromPorts[ect, eltPorts.Difference[ports].CreateHashCopy[]]}};
            RETURN};
        FromWires: PROC [ct: CellType, ws: Set--of Wire--] ~ {
            PerWire: PROC [wv: Sets.Value] RETURNS [BOOL] ~ {
                w: Wire ~ NARROW[wv.VA];
                PerConn: PROC [pair: BiRels.Pair] RETURNS [BOOL] ~ {
                    IF ports.HasMember[pair[left]] THEN RETURN [FALSE];
                    WITH pair[right].VA SELECT FROM
                        ci: CellInstance => FromPorts[d.CiT[ci], Sets.CreateSingleton[pair[left], d.eSpace]];
                        x: CellType => ct _ ct;
                        ENDCASE => ERROR;
                    RETURN [FALSE]};
                IF w.conns.Scan[PerConn].found THEN ERROR;
                RETURN [FALSE]};
            [] _ w2c.AddSet[BiRels.CreateProduct[[ws, Sets.CreateSingleA[ct, d.eSpace]]]];
            IF ws.Scan[PerWire].found THEN ERROR;
            RETURN};
        orgCT: CellType ~ d.PCct[org];
        IF clip=nilSet THEN clip _ Sets.CreateEmptySet[d.eSpace];
        FromPorts[orgCT, Sets.CreateSingleA[org, d.eSpace]];
        RETURN};

    DeletePortsAndWires: PROC [d: Design, p2c, w2c: Fn--PW 
        pCts: Set ~ p2c.SetOn[right];
        wCts: Set ~ w2c.SetOn[right];
        PerPCt: PROC [ctv: Sets.Value] RETURNS [BOOL] ~ {
            ct: CellType ~ NARROW[ctv.VA];
            ports: Set ~ p2c.Mapping[ctv, rightToLeft];
            DeletePorts[ct, ports, TRUE, FALSE, FALSE];
            RETURN [FALSE]};
        PerWCt: PROC [ctv: Sets.Value] RETURNS [BOOL] ~ {
            ct: CellType ~ NARROW[ctv.VA];
            wires: Set ~ w2c.Mapping[ctv, rightToLeft];
            DeleteWires[ct, wires, TRUE, FALSE];
            RETURN [FALSE]};
        IF pCts.Scan[PerPCt].found THEN ERROR;
        IF wCts.Scan[PerWCt].found THEN ERROR;
        RETURN};

    DeleteWires: PUBLIC PROC [ct: CellType, wires: Set, visitConns, lowerPortsToo: BOOL, log: IO.STREAM _ NIL, clip: Set--of CellType-- 
    _ nilSet] ~ {
        d: Design ~ ct.d;
        FixInst: PROC [civ: Sets.Value] RETURNS [BOOL] ~ {
            ci: CellInstance ~ NARROW[civ.VA];
            IF lowerPortsToo THEN {
                ports: Set ~ ci.conns.Image[wires, rightToLeft].CreateHashCopy[];
                ict: CellType ~ d.CiT[ci];
                IF log#NIL THEN log.PutF["DelP %g of %g from wires.\n", [rope[ports.FormatSet[]]], [rope[d.Describe[ict, d]]]];
                DeletePorts[ict, ports, FALSE, FALSE, TRUE, log, clip]};
            IF visitConns THEN [] _ ci.conns.DeleteSet[wires, right];
            RETURN [FALSE]};
        [] _ d.sub.DeleteSet[wires];
        [] _ d.parent.DeleteSet[wires, right];
        [] _ d.cct[w].DeleteSet[wires];
        [] _ ct.fullName[w].DeleteSet[wires];
        [] _ ct.asu.exports.DeleteSet[wires, right];
        IF (visitConns OR lowerPortsToo) AND d.cct[i].ScanMapping[AV[ct], FixInst, rightToLeft].found THEN ERROR;
        RETURN};

    DeletePorts: PUBLIC PROC [ct: CellType, ports: Set, visitInsts, deleteWires, lowerWiresToo: BOOL, log: IO.STREAM _ NIL, clip: 
    Set--of CellType-- _ nilSet] ~ {
        d: Design ~ ct.d;
        FixWire: PROC [wv: Sets.Value] RETURNS [BOOL] ~ {
            w: Wire ~ NARROW[wv.VA];
            [] _ w.conns.DeleteSet[ports];
            RETURN [FALSE]};
        FixInst: PROC [civ: Sets.Value] RETURNS [BOOL] ~ {
            ci: CellInstance ~ NARROW[civ.VA];
            wires: Set _ ci.conns.Image[ports];
            Connected: PROC [wv: Sets.Value] RETURNS [BOOL] ~ {
                w: Wire ~ NARROW[wv.VA];
                RETURN [NOT w.conns.Empty]};
            IF deleteWires THEN wires _ wires.CreateHashCopy[];
            IF wires.Scan[FixWire].found THEN ERROR;
            [] _ ci.conns.DeleteSet[ports];
            IF deleteWires AND wires.NonEmpty THEN {
                cct: CellType ~ d.CiCct[ci];
                IF wires.Scan[Connected].found THEN ERROR;
                IF log#NIL THEN log.PutF["DelW %g in %g conlos.\n", [rope[wires.FormatSet[length: INT.LAST, order: cct.nameOrder[w]]]], 
                [rope[ACtName[cct]]]];
                DeleteWires[cct, wires, FALSE, FALSE, log, clip]};
            RETURN [FALSE]};
        lowerWiresToo _ lowerWiresToo AND NOT clip.HasMemA[ct];
        [] _ d.sub.DeleteSet[ports];
        [] _ d.parent.DeleteSet[ports, right];
        [] _ d.cct[p].DeleteSet[ports];
        [] _ ct.fullName[p].DeleteSet[ports];
        IF ct.asu#NIL THEN {
            wires: Set ~ IF lowerWiresToo THEN ct.asu.exports.Image[ports].CreateHashCopy[] ELSE nilSet;
            IF ct.asu.exports.Image[ports].Scan[FixWire].found THEN ERROR;
            [] _ ct.asu.exports.DeleteSet[ports];
            IF lowerWiresToo THEN {
                IF log#NIL THEN log.PutF["DelW %g in %g from ports.\n", [rope[wires.FormatSet[]]], [rope[d.Describe[ct, d]]]];
                DeleteWires[ct, wires, FALSE, TRUE, log, clip]};
            };
        IF ct.asArray#NIL THEN {
            a: Array ~ ct.asArray;
            dr: DumRep ~ a.dumrep;
            dws: Set ~ IF lowerWiresToo THEN dr.apToWire.Image[ports].CreateHashCopy[] ELSE nilSet;
            [] _ a.statrep.apToPAI.DeleteSet[ports];
            IF dr#NIL THEN [] _ dr.apToWire.DeleteSet[ports];
            IF lowerWiresToo THEN {
                ect: CellType ~ ct.EltType[];
                eps: BiRel--elt port 
                SeeDumb: PROC [dwv: Sets.Value] RETURNS [BOOL] ~ {
                    dw: DumbWire ~ NARROW[dwv.VA];
                    [] _ eps.AddSet[dw.eps];
                    RETURN [FALSE]};
                IF dws.Scan[SeeDumb].found THEN ERROR;
                {eltPorts: Set ~ eps.SetOn[left];
                cais: Set ~ Sets.IIAsSet[[0, a.size-1]];
                all: BiRel ~ BiRels.CreateProduct[[eltPorts, cais]];
                IF NOT all.Equal[eps] THEN ERROR;
                IF log#NIL THEN log.PutF["DelPts %g of %g from array ports.\n", [rope[eltPorts.FormatSet[]]], [rope[d.Describe[ect, d]]]];
                DeletePorts[ect, eltPorts, FALSE, FALSE, TRUE, log, clip];
                }};
            };
        IF visitInsts THEN {
            NoteExEltPorts[ct, ports, TRUE, log];
            IF d.ciType.ScanMapping[AV[ct], FixInst, rightToLeft].found THEN ERROR};
        RETURN};

    EltCtr: PUBLIC PROC [a: Array, ect: CellType, ai: Int2] RETURNS [Int2] ~ {
        qr: QuotRem ~ LIB.DivMod[ai, a.basePeriod];
        {xfm: Transform ~ VXfm[a.
        c
        offset: Int2 ~ LIB.Mul[qr.q, a.offsets[c
        RETURN xfm.TransOffPos[offset, Range2Mid[ect.bbox]]}};

    SomePAI: PUBLIC PROC [act: CellType, dw: DumbWire] RETURNS [PortAtIndex] ~ {
        mpc: BiRels.MaybePair ~ dw.eps.APair[[[Sets.alleq, Sets.fwd], right]];
        IF mpc.found THEN {
            ep: Port ~ NARROW[mpc.it[left].VA];
            cai: CompositeArrayIndex ~ mpc.it[right].VI;
            ai: Int2 ~ act.asArray.DecomposeAI[cai];
            RETURN [[ep, ai]]}
        ELSE RETURN [[NIL, [0, 0]]]};

    FindStatEdge: PUBLIC PROC [sr: StatRep, sep: StatEdgeSpec, careAboutOthers: BOOL] RETURNS [fse: StatEdge _ NIL, others: BOOL _ 
    FALSE] ~ {
        TestEdge: PROC [se: StatEdge, ob: BOOL] RETURNS [BOOL] ~ {
            IF ob AND se.SeRSv[sr, TRUE]=sep.vs[TRUE] AND sep.
            others _ TRUE;
            RETURN [FALSE]};
        [] _ ScanStatEdgesFrom[sr, sep.vs[FALSE], ALL[TRUE], TestEdge];
        RETURN};

    GetDumbWires: PUBLIC PROC [a: Array, ep: Port, mayAdd: BOOL] RETURNS [dws: RefBiRel--cai 
        dws _ NARROW[a.dumrep.epToWire.ApplyA[ep].MDA];
        IF dws=NIL AND mayAdd THEN {
            dws _ BiRels.CreateVector[bounds: [0, a.size-1], rightSpace: a.dumrep.dwSpace].Refify;
            a.dumrep.epToWire.AddNewAA[ep, dws]};
        RETURN};

    EnsureStatEdge: PUBLIC PROC [d: Design, sr: StatRep, sep: StatEdgeSpec, mayHaveParent, mayHaventParent, close: BOOL] RETURNS [se: 
    StatEdge] ~ {
        se _ FindStatEdge[sr, sep, FALSE].fse;
        IF se=NIL THEN se _ AddStatEdge[d, sr, sep];
        IF (sep.vs[FALSE] _ ParentSV[d, sep.vs[FALSE]]).port = NIL THEN GOTO Istop;
        IF (sep.vs[TRUE] _ ParentSV[d, sep.vs[TRUE]]).port = NIL THEN GOTO Istop;
        {width: NATURAL ~ d.Width[sep.vs[FALSE].port];
        IF width # d.Width[sep.vs[TRUE].port] THEN GOTO Istop;
        FOR i: NATURAL IN [0 .. width) DO
            IF FindStatEdge[sr, ChildSEP[d, sep, i], FALSE].fse=NIL THEN GOTO Istop;
            ENDLOOP;
        IF NOT mayHaveParent THEN ERROR;
        IF close THEN [] _ EnsureStatEdge[d, sr, sep, mayHaveParent, mayHaventParent, close];
        RETURN};
        EXITS Istop => IF NOT mayHaventParent THEN ERROR;
        };

    AddStatEdge: PUBLIC PROC [d: Design, sr: StatRep, sep: StatEdgeSpec] RETURNS [se: StatEdge] ~ {
        se _ NEW [StatEdgePrivate _ [d.PWRank[sep.vs[FALSE].port], sep.
        IF se.rank # d.PWRank[sep.vs[TRUE].port] THEN ERROR;
        IF NOT sr.edges.AddA[se] THEN ERROR;
        sr.portEdge[FALSE].AddNewAA[sep.vs[FALSE].port, se];
        sr.portEdge[TRUE].AddNewAA[sep.vs[TRUE].port, se];
        sr.svEdge[FALSE].AddNewPair[[SvV[sep.vs[FALSE]], AV[se]]];
        sr.svEdge[TRUE].AddNewPair[[SvV[sep.vs[TRUE]], AV[se]]];
        RETURN};

    RemLowerStateEdges: PROC [d: Design, sr: StatRep, sep: StatEdgeSpec] ~ {
        kidPortsA: Seq ~ d.SubSeq[sep.vs[FALSE].port];
        IF kidPortsA=nilBiRel THEN {
            IF NOT d.Atomic[sep.vs[TRUE].port] THEN ERROR;
            RETURN};
        {width: LNAT ~ kidPortsA.Size.EN;
        IF width # d.Width[sep.vs[TRUE].port] THEN ERROR;
        FOR i: LNAT IN [0 .. width) DO
            csep: StatEdgeSpec ~ ChildSEP[d, sep, i];
            RemStatEdge[d, sr, csep];
            RemLowerStateEdges[d, sr, csep];
            ENDLOOP;
        RETURN}};

    RemStatEdge: PUBLIC PROC [d: Design, sr: StatRep, sep: StatEdgeSpec] ~ {
        se: StatEdge ~ FindStatEdge[sr, sep, FALSE].fse;
        IF se=NIL THEN ERROR;
        IF NOT sr.edges.RemA[se] THEN ERROR;
        IF NOT sr.portEdge[FALSE].DeleteA[se, right] THEN ERROR;
        IF NOT sr.portEdge[TRUE].DeleteA[se, right] THEN ERROR;
        IF NOT sr.svEdge[FALSE].DeleteA[se, right] THEN ERROR;
        IF NOT sr.svEdge[TRUE].DeleteA[se, right] THEN ERROR;
        RETURN};

    ChildSEP: PUBLIC PROC [d: Design, sep: StatEdgeSpec, i: NATURAL] RETURNS [StatEdgeSpec] ~ {
        RETURN [[
            vs: [
                FALSE: ChildSV[d, sep.vs[FALSE], i],
                TRUE: ChildSV[d, sep.vs[TRUE], i] ],
            

    ChildSV: PROC [d: Design, sv: StatVertex, i: NATURAL] RETURNS [StatVertex] ~ {
        RETURN [[NARROW[d.Sub[sv.port, i]], sv.phase]]};

    ParentSEP: PUBLIC PROC [d: Design, sep: StatEdgeSpec] RETURNS [StatEdgeSpec] ~ {
        RETURN [[
            vs: [
                FALSE: ParentSV[d, sep.vs[FALSE]],
                TRUE: ParentSV[d, sep.vs[TRUE]] ],
            

    ParentSV: PROC [d: Design, sv: StatVertex] RETURNS [StatVertex] ~ {
        RETURN [[d.PParent[sv.port], sv.phase]]};

    SeP: PUBLIC PROC [se: StatEdge, a: Array, b: BOOL] RETURNS [Port] ~ {
        RETURN [NARROW[a.statrep.portEdge[b].InvApplyA[se].MA]]};

    END.