
    <<LichenFromCoreImpl.Mesa>>
        <<Last tweaked by Mike Spreitzer on August 3, 1988 3:28:19 pm PDT>>

    DIRECTORY AbSets, Atom, BiRels, Convert, Core, CoreClasses, CoreOps, CoreProperties, IO, LichenDataOps, LichenDataStructure, 
    LichenFromCore, LichenIntBasics, RefTab, Rope, RopeHash, SetBasics;

    LichenFromCoreImpl: CEDAR PROGRAM
        IMPORTS AbSets, Atom, BiRels, Convert, CoreClasses, CoreOps, CoreProperties, IO, LichenDataOps, LichenDataStructure, RefTab, Rope, 
        RopeHash, SetBasics
        EXPORTS LichenFromCore
        =

    BEGIN OPEN CC:CoreClasses, CO:CoreOps, CP:CoreProperties, LDO:LichenDataOps, LDS:LichenDataStructure, LichenFromCore, 
    LIB:LichenIntBasics, Sets:AbSets;

    ROPE: TYPE = Rope.ROPE;
    VarSet: TYPE ~ Sets.VarSet;

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

    implKey: PUBLIC ATOM ~ Atom.MakeAtom--the compiler is remarkably stupid about some things--["LichenFromCoreImplInstance"];
    implVal: REF ROPE _ NEW [ROPE _ "New for this one"];

    lichenToCore: LDS.Fn ~ BiRels.CreateHashTable[ALL[SetBasics.refs]];

    GetDesign: PROC [rt: RefTab.Ref, name, suffix: ROPE, pacify: IO.STREAM _ NIL] RETURNS [d: LDS.Design] ~ {
        root: Core.CellType ~ NARROW[rt.Fetch[name].val];
        d _ LDO.CreateDesign[LDS.OneRope[name.Concat[suffix]]];
        d.root _ GetLCT[d, root, pacify];
        RETURN};

    GetLCT: PUBLIC PROC [d: LDS.Design, cct: Core.CellType, pacify: IO.STREAM _ NIL] 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 x.other.HasAA[implKey, implVal] THEN lct _ x;
            ENDCASE;
        IF lct = NIL THEN {
            cName: ROPE = CO.GetCellTypeName[cct];
            colorer: Colorer = WITH CP.InheritCellTypeProp[cct, ColorerKey] SELECT FROM
                x: Colorer => x,
                ENDCASE => defaultColorer;
            typeColor: LDS.Color = LDS.FilterColor[colorer.CellTypeColor[cct]];
            flavor: LDO.CellFlavor ~ WITH cct.data SELECT FROM
                x: CC.RecordCellType => unorganized,
                x: CC.SequenceCellType => array,
                x: ROPE => leaf,
                x: LDS.Design => ERROR,
                ENDCASE => ERROR;
            CopyPort: PROC [wire: Core.Wire] RETURNS [subWires, quit: BOOL] --CoreOps.EachWireProc-- ~ {
                [] _ ToNewPort[wire];
                RETURN [FALSE, FALSE]};
            ToNewPort: PROC [wire: Core.Wire] RETURNS [p: LDS.Port] ~ {
                kids: LDS.Seq _ LDS.nilBiRel;
                names: LDS.Set ~ Sets.CreateHashSet[LDS.steppyNameSpace];
                FOR nl: LDS.LOR _ CO.GetFullWireNames[cct.public, wire], nl.rest WHILE nl # NIL DO [] _ names.AddElt[ConvertName[nl.first].SnV] 
                ENDLOOP;
                IF wire.size#0 THEN {
                    kids _ LDS.CreateSeq[len: wire.size, oneToOne: TRUE, dense: TRUE, rightSpace: d.eSpace];
                    FOR i: NATURAL IN [0 .. wire.size) DO
                        kids.AddNewIA[i, ToNewPort[wire[i]]];
                        ENDLOOP;
                    wire _ wire};
                p _ LDO.CreatePort[ct: lct, fullNames: names, deduced: FALSE, addum: FALSE, nameDum: FALSE, fixExpConns: FALSE, fixInstConns: 
                FALSE, fixWExpConns: FALSE, fixWInstConns: FALSE, children: kids];
                CP.PutWireProp[wire, portKey, p];
                lichenToCore.AddNewAA[p, wire];
                RETURN};
            IF pacify#NIL THEN pacify.PutF["Converting %g\n", [rope[cName]]];
            SetWireColor[cct.public, typeColor];
            colorer.ColorPorts[cct, SetWireColor];
            lct _ LDO.CreateCellType[d, flavor, LIB.emptyRange2, LDS.OneRope[cName]];
            lct.other.AddNewAA[implKey, implVal];
            lct.color _ typeColor;
            [] _ CO.VisitWireSeq[cct.public, CopyPort];
            SELECT flavor FROM
            unorganized => {rct: CC.RecordCellType ~ NARROW[cct.data];
                CopyWire: PROC [wire: Core.Wire] RETURNS [subWires, quit: BOOL] --CoreOps.EachWireProc-- ~ {
                    [] _ ToNewWire[wire];
                    RETURN [FALSE, FALSE]};
                ToNewWire: PROC [cw: Core.Wire] RETURNS [lw: LDS.Wire] ~ {
                    kids: LDS.Seq _ LDS.nilBiRel;
                    names: LDS.Set ~ Sets.CreateHashSet[LDS.steppyNameSpace];
                    FOR nl: LDS.LOR _ CO.GetFullWireNames[rct.internal, cw], nl.rest WHILE nl # NIL DO [] _ names.AddElt[ConvertName[nl.first].SnV] 
                    ENDLOOP;
                    IF CP.GetWireProp[cw, lichenFromCore] # NIL THEN ERROR --DAG, not Tree--;
                    IF cw.size#0 THEN {
                        kids _ LDS.CreateSeq[len: cw.size, oneToOne: TRUE, dense: TRUE, rightSpace: d.eSpace];
                        FOR i: NATURAL IN [0 .. cw.size) DO
                            kids.AddNewIA[i, ToNewWire[cw[i]]];
                            ENDLOOP;
                        cw _ cw};
                    lw _ LDO.CreateWire[ct: lct, fullNames: names, deduced: FALSE, fixExpConns: FALSE, fixInstConns: FALSE, children: kids];
                    CP.PutWireProp[cw, lichenFromCore, lw];
                    lichenToCore.AddNewAA[lw, cw];
                    RETURN};
                ConnectPort: PROC [cw: Core.Wire] RETURNS [subWires, quit: BOOL] --CoreOps.EachWireProc-- ~ {
                    lp: LDS.Port ~ GetPort[cw];
                    lw: LDS.Wire ~ NARROW[CP.GetWireProp[cw, lichenFromCore]];
                    IF lp=NIL OR lw=NIL THEN ERROR;
                    LDO.Connect[d, lw, lp, lct];
                    RETURN [TRUE, FALSE]};
                [] _ CO.VisitWireSeq[rct.internal, CopyWire];
                [] _ CO.VisitWireSeq[cct.public, ConnectPort];
                FOR ii: INT IN [0 .. rct.size) DO
                    cci: CC.CellInstance = rct.instances[ii];
                    type: LDS.CellType = GetLCT[d, cci.type, pacify];
                    lci: LDS.CellInstance = LDO.Instantiate[type, lct, FALSE, [], LIB.dullInt2, ConvertName[CC.GetCellInstanceName[cci]].OneSteppy];
                    Bind: PROC [actualWire, publicWire: Core.Wire] RETURNS [subWires, quit: BOOL] ~ {
                        lp: LDS.Port ~ GetPort[publicWire];
                        lw: LDS.Wire ~ NARROW[GetLElt[actualWire]];
                        LDO.Connect[d, lw, lp, lci];
                        RETURN [TRUE, FALSE]};
                    lichenToCore.AddNewAA[lci, cci];
                    CP.PutCellInstanceProp[cci, lichenFromCore, lci];
                    [] _ CO.VisitBindingSeq[cci.actual, cci.type.public, Bind];
                    ENDLOOP;
                };
            array => {sct: CC.SequenceCellType ~ NARROW[cct.data];
                lect: LDS.CellType ~ GetLCT[d, sct.base, pacify];
                seqs: LDS.Set--of INT-- ~ Setify[sct.sequence];
                IF sct.flatSequence#NIL AND sct.flatSequence.length#0 THEN ERROR;
                IF sct.stitch#NIL AND sct.stitch.length#0 THEN ERROR;
                LDO.SetArrayPart[lct, lect, LDO.CreateArrayPart[lct, lect, [sct.count, 1], [1, 1], LDS.nilBiRel, NIL]];
                IF cct.public.size # sct.base.public.size THEN ERROR;
                FOR idx: INT IN [0 .. cct.public.size) DO
                    ep: LDS.Port ~ GetPort[sct.base.public[idx]];
                    ap: LDS.Port ~ GetPort[cct.public[idx]];
                    IF NOT seqs.HasMemI[idx] THEN {
                        IF cct.public[idx].size # 0 THEN ERROR;
                        LDO.MakeArrayNewConnection[d, lct.asArray, [[0, sct.count-1], [0, 1]], [1, 0], ep, ep];
                        LDO.MakeArrayExport[d, lct.asArray, ap, ep, [0, 0]]}
                    ELSE {
                        IF cct.public[idx].size # sct.count THEN ERROR;
                        FOR j: NAT IN [0 .. sct.count) DO
                            LDO.MakeArrayExport[d, lct.asArray, NARROW[d.Sub[ap, j]], ep, [j, 0]];
                            ENDLOOP};
                    ENDLOOP;
                LDO.FinishedMakingArrayConnections[lct];
                };
            leaf => NULL;
            ENDCASE => ERROR;
            lichenToCore.AddNewAA[lct, cct];
            CP.PutCellTypeProp[cct, lichenFromCore, lct];
            };
        RETURN};

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

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

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

    GetCCT: PUBLIC PROC [lct: LDS.CellType] RETURNS [cct: Core.CellType] = {
        cct _ NARROW[lichenToCore.ApplyA[lct].MDA];
        RETURN};

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

    GetCElt: PUBLIC PROC [v: LDS.Vertex] RETURNS [ce: CircuitElement] = {
        ce _ NARROW[lichenToCore.ApplyA[v].MDA];
        RETURN};

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

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

    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]];
                };
            RETURN};
        [] _ CO.VisitWire[ct.public, ColorPort];
        RETURN};

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

    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
                    ];
                };
            RETURN};
        [] _ CO.VisitWire[ct.public, ColorPort];
        RETURN};
        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;
        RETURN};

    Setify: PROC [ss: CC.SequenceSet] RETURNS [ints: LDS.Set] ~ {
        ints _ Sets.CreateHashSet[SetBasics.ints];
        FOR i: NAT IN [0 .. ss.length) DO [] _ ints.AddI[ss[i]] ENDLOOP;
        RETURN};

    ConvertName: PROC [coreName: ROPE] RETURNS [LDS.SteppyName] ~ {
        lb: INT ~ coreName.Find["["];
        IF lb=-1 THEN RETURN LDS.OSn[coreName];
        {rb: INT ~ coreName.Find["]", lb];
        IF rb=-1 THEN ERROR;
        {idx: NAT ~ Convert.IntFromRope[coreName.Substr[start: lb+1, len: rb-lb-1]];
        IF lb=0 THEN RETURN LDS.OSn[NEW [INT _ idx]];
        RETURN LDS.LSn[LIST[coreName.Substr[len: lb], NEW [INT _ idx]]]}}};

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

    Start[];

    END.