LichenData5Impl.Mesa
Last tweaked by Mike Spreitzer on September 18, 1987 11:27:44 am PDT
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 b Seq of child things--, ToNames: Function--thing b 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: BOOLFALSE;
PerElt: PROC [elt: StepNode] RETURNS [pass: BOOLFALSE] ~ {
leaf: BOOL ~ WITH elt SELECT FROM
x: Vertex => TRUE,
x: Port => TRUE,
ENDCASE => FALSE;
SeeUp: PROC [pair: PairColls.Pair] RETURNS [pass: BOOLFALSE] ~ {
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: BOOLFALSE] ~ {
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: BOOLFALSE;
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 b 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: BOOLFALSE;
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.