
    <<PWCLCoreFlatExtrasImpl.mesa>>
        <<Barth, February 18, 1987 8:29:51 pm PST>>
        <<Last tweaked by Mike Spreitzer on February 16, 1988 1:22:48 pm PST>>

    DIRECTORY BitOps, Core, CoreClasses, CoreFlat, CoreOps, IO, PWCLCoreFlatExtras, RefTab, StructuredStreams, UnparserBuffer;

    PWCLCoreFlatExtrasImpl: CEDAR PROGRAM
        IMPORTS BitOps, CoreClasses, CoreFlat, CoreOps, IO, PWCLCoreFlatExtras, RefTab, StructuredStreams, UnparserBuffer
        EXPORTS PWCLCoreFlatExtras
        =

    BEGIN OPEN CC: CoreClasses, CoreFlat, CO: CoreOps, PWCLCoreFlatExtras, SS: StructuredStreams, UB: UnparserBuffer;

    SetCut: PUBLIC PROC [cs: CutSet] RETURNS [Cut] = {
        RETURN [[IsCutSetMember, cs]];
        };

    IsCutSetMember: PROC [cutData: REF ANY, root: CellType, cellType: CellType, flatCell: FlatCellTypeRec, instance: CellInstance] 
    RETURNS [BOOL] = {RETURN [CutSetMember[root, flatCell, NARROW[cutData]]]};

    leaves: PUBLIC Cut _ [IsLeaf, NIL];

    IsLeaf: PROC [cutData: REF ANY, root: CellType, cellType: CellType, flatCell: FlatCellTypeRec, instance: CellInstance] RETURNS 
    [BOOL] --CutMembershipTester-- = {
        cellType _ CO.ToBasic[cellType];
        RETURN [cellType.class # CC.recordCellClass AND cellType.class.recast = NIL];
        };

    PrintObject: PROC [to: IO.STREAM, PrintIt: PROC, cond: UB.BreakCondition _ width, sep: ROPE _ NIL] = {
        SS.Bp[to, cond, step, sep];
        SS.Begin[to];
        PrintIt[!UNWIND => SS.End[to]];
        SS.End[to];
        };
        step: NAT _ 3;

    FlatPrint: PUBLIC PROC
        [
            root: CellType,
            filter: Filter _ NIL,
            to: IO.STREAM,
            Annotator: PROC [subject: Descendant, to: IO.STREAM] _ NIL,
            leaves: Cut
            ]
        = {
        firstCell: BOOL _ TRUE;
        Flatten: PROC [cell: Core.CellType, target: FlatCellTypeRec _ allFlatCells, flatCell: FlatCellTypeRec _ [], instance: CellInstance 
        _ NIL, index: NAT _ LAST[NAT], parent: Core.CellType _ NIL, flatParent: FlatCellTypeRec _ [], data: REF ANY _ NIL, 
        bindings: Bindings _ NIL] --BoundFlatCellProc-- = {
            flatten: BOOL = NOT leaves.Includes[root, cell, flatCell, instance];
            IF flatten THEN {
                NextBoundCellType[cell, target, flatCell, instance, index, parent, flatParent, data, bindings, Flatten];
                }
            ELSE {
                PrintCell: PROC = {
                    firstBind: BOOL _ TRUE;
                    PrintBinding: PROC [actualWire, publicWire: Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] --CO.EachWirePairProc-- = {
                        publicName: ROPE = CO.GetFullWireName[cell.public, publicWire];
                        caw: FlatWire = NARROW[bindings.Fetch[publicWire].val];
                        actualName: ROPE = WirePathRope[root, caw^];
                        PrintBinding: PROC = {
                            to.PutRope[publicName];
                            to.PutRope[": "];
                            to.PutRope[actualName];
                            IF Annotator # NIL THEN Annotator[caw, to];
                            };
                        subWires _ CO.GetShortWireName[publicWire]=NIL;
                        IF NOT subWires THEN {
                            IF firstBind THEN firstBind _ FALSE ELSE to.PutRope[", "];
                            PrintObject[to, PrintBinding, width];
                            };
                        };
                    to.PutRope[InstancePathRope[root, flatCell.path]];
                    IF Annotator # NIL THEN Annotator[NEW [FlatCellTypeRec _ flatCell], to];
                    to.PutRope["["];
                    [] _ CO.VisitBindingSeq[instance.actual, cell.public, PrintBinding];
                    to.PutRope["]"];
                    };
                IF filter = NIL OR filter[cell, flatCell, instance, bindings] THEN {
                    IF firstCell THEN firstCell _ FALSE ELSE to.PutRope[";"];
                    PrintObject[to, PrintCell, united, " "];
                    };
                };
            };
        IF NOT SS.IsAnSS[to] THEN to _ SS.Create[UB.NewInittedHandle[[margin: 50, output: [stream[to]]]]];
        to.PutRope["{"];
        Flatten[root, allFlatCells, [], NIL, LAST[NAT], NIL, [], NIL, InitialBindingTable[root]];
        to.PutRope["}"];
        };

    PrintNeighborhood: PUBLIC PROC
        [
            root: CellType,
            of: DescendantListList,
            to: IO.STREAM,
            Annotator: PROC [subject: Descendant, to: IO.STREAM] _ NIL,
            leaves: Cut
            ]
        = {
        WithFilter: PROC [filter: Filter] ~ {
            FlatPrint[root, filter, to, Annotator, leaves];
            };
        MakeNeighborhoodFilter[of, WithFilter];
        root _ root;
        };

    MakeNeighborhoodFilter: PUBLIC PROC [of: DescendantListList, Consume: PROC [Filter]] ~ {
        wires: RefTab.Ref = RefTab.Create[hash: FlatWireHash, equal: FlatWireEqual];
        cells: RefTab.Ref = RefTab.Create[hash: HashIP, equal: IPEqual];
        filter: Filter = {
            FindSubject: PROC [wire: Core.Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] --CO.EachWireProc-- = {
                caw: FlatWire = NARROW[bindings.Fetch[wire].val];
                quit _ wires.Fetch[caw].found;
                };
            RETURN [cells.Fetch[NEW [InstancePath _ flatCell.path]].found OR CO.VisitWireSeq[cellType.public, FindSubject]];
            };
        FOR dll: DescendantListList _ of, dll.rest WHILE dll # NIL DO
            FOR ds: DescendantList _ dll.first, ds.rest WHILE ds # NIL DO
                WITH ds.first SELECT FROM
                    x: FlatWire => IF NOT wires.Insert[x, $T] THEN ERROR;
                    x: REF InstancePath => IF NOT cells.Insert[x, $T] THEN ERROR;
                    x: FlatCellType => IF NOT cells.Insert[NEW [InstancePath _ x.path], $T] THEN ERROR;
                    ENDCASE => ERROR;
                ENDLOOP;
            ENDLOOP;
        Consume[filter];
        of _ of;
        };

    HashIP: PROC [ra: REF ANY] RETURNS [hash: CARDINAL] = {
        hash _ WITH ra SELECT FROM
            x: REF InstancePath => FlatCellTypeHashRec[[x^]],
            ENDCASE => ERROR;
        };

    IPEqual: PROC [key1, key2: REF ANY] RETURNS [equal: BOOL] = {
        equal _ WITH key1 SELECT FROM
            x: REF InstancePath => WITH key2 SELECT FROM
                y: REF InstancePath => x^.InstancePathEqual[y^],
                ENDCASE => ERROR,
            ENDCASE => ERROR;
        };

    LowerInstancePath: PUBLIC PROC [path, by: InstancePath] RETURNS [lower: InstancePath] ~ {
        length: NATURAL ~ NATURAL[path.length] + by.length;
        lower _ [
            length: length,
            bits: LOOPHOLE[BitOps.QOR[
                LOOPHOLE[by.bits],
                BitOps.QShift[LOOPHOLE[path.bits], -by.length]
                ]]];
        RETURN};

    LowerFlatCell: PUBLIC PROC [fc: FlatCellTypeRec, by: FlatCellTypeRec] RETURNS [lower: FlatCellTypeRec] ~ {
        lower _ [
            path: LowerInstancePath[fc.path, by.path],
            recastCount: IF fc.path.length#0 THEN fc.recastCount ELSE by.recastCount];
        RETURN};

    LowerFlatWire: PUBLIC PROC [fw: FlatWireRec, by: FlatCellTypeRec] RETURNS [lower: FlatWireRec] ~ {
        lower _ fw;
        lower.flatCell _ LowerFlatCell[lower.flatCell, by];
        RETURN};

    END.