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: 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 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: 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.