DIRECTORY Collections, LichenDataOps, LichenDataStructure, IntFunctions, IntStuff, LichenNavigation, PairCollections, LichenStructuring;

LichenData5Impl: CEDAR PROGRAM
IMPORTS Collections, LichenDataOps, LichenDataStructure, IntFunctions, IntStuff, LichenNavigation, PairCollections, LichenStructuring
=

BEGIN OPEN LichenDataOps, LichenDataStructure, Colls:Collections, PairColls:PairCollections, Ints:IntStuff, IntFns:IntFunctions, LichenStructuring;

AddDeducedStructureToDesign: PROC [design: Design] ~ {
PerCellType: PROC [val: REF ANY] ~ {
ct: CellType ~ NARROW[val];
AddDeducedStructureToPort[ct.port];
IF ct.asUnorganized#NIL THEN AddDeducedStructureToWire[ct.asUnorganized.internalWire];
RETURN};
design.cellTypes.Enumerate[PerCellType];
RETURN};

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

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

AddDeducedStructureToThing: PROC [root: Thing, ToChildren: Function--thing _ Seq of child things--, ToNames: Function--thing _ Set(of SteppyName)--, Group: PROC [sibs: Seq--of child thing--, parentNames: ListData] RETURNS [parent: Thing]] ~ {
Work: PROC [subroot: Thing] ~ {
children: Seq--of thing-- ~ IntFns.DeRef[ToChildren.Apply[subroot].val];
IF children.Size[limit: 1]=0 THEN RETURN;
{dag: StepDAG ~ CreateDAG[subroot, TRUE];
InsertThing: PROC [child: Thing] ~ {
names: Set--of SteppyName-- ~ Colls.DeRef[ToNames.Apply[child].val];
PerName: PROC [val: REF ANY] ~ {
name: SteppyName ~ NARROW[val];
InsertInDAG[dag, subroot, name, child];
RETURN};
names.Enumerate[PerName];
RETURN};
TryCandidates: PROC [cands, delayedCands: Set--of StepNode--, delay: BOOL] ~ {
TryCandidate: PROC [cand: StepNode] ~ {
IF NOT cands.HasMember[cand] THEN RETURN;
{seq: Seq ~ Sequify[GetDecomp[dag, cand, FALSE]^];
size: INT ~ seq.Size[];
delayworthy, reject: BOOL _ FALSE;
PerElt: PROC [elt: StepNode] RETURNS [pass: BOOL _ FALSE] ~ {
leaf: BOOL ~ WITH elt SELECT FROM
x: Vertex => TRUE,
x: Port => TRUE,
ENDCASE => FALSE;
SeeUp: PROC [pair: PairColls.Pair] RETURNS [pass: BOOL _ FALSE] ~ {
parent: StepNode ~ pair[left];
IF parent=cand THEN RETURN;
IF NOT cands.HasMember[parent] THEN RETURN;
{ograde: CandGrade ~ GradeCand[dag, parent];
IF NOT ograde.good THEN {
IF NOT cands.RemoveElt[parent] THEN ERROR;
RETURN};
IF ograde.size <= size THEN {
IF NOT cands.RemoveElt[parent] THEN ERROR;
RETURN}
ELSE IF ograde.size > size THEN RETURN [TRUE]
ELSE ERROR}};
ups: Ups ~ GetUps[dag, elt, FALSE];
IF ups=NIL THEN ERROR;
IF NOT leaf THEN delayworthy _ TRUE;
pass _ ups^.Scan[SeeUp].found;
RETURN};
IF NOT cands.RemoveElt[cand] THEN ERROR;
IF seq.RightCollection.Scan[PerElt].found THEN RETURN;
IF delay AND delayworthy THEN {
IF NOT delayedCands.AddElt[cand] THEN ERROR;
RETURN};
{parentNames: ListData ~ CreateSteppyNames[];
GetNames[dag, cand, [listClass, parentNames], NIL];
{repl: Thing ~ Group[seq, parentNames];
Delit: PROC [val: REF ANY] ~ {RemoveLeaf[dag, val]};
ReplaceNode[dag, cand, repl];
seq.RightCollection.Enumerate[Delit];
VerifyDAG[dag, NIL, FALSE];
RETURN}}}};
cands.Enumerate[TryCandidate];
};
delayedCands: Set--of StepNode-- ~ Colls.CreateHashSet[];
children.RightCollection.Enumerate[Work];
children.RightCollection.Enumerate[InsertThing];
VerifyDAG[dag, NIL, FALSE];
DiscoverAndLowerSeqs[dag, subroot];
CommonizeDecomps[dag];
VerifyDAG[dag, NIL, FALSE];
TryCandidates[dag.cands, delayedCands, TRUE];
VerifyDAG[dag, NIL, FALSE];
TryCandidates[delayedCands, Colls.nilColl, FALSE];
VerifyDAG[dag, NIL, FALSE];
RETURN}};
Work[root];
RETURN};

GetNames: PROC [dag: StepDAG, node: StepNode, parentNameSet: Set--of SteppyName--, sofar: SteppyName] ~ {
IF node=dag.root THEN {
IF NOT parentNameSet.AddElt[sofar] THEN ERROR;
RETURN}
ELSE {
ups: Ups ~ GetUps[dag, node, FALSE];
PerUp: PROC [pair: PairColls.Pair] ~ {
next: SteppyName ~ CONS[pair[right], sofar];
GetNames[dag, pair[left], parentNameSet, next];
RETURN};
ups^.Enumerate[PerUp];
RETURN};
};

CandGrade: TYPE ~ RECORD [
good: BOOL,
size: INT
];

GradeCand: PROC [dag: StepDAG, cand: StepNode] RETURNS [grade: CandGrade] ~ {
OPEN grade;
dec: Decomp ~ GetDecomp[dag, cand, FALSE];
bounds: Ints.Interval _ Ints.anEmptyInterval;
PerPair: PROC [pair: PairColls.Pair] RETURNS [BOOL] ~ {
WITH pair[left] SELECT FROM
x: REF INT => bounds _ bounds.MBI[[x^, x^]];
x: ROPE => ERROR;
ENDCASE => ERROR;
WITH pair[right] SELECT FROM
x: Port => NULL;
x: Vertex => NULL;
x: Fake => RETURN [TRUE];
ENDCASE => ERROR;
size _ size+1;
RETURN [FALSE]};
size _ 0;
good _ cand#dag.root AND (NOT dec^.Scan[PerPair].found) AND bounds.min IN [0 .. 1] AND bounds.Length.EI=size AND size>1;
RETURN};

Sequify: PROC [oto: OneToOne] RETURNS [seq: Seq] ~ {
PerPair: PROC [pair: PairColls.Pair] ~ {
IF NOT IsThing[pair[right]] THEN ERROR;
WITH pair[left] SELECT FROM
x: REF INT => {
news: PairColls.NewsPair ~ seq.AddPair[[x^, pair[right]], PairColls.addIfNew];
IF news#ALL[new] THEN ERROR};
x: ROPE => ERROR;
ENDCASE => ERROR;
RETURN};
seq _ CreateSeq[len: oto.Size[], oneToOne: TRUE, invable: TRUE];
oto.Enumerate[PerPair];
RETURN};

DiscoverAndLowerSeqs: PROC [dag: StepDAG, subroot: StepNode] ~ {
dec: Decomp ~ GetDecomp[dag, subroot, FALSE];
DoLower: PROC [pair: PairColls.Pair] ~ {DiscoverAndLowerSeqs[dag, pair[right]];};
CheckName: PROC [pair: PairColls.Pair] RETURNS [pass: BOOL _ FALSE] ~ {
WITH pair[left] SELECT FROM
x: ROPE => RETURN [TRUE];
x: REF INT => RETURN [FALSE];
ENDCASE => ERROR;
};
IF dec=NIL THEN RETURN;
dec^.Enumerate[DoLower];
IF dec^.Scan[CheckName].found THEN RETURN;
{toDo: StepDAG ~ CreateDAG[subroot, TRUE];
FindPaths: PROC [pair: PairColls.Pair] ~ {
WITH pair[left] SELECT FROM
x: ROPE => ERROR;
x: REF INT => FindPath[pair[right], subroot, x];
ENDCASE => ERROR;
RETURN};
FindPath: PROC [from, to: StepNode, index: REF INT] ~ {
leaf: BOOL ~ IsKidCand[dag, from];
IF leaf THEN {
[] _ toDo.cands.AddElt[to];
AddLink[toDo, to, index, from, FALSE];
RETURN}
ELSE {
dec: Decomp ~ GetDecomp[dag, from, FALSE];
Subadd: PROC [pair: PairColls.Pair] ~ {
step: NameStep ~ pair[left];
oldKid: StepNode ~ pair[right];
newKid: StepNode ~ GetDown[toDo, to, step, TRUE];
FindPath[oldKid, newKid, index];
RETURN};
dec^.Enumerate[Subadd];
RETURN};
};
PruneBadCands: PROC [parent: StepNode] ~ {
dec: Decomp ~ GetDecomp[toDo, parent, FALSE];
cand: BOOL ~ toDo.cands.HasMember[parent];
bounds: Ints.Interval _ Ints.anEmptyInterval;
badBranchSeen: BOOL _ FALSE;
size: NATURAL _ 0;
seen: Set--of StepNode-- ~ Colls.CreateHashSet[];
PerPair: PROC [pair: PairColls.Pair] ~ {
IF NOT IsKidCand[dag, pair[right]] THEN {
badBranchSeen _ TRUE;
PruneBadCands[pair[right]];
RETURN}
ELSE IF seen.AddElt[pair[right]] THEN {
ri: REF INT ~ NARROW[pair[left]];
size _ size + 1;
bounds _ bounds.MBI[[ri^, ri^]];
IF NOT cand THEN ERROR;
RETURN}
ELSE {
badBranchSeen _ TRUE;
RETURN};
};
dec^.Enumerate[PerPair];
IF NOT cand THEN RETURN;
IF badBranchSeen OR NOT (parent#dag.root 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]] ~ {
dec: Decomp ~ GetDecomp[toDo, from, FALSE];
fromIsCand: BOOL ~ toDo.cands.HasMember[from];
PerDec: PROC [pair: PairColls.Pair] ~ {
leaf1: BOOL ~ IsKidCand[dag, pair[right]];
leaf2: BOOL ~ NOT toDo.down.Apply[pair[right]].found;
IF leaf1#leaf2 THEN ERROR;
IF leaf1#fromIsCand THEN ERROR;
IF leaf1 THEN {
ur: StepTriple ~ DownToDelete[pair[left]];
IF ur.child#pair[right] THEN ERROR;
RemoveLink[dag, ur.parent, ur.step, ur.child, do];
AddLink[dag, to, pair[left], pair[right], FALSE];
}
ELSE {
SubDownToDelete: PROC [seqStep: NameStep] RETURNS [ur: StepTriple] ~ {
urParent: StepNode ~ DownToDelete[seqStep].ur.child;
urKid: StepNode ~ GetDown[dag, urParent, pair[left], FALSE];
IF urKid=NIL THEN ERROR;
RETURN [[urParent, pair[left], urKid]]};
fake: StepNode ~ GetDown[dag, to, pair[left], TRUE];
MovePath[pair[right], fake, SubDownToDelete];
RETURN};
RETURN};
IF toDo.cands.HasMember[from] THEN IF NOT dag.cands.AddElt[to] THEN ERROR;
dec^.Enumerate[PerDec];
RETURN};
dec^.Enumerate[FindPaths];
PruneBadCands[subroot];
IF toDo.down.Size[]#0 THEN {
MovePath[subroot, subroot, RootDownToDelete];
VerifyDAG[dag, NIL, FALSE];
};
RETURN}};

PruneCand: PROC [dag: StepDAG, cand: StepNode] ~ {
dec: Decomp ~ GetDecomp[dag, cand, FALSE];
RemoveDownlink: PROC [pair: PairColls.Pair] ~ {
RemoveLink[dag, cand, pair[left], pair[right], do];
RETURN};
IF NOT dag.cands.RemoveElt[cand] THEN ERROR;
IF dec=NIL THEN ERROR;
dec^.Enumerate[RemoveDownlink];
RETURN};

StepTree: TYPE ~ StepNode;

CommonizeDecomps: PROC [dag: StepDAG] ~ {
treeSpace: Colls.Space ~ CreateTreeSpace[dag];
indexed: Function--parent StepNode _ StepTree-- ~ dag.down.CreateHashCopy[spaces: [Colls.refs, treeSpace], mappable: [TRUE, TRUE]];
collapsars: Set--of Set of parent StepNode-- ~ Colls.CreateHashSet[Colls.refColls];
PerDown: PROC [pair: PairColls.Pair] ~ {
dec: Decomp ~ NARROW[pair[right]];
parents: Set--of parent StepNode-- ~ indexed.Mapping[dec, rightToLeft];
nParents: NATURAL ~ parents.Size[];
IF nParents>1 THEN IF pair[left]=parents.First.val THEN IF NOT collapsars.AddElt[parents.CreateHashCopy.Refify] THEN ERROR;
RETURN};
Collapsit: PROC [val: REF ANY] ~ {
parents: Set--of parent StepNode-- ~ Colls.DeRef[val];
nParents: NATURAL ~ parents.Size[];
survivor: StepNode ~ parents.First.Val;
foundSurvivor: BOOL _ FALSE;
Replace: PROC [parent: StepNode] ~ {
IF parent=survivor THEN {foundSurvivor _ TRUE; RETURN};
[] _ dag.cands.RemoveElt[parent];
ReplaceNode[dag, parent, survivor];
RETURN};
IF nParents<2 THEN ERROR;
parents.Enumerate[Replace];
IF NOT foundSurvivor THEN ERROR;
RETURN};
indexed.Enumerate[PerDown];
collapsars.Enumerate[Collapsit];
RETURN};

END.
`LichenData5Impl.Mesa
Last tweaked by Mike Spreitzer on September 18, 1987 11:27:44 am PDT
Κ"˜™Icodeš
œD™D—J˜KšΟk	œ˜ˆ
K˜šΡbnxœœ
˜Kšœ~˜…
Kš
œ
˜
—K˜Kšœ
œ%ΟnœŸ	œŸœŸœ!˜“
K˜šŸœœ˜6šŸœœœ
œ˜$Kšœœ˜Kš
œ#˜#Kšœœ
œ:˜VKšœ˜—Kš
œ(˜(Kšœ˜—K˜šŸœœ˜0Kšœ'Ÿ
œ#ŸœŸœ˜Œ
Kšœ˜—K˜šŸœœ˜0Kšœ'Ÿ
œ#Ÿœ Ÿœ˜Ž
Kšœ˜—K˜šŸœœŸ
œ
ΟcΠcm
 œŸœ
 ‘
 œŸœœ œœ˜ς
šŸœœ˜Kšœ
 œ/˜HKšœœ
œ
˜)Kšœ#œ˜)šŸœœ˜$Kšœ
 œ)˜DšŸœœœ
œ˜ Kšœœ˜Kš
œ'˜'Kšœ˜—K˜Kšœ˜—šŸ
œœ œ	œ˜NšŸœœ˜'Kšœ
œœ
œ
˜)Kšœ)œ˜2Kšœœ˜Kšœœœ
˜"š
Ÿœœœœœ˜=šœœœœ
˜!Kšœ
œ
˜Kšœœ
˜Kšœœ
˜—š
Ÿœœœœœ˜CK˜Kšœ
œ
œ
˜Kšœ
œœ
œ
˜+Kš
œ,˜,šœ
œ
œ˜Kšœ
œœ
œ
˜*Kšœ˜—šœœ˜Kšœ
œœ
œ
˜*Kšœ
˜—Kš
œ
œœ
œœ
˜-Kšœ
œ˜
—Kšœœ˜#Kšœœ
œ
œ
˜Kšœ
œœœ
˜$Kš
œ˜Kšœ˜—Kšœ
œœ
œ
˜(Kšœ(œ
œ
˜6šœœ
œ˜Kšœ
œœ
œ
˜,Kšœ˜—Kš
œ-˜-Kšœ.œ˜3Kš
œ'˜'KšŸœœœ
œ˜4K˜K˜%Kšœœœ˜Kšœ˜—K˜K˜—Kšœ œ˜9K˜)Kš
œ0˜0Kšœœœ˜Kš
œ#˜#K˜Kšœœœ˜Kšœ'œ˜-Kšœœœ˜Kšœ+œ˜2Kšœœœ˜Kšœ˜	—K˜Kšœ˜—K˜šŸœœ2 œ˜išœœ˜Kšœ
œœ
œ
˜.Kšœ
˜—šœ˜Kšœœ˜$šŸœœ˜&Kšœœ˜,Kš
œ/˜/Kšœ˜—Kš
œ˜Kšœ˜—K˜—K˜šœœœ˜Kšœœ
˜Kšœ˜	Kš
œ˜—K˜šŸ	œœ œ˜MKšœ˜Kšœ#œ˜*Kš
œ-˜-šŸœœœœ˜7šœœ
˜Kšœœ
œœ˜,Kšœœœ
˜Kšœœ
˜—šœ
œ
˜Kšœœ
˜Kšœ
œ
˜Kšœœœ˜Kšœœ
˜—K˜Kšœœ˜—K˜	Kšœœœœœ
œœœ˜xKšœ˜—K˜šŸœœœ˜4šŸœœ˜(Kšœ
œœ
œ
˜'šœœ
˜šœœ
œ˜Kš
œN˜NKšœœœ
œ˜—Kšœœœ
˜Kšœœ
˜—Kšœ˜—Kšœ+œœ˜@Kš
œ˜Kšœ˜—K˜šŸœœ&˜@Kšœ&œ˜-KšŸœœD˜Qš
Ÿ	œœœœœ˜Gšœœ
˜Kšœœœœ˜Kš	œœ
œœœ˜Kšœœ
˜—K˜—Kšœœ
œ
œ
˜Kš
œ˜Kšœœ
œ
˜*Kšœ$œ˜*šŸ	œœ˜*šœœ
˜Kšœœœ
˜Kšœœ
œ&˜0Kšœœ
˜—Kšœ˜—šŸœœœ
œ˜7Kšœœ˜"šœœ˜Kš
œ˜Kšœœ˜&Kšœ
˜—šœ˜Kšœ#œ˜*šŸœœ˜'Kš
œ˜K˜Kšœ+œ˜1Kš
œ ˜ Kšœ˜—Kš
œ˜Kšœ˜—Kš
œ˜—šŸ
œœ˜*Kšœ&œ˜-Kšœœ ˜*Kš
œ-˜-Kšœœœ
˜Kšœœ˜Kšœ	 œ˜1šŸœœ˜(šœ
œœ˜)Kšœœ
˜Kš
œ˜Kšœ
˜—šœ
œœ˜'Kšœœ
œœ
˜!Kš
œ˜Kšœœ
˜ Kšœ
œœ
œ
˜Kšœ
˜—šœ˜Kšœœ
˜Kšœ˜—K˜—K˜Kšœ
œœ
œ
˜Kšœœ
œœœ
œœœ	œ˜‡
Kšœ˜—šŸœœœ˜GKšœ7œ˜?Kšœ
œ
œ
œ˜—š
ŸœœŸœœœ˜hKšœ$œ˜+Kšœœ˜.šŸœœ˜'Kšœœ˜*Kšœœœ$˜5Kšœ
œ
œ
˜Kšœœ
œ
˜šœœ˜Kš
œ*˜*Kšœœ
œ
˜#Kš
œ2˜2Kšœ*œ˜1Kš
œ
˜
—šœ˜šŸœœœ˜FKš
œ4˜4Kšœ5œ˜<Kšœœ
œ
œ
˜Kšœ"˜(—Kšœ.œ˜4Kš
œ-˜-Kšœ˜—Kšœ˜—Kšœœ
œ
œœ
œ
˜JKš
œ˜Kšœ˜—Kš
œ˜K˜šœœ˜Kš
œ-˜-Kšœœœ˜K˜—Kšœ˜	—K˜šŸ	œœ#˜2Kšœ#œ˜*šŸœœ˜/Kš
œ3˜3Kšœ˜—Kšœ
œœ
œ
˜,Kšœœ
œ
œ
˜Kš
œ˜Kšœ˜—K˜Kšœ
œ˜K˜šŸœœ˜)K˜.Kš	œ ‘
 œGœœ˜ƒ
Kšœ œ'˜SšŸœœ˜(Kšœœ˜"Kšœ œ%˜GKšœ
œ˜#Kšœœ
œœ
œ
œ2œ
œ
˜{Kšœ˜—šŸ	œœœ
œ˜"Kšœ œ˜6Kšœ
œ˜#K˜'Kšœœœ
˜šŸœœ˜$Kšœœœœ˜7K˜!Kš
œ#˜#Kšœ˜—Kšœœ
œ
˜K˜Kšœ
œœ
œ
˜ Kšœ˜—Kš
œ˜Kš
œ ˜ Kšœ˜—K˜Kšœ
˜—…—'Έ6: