
    <<StructureFromCoreImpl.Mesa>>
    <<Last Edited by: Spreitzer, April 28, 1986 4:53:52 pm PDT>>

    DIRECTORY Asserting, Basics, Core, CoreClasses, CoreFlat, CoreOps, CoreProperties, CoreStructuralComparison, HashTable, IO, Rope, 
    RopeHash, StructuralComparisonDataStructure, StructureFromCore;

    StructureFromCoreImpl: CEDAR PROGRAM
        IMPORTS Asserting, CoreClasses, CoreFlat, CoreOps, CoreProperties, HashTable, IO, Rope, RopeHash, StructuralComparisonDataStructure
        EXPORTS StructureFromCore
        SHARES StructuralComparisonDataStructure =

        BEGIN OPEN CC: CoreClasses, CO: CoreOps, CP: CoreProperties, CoreStructuralComparison, StructuralComparisonDataStructure;

        implKey: ATOM = $StructureFromCoreImplInstance;
        implVal: REF ROPE _ NEW [ROPE _ "New for this one"];

        ColorerKey: ATOM = $CoreStructureColorer;

        Colorer: TYPE = REF ColorerPrivate;
        ColorerPrivate: TYPE = RECORD [
            CellTypeColor: PROC [ct: Core.CellType] RETURNS [Color],
            ColorPorts: PROC [ct: Core.CellType, SetColor: PROC [Core.Wire, Color]]
                <<Must set the color of each atom of the public wire.>>
            ];

        wireColorKey: ATOM = CP.RegisterProperty[
            $LichenStructureFromCoreImplWireColor,
            CP.Props[[CP.propPrint, CP.PropDontPrint]]];

        structureFromFlattenedCore: ATOM = CP.RegisterProperty[
            $StructureFromFlattenedCore,
            CP.Props[[CP.propPrint, CP.PropDontPrint]]];

        structureFromUnflattenedCore: ATOM = CP.RegisterProperty[
            $StructureFromUnflattenedCore,
            CP.Props[[CP.propPrint, CP.PropDontPrint]]];

        backHashKey: ATOM = $StructureFromCoreImplCellTypeToBackpointerHashtable;
        structureToCore: ATOM = $StructureToCore;

        emptyPath: CoreFlat.PackedPath = [];

        GetGraph: PUBLIC PROC [cct: Core.CellType, internals, flatten: BOOL] RETURNS [sct: CellType] = {
            raw: REF ANY;
            colorer: Colorer _ NIL;
            backHash: HashTable.Table;
            flattenByAnotherName: BOOL = flatten;
            structureFromCoreCellType: ATOM = IF flatten THEN structureFromFlattenedCore ELSE structureFromUnflattenedCore;
            sct _ NIL;
            DO
                raw _ CP.GetCellClassProp[cct.class, ColorerKey];
                IF raw # NIL THEN WITH raw SELECT FROM
                    x: Colorer => colorer _ x;
                    ENDCASE;
                raw _ CP.GetCellTypeProp[cct, structureFromCoreCellType];
                IF raw # NIL THEN WITH raw SELECT FROM
                    x: CellType => sct _ IF Asserting.FnVal[implKey, x.otherPublic] = implVal THEN x ELSE NIL;
                    ENDCASE => sct _ NIL;
                IF sct # NIL THEN EXIT;
                IF colorer # NIL THEN EXIT;
                IF cct.class.recast = NIL THEN EXIT;
                cct _ CO.Recast[cct];
                ENDLOOP;
            IF sct = NIL THEN {
                seen: HashTable.Table = HashTable.Create[];
                pi: PortIndex _ 0;
                DefinePorts: PROC [wire: Core.Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] --CO.EachWireProc-- = {
                    IF wire.size = 0 AND NOT seen.Fetch[wire].found THEN {
                        name: ROPE = UnionNames[CO.GetFullWireNames[cct.public, wire]];
                        sct.ports[pi] _ [
                            name: name,
                            color: GetWireColor[wire]
                            ];
                        IF NOT seen.Insert[wire, $T] THEN ERROR;
                        pi _ pi + 1;
                        };
                    };
                IF colorer = NIL THEN colorer _ defaultColorer;
                sct _ NEW [CellTypeRep _ [
                    name: GetCellTypeName[cct],
                    color: FilterColor[colorer.CellTypeColor[cct]],
                    ports: NEW [PortSeq[CO.WireBits[cct.public]]],
                    otherPublic: Asserting.AssertFn1[structureToCore, cct, Asserting.AssertFn1[implKey, implVal, NIL]]
                    ]];
                CP.PutCellTypeProp[cct, structureFromCoreCellType, sct];
                colorer.ColorPorts[cct, SetWireColor];
                [] _ CO.VisitWire[cct.public, DefinePorts];
                IF pi # sct.ports.length THEN ERROR;
                };
            IF sct.internalsKnown OR NOT internals THEN RETURN;
            sct.internalsKnown _ TRUE;
            backHash _ HashTable.Create[hash: HashDescendant, equal: DescendantEqual];
            sct.otherPrivate _ Asserting.AssertFn1[backHashKey, backHash, sct.otherPrivate];
            {
            Prefix: PROC [path: CoreFlat.PackedPath] RETURNS [prefix: ROPE] = {
                IF path.length=0 THEN RETURN [NIL];
                prefix _ CoreFlat.PathRope[cct, path].Concat["/"];
                };
            BeforeExpand: PROC [bindings: HashTable.Table, path: CoreFlat.PackedPath, cellType: Core.CellType] = {
                DefineInternal: PROC [key, value: REF ANY] RETURNS [quit: BOOL _ FALSE] --HashTable.EachPairAction-- = {
                    wb: CoreFlat.WireBind = NARROW[value];
                    IF wb.wire.size # 0 THEN RETURN;
                    {dw: DescendantWire = NEW [DescendantWirePrivate _ [wb.path, wb.wire]];
                    IF NOT backHash.Fetch[dw].found THEN {
                        iw: Core.Wire = wb.wire;
                        rct: CC.RecordCellType = NARROW[cellType.data];
                        name: ROPE = Prefix[dw.path].Concat[UnionNames[CO.GetFullWireNames[rct.internal, iw]]];
                        v: Vertex = NEW [VertexRep _ [
                            name: name,
                            class: net,
                            other: Asserting.AssertFn1[structureToCore, dw, NIL]
                            ]];
                        IF NOT backHash.Insert[dw, v] THEN ERROR;
                        AddPart[sct, v];
                        };
                    }};
                [] _ bindings.Pairs[DefineInternal];
                };
            SeeInstance: PROC [bindings: HashTable.Table, path: CoreFlat.PackedPath, instance: CC.CellInstance] RETURNS [flatten: BOOL] = {
                flatten _ flattenByAnotherName AND CO.ToBasic[instance.type].class = CC.recordCellClass;
                IF flatten THEN RETURN;
                {ci: CC.CellInstance = instance;
                di: DescendantCellInstance = NEW [DescendantCellInstancePrivate _ [path, ci]];
                name: ROPE = Prefix[path].Concat[CC.GetCellInstanceName[ci]];
                type: CellType = GetGraph[ci.type, FALSE, FALSE];
                v: Vertex = NEW [VertexRep _ [
                    name: name,
                    class: cell,
                    type: type,
                    other: Asserting.AssertFn1[structureToCore, di, NIL]
                    ]];
                pi: PortIndex _ 0;
                seen: HashTable.Table = HashTable.Create[];
                SeeBinding: PROC [actualWire, publicWire: Core.Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] --CO.EachWirePairProc-- = {
                    pw: Core.Wire = publicWire;
                    IF pw.size = 0 AND NOT seen.Fetch[pw].found THEN {
                        awb: CoreFlat.WireBind = NARROW[bindings.Fetch[actualWire].value];
                        adw: DescendantWire = NEW [DescendantWirePrivate _ [awb.path, awb.wire]];
                        nv: Vertex = GetStructure[sct, adw];
                        IF nv = NIL THEN ERROR;
                        Link[v, nv, type.ports[pi].color];
                        IF NOT seen.Insert[pw, $T] THEN ERROR;
                        pi _ pi + 1;
                        };
                    };
                IF NOT backHash.Insert[di, v] THEN ERROR;
                AddPart[sct, v];
                [] _ CO.VisitBinding[ci.actual, ci.type.public, SeeBinding];
                IF pi # type.ports.length THEN ERROR;
                }};
            CoreFlat.EnumerateLeaves[cct, SeeInstance, NIL, BeforeExpand, NIL]};
            {pi: PortIndex _ 0;
            seen: HashTable.Table = HashTable.Create[];
            SetPortNet: PROC [wire: Core.Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] --CO.EachWireProc-- = {
                IF wire.size = 0 AND NOT seen.Fetch[wire].found THEN {
                    dw: DescendantWire = NEW [DescendantWirePrivate _ [emptyPath, wire]];
                    nv: Vertex = GetStructure[sct, dw];
                    IF nv = NIL THEN ERROR;
                    sct.ports[pi].net _ nv;
                    IF NOT seen.Insert[wire, $T] THEN ERROR;
                    pi _ pi + 1;
                    };
                };
            [] _ CO.VisitWire[cct.public, SetPortNet];
            IF pi # sct.ports.length THEN ERROR;
            };
            AddMirror[sct];
            sct _ sct;
            };

        ForgetGraph: PUBLIC PROC [sct: CellType] = {
            cct: Core.CellType = GetCellType[sct];
            EnumerateParts[sct, DestroyVertex, TRUE];
            sct^ _ [];
            CP.PutCellTypeProp[cct, structureFromFlattenedCore, NIL];
            CP.PutCellTypeProp[cct, structureFromUnflattenedCore, NIL];
            };

        AddPart: PROC [sct: CellType, v: Vertex] = {
            v.nextPart _ sct.firstPart;
            sct.firstPart _ v;
            sct.size _ sct.size + 1};

        Link: PROC [cv, nv: Vertex, edgeColor: Color] = {
            e: Edge = NEW [EdgeRep _ [
                sides: [
                    net: [v: nv, next: NIL, prev: nv.lastEdge],
                    cell: [v: cv, next: NIL, prev: cv.lastEdge]],
                color: edgeColor]];
            IF nv.lastEdge = NIL THEN nv.firstEdge _ e ELSE nv.lastEdge.sides[net].next _ e;
            IF cv.lastEdge = NIL THEN cv.firstEdge _ e ELSE cv.lastEdge.sides[cell].next _ e;
            nv.lastEdge _ cv.lastEdge _ e;
            };

        DestroyVertex: PROC [v: Vertex] = {
            WHILE v.firstEdge # NIL DO
                e: Edge _ v.firstEdge;
                v.firstEdge _ e.sides[v.class].next;
                e.sides[v.class] _ [NIL, NIL, NIL];
                ENDLOOP;
            v^ _ [class: v.class];
            };

        AddMirror: PROC [sct: CellType] = {
            v: Vertex = NEW [VertexRep _ [
                name: " The Outside World! ",
                class: cell,
                type: sct,
                isMirror: TRUE
                ]];
            sct.mirror _ v;
            FOR pi: PortIndex IN [0 .. sct.ports.length) DO
                Link[v, sct.ports[pi].net, sct.ports[pi].color];
                ENDLOOP;
            };

        SetWireColor: PROC [wire: Core.Wire, color: Color] = {
            CP.PutWireProp[wire, wireColorKey, NEW [Color _ color]];
            };

        GetWireColor: PROC [wire: Core.Wire] RETURNS [color: Color] = {
            rc: REF Color = NARROW[CP.GetWireProp[wire, wireColorKey]];
            color _ rc^;
            };

        GetCellType: PUBLIC PROC [sct: CellType] RETURNS [cct: Core.CellType] = {
            cct _ NARROW[Asserting.FnVal[structureToCore, sct.otherPublic]];
            };

        GetStructure: PUBLIC PROC [sct: CellType, core: Descendant] RETURNS [v: Vertex] = {
            backHash: HashTable.Table = NARROW[Asserting.FnVal[backHashKey, sct.otherPrivate]];
            v _ NARROW[backHash.Fetch[core].value];
            };

        GetCore: PUBLIC PROC [v: Vertex] RETURNS [core: Descendant] = {
            core _ Asserting.FnVal[structureToCore, v.other];
            };

        HashDescendant: PROC [ra: REF ANY] RETURNS [hash: CARDINAL] = {
            org: Descendant = ra;
            hash _ WITH org SELECT FROM
                x: DescendantWire => x.path.PathHash[] + RefHash[x.wire],
                x: DescendantCellInstance => x.path.PathHash[] + RefHash[x.instance],
                ENDCASE => ERROR;
            };

        DescendantEqual: PROC [r1, r2: REF ANY] RETURNS [equal: BOOL] = {
            o1: Descendant = r1;
            o2: Descendant = r2;
            equal _ WITH o1 SELECT FROM
                x: DescendantWire => WITH o2 SELECT FROM
                    y: DescendantWire => x.path.PathEqual[y.path] AND x.wire = y.wire,
                    ENDCASE => FALSE,
                x: DescendantCellInstance => WITH o2 SELECT FROM
                    y: DescendantCellInstance => x.path.PathEqual[y.path] AND x.instance = y.instance,
                    ENDCASE => FALSE,
                ENDCASE => ERROR;
            };

        RefHash: PROC [ra: REF ANY] RETURNS [hash: CARDINAL] = INLINE {
            ln: Basics.LongNumber _ [lc[LOOPHOLE[ra]]];
            hash _ ln.lo + ln.hi;
            };

        defaultColorer: Colorer _ NEW [ColorerPrivate _ [DefaultCellTypeColor, DefaultColorPorts]];

        DefaultCellTypeColor: PROC [ct: Core.CellType] RETURNS [color: Color] = {
            name: ROPE _ CO.GetCellTypeName[ct];
            color _ RopeHash.FromRope[name];
            };

        DefaultColorPorts: PROC [ct: Core.CellType, SetColor: PROC [Core.Wire, Color]] = {
            ColorPort: PROC [wire: Core.Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] --CO.EachWireProc-- = {
                IF wire.size = 0 THEN {
                    name: ROPE = UnionNames[CO.GetFullWireNames[ct.public, wire]];
                    SetColor[wire, RopeHash.FromRope[name]];
                    };
                };
            [] _ CO.VisitWire[ct.public, ColorPort];
            };

        transistorColorer: Colorer _ NEW [ColorerPrivate _ [TransistorCellTypeColor, ColorTransistorPorts]];

        TransistorCellTypeColor: PROC [ct: Core.CellType] RETURNS [color: Color] = {
        td: CC.Transistor = NARROW[ct.data];
        color _ SELECT td.type FROM
        nE => 36,
        pE => 24,
        nD => 33,
        ENDCASE => ERROR;
            };

        ColorTransistorPorts: PROC [ct: Core.CellType, SetColor: PROC [Core.Wire, Color]] = {
            ColorPort: PROC [wire: Core.Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] --CO.EachWireProc-- = {
                IF wire.size = 0 THEN {
                    name: ROPE = CO.GetShortWireName[wire];
                    SetColor[wire, SELECT TRUE FROM
                        name.Substr[len: 2].Equal["ch", FALSE] => channelColor,
                        name.Equal["gate", FALSE] => gateColor,
                        ENDCASE => ERROR
                        ];
                    };
                };
            [] _ CO.VisitWire[ct.public, ColorPort];
            };
            gateColor: Color _ 47;
            channelColor: Color _ 834;

        UnionNames: PROC [names: LIST OF ROPE] RETURNS [unioned: ROPE] = {
            unioned _ NIL;
            FOR names _ names, names.rest WHILE names # NIL DO
                unioned _ IF unioned=NIL THEN names.first ELSE Rope.Cat[unioned, "|", names.first];
                ENDLOOP;
            unioned _ unioned;
            };

        GetCellTypeName: PROC [cct: Core.CellType] RETURNS [name: ROPE] = {
            IF (name _ CO.GetCellTypeName[cct]).Length[] # 0 THEN RETURN;
            cct _ CO.ToBasic[cct];
            IF (name _ CO.GetCellTypeName[cct]).Length[] # 0 THEN RETURN;
            WITH cct.data SELECT FROM
                t: CC.Transistor => {
                    name _ IO.PutFR[
                        "%g(%g/%g)",
                        [rope[SELECT t.type FROM
                            nE => "nE",
                            pE => "pE",
                            nD => "nD",
                            ENDCASE => ERROR]],
                        [integer[t.length]],
                        [integer[t.width]]];
                    [] _ CO.SetCellTypeName[cct, name];
                    };
                ENDCASE => name _ IO.PutFR["%xB^", [cardinal[LOOPHOLE[cct]]]];
            };

        Start: PROC = {
            CP.PutCellClassProp[CC.transistorCellClass, ColorerKey, transistorColorer];
            };

        Start[];

        END.