
<<LichenStructureDeduction.Mesa>>
    <<Last tweaked by Mike Spreitzer on February 2, 1988 5:44:13 pm PST>>

    DIRECTORY AbSets, Asserting, BasicTime, BiRelBasics, BiRels, Convert, Histograms, IntStuff, IO, LichenDataOps, LichenDataStructure, 
    LichenNavigation, LichenStructuring, LichenTransforms, Process, RealFns, Rope, SetBasics;

    LichenStructureDeduction: CEDAR PROGRAM
        IMPORTS AbSets, Asserting, BasicTime, BiRelBasics, BiRels, Convert, Histograms, IntStuff, IO, LichenDataOps, LichenDataStructure, 
        LichenNavigation, LichenStructuring, Process, RealFns, Rope, SetBasics
        EXPORTS LichenTransforms
        =

    BEGIN OPEN LichenDataOps, LichenDataStructure, Sets:AbSets, IS:IntStuff, LichenStructuring;

    base: REAL ~ RealFns.Power[2, 1.0/4];
    minTime: REAL ~ 1.0/32;
    portTimes: Histograms.Histogram ~ Histograms.Create2D[iFactor: base, jFactor: base, iOffset: 1, jOffset: minTime, logI: TRUE, logJ: 
    TRUE];
    wireTimes: Histograms.Histogram ~ Histograms.Create2D[iFactor: base, jFactor: base, iOffset: 1, jOffset: minTime, logI: TRUE, logJ: 
    TRUE];

    Break: SIGNAL ~ CODE;
    breakCTN: ROPE _ NIL;
    breakKill: SteppyName _ noName;
    checkA: BOOL _ FALSE;
    checkB: BOOL _ FALSE;
    checkC: BOOL _ FALSE;
    mayCollide: BOOL _ FALSE;

    AddDeducedStructureToDesign: PUBLIC PROC [design: Design, pacify: IO.STREAM _ NIL] ~ {
        n: INT _ 0;
        PerCellType: PROC [val: REF ANY] ~ {
            ct: CellType ~ NARROW[val];
            portSize: LNAT ~ PortSize[ct.port];
            n _ n + 1;
            Process.CheckForAbort[];
            IF breakCTN#NIL AND Asserting.Test1[nameReln, breakCTN, ct.otherPublic] THEN Break;
            IF pacify#NIL THEN pacify.PutF["%g %g: %g;  port %g ", [rope[Convert.RopeFromTime[from: BasicTime.Now[], start: hours, end: 
            seconds, useAMPM: FALSE, includeZone: FALSE]]], [integer[n]], [rope[Describe[ct, design]]], [integer[portSize]]];
            {start: BasicTime.Pulses ~ BasicTime.GetClockPulses[];
            AddDeducedStructureToPort[ct.port];
            {mid: BasicTime.Pulses ~ BasicTime.GetClockPulses[];
            portTime: REAL ~ BasicTime.PulsesToSeconds[mid - start];
            portTimes.ChangeTransformed[portSize, MAX[portTime, minTime]];
            IF pacify#NIL THEN pacify.PutF["* %g s", [real[portTime]]];
            IF ct.asUnorganized#NIL THEN {
                wireSize: LNAT ~ WireSize[ct.asUnorganized.internalWire];
                IF pacify#NIL THEN pacify.PutF[";  wire %g ", [integer[wireSize]]];
                {before: BasicTime.Pulses ~ BasicTime.GetClockPulses[];
                AddDeducedStructureToWire[ct.asUnorganized.internalWire];
                {after: BasicTime.Pulses ~ BasicTime.GetClockPulses[];
                wireTime: REAL ~ BasicTime.PulsesToSeconds[after - before];
                wireTimes.ChangeTransformed[wireSize, MAX[wireTime, minTime]];
                IF pacify#NIL THEN pacify.PutF["* %g s", [real[wireTime]]];
                }}};
            IF pacify#NIL THEN pacify.PutRope[" .\n"];
            RETURN}}};
        IF pacify#NIL THEN pacify.PutF["Total: %g\n", [integer[design.cellTypes.Size.EN]]];
        design.cellTypes.EnumA[PerCellType];
        RETURN};

    AddDeducedStructureToPort: PROC [port: Port] ~ {
        AddDeducedStructureToThing[root: port, ToChildren: LichenNavigation.portToChildren, ToNames: LichenNavigation.portNames, Rename: 
        RenamePort, Group: GroupPorts];
        RETURN};

    AddDeducedStructureToWire: PROC [wire: Wire] ~ {
        AddDeducedStructureToThing[root: wire, ToChildren: LichenNavigation.wireToChildren, ToNames: LichenNavigation.vertexNames, Rename: 
        RenameWire, Group: GroupWires];
        RETURN};

    RenamePort: PROC [thing: Thing, old, new: SteppyName] ~ {
        port: Port ~ NARROW[thing];
        IF NOT ForgetPortName[port, old] THEN ERROR;
        [] _ KnowPortName[port, new];
        RETURN};

    RenameWire: PROC [thing: Thing, old, new: SteppyName] ~ {
        w: Wire ~ NARROW[thing];
        ForgetVertexName[w, old];
        KnowVertexName[w, new];
        RETURN};

    setOfOne: Set ~ Sets.CreateSingleton[AV[NEW [INT _ 1]], nameStepSpace];
    r0: REF INT ~ NEW [INT _ 0];

    AddDeducedStructureToThing: PROC [root: Thing, ToChildren: Function--thing     Set(of SteppyName)--, Rename: PROC [thing: Thing, old, new: SteppyName], Group: PROC [sibs: Seq--of child thing--, parentNames: 
    ListData] RETURNS [parent: Thing]] ~ {
        Work: PROC [subroot: Thing] ~ {
            children: Seq--of thing-- ~ BiRels.DeRef[ToChildren.ApplyA[subroot].MA];
            IF children.Empty THEN RETURN;
            {dag: StepDAG ~ CreateDAG[subroot, NIL];
            InsertThing: PROC [child: Thing] ~ {
                names: Set--of SteppyName-- ~ Sets.DeRef[ToNames.ApplyA[child].MA];
                PerName: PROC [val: Sets.Value] ~ {
                    name: SteppyName ~ FixSteppyName[VSn[val]];
                    Process.CheckForAbort[];
                    InsertInDAG[dag, dag.rootNode, name.steps, child];
                    RETURN};
                names.Enumerate[PerName];
                RETURN};
            LeafizeInternal: PROC [parenta, deca: REF ANY] ~ {
                parent: StepNode ~ NARROW[parenta];
                dec: Decomp ~ NARROW[deca];
                mv: Sets.MaybeValue ~ dag.toThing.ApplyA[parent];
                IF NOT mv.found THEN RETURN;
                IF NOT mayCollide THEN ERROR;
                IF NOT dec^.SetOn[left].Equal[setOfOne] THEN ERROR;
                {thing: Thing ~ mv.MA;
                downd: StepNode ~ GetDown[dag, parent, r0, TRUE];
                parentNamesData: ListData ~ CreateSteppyNames[];
                parentNames: Set--of SteppyName-- ~ Setify[parentNamesData];
                ChangeName: PROC [val: Sets.Value] ~ {
                    old: SteppyName ~ VSn[val];
                    new: SteppyName ~ SNAppend[old, r0];
                    Rename[thing, old, new];
                    RETURN};
                GetNames[dag, parent, parentNames, noName];
                parentNames.Enumerate[ChangeName];
                dag.toThing.RemOldAA[parent, thing];
                dag.toThing.AddNewAA[downd, thing];
                IF checkC THEN VerifyDAG[dag];
                RETURN}};
            candSize: Function--StepNode             hints: [leftToRight: [[$Hash]], rightToLeft: [[$BalancedTree], [$Hash]]]];
            SizeCand: PROC [canda: REF ANY] ~ {
                cand: StepNode ~ NARROW[canda];
                g: CandGrade ~ GradeCand[dag, cand];
                IF g.good THEN candSize.AddNewPair[[AV[cand], IV[g.size]]];
                RETURN};
            Groupit: PROC [canda: REF ANY] ~ {
                cand: StepNode ~ NARROW[canda];
                parentNames: ListData ~ CreateSteppyNames[];
                dec: Decomp ~ GetDecomp[dag, cand, FALSE];
                aKid: StepNode ~ NARROW[dec^.APair.P[][right].VA];
                IF GetDecomp[dag, aKid, FALSE]#NIL THEN {
                    kids: Set--of StepNode-- ~ dec^.SetOn[right];
                    kids.EnumA[Groupit];
                    canda _ canda};
                GetNames[dag, cand, Setify[parentNames], noName];
                {seq: Seq ~ Sequify[dec^.Compose[right: dag.toThing, restricts: [TRUE, FALSE]]];
                repl: Thing ~ Group[seq, parentNames];
                Delit: PROC [step, child: REF ANY] ~ {RemoveLeaf[dag, NARROW[child]]};
                dag.toThing.AddNewAA[cand, repl];
                dec^.EnumAA[Delit];
                IF checkA THEN VerifyDAG[dag];
                RETURN}};
            children.SetOn[right].EnumA[Work];
            children.SetOn[right].EnumA[InsertThing];
            IF checkA THEN VerifyDAG[dag];
            dag.down.EnumAA[LeafizeInternal];
            dag.prefixd _ TRUE;
            IF checkA THEN VerifyDAG[dag];
            CommonizeLeaves[dag];
            dag.leavesCommonized _ TRUE;
            IF checkA THEN VerifyDAG[dag];
            DiscoverAndLowerSeqs[dag, dag.rootNode];
            CommonizeDecomps[dag];
            IF checkA THEN VerifyDAG[dag];
            dag.cands.EnumA[SizeCand];
            dag.cands _ candSize.SetOn[left];
            IF checkA THEN VerifyDAG[dag];
            UNTIL candSize.Empty[] DO
                cand: StepNode ~ NARROW[candSize.Pop[[[no, bwd], right]].P[][left].VA[]];
                KillCand[dag, candSize, cand, one];
                Groupit[cand];
                root _ root; ENDLOOP;
            IF checkA THEN VerifyDAG[dag];
            RETURN}};
        Work[root];
        RETURN};

    KillCand: PROC [dag: StepDAG, candSize: Function--StepNode     all descendants; phase two kills all their candidate ancestors; phase three kills all their descendants--}] ~ {
        IF breakKill#noName THEN WITH dag.toThing.ApplyA[cand].MDA SELECT FROM
            p: Port => IF p.PortNames.HasMember[SnV[breakKill]] THEN Break;
            w: Wire => IF w.VertexNames.HasMember[SnV[breakKill]] THEN Break;
            ENDCASE => NULL;
        IF phase>one AND NOT candSize.DeleteA[cand] THEN RETURN;
        --now cand is either an ex-candidate or a descendant of one-- NULL;
        IF phase#three THEN {ups: Ups ~ GetUps[dag, cand, FALSE];
            KillParent: PROC [parent: REF ANY, step: NameStep] ~ {
                KillCand[dag, candSize, NARROW[parent], two];
                RETURN};
            IF ups#NIL THEN ups^.EnumAA[KillParent]};
        {dec: Decomp ~ GetDecomp[dag, cand, FALSE];
        KillKid: PROC [step: NameStep, child: REF ANY] ~ {
            KillCand[dag, candSize, NARROW[child], IF phase=one THEN one ELSE three];
            RETURN};
        IF dec#NIL THEN dec^.EnumAA[KillKid]};
        RETURN};

    GetNames: PROC [dag: StepDAG, node: StepNode, parentNameSet: Set--of SteppyName--, sofar: SteppyName] ~ {
        IF node=dag.rootNode THEN {
            IF NOT parentNameSet.AddElt[SnV[sofar]] THEN ERROR;
            RETURN}
        ELSE {
            ups: Ups ~ GetUps[dag, node, FALSE];
            PerUp: PROC [parenta: REF ANY, step: NameStep] ~ {
                parent: StepNode ~ NARROW[parenta];
                next: SteppyName ~ SNPrepend[step, sofar];
                GetNames[dag, parent, parentNameSet, next];
                RETURN};
            ups^.EnumAA[PerUp];
            RETURN};
        };

    DiscoverAndLowerSeqs: PROC [dag: StepDAG, subroot: StepNode] ~ {
        dec: Decomp ~ GetDecomp[dag, subroot, FALSE];
        DoLower: PROC [step, childa: REF ANY] ~ {DiscoverAndLowerSeqs[dag, NARROW[childa]]};
        CheckName: PROC [pair: BiRels.Pair] RETURNS [BOOL] ~ {
            WITH pair[left].VA SELECT FROM
                x: ROPE => RETURN [TRUE];
                x: REF INT => RETURN [FALSE];
                ENDCASE => ERROR;
            };
        IF dec=NIL THEN RETURN;
        dec^.EnumAA[DoLower];
        IF dec^.Scan[CheckName].found THEN RETURN;
        {toDo: StepDAG ~ CreateDAG[subroot, dag];
        FindPaths: PROC [step, child: REF ANY] ~ {
            WITH step SELECT FROM
                x: ROPE => ERROR;
                x: REF INT => FindPath[NARROW[child], subroot, x];
                ENDCASE => ERROR;
            RETURN};
        FindPath: PROC [from, to: StepNode, index: REF INT] ~ {
            leaf: BOOL ~ IsKidCand[dag, from];
            IF leaf THEN {
                [] _ toDo.cands.AddA[to];
                AddLink[toDo, to, index, from];
                RETURN}
            ELSE {
                dec: Decomp ~ GetDecomp[dag, from, FALSE];
                Subadd: PROC [step: NameStep, oldKida: REF ANY] ~ {
                    oldKid: StepNode ~ NARROW[oldKida];
                    newKid: StepNode ~ GetDown[toDo, to, step, TRUE];
                    FindPath[oldKid, newKid, index];
                    RETURN};
                dec^.EnumAA[Subadd];
                RETURN};
            };
        PruneBadCands: PROC [parent: StepNode] ~ {
            ddec: Decomp ~ GetDecomp[toDo, parent, FALSE];
            cand: BOOL ~ toDo.cands.HasMemA[parent];
            bounds: IS.Interval _ IS.anEmptyInterval;
            badBranchSeen: BOOL _ FALSE;
            size: NATURAL _ 0;
            seen: Set--of StepNode-- ~ IF cand THEN Sets.CreateHashSet[] ELSE Sets.nilSet;
            PerPair: PROC [step, childa: REF ANY] ~ {
                child: StepNode ~ NARROW[childa];
                IF NOT (cand AND IsKidCand[dag, child]) THEN {
                    badBranchSeen _ TRUE;
                    PruneBadCands[child];
                    RETURN}
                ELSE IF seen.AddA[child] THEN {
                    ri: REF INT ~ NARROW[step];
                    size _ size + 1;
                    bounds _ bounds.MBI[[ri^, ri^]];
                    IF NOT cand THEN ERROR;
                    RETURN}
                ELSE {
                    badBranchSeen _ TRUE;
                    RETURN};
                };
            IF ddec#NIL THEN ddec^.EnumAA[PerPair];
            IF NOT cand THEN RETURN;
            IF badBranchSeen OR NOT (parent#dag.rootNode AND bounds.min IN [0 .. 1] AND bounds.Length.EN=size AND size>1) THEN PruneCand[toDo, 
            parent];
            RETURN};
        RootDownToDelete: PROC [seqStep: NameStep] RETURNS [ur: StepTriple] ~ {
            ur _ [subroot, seqStep, GetDown[dag, subroot, seqStep, FALSE]];
            IF ur.child=NIL THEN ERROR};
        MovePath: PROC [from, to: StepNode, DownToDelete: PROC [seqStep: NameStep] RETURNS [ur: StepTriple]] ~ {
            ddec: Decomp ~ GetDecomp[toDo, from, FALSE];
            fromIsCand: BOOL ~ toDo.cands.HasMemA[from];
            MoveDec: PROC [step: NameStep, childa: REF ANY] ~ {
                child: StepNode ~ NARROW[childa];
                leaf1: BOOL ~ dag.toThing.HasMapA[child] OR dag.cands.HasMemA[child];
                leaf2: BOOL ~ NOT toDo.down.HasMapA[child];
                IF leaf1#leaf2 OR leaf1#fromIsCand THEN ERROR;
                IF leaf1 THEN {
                    ur: StepTriple ~ DownToDelete[step];
                    IF ur.child#child THEN ERROR;
                    RemoveLink[dag, ur.parent, ur.step, ur.child, do];
                    AddLink[dag, to, step, child];
                    IF checkB THEN VerifyDAG[dag];
                    RETURN}
                ELSE {
                    SubDownToDelete: PROC [seqStep: NameStep] RETURNS [ur: StepTriple] ~ {
                        urParent: StepNode ~ DownToDelete[seqStep].ur.child;
                        urKid: StepNode ~ GetDown[dag, urParent, step, FALSE];
                        IF urKid=NIL THEN ERROR;
                        RETURN [[urParent, step, urKid]]};
                    fake: StepNode ~ GetDown[dag, to, step, TRUE];
                    MovePath[child, fake, SubDownToDelete];
                    RETURN};
                };
            IF fromIsCand THEN IF NOT dag.cands.AddA[to] THEN ERROR;
            ddec^.EnumAA[MoveDec];
            RETURN};
        IF NOT dag.prefixd THEN ERROR--needed to compute leaf1 in MoveDec--;
        toDo.prefixd _ dag.prefixd;
        toDo.leavesCommonized _ dag.leavesCommonized;
        dec^.EnumAA[FindPaths];
        PruneBadCands[subroot];
        IF NOT toDo.down.Empty THEN {
            IF checkB THEN VerifyDAG[dag];
            MovePath[subroot, subroot, RootDownToDelete];
            IF checkA AND NOT checkB THEN VerifyDAG[dag];
            };
        RETURN}};

    PortSize: PROC [p: Port] RETURNS [size: LNAT--number of leaves-- _ 1] ~ {
        FOR c: Port _ p.FirstChildPort[], c.NextChildPort[] WHILE c # NIL DO
            size _ size + PortSize[c];
            p _ p;
            ENDLOOP;
        RETURN};

    WireSize: PROC [p: Wire] RETURNS [size: LNAT--number of leaves-- _ 1] ~ {
        FOR c: Wire _ p.FirstChildWire[], c.NextChildWire[] WHILE c # NIL DO
            size _ size + WireSize[c];
            p _ p;
            ENDLOOP;
        RETURN};

    FixSteppyName: PROC [old: SteppyName] RETURNS [SteppyName] ~ {
        copied: BOOL _ FALSE;
        copy: TList _ [];
        IF skipFix THEN RETURN [old];
        FOR cur: NameStepList _ old.steps, cur.rest WHILE cur#NIL DO
            {WITH cur.first SELECT FROM
                x: ROPE => {dotPos: INT ~ x.FindBackward["."];
                    IF dotPos<0 THEN GOTO Not;
                    {sepPos: INT ~ x.Index[s2: "_", pos1: dotPos];
                    FOR i: INT IN (dotPos .. sepPos) DO
                        IF x.InlineFetch[i] NOT IN ['0 .. '9] THEN GOTO Not;
                        ENDLOOP;
                    IF NOT copied THEN {copy _ CopyTil[[old.steps, cur]]; copied _ TRUE};
                    copy _ copy.Append[x.Substr[len: dotPos].Concat[x.Substr[start: sepPos]]].Append[NEW [INT _ Convert.IntFromRope[x.Substr[start: 
                    dotPos+1, len: sepPos - dotPos - 1]]]];
                    }};
                x: REF INT => GOTO Not;
                ENDCASE => ERROR;
            EXITS Not => IF copied THEN copy _ copy.Append[cur.first];
            }ENDLOOP;
        RETURN [IF copied THEN LSn[copy.head] ELSE old]};
        skipFix: BOOL _ FALSE;

    Start: PROC ~ {
        [] _ portTimes.Show[viewerInit: [name: "Deduce port structure size * time"], base: 2, updatePeriod: 5];
        [] _ wireTimes.Show[viewerInit: [name: "Deduce wire structure size * time"], base: 2, updatePeriod: 5];
        RETURN};

    Start[];

    END.