
    <<LichenFromExtImpl1.Mesa>>
        <<Last tweaked by Mike Spreitzer on August 25, 1988 12:35:00 pm PDT>>

    DIRECTORY AbSets, Basics, BasicTime, BiRelBasics, BiRels, Buttons, Containers, FS, Icons, IntStuff, IO, LichenDataOps, 
    LichenDataStructure, LichenFromExtPrivate, LichenIntBasics, List, PieViewers, Process, ProcessProps, RefText, Rope, RopeHash, 
    SetBasics, ViewerOps, ViewerTools;

    LichenFromExtImpl1: CEDAR MONITOR
        LOCKS dr USING dr: DesignReading
        IMPORTS AbSets, BasicTime, BiRelBasics, BiRels, Buttons, Containers, FS, Icons, IO, LichenDataOps, LichenDataStructure, 
        LichenFromExtPrivate, List, PieViewers, Process, ProcessProps, RefText, Rope, RopeHash, SetBasics, ViewerOps, ViewerTools
        EXPORTS LichenFromExtPrivate
        =

    BEGIN OPEN LichenIntBasics, LichenDataOps, LichenDataStructure, LichenFromExtPrivate, Sets:AbSets, IS:IntStuff;

    readers: Fn _ BiRels.CreateHashDictionary[TRUE];

    pacifierIcon: Icons.IconFlavor _ Icons.NewIconFromFile["Lichen.icons", 0];
    pacifyPeriod: Process.Milliseconds _ 2500;
    labelHeight: INTEGER _ 27;
    pauseWidth: INTEGER _ 60;
    pieDiameter: INTEGER _ 50;
    roperels: Sets.Space ~ BiRelBasics.CreateBiRelSpace[ALL[SetBasics.ropes[TRUE]]];

    ReadRenaming: PROC [fileName: ROPE] RETURNS [rg: Renaming] ~ {
        in: IO.STREAM ~ FS.StreamOpen[fileName];
        rg _ BiRels.CreateHashTable[[SetBasics.ropes[TRUE], roperels]];
        DO
            ctn: ROPE ~ in.GetTokenRope[RenameToken].token;
            IF ctn.Equal["."] THEN EXIT;
            {ren: Fn ~ BiRels.CreateHashTable[[SetBasics.ropes[TRUE], steppyNameSpace]];
            ob: ROPE ~ in.GetTokenRope[RenameToken].token;
            IF NOT ob.Equal["{"] THEN ERROR;
            DO
                old: ROPE ~ in.GetTokenRope[RenameToken].token;
                colon: ROPE ~ in.GetTokenRope[RenameToken].token;
                new: ROPE ~ in.GetTokenRope[RenameToken].token;
                next: ROPE ~ in.GetTokenRope[RenameToken].token;
                parsd: SteppyName ~ ParseSteppyName[new];
                IF NOT colon.Equal[":"] THEN ERROR;
                ren.AddNewPair[[AV[old], parsd.SnV[]]];
                IF next.Equal["}"] THEN EXIT;
                IF NOT next.Equal[","] THEN ERROR;
                ENDLOOP;
            rg.AddNewPair[[AV[ctn], ren.BV]];
            }ENDLOOP;
        in.Close[];
        RETURN};

    RenameToken: PROC [char: CHAR] RETURNS [cc: IO.CharClass] =
        {cc _ SELECT char FROM
            '{, '}, ':, ', => break,
            IN [0C .. ' ] => sepr,
            ENDCASE => other};

    MapName: PUBLIC PROC [dr: DesignReading, ct: CellType, wn: ROPE] RETURNS [SteppyName] ~ {
        ren: Fn ~ BiRels.DeRef[dr.rg.ApplyA[ct.ACtName].MDA];
        IF ren=nilBiRel THEN RETURN OSn[wn];
        {repl: Sets.MaybeValue ~ ren.ApplyA[wn];
        IF repl.found THEN RETURN VSn[repl.it] ELSE RETURN OSn[wn]}};

    MapFirst: PUBLIC PROC [dr: DesignReading, ct: CellType, sn: SteppyName] RETURNS [SteppyName] ~ {
        old: ROPE ~ NARROW[sn.steps.first];
        ren: Fn ~ BiRels.DeRef[dr.rg.ApplyA[ct.ACtName].MDA];
        IF ren=nilBiRel THEN RETURN [sn];
        {repl: Sets.MaybeValue ~ ren.ApplyA[old];
        IF NOT repl.found THEN RETURN [sn];
        RETURN VSn[repl.it].SNCat[SNTail[sn]]}};

    ReadDesign: PROC [rootCellFileName: ROPE, renamingFileName: ROPE] RETURNS [dr: DesignReading] ~ {
        rg: Renaming ~ ReadRenaming[renamingFileName];
        cp: FS.ComponentPositions;
        fullFName, designName: ROPE;
        [fullFName, cp, ] _ FS.ExpandName[rootCellFileName];
        designName _ fullFName.Substr[start: cp.base.start, len: cp.base.length].Concat["-l"];
        {d: Design ~ CreateDesign[OneRope[designName]];
        Doit: PROC = {
            dr.stack _ NIL;
            d.root _ ReadCellType[dr.d, rootCellFileName, dr];
            ReadPorts[dr, d.root, designName.Concat[".ports"]];
            RETURN};
        dr _ NEW [DesignReadingRep _ [
            d: d,
            wDir: fullFName.Substr[len: cp.base.start],
            rg: rg,
            fetTypes: BiRels.CreateHashTable[[fetSpace, SetBasics.refs]],
            unkosherArrays: Sets.CreateHashSet[],
            toMerge: BiRels.CreateHashTable[[paths, SetBasics.refs]],
            arraySpecs: BiRels.CreateHashTable[[d.eSpace, SetBasics.refs]],
            buffer: RefText.New[200],
            pacifier: Containers.Create[info: [name: designName.Cat[" pacifier"], icon: pacifierIcon]],
            pie: NIL,
            label: NIL,
            pause: NIL
            ]];
        TRUSTED {
            Process.InitializeCondition[@dr.change, Process.SecondsToTicks[60]];
            Process.EnableAborts[@dr.change]};
        dr.pause _ Buttons.Create[info: [name: "Pause", parent: dr.pacifier, wx: 0, wy: 0, ww: pauseWidth, wh: labelHeight], proc: 
        TogglePause, clientData: dr];
        dr.label _ ViewerTools.MakeNewTextViewer[info: [parent: dr.pacifier, wx: dr.pause.wx+dr.pause.ww, wy: 0, ww: 100, wh: labelHeight]];
        Containers.ChildXBound[container: dr.pacifier, child: dr.label];
        dr.pie _ PieViewers.Create[parent: dr.pacifier, x: 0, y: dr.label.wy+dr.label.wh, diameter: pieDiameter, total: 1.0, divisions: 
        100];
        Containers.ChildXBound[container: dr.pacifier, child: dr.pie];
        Containers.ChildYBound[container: dr.pacifier, child: dr.pie];
        ViewerOps.SetOpenHeight[dr.pacifier, dr.pie.wy+dr.pie.wh];
        TRUSTED {Process.Detach[FORK Pacify[dr]]};
        ProcessProps.PushPropList[List.PutAssoc[$WorkingDirectory, dr.wDir, NIL], Doit];
        RETURN}};

    Wait: ENTRY PROC [dr: DesignReading] = {
        ENABLE UNWIND => NULL;
        WHILE dr.stop DO WAIT dr.change ENDLOOP};

    Pacify: PROC [dr: DesignReading] = {
        lastStack: SourceList _ NIL;
        lastIndex: INT _ 0;
        ViewerOps.OpenIcon[icon: dr.pacifier, bottom: FALSE];
        WHILE NOT dr.pacifier.destroyed DO
            WithLock: ENTRY PROC [dr: DesignReading] = {
                ENABLE UNWIND => NULL;
                IF dr.stack = NIL THEN {
                    IF dr.stack # lastStack THEN {
                        lastStack _ dr.stack;
                        ViewerTools.SetContents[dr.label, "Idle"];
                        PieViewers.Set[dr.pie, 0];
                        };
                    }
                ELSE {
                    index: INT = dr.stack.first.stream.GetIndex[];
                    IF dr.stack # lastStack OR index # lastIndex THEN {
                        lastStack _ dr.stack;
                        lastIndex _ index;
                        ViewerTools.SetContents[dr.label, IO.PutFR["%g%g%g[%g]", [rope[dr.prefix]], [rope[dr.curCellTypeName]], [rope[IF dr.curArray THEN 
                        ".aext" ELSE ""]], [integer[index]]]];
                        PieViewers.Set[dr.pie, index/dr.curCellFileLength];
                        };
                    };
                };
            Process.Pause[Process.MsecToTicks[pacifyPeriod]];
            WithLock[dr];
            ENDLOOP;
        RETURN};

    TogglePause: Buttons.ButtonProc = {
        dr: DesignReading = NARROW[clientData];
        Flip: ENTRY PROC [dr: DesignReading] = {
            ENABLE UNWIND => NULL;
            dr.stop _ NOT dr.stop;
            BROADCAST dr.change};
        Flip[dr];
        Buttons.ReLabel[dr.pause, IF dr.stop THEN "Continue" ELSE "Pause"];
        };

    DoPushed: PROC [dr: DesignReading, cellTypeName: ROPE, array: BOOL, s: Source, Proc: PROC [Source]] = {
        cooler: SourceList = dr.stack;
        oldCellTypeName: ROPE = dr.curCellTypeName;
        oldArray: BOOL = dr.curArray;
        oldPrefix: ROPE = dr.prefix;
        oldCellFileLength: REAL = dr.curCellFileLength;
        newPrefix: ROPE = FmtStack[cooler];
        newCellFileLength: INT = MAX[s.stream.GetLength[], 1];
        Push: ENTRY PROC [dr: DesignReading] = {
            ENABLE UNWIND => NULL;
            dr.stack _ CONS[s, dr.stack];
            dr.curCellTypeName _ cellTypeName;
            dr.curArray _ array;
            dr.prefix _ newPrefix;
            dr.curCellFileLength _ newCellFileLength;
            };
        Pop: ENTRY PROC [dr: DesignReading] = {
            ENABLE UNWIND => NULL;
            dr.stack _ cooler;
            dr.curCellTypeName _ oldCellTypeName;
            dr.curArray _ oldArray;
            dr.prefix _ oldPrefix;
            dr.curCellFileLength _ oldCellFileLength;
            };
        Push[dr];
        Proc[s !UNWIND => Pop[dr]];
        Pop[dr];
        };

    ReadCellType: PUBLIC PROC [d: Design, cellFileName: ROPE, dr: DesignReading] RETURNS [ct: CellType] = {
        cp: FS.ComponentPositions;
        fullFName, cellTypeName: ROPE;
        from: IO.STREAM;
        s: Source;
        cr: CellReading;
        Pushed: PROC [s: Source] = {PushedRead[dr, cr, s, FALSE]};
        [fullFName, cp] _ ExtendName[cellFileName, "ext"];
        cellTypeName _ fullFName.Substr[start: cp.base.start, len: cp.base.length];
        ct _ CreateCellType[d, unorganized, emptyRange2, OneRope[cellTypeName]];
        cr _ NEW[CellReadingRep _ [dr: dr, ct: ct, name: cellTypeName, newArrays: Sets.CreateHashSet[]]];
        s _ [from _ FS.StreamOpen[fullFName], fullFName];
        DoPushed[dr, cellTypeName, FALSE, s, Pushed];
        from.Close[];
        RETURN};

    TryArrayFile: PUBLIC PROC [cr: CellReading] = {
        fullFName: ROPE = ExtendName[cr.name, "aext"].fullFName;
        s: Source = [FS.StreamOpen[fullFName], fullFName];
        Pushed: PROC [s: Source] = {
            PushedRead[cr.dr, cr, s, TRUE];
            FinishWaitingMerges[cr];
            RETURN};
        FinishArray: PROC [ra: Sets.Value] ~ {
            act: CellType ~ NARROW[ra.VA];
            TrimStatrep[act, act.asArray];
            FinishedMakingArrayConnections[act];
            RETURN};
        IF (NOT cr.dr.toMerge.Empty[]) OR cr.waitingMerges # NIL THEN ERROR;
        DoPushed[cr.dr, cr.name, TRUE, s, Pushed];
        s.stream.Close[];
        cr.newArrays.Enumerate[FinishArray];
        RETURN};

    PushedRead: PROC [dr: DesignReading, cr: CellReading, s: Source, nested: BOOL] = {
        from: IO.STREAM = s.stream;
        ct: CellType = cr.ct;
        d: Design ~ dr.d;
        DO
            keyword: ROPE;
            reader: Reader;
            Process.CheckForAbort[];
            [] _ from.SkipWhitespace[];
            IF from.EndOf[] THEN EXIT;
            IF dr.stop THEN Wait[dr];
            keyword _ from.GetTokenRope[TokenBreak].token;
            reader _ NARROW[readers.ApplyA[keyword].MDA];
            IF reader # NIL
                THEN reader.read[s, reader, cr]
                ELSE {ERROR--let's not be sloppy--;
                    <<terms: Terms _ GetLineTerms[from];
                    reln: ATOM _ Atom.MakeAtom[keyword];
                    ct.otherPublic _ Assert[reln, terms, ct.otherPublic];>>
                    };
            ENDLOOP;
        IF (NOT dr.toMerge.Empty[]) THEN {
            IF cr.firstMerge THEN ERROR;
            DoMerges[s, cr];
            }
        ELSE IF cr.firstMerge THEN {cr.firstMerge _ FALSE; TryArrayFile[cr]};
        IF nested THEN RETURN;
        DesignScaleIs[d, cr.lUnits];
        {CleanupChild: PROC [ra: Sets.Value] = {
            ci: CellInstance = NARROW[ra.VA];
            childType: CellType = NARROW[d.ciType.ApplyA[ci].MA];
            IF childType.asArray # NIL THEN CheckArrayUsage[d, childType];
            RETURN};
        d.cct[i].EnumerateMapping[AV[ct], CleanupChild, rightToLeft];
        RETURN}};

    ReadPorts: PROC [dr: DesignReading, ct: CellType, fileName: ROPE] ~ {
        in: IO.STREAM ~ FS.StreamOpen[fileName !FS.Error => GOTO DontExist];
        wires: Set ~ Sets.CreateHashSet[ct.d.eSpace];
        DO
            [] _ in.SkipWhitespace[];
            IF in.EndOf THEN EXIT;
            {name: ROPE ~ in.GetRopeLiteral[];
            path: Path ~ ParsePath[[in, fileName], dr, ct, name, FALSE];
            w: Wire ~ PathGet[dr, ct, path, TRUE];
            IF w=NIL THEN {when: BasicTime.GMT ~ BasicTime.Now[]; ERROR};
            [] _ wires.AddA[w];
            }ENDLOOP;
        in.Close[];
        {ports: Set ~ FullySfwdlyExportWires[ct, wires];
        RETURN};
        EXITS DontExist => fileName _ fileName};

    CheckArrayUsage: PUBLIC PROC [d: Design, act: CellType] ~ {
        IF d.arrayElt.HasMapA[act, rightToLeft] OR d.ciType.MappingSize[AV[act], rightToLeft] # IS.one THEN ERROR;
        };

    FinishWaitingMerges: PUBLIC PROC [cr: CellReading] = {
        DO
            progress: BOOL _ FALSE;
            wml: PathPairList _ cr.waitingMerges;
            cr.waitingMerges _ NIL;
            FOR wml _ wml, wml.rest WHILE wml # NIL DO
                progress _ MergeWork[cr, wml.first.p1, wml.first.p2] OR progress;
                ENDLOOP;
            IF NOT progress THEN EXIT;
            ENDLOOP;
        IF cr.waitingMerges # NIL THEN ERROR;
        };

    FmtStack: PROC [stack: SourceList] RETURNS [prefix: ROPE] = {
        prefix _ NIL;
        FOR stack _ stack, stack.rest WHILE stack # NIL DO
            full: ROPE;
            cp: FS.ComponentPositions;
            [full, cp, ] _ FS.ExpandName[stack.first.name];
            prefix _ IO.PutFR["%g[%g], %g", [rope[full.Substr[cp.base.start, cp.base.length]]], [integer[IO.GetIndex[stack.first.stream]]], 
            [rope[prefix]]];
            ENDLOOP;
        RETURN};

    PrintImpossibles: PROC [to: IO.STREAM, dr: DesignReading] = {
        FOR ims: ImpossibleMergeList _ dr.impossibleMerges, ims.rest WHILE ims # NIL DO
            im: ImpossibleMerge = ims.first;
            to.PutF["%g: %g & %g\n", [rope[Describe[dr.d, im.arrayInstance]]], [rope[FmtPath[im.path1]]], [rope[FmtPath[im.path2]]]];
            ENDLOOP;
        };

    TokenBreak: PUBLIC PROC [char: CHAR] RETURNS [cc: IO.CharClass] =
        {cc _ SELECT char FROM
            '\n => break,
            IN [0C .. ' ] => sepr,
            ENDCASE => other};

    paths: PUBLIC SetBasics.Space ~ NEW [SetBasics.SpacePrivate _ [
        Contains: PathsContains,
        Equal: PathsEqual,
        Print: PathsPrint,
        AHash: PathsHash,
        ACompare: PathsCompare,
        name: "paths"
        ]];

    PathsContains: PROC [data: REF ANY, v: Sets.Value] RETURNS [BOOL] ~ {
        RETURN [WITH v.ra SELECT FROM
            x: REF Path => TRUE,
            ENDCASE => FALSE]};

    PathsEqual: PROC [data: REF ANY, v1, v2: Sets.Value] RETURNS [BOOL] --SetBasics.EqualProc-- ~ {
        p1: Path ~ VPath[v1];
        p2: Path ~ VPath[v2];
        RETURN [ComparePaths[p1, p2]=equal]};

    PathsHash: PROC [data: REF ANY, v: Sets.Value] RETURNS [CARDINAL] --SetBasics.HashProc-- ~ {
        RETURN [HashPath[VPath[v]]]};

    PathsCompare: PROC [data: REF ANY, v1, v2: Sets.Value] RETURNS [c: SetBasics.TotalComparison] --SetBasics.CompareProc-- ~ {
        p1: Path ~ VPath[v1];
        p2: Path ~ VPath[v2];
        RETURN ComparePaths[p1, p2]};

    PathsPrint: PROC [data: REF ANY, v: Sets.Value, to: IO.STREAM, depth, length: INT, verbose: BOOL] ~ {
        path: Path ~ VPath[v];
        asRope: ROPE ~ FmtPath[path];
        to.PutRope[asRope]};

    ComparePaths: PUBLIC PROC [path1, path2: Path] RETURNS [c: SetBasics.TotalComparison] = {
        DO
            IF path1.cells = path2.cells THEN EXIT;
            IF path1.cells = NIL THEN RETURN [less];
            IF path2.cells = NIL THEN RETURN [greater];
            WITH path1.cells.first SELECT FROM
                r1: ROPE => WITH path2.cells.first SELECT FROM
                    r2: ROPE => c _ SetBasics.Unbasicify[r1.Compare[r2]];
                    x2: REF Range2 => c _ less;
                    ENDCASE => ERROR;
                s1: REF Range2 => WITH path2.cells.first SELECT FROM
                    r2: ROPE => c _ greater;
                    s2: REF Range2 =>
                        IF (c _ IntCompare[s1[X].min, s2[X].min]) = equal THEN
                        IF (c _ IntCompare[s1[X].maxPlusOne, s2[X].maxPlusOne]) = equal THEN
                        IF (c _ IntCompare[s1[Y].min, s2[Y].min]) = equal THEN
                        c _ IntCompare[s1[Y].maxPlusOne, s2[Y].maxPlusOne];
                    ENDCASE => ERROR;
                ENDCASE => ERROR;
            IF c # equal THEN RETURN;
            path1.cells _ path1.cells.rest;
            path2.cells _ path2.cells.rest;
            ENDLOOP;
        RETURN [steppyNameSpace.SCompare[path1.wireName.SnV, path2.wireName.SnV]]};

    HashPath: PROC [path: Path] RETURNS [hash: CARDINAL] = {
        hash _ steppyNameSpace.SHash[path.wireName.SnV];
        FOR cells: LORA _ path.cells, cells.rest WHILE cells # NIL DO
            WITH cells.first SELECT FROM
                r: ROPE => hash _ hash + RopeHash.FromRope[r];
                x: REF Range2 => hash _ hash + SetBasics.HashIntI[x[X].min] + SetBasics.HashIntI[x[X].maxPlusOne] + SetBasics.HashIntI[x[Y].min] + 
                SetBasics.HashIntI[x[Y].maxPlusOne];
                ENDCASE => ERROR;
            ENDLOOP;
        RETURN};

    fetSpace: Sets.Space ~ NEW [SetBasics.SpacePrivate _ [
        Contains: FetsContains,
        Equal: FetsEqual,
        AHash: FetsHash,
        ACompare: FetsCompare,
        name: "fets"]];

    FetsContains: PROC [data: REF ANY, v: Sets.Value] RETURNS [BOOL] ~ {
        IF v.i#0 THEN RETURN [FALSE];
        WITH v.ra SELECT FROM
            x: FetType => RETURN [TRUE];
            ENDCASE => RETURN [FALSE];
        };

    FetsHash: PROC [data: REF ANY, v: Sets.Value] RETURNS [hash: CARDINAL] ~ {
        ft: FetType ~ NARROW[v.VA];
        hash _ RopeHash.FromRope[ft.className];
        hash _ (hash + 3*ft.area + 11*ft.perim + 101*ft.twiceLength) MOD 65536;
        RETURN};

    FetsEqual: PROC [data: REF ANY, v1, v2: Sets.Value] RETURNS [BOOL]
        ~ {RETURN [FetsCompare[data, v1, v2]=equal]};

    FetsCompare: PROC [data: REF ANY, v1, v2: Sets.Value] RETURNS [c: SetBasics.TotalComparison] ~ {
        k1: FetType ~ NARROW[v1.VA];
        k2: FetType ~ NARROW[v2.VA];
        IF (c _ SetBasics.Unbasicify[k1.className.Compare[k2.className]]) # equal THEN RETURN;
        IF (c _ IntCompare[k1.area, k2.area]) # equal THEN RETURN;
        IF (c _ IntCompare[k1.perim, k2.perim]) # equal THEN RETURN;
        IF (c _ IntCompare[k1.twiceLength, k2.twiceLength]) # equal THEN RETURN;
        RETURN [equal]};

    IntCompare: PROC [a, b: INT] RETURNS [SetBasics.TotalComparison]
        ~ INLINE {RETURN SetBasics.CompareIntI[a, b]};

    Register: PUBLIC PROC [keyword: ROPE, read: PROC [s: Source, reader: Reader, cr: CellReading], data: REF ANY _ NIL] = {
        r: Reader _ NEW [ReaderRep _ [keyword, read, data]];
        readers.AddNewAA[keyword, r];
        };

    Start: PROC = {
        };

    Start[];

    END.