
    <<StructureFromCoreImpl.Mesa>>
        <<Barth, February 18, 1987 8:30:10 pm PST>>
        <<Mike Spreitzer March 16, 1987 3:05:36 pm PST>>
        <<Last tweaked by Mike Spreitzer on March 24, 1987 2:18:01 pm PST>>

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

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

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

        ATOMList: TYPE = LIST OF ATOM;

        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]]];

        ttolProps: ARRAY TransistorDim OF ATOM ~ [
            length: CP.RegisterProperty[
                $LichenLengthTolerance,
                CP.Props[[CP.propPrint, CP.PropDontPrint]]],
            width: CP.RegisterProperty[
                $LichenWidthTolerance,
                CP.Props[[CP.propPrint, CP.PropDontPrint]]]
            ];

        structureFromCorePrefix: ROPE = "StructureFromCore by SubtreeSpec ";
        structureFromCorePrefixLength: INT = structureFromCorePrefix.Length[];
        structureFromCoreFormat: ROPE = structureFromCorePrefix.Concat["%g(%g) and MergeSpec %g(%g)"];

        SpecAndKeyList: TYPE = LIST OF SpecAndKey;
        SpecAndKey: TYPE = RECORD [sts: SubtreeSpec, ms: MergeSpec, key: ATOM];

        stsToKey: SpecAndKeyList _ NIL;

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

        GetKeyForSpecs: PROC [sts: SubtreeSpec, ms: MergeSpec] RETURNS [key: ATOM] = {
            FOR stks: SpecAndKeyList _ stsToKey, stks.rest WHILE stks # NIL DO
                IF stks.first.sts = sts AND stks.first.ms = ms THEN RETURN [stks.first.key];
                ENDLOOP;
            key _ CP.RegisterProperty[
                Atom.MakeAtom[IO.PutFR[
                    structureFromCoreFormat,
                    [cardinal[LOOPHOLE[sts, CARDINAL]]],
                    [refAny[NEW [SubtreeSpec _ sts]]],
                    [cardinal[LOOPHOLE[ms, CARDINAL]]],
                    [refAny[NEW [MergeSpec _ ms]]]
                    ]],
                CP.Props[[CP.propPrint, CP.PropDontPrint]]];
            stsToKey _ CONS[[sts, ms, key], stsToKey];
            };

        GetGraph: PUBLIC PROC [ttols: TransistorTolerances _ NIL, cct: Core.CellType, internals: BOOL, sts: SubtreeSpec, ms: MergeSpec, 
        SurveyPart: PROC [v: Vertex, core: REF ANY --UNION [Wire, CellInstance]--] _ NIL] RETURNS [sct: CellType] = {
            original: Core.CellType = cct;
            raw: REF ANY;
            colorer: Colorer = WITH CP.InheritCellTypeProp[cct, ColorerKey] SELECT FROM
                x: Colorer => x,
                ENDCASE => defaultColorer;
            backHash: HashTable.Table;
            structureFromCoreCellType: ATOM = GetKeyForSpecs[sts, ms];
            ttolsCopied: BOOL _ FALSE;
            IF NOT (internals OR ms=MergeNothing) THEN ERROR--Not implemented because not needed, right?--;
            IF ttols = NIL THEN ttols _ defaultTransistorTolerances;
            FOR td: TransistorDim IN TransistorDim DO
                WITH CP.InheritCellTypeProp[cct, ttolProps[td]] SELECT FROM
                    x: ROPE => {
                        y: REAL ~ Convert.RealFromRope[x];
                        IF NOT ttolsCopied THEN {
                            ttolsCopied _ TRUE;
                            ttols _ NEW [TransistorTolerancesPrivate _ ttols^]};
                        ttols[td] _ SELECT y FROM
                            >= 1.0 => [1.0/y, y],
                            <= 0.0 => ERROR,
                            ENDCASE => [y, 1.0/y];
                        };
                    ENDCASE => NULL;
                ENDLOOP;
            sct _ NIL;
            DO
                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 cct.class.recast = NIL THEN EXIT;
                IF TRUE THEN EXIT--because backHash (& other, less obvious, things) references original, it won't do to inherit the graph of a 
                Recast--;
                cct _ CO.Recast[cct];
                ENDLOOP;
            IF sct = NIL THEN {
                sct _ NEW [CellTypeRep _ [
                    name: GetCellTypeName[original],
                    color: FilterColor[colorer.CellTypeColor[original]],
                    ports: NEW [PortSeq[CO.WireBits[original.public]]],
                    otherPublic: Asserting.AssertFn1[structureToCore, original, Asserting.AssertFn1[implKey, implVal, 
                    Asserting.AssertFn1[transistorTolerancesKey, ttols, NIL]]]
                    ]];
                sct.ports.length _ 0;
                CP.PutCellTypeProp[original, structureFromCoreCellType, sct];
                colorer.ColorPorts[original, SetWireColor];
                IF NOT internals THEN {
                    seen: HashTable.Table = HashTable.Create[];
                    pi: PortIndex _ 0;
                    DefinePorts: PROC [wire: Core.Wire] = {
                        IF NOT seen.Fetch[wire].found THEN {
                            name: ROPE = UnionNames[CO.GetFullWireNames[original.public, wire]];
                            sct.ports[pi] _ [
                                name: name,
                                color: GetWireColor[wire]
                                ];
                            IF NOT seen.Insert[wire, $T] THEN ERROR;
                            pi _ pi + 1;
                            };
                        };
                    CO.VisitRootAtomics[original.public, DefinePorts];
                    IF pi # sct.ports.size THEN ERROR;
                    sct.ports.length _ pi;
                    };
                }
            ELSE IF GetCellType[sct] # original THEN ERROR;
            IF sct.internalsKnown OR NOT internals THEN RETURN;
            sct.internalsKnown _ TRUE;
            {ENABLE UNWIND => ForgetGraph[sct];
            backHash _ HashTable.Create[hash: HashDescendant, equal: DescendantEqual];
            sct.otherPrivate _ Asserting.AssertFn1[backHashKey, backHash, sct.otherPrivate];
            {
            Prefix: PROC [path: CF.InstancePath] RETURNS [prefix: ROPE] = {
                IF path.length=0 THEN RETURN [NIL];
                prefix _ CF.InstancePathRope[original, path].Concat["/"];
                };
            IntroduceWires: PROC [flatCell: CF.FlatCellTypeRec, wireRoot: CF.WireRoot, root: Core.Wire, bindings: CF.Bindings] = {
                DefineInternal: PROC [wire: Core.Wire] = {
                    IF bindings = NIL OR NOT bindings.Fetch[wire].found THEN {
                        dw: CF.FlatWire = NEW [CF.FlatWireRec _ [flatCell: flatCell, wireRoot: wireRoot, wire: wire]];
                        IF NOT backHash.Fetch[dw].found THEN {
                            name: ROPE ~ CF.WirePathRope[root: original, wire: dw^];
                            <<name: ROPE = Prefix[flatCell.path].Concat[UnionNames[CO.GetFullWireNames[root, wire]]];>>
                            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];
                            IF SurveyPart # NIL THEN SurveyPart[v, wire];
                            };
                        };
                    };
                CO.VisitRootAtomics[root, DefineInternal];
                };
            Flatten: PROC [cell: Core.CellType, target: CF.FlatCellTypeRec _ CF.allFlatCells, flatCell: CF.FlatCellTypeRec _ [], instance: 
            CF.CellInstance _ NIL, index: NAT _ LAST[NAT], parent: Core.CellType _ NIL, flatParent: CF.FlatCellTypeRec _ [], data: 
            REF ANY _ NIL, bindings: CF.Bindings _ NIL] --CF.BoundFlatCellProc-- = {
                path: DescendantCellInstancePrivate = flatCell.path;
                childCCT: Core.CellType = IF path.length > 0 THEN sts[instance, path] ELSE NIL;
                flatten: BOOL = childCCT = NIL;
                IF flatten THEN {
                    IF cell.class=CC.recordCellClass THEN {
                        rct: CC.RecordCellType = NARROW[cell.data];
                        IntroduceWires[flatCell, internal, rct.internal, bindings];
                        };
                    CF.NextBoundCellType[cell, target, flatCell, instance, index, parent, flatParent, data, bindings, Flatten];
                    IF cell.class=CC.recordCellClass THEN {
                        rct: CC.RecordCellType = NARROW[cell.data];
                        EnumerateInstances: PROC [Consume: PROC [ci: CC.CellInstance] RETURNS [stop: BOOL _ FALSE]] = {
                            FOR i: NAT IN [0 .. rct.size) DO
                                IF Consume[rct[i]] THEN EXIT;
                                ENDLOOP;
                            };
                        IdentifyActual: PROC [ci: CoreClasses.CellInstance, actual: Core.Wire, describe: BOOL _ FALSE] RETURNS [ActualID] = {
                            dw: DescendantWire ~ NARROW[bindings.Fetch[actual].value];
                            IF dw # NIL THEN RETURN [[dw, IF describe THEN CF.WirePathRope[original, dw^] ELSE NIL]];
                            RETURN [[actual, IF describe THEN CF.WirePathRope[original, [flatCell: flatCell, wire: actual]] ELSE NIL]];
                            };
                        ConsumeMerge: PROC [ds: Element] = {
                            v: Vertex _ CanonizeAndGetStructure[sct, ds.first];
                            FOR ds _ ds.rest, ds.rest WHILE ds # NIL DO
                                w: Vertex _ CanonizeAndGetStructure[sct, ds.first];
                                v _ MergeVertices[sct, v, w].merged;
                                ENDLOOP;
                            };
                        ms[original, cell, path, EnumerateInstances, IdentifyActual, ConsumeMerge];
                        }
                    }
                ELSE {
                    ci: CC.CellInstance = instance;
                    di: DescendantCellInstance = NEW [DescendantCellInstancePrivate _ path];
                    name: ROPE = Prefix[path].Concat[CC.GetCellInstanceName[ci]];
                    type: CellType = GetGraph[ttols, childCCT, FALSE, sts, MergeNothing, NIL];
                    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 pw # ci.type.public AND NOT seen.Fetch[pw].found THEN {
                            adw: DescendantWire = NARROW[bindings.Fetch[publicWire].value];
                            IF adw = NIL THEN ERROR;
                            {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;
                    IF SurveyPart # NIL THEN SurveyPart[v, ci];
                    };
                };
            IntroduceWires[[], public, original.public, NIL];
            Flatten[original, CF.allFlatCells, [], NIL, LAST[NAT], NIL, [], NIL, HashTable.Create[]];
            };
            IF sct.ports.length # 0 THEN ERROR;
            {pi: PortIndex _ 0;
            seen: HashTable.Table = HashTable.Create[];
            SetPortNet: PROC [wire: Core.Wire] = {
                IF NOT seen.Fetch[wire].found THEN {
                    dw: DescendantWire = NEW [DescendantWirePrivate _ [wireRoot: public, wire: wire]];
                    nv: Vertex = GetStructure[sct, dw];
                    IF nv = NIL THEN ERROR;
                    IF NOT seen.Fetch[nv].found THEN {
                        first: BOOL _ TRUE;
                        color: Color _ 0;
                        FOR ds: Element _ GetCore[nv], ds.rest WHILE ds # NIL DO
                            dw: DescendantWire = NARROW[ds.first];
                            IF dw.path.length # 0 THEN ERROR;
                            IF first THEN first _ FALSE;
                            color _ color + GetWireColor[dw.wire];
                            ENDLOOP;
                        IF first THEN ERROR;
                        sct.ports[pi] _ [
                            name: nv.name,
                            net: nv,
                            color: FilterColor[color]
                            ];
                        IF NOT seen.Insert[nv, $T] THEN ERROR;
                        pi _ pi + 1;
                        };
                    };
                };
            [] _ CO.VisitRootAtomics[original.public, SetPortNet];
            sct.ports.length _ pi;
            };
            AddMirror[sct];
            };
            sct _ sct;
            };

        ForgetGraph: PUBLIC PROC [sct: CellType] = {
            cct: Core.CellType = GetCellType[sct];
            propsToRemove: ATOMList _ NIL;
            FindPropsToRemove: PROC [prop: ATOM, val: REF ANY _ NIL] = {
                IF structureFromCorePrefix.Equal[Atom.GetPName[prop].Substr[len: structureFromCorePrefixLength]] THEN propsToRemove _ CONS[prop, 
                propsToRemove];
                };
            EnumerateParts[sct, DestroyVertex, TRUE];
            sct^ _ CellTypeRep[destroyed: TRUE];
            CP.Enumerate[cct.properties, FindPropsToRemove];
            FOR propsToRemove _ propsToRemove, propsToRemove.rest WHILE propsToRemove # NIL DO
                CP.PutCellTypeProp[cct, propsToRemove.first, NIL];
                ENDLOOP;
            };

        AddPart: PROC [sct: CellType, v: Vertex] = {
            v.nextPart _ sct.firstPart;
            sct.firstPart _ v;
            sct.size _ sct.size + 1;
            SELECT v.class FROM
                cell => sct.cellCount _ sct.cellCount + 1;
                net => sct.netCount _ sct.netCount + 1;
                ENDCASE => ERROR;
            };

        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]];
            };

        CanonizeAndGetStructure: PUBLIC PROC [sct: CellType, core: --not necessarily canonical--Descendant] RETURNS [v: Vertex] = {
            backHash: HashTable.Table = NARROW[Asserting.FnVal[backHashKey, sct.otherPrivate]];
            cd: --Canonized--Descendant _ core;
            WITH core SELECT FROM
                di: DescendantCellInstance => NULL;
                dw: DescendantWire => {
                    original: Core.CellType = GetCellType[sct];
                    cd _ NEW [CF.FlatWireRec _ CF.CanonizeWire[original, dw^]];
                    };
                ENDCASE => ERROR;
            FOR v _ NARROW[backHash.Fetch[cd].value], v.better UNTIL v.better = NIL DO NULL ENDLOOP;
            };

        GetStructure: PUBLIC PROC [sct: CellType, core: --Canonized--Descendant] RETURNS [v: Vertex] = {
            backHash: HashTable.Table = NARROW[Asserting.FnVal[backHashKey, sct.otherPrivate]];
            FOR v _ NARROW[backHash.Fetch[core].value], v.better UNTIL v.better = NIL DO NULL ENDLOOP;
            };

        GetCore: PUBLIC PROC [v: Vertex] RETURNS [core: Element] = {
            Note: PROC [assertion: Asserting.Assertion] --Asserting.AssertionConsumer-- = {
                d: Descendant = Asserting.FnVal[structureToCore, LIST[assertion]];
                core _ CONS[d, core];
                };
            core _ NIL;
            Asserting.EnumerateAssertionsAbout[structureToCore, v.other, Note];
            };

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

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

        DefaultColorPorts: PROC [ct: Core.CellType, SetColor: PROC [Core.Wire, Color]] = {
            ColorPort: PROC [wire: Core.Wire] = {
                <<name: ROPE = UnionNames[CO.GetFullWireNames[ct.public, wire]];>>
                <<SetColor[wire, RopeHash.FromRope[name]];>>
                SetColor[wire, RefHash[wire]];
                };
            [] _ CO.VisitRootAtomics[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] = {
                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.VisitRootAtomics[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.