
    <<LichenFromCoreImpl.Mesa>>
    <<Last Edited by: Spreitzer, May 7, 1986 5:12:00 pm PDT>>
        <<Mike Spreitzer October 20, 1986 7:47:26 pm PDT>>

    DIRECTORY Asserting, Core, CoreClasses, CoreOps, CoreProperties, Rope, RopeHash, LichenDataOps, LichenDataStructure, 
    LichenFromCore, LichenSetTheory;

    LichenFromCoreImpl: CEDAR PROGRAM
        IMPORTS Asserting, CoreClasses, CoreOps, CoreProperties, Rope, RopeHash, LichenDataOps, LichenDataStructure, LichenSetTheory
        EXPORTS LichenFromCore
        =

    BEGIN OPEN CC: CoreClasses, CO: CoreOps, CP: CoreProperties, LDO: LichenDataOps, LDS: LichenDataStructure, LichenFromCore, 
    LichenSetTheory;

    ROPE: TYPE = Rope.ROPE;

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

    ColorerKey: ATOM = $CoreLichenColorer;

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

    wireColorKey: ATOM = CP.RegisterProperty[
        $LichenFromCoreImplWireColor,
        CP.Props[]];

    portKey: ATOM = CP.RegisterProperty[
        $LichenPortFromCorePublicWire,
        CP.Props[]];

    lichenFromCore: ATOM = CP.RegisterProperty[
        $LichenFromCore,
        CP.Props[]];

    lichenToCore: ATOM = $LichenToCore;

    GetLCT: PUBLIC PROC [cct: Core.CellType] RETURNS [lct: LDS.CellType] = {
        original: Core.CellType = cct;
        Work: PROC [cct: Core.CellType] RETURNS [lct: LDS.CellType] = {
            raw: REF ANY;
            lct _ NIL;
            raw _ CP.GetCellTypeProp[cct, lichenFromCore];
            IF raw # NIL THEN WITH raw SELECT FROM
                x: LDS.CellType => IF Asserting.FnVal[implKey, x.otherPublic] = implVal THEN lct _ x;
                ENDCASE;
            IF lct = NIL THEN {
                cName: ROPE = CO.GetCellTypeName[original];
                colorer: Colorer = WITH CP.InheritCellTypeProp[original, ColorerKey] SELECT FROM
                    x: Colorer => x,
                    ENDCASE => defaultColorer;
                SELECT cct.class.recast FROM
                    =NIL => {
                        typeColor: LDS.Color = LDS.FilterColor[colorer.CellTypeColor[cct]];
                        SetWireColor[cct.public, typeColor];
                        colorer.ColorPorts[cct, SetWireColor];
                        lct _ NEW [LDS.CellTypePrivate _ [
                            class: coreLCC,
                            designs: CreateHashSet[],
                            publicKnown: TRUE,
                            privateKnown: FALSE,
                            otherPublic: Asserting.AssertFn1[implKey, implVal, NIL],
                            otherPrivate: Asserting.AssertFn1[understoodCore, cct, NIL],
                            color: typeColor
                            ]];
                        lct.port _ PublicToPort[lct, cct.public, CreateHashSet[]];
                        };
                    #NIL => lct _ Work[CO.Recast[cct]];
                    ENDCASE => ERROR;
                VisitPortAndCoreWire[lct.port, cct.public, AssocPortWithPublicWire];
                lct.otherPublic _ Asserting.AssertFn1[lichenToCore, cct, lct.otherPublic];
                lct.otherPublic _ Asserting.Assert[LDS.nameReln, LIST[cName], lct.otherPublic];
                CP.PutCellTypeProp[cct, lichenFromCore, lct];
                };
            };
        lct _ Work[cct];
        };

    understoodCore: ATOM = $LichenUnderstoodCoreCellType;

    coreLCC: LDS.CellClass = NEW [LDS.CellClassPrivate _ [
        DefinePrivates: DefinePrivates]];

    DefinePrivates: PROC [lct: LDS.CellType] = {
        cct: Core.CellType = NARROW[Asserting.FnVal[understoodCore, lct.otherPrivate]];
        rct: CC.RecordCellType = WITH cct.data SELECT FROM
            x: CC.RecordCellType => x,
            ENDCASE => NIL;
        IF lct.privateKnown THEN RETURN;
        lct.privateKnown _ TRUE;
        IF rct = NIL THEN RETURN;
        lct.asUnorganized _ NEW [LDS.UnorganizedPrivate _ [
            internalWire: NEW [LDS.VertexPrivate.wire _ [
                containingCT: lct,
                other: Asserting.Assert[LDS.nameReln, LIST[NARROW["Internal", ROPE]], NIL],
                variant: wire[]
                ]],
            containedInstances: CreateHashSet[]
            ]];
        {DefineInternal: PROC [cw: Core.Wire, containingWire: LDS.Wire, seen: Set] = {
            lw: LDS.Wire = IF cw = rct.internal THEN lct.asUnorganized.internalWire ELSE LDO.CreateWire[lct, containingWire, 
            Asserting.Assert[LDS.nameReln, LIST[CO.GetShortWireName[cw]], NIL]];
            IF NOT seen.UnionSingleton[cw] THEN ERROR--DAG, not Tree--;
            lw.other _ Asserting.AssertFn1[lichenToCore, cw, lw.other];
            CP.PutWireProp[cw, lichenFromCore, lw];
            FOR i: INT IN [0 .. cw.size) DO
                DefineInternal[
                    cw: cw[i],
                    containingWire: IF cw # rct.internal THEN lw ELSE NIL,
                    seen: seen];
                ENDLOOP;
            };
        DefineInternal[rct.internal, NIL, CreateHashSet[]];
        };
        {SetPortWire: PROC [port: LDS.Port, pw: Core.Wire] = {
            IF (port.wire _ NARROW[GetLElt[pw]]) = NIL AND pw.size = 0 THEN ERROR;
            };
        VisitPortAndCoreWire[lct.port, cct.public, SetPortWire]};
        FOR ii: INT IN [0 .. rct.size) DO
            cci: CC.CellInstance = rct.instances[ii];
            type: LDS.CellType = GetLCT[cci.type];
            lci: LDS.CellInstance = LDO.Instantiate[type, lct, Asserting.Assert[LDS.nameReln, LIST[CC.GetCellInstanceName[cci]], NIL]];
            CreateBinding: PROC [lp: LDS.Port, caw, cpw: Core.Wire, cellward: LDS.Vertex] = {
                subLP: LDS.Port _ lp.firstChild;
                IF caw.size # cpw.size THEN ERROR;
                FOR i: INT IN [0 .. caw.size) DO
                    scaw: Core.Wire = caw[i];
                    scpw: Core.Wire = cpw[i];
                    slaw: LDS.Wire = NARROW[GetLElt[scaw]];
                    IF subLP = NIL THEN ERROR;
                    IF slaw # NIL THEN {
                        LDO.AddEdge[[cellward: cellward, wireward: slaw], subLP];
                        }
                    ELSE {
                        sich: LDS.Vertex = LDO.CreateIntermediary[cellward, wireward, lct, subLP, Asserting.Filter[LDS.nameReln, subLP.other].about];
                        IF scaw.size = 0 THEN ERROR--should've reached internal wire by now--;
                        CreateBinding[subLP, scaw, scpw, sich];
                        };
                    subLP _ subLP.next;
                    ENDLOOP;
                IF subLP # NIL THEN ERROR;
                };
            lci.other _ Asserting.AssertFn1[lichenToCore, cci, lci.other];
            CP.PutCellInstanceProp[cci, lichenFromCore, lci];
            CreateBinding[type.port, cci.actual, cci.type.public, lci];
            ENDLOOP;
        LDO.AddMirror[lct];
        lct _ lct;
        };

    PublicToPort: PROC [parent: REF ANY, public: Core.Wire, alreadySeen: Set--of Core.Wire--] RETURNS [port: LDS.Port] = {
        cName: ROPE = CO.GetShortWireName[public];
        IF NOT alreadySeen.UnionSingleton[public] THEN ERROR--DAG, not Tree--;
        port _ LDO.AddPort[[
            parent: parent,
            other: Asserting.Assert[LDS.nameReln, LIST[cName], NIL],
            color: GetWireColor[public]
            ]];
        FOR i: NAT IN [0 .. public.size) DO
            child: LDS.Port = PublicToPort[port, public[i], alreadySeen];
            ENDLOOP;
        };

    AssocPortWithPublicWire: PROC [port: LDS.Port, public: Core.Wire] = {
        CP.PutWireProp[public, portKey, port];
        port.other _ Asserting.AssertFn1[lichenToCore, public, port.other];
        };

    GetPort: PUBLIC PROC [pw: Core.Wire] RETURNS [port: LDS.Port] = {
        port _ NARROW[CP.GetWireProp[pw, portKey]];
        };

    InsertCoreWire: PROC [cw: Core.Wire, in: Set] = {
        Insert: PROC [wire: Core.Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] --CO.EachWireProc-- = {
            subWires _ in.UnionSingleton[wire];
            };
        [] _ CO.VisitWire[cw, Insert]};

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

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

    GetCCT: PUBLIC PROC [lct: LDS.CellType] RETURNS [cct: Core.CellType] = {
        cct _ NARROW[Asserting.FnVal[lichenToCore, lct.otherPublic]];
        };

    GetLElt: PUBLIC PROC [ce: CircuitElement] RETURNS [v: LDS.Vertex] = {
        WITH ce SELECT FROM
            w: Core.Wire => v _ NARROW[CP.GetWireProp[w, lichenFromCore]];
            ci: CC.CellInstance => v _ NARROW[CP.GetCellInstanceProp[ci, lichenFromCore]];
            ENDCASE => ERROR;
        };

    GetCElt: PUBLIC PROC [v: LDS.Vertex] RETURNS [ce: CircuitElement] = {
        ce _ Asserting.FnVal[lichenToCore, v.other];
        };

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

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

    DefaultColorPorts: PROC [ct: Core.CellType, SetColor: PROC [Core.Wire, LDS.Color]] = {
        ColorPort: PROC [wire: Core.Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] --CO.EachWireProc-- = {
            IF wire # ct.public 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: LDS.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, LDS.Color]] = {
        ColorPort: PROC [wire: Core.Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] --CO.EachWireProc-- = {
            IF wire # ct.public 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: LDS.Color _ 47;
        channelColor: LDS.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;
        };

    VisitPortAndCoreWire: PROC [port: LDS.Port, cw: Core.Wire, Consume: PROC [LDS.Port, Core.Wire]] = {
        subPort: LDS.Port _ port.firstChild;
        Consume[port, cw];
        FOR i: INT IN [0 .. cw.size) DO
            IF subPort = NIL THEN ERROR;
            VisitPortAndCoreWire[subPort, cw[i], Consume];
            subPort _ subPort.next;
            ENDLOOP;
        IF subPort # NIL THEN ERROR;
        };

    VisitCoreWire: PROC [cw, containing: Core.Wire, Consume: PROC [coreWire, containingCoreWire: Core.Wire]] = {
        Consume[cw, containing];
        FOR i: INT IN [0 .. cw.size) DO VisitCoreWire[cw[i], cw, Consume] ENDLOOP;
        };

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

    Start[];

    END.