DIRECTORY LichenArrayStuff, Collections, LichenDataOps, LichenDataStructure, IntFunctions, IntStuff, LichenNavigation, PairCollections, Rope, StructuredStreams, UnparserBuffer, ViewerIO;

LichenData4Impl: CEDAR PROGRAM
IMPORTS LichenArrayStuff, Collections, LichenDataOps, LichenDataStructure, IntFunctions, LichenNavigation, PairCollections
=

BEGIN OPEN LichenArrayStuff, LichenDataOps, LichenDataStructure, Colls:Collections, PairColls:PairCollections, Ints:IntStuff, IntFns:IntFunctions, SS:StructuredStreams, UB:UnparserBuffer;

Set: TYPE ~ LichenDataStructure.Set;
Function: TYPE ~ LichenDataStructure.Function;
OneToOne: TYPE ~ LichenDataStructure.OneToOne;
Seq: TYPE ~ LichenDataStructure.Seq;

Thing: TYPE ~ REF ANY --actually UNION [Port, Wire]--;
Wirism: TYPE ~ REF ANY --actually UNION [Vertex, ArrayWire]--;

ReOrderDesign: PROC [d: Design] ~ {
desiredPerm: Relation--Wirism X REF Permutation-- ~ PairColls.CreateHashReln[[Colls.refs, IntFns.refIntFns]];
portDesires: Function--Port _ REF Permutation-- ~ PairColls.CreateHashFn[invable: FALSE];
delayedVerts: Set--of Vertex-- ~ Colls.CreateHashSet[];
delayedPorts: Set--of Port-- ~ Colls.CreateHashSet[];
arrayWireArray: Function--ArrayWire _ Array-- ~ PairColls.CreateHashFn[invable: FALSE];
StartCellType: PROC [val: REF ANY] ~ {
ct: CellType ~ NARROW[val];
WorkOnPort: PROC [port: Port] RETURNS [doKids, moreSibs: BOOL _ TRUE] ~ {
IF port.FirstChildPort[]=NIL THEN RETURN;
{desire: Permutation ~ DesiredPerm[port, LichenNavigation.portToChildren, LichenNavigation.bestPortShortName];
IF desire.IsIdentitySubset[] THEN RETURN;
{refDesire: REF ANY ~ desire.Refify;
delay: BOOL _ FALSE;
CheckInstance: PROC [ci: CellInstance] ~ {
v: Vertex ~ FindTopEdge[ci, port].v;
allMe: BOOL ~ AllForPort[v, port];
IF NOT allMe THEN delay _ TRUE;
RETURN};
CheckArray: PROC [act: CellType] ~ {
a: Array ~ act.asArray;
CheckGroup: PROC [gi2: Nat2, gi: NATURAL, g: Group] ~ {
CheckArrayWire: PROC [aw: ArrayWire] ~ {
CheckOtherGroup: PROC [gi2: Nat2, gi: NATURAL, g: Group, membership: BoolSeq--group instance index _ isMember--] ~ {
IF g.ports=NIL OR g.ports.rest#NIL OR g.ports.first#port THEN delay _ TRUE;
RETURN};
EnumerateGroupsOfArrayWire[a, aw, CheckOtherGroup];
RETURN};
EnumerateArrayWiresContainingGroup[a, gi2, gi, g, CheckArrayWire, TRUE];
RETURN};
EnumerateGroupsContainingPort[a, port, CheckGroup];
RETURN};
DelayInstance: PROC [ci: CellInstance] ~ {
v: Vertex ~ FindTopEdge[ci, port].v;
[] _ delayedVerts.AddElt[v];
[] _ desiredPerm.AddPair[[v, refDesire]];
RETURN};
DelayArray: PROC [act: CellType] ~ {
a: Array ~ act.asArray;
DelayGroup: PROC [gi2: Nat2, gi: NATURAL, g: Group] ~ {
DelayArrayWire: PROC [aw: ArrayWire] ~ {
[] _ arrayWireArray.AddPair[[aw, a]];
[] _ desiredPerm.AddPair[[aw, refDesire]];
RETURN};
EnumerateArrayWiresContainingGroup[a, gi2, gi, g, DelayArrayWire, TRUE];
RETURN};
EnumerateGroupsContainingPort[a, port, DelayGroup];
RETURN};
ct.EnumerateInstances[CheckInstance, TRUE];
ct.EnumerateArrays[CheckArray];
IF delay THEN {
ct.EnumerateInstances[DelayInstance, TRUE];
ct.EnumerateArrays[DelayArray];
IF NOT delayedPorts.AddElt[port] THEN ERROR;
Store[portDesires, [port, refDesire]]}
ELSE PermutePort[port, desire, TRUE];
RETURN}}};
WorkOnWire: PROC [wire: Wire] RETURNS [doKids, moreSibs: BOOL _ TRUE] ~ {
IF wire.FirstChildWire[]=NIL THEN RETURN;
{desire: Permutation ~ DesiredPerm[wire, LichenNavigation.wireToChildren, LichenNavigation.bestVertexShortName];
IF desire.IsIdentitySubset[] THEN RETURN;
{refDesire: REF ANY ~ desire.Refify;
delay: BOOL ~ NOT AllForPort[wire];
IF delay THEN {
[] _ delayedVerts.AddElt[wire];
[] _ desiredPerm.AddPair[[wire, refDesire]];
}
ELSE PermuteWire[wire, desire];
RETURN}}};
[] _ EnumeratePort[ct.port, WorkOnPort];
IF ct.asUnorganized#NIL THEN [] _ ct.asUnorganized.internalWire.EnumerateWire[WorkOnWire];
RETURN};
DoDelayedPort: PROC [val: REF ANY] ~ {
port: Port ~ NARROW[val];
ct: CellType ~ PortCCT[port];
allSame: BOOL _ TRUE;
desire: Permutation ~ IntFns.DeRef[portDesires.Apply[port].val];
CheckInstance: PROC [ci: CellInstance] ~ {
v: Vertex ~ FindTopEdge[ci, port].v;
perms: Set ~ desiredPerm.Mapping[v];
size: INT ~ perms.Size[2];
IF size=0 THEN ERROR;
IF size>1 THEN allSame _ FALSE;
RETURN};
CheckArray: PROC [act: CellType] ~ {
a: Array ~ act.asArray;
CheckGroup: PROC [gi2: Nat2, gi: NATURAL, g: Group] ~ {
CheckArrayWire: PROC [aw: ArrayWire] ~ {
perms: Set ~ desiredPerm.Mapping[aw];
size: INT ~ perms.Size[2];
IF size=0 THEN ERROR;
IF size>1 THEN allSame _ FALSE;
RETURN};
EnumerateArrayWiresContainingGroup[a, gi2, gi, g, CheckArrayWire, TRUE];
RETURN};
EnumerateGroupsContainingPort[a, port, CheckGroup];
RETURN};
ct.EnumerateInstances[CheckInstance, TRUE];
ct.EnumerateArrays[CheckArray];
IF allSame
THEN PermutePort[port, desire, FALSE]
ELSE Log["Port %g not permuted", LIST[port]];
RETURN};
DoDelayedWire: PROC [val: REF ANY] ~ {
wire: Wire ~ NARROW[val];
ct: CellType ~ wire.containingCT;
perms: Set ~ desiredPerm.Mapping[wire];
size: INT ~ perms.Size[2];
IF size=0 THEN ERROR;
IF size>1 THEN {
Log["%g perms desired for wire %g", LIST[NEW [INT _ size], wire]];
RETURN};
{desire: Permutation ~ IntFns.DeRef[perms.TheElt];
PermuteWire[wire, desire];
RETURN}};
d.cellTypes.Enumerate[StartCellType];
delayedPorts.Enumerate[DoDelayedPort];
delayedVerts.Enumerate[DoDelayedWire];
RETURN};

AllForPort: PROC [v: Vertex, port: Port _ NIL] RETURNS [allSame: BOOL _ TRUE] ~ {
CheckEdge: PROC [p: Port, w: Vertex, e: Edge] ~ {
IF p=NIL THEN ERROR;
IF port=NIL THEN port_p ELSE IF p#port THEN allSame _ FALSE;
RETURN};
v.EnumerateImmediateEdges[CheckEdge, [cellward: TRUE, wireward: FALSE]];
IF NOT allSame THEN RETURN;
WITH v SELECT FROM
ci: CellInstance => NULL;
im: Intermediary => NULL;
w: Wire => IF w.containingWire#NIL AND NOT AllForPort[w.containingWire] THEN RETURN [FALSE];
ENDCASE => ERROR;
RETURN};

DesiredPerm: PROC [parent: Thing, ToChildren: OneToOne--Thing f Seq of children--, ToName: Function--Thing _ SteppyName--] RETURNS [perm: Permutation] ~ {
children: Seq--of child Things-- ~ IntFns.DeRef[ToChildren.Apply[parent].val];
names: Seq--of SteppyName-- ~ children.Compose[right: ToName, rightRestricts: FALSE];
perm _ IntFns.GradeUp[names, Colls.LexOrdering[NIL, LIST[nameStepSpace.SpaceOrdering]]];
RETURN};

PermutePort: PROC [port: Port, perm: Permutation, doConnections: BOOL] ~ {
oldKids: Seq ~ IntFns.DeRef[LichenNavigation.portToChildren.Apply[port].val] .CreateSimpleCopy;
n: INT ~ oldKids.Size;
prev: Port _ NIL;
index: INT _ 0;
FixElt: PROC [pair: IntFns.IVPair] ~ {
newIndex: INT ~ pair.left;
oldIndex: INT ~ NARROW[pair.right, REF INT]^;
kid: Port ~ NARROW[oldKids.Apply[oldIndex].val];
IF index#newIndex THEN ERROR;
kid.prev _ prev;
IF prev#NIL THEN prev.next _ kid ELSE port.firstChild _ kid;
prev _ kid;
index _ index+1;
RETURN};
FixInstance: PROC [ci: CellInstance] ~ {
v: Vertex ~ FindTopEdge[ci, port].v;
PermuteVertex[v, perm];
};
perm.Enumerate[FixElt];
IF index#n THEN ERROR;
prev.next _ NIL;
port.lastChild _ prev;
IF doConnections THEN port.PortCCT.EnumerateInstances[FixInstance, TRUE];
RETURN};

PermuteWire: PROC [wire: Wire, perm: Permutation] ~ {
oldKids: Seq ~ IntFns.DeRef[LichenNavigation.wireToChildren.Apply[wire].val] .CreateSimpleCopy;
n: INT ~ oldKids.Size;
prev: Wire _ NIL;
index: INT _ 0;
FixElt: PROC [pair: IntFns.IVPair] ~ {
newIndex: INT ~ pair.left;
oldIndex: INT ~ NARROW[pair.right, REF INT]^;
kid: Wire ~ NARROW[oldKids.Apply[oldIndex].val];
IF index#newIndex THEN ERROR;
kid.prev _ prev;
IF prev#NIL THEN prev.next _ kid ELSE wire.firstChild _ kid;
prev _ kid;
index _ index+1;
RETURN};
perm.Enumerate[FixElt];
IF index#n THEN ERROR;
prev.next _ NIL;
wire.lastChild _ prev;
RETURN};

PermuteVertex: PROC [v: Vertex, perm: Permutation] ~ {
WITH v SELECT FROM
w: Wire => {PermuteWire[w, perm]; RETURN};
im: Intermediary => NULL;
ci: CellInstance => NULL;
ENDCASE => ERROR;
{old: Seq--of old Edge-- ~ IntFns.CreateSimple[oneToOne: TRUE, dense: TRUE];
NoteOldEdge: PROC [p: Port, w: Vertex, e: Edge] ~ {
IF e.sides[cellward].v#v THEN ERROR;
old.Append[e];
RETURN};
v.EnumerateImmediateEdges[NoteOldEdge, [cellward: FALSE, wireward: TRUE], forward];
{n: INT ~ old.Size;
oldFirstWireward: Edge ~ NARROW[old.First[].pair.right];
lastCellward: Edge ~ oldFirstWireward.sides[cellward].prev;
prev: Edge _ lastCellward;
prevSide: GraphDirection _ wireward;
index: INT _ 0;
FixElt: PROC [pair: IntFns.IVPair] ~ {
newIndex: INT ~ pair.left;
oldIndex: INT ~ NARROW[pair.right, REF INT]^;
e: Edge ~ NARROW[old.Apply[oldIndex].val];
IF index#newIndex THEN ERROR;
e.sides[cellward].prev _ prev;
IF prev#NIL THEN prev.sides[prevSide].next _ e
ELSE IF v.firstEdge.sides[cellward].v#v THEN ERROR
ELSE v.firstEdge _ e;
prev _ e;
prevSide _ cellward;
index _ index+1;
RETURN};
IF lastCellward#NIL AND lastCellward.sides[wireward].v#v THEN ERROR;
perm.Enumerate[FixElt];
IF index#n OR n=0 THEN ERROR;
prev.sides[cellward].next _ NIL;
v.lastEdge _ prev;
RETURN}}};

Store: PROC [pc: PairColls.PairColl, pair: PairColls.Pair] ~ {
lr: BOOL ~ pc.Functional[][leftToRight];
rl: BOOL ~ pc.Functional[][rightToLeft];
news: PairColls.NewsPair ~ pc.AddPair[pair, [[NOT lr, TRUE], [NOT rl, TRUE]]];
IF lr AND news[leftToRight]#new THEN ERROR;
IF rl AND news[rightToLeft]#new THEN ERROR;
};

END.
`LichenData4Impl.Mesa
Last tweaked by Mike Spreitzer on September 18, 1987 1:16:36 pm PDT
ΚΈ˜™Icodeš
œC™C—J˜KšΟk	œ±
˜Ί
K˜šΡbnxœœ
˜Kšœs˜zKš
œ
˜
—K˜Kšœ
œ7ΟnœŸ	œŸœŸœœœ˜»
K˜Kšœœ˜$Kšœ
œ ˜.Kšœ
œ ˜.Kšœœ˜$K˜Kš	œœœ
œ
Οcœ
˜6Kš	œœœ
œ
 &œ
˜>K˜šŸ
œœ˜#Kšœ 	Πcm
 œ<˜mKšœ ‘
 œ#œ˜YKšœ 
œ˜7Kšœ œ˜5Kšœ ‘
 œ#œ˜WšŸ
œœœ
œ˜&Kšœœ˜š
Ÿ
œœœœœ˜IKšœœ
œ
œ
˜)Kš
œn˜nKšœœ
œ
˜)Kšœœ
œ˜$Kšœœœ
˜šŸ
œœ˜*Kš
œ$˜$Kšœœ˜"Kšœ
œœ	œ
˜Kšœ˜—šŸ
œœ˜$K˜šŸ
œœœ˜7šŸœœ˜(š
Ÿœœœ ‘
 œ˜tKšœ	œ
œœ
œœ	œ
˜KKšœ˜—Kš
œ3˜3Kšœ˜—KšœBœ˜HKšœ˜—Kš
œ3˜3Kšœ˜—šŸ
œœ˜*Kš
œ$˜$Kš
œ˜Kš
œ)˜)Kšœ˜—šŸ
œœ˜$K˜šŸ
œœœ˜7šŸœœ˜(K˜%Kš
œ*˜*Kšœ˜—KšœBœ˜HKšœ˜—Kš
œ3˜3Kšœ˜—Kšœ%œ˜+Kš
œ˜šœœ˜Kšœ%œ˜+Kš
œ˜Kšœ
œœ
œ
˜,Kš
œ&˜&—Kšœœ˜%Kšœ˜
—š
Ÿ
œœœœœ˜IKšœœ
œ
œ
˜)Kš
œp˜pKšœœ
œ
˜)Kšœœ
œ˜$Kšœœœ˜#šœœ˜Kš
œ˜Kš
œ,˜,Kš
œ
˜
—Kšœ˜Kšœ˜
—Kš
œ(˜(Kšœœ
œ>˜ZKšœ˜—šŸ
œœœ
œ˜&Kšœ
œ˜K˜Kšœ	œœ
˜Kš
œ@˜@šŸ
œœ˜*Kš
œ$˜$Kš
œ$˜$Kšœœ˜Kšœœ
œ
˜Kšœœœ
˜Kšœ˜—šŸ
œœ˜$K˜šŸ
œœœ˜7šŸœœ˜(Kš
œ%˜%Kšœœ˜Kšœœ
œ
˜Kšœœœ
˜Kšœ˜—KšœBœ˜HKšœ˜—Kš
œ3˜3Kšœ˜—Kšœ%œ˜+Kš
œ˜šœ˜
Kšœœ
˜%Kšœœ˜-—Kšœ˜—šŸ
œœœ
œ˜&Kšœ
œ˜K˜!Kš
œ'˜'Kšœœ˜Kšœœ
œ
˜šœœ˜Kšœ$œ
œœ˜BKšœ˜—Kš
œ2˜2Kš
œ˜Kšœ˜	—K˜%Kš
œ&˜&Kš
œ&˜&Kšœ˜—K˜šŸ
œœœœœœ˜QšŸ	œœ"˜1Kšœœ
œ
œ
˜Kšœœ
œœ
œœœ
˜<Kšœ˜—Kšœ0œœ˜HKšœ
œ	œ
œ
˜šœœ
˜Kšœœ
˜Kšœœ
˜Kšœœœ
œ
œœ
œœ˜\Kšœœ
˜—Kšœ˜—K˜šŸœœŸ
œ
 ‘
 œŸœ
 ‘
 
œœ˜š
Kšœ
 œ.˜NKšœ
 œ3œ˜UKšœ/œœ ˜XKšœ˜—K˜šŸœœ0œ˜JKš
œ_˜_Kšœœ˜Kšœ
œ
˜Kšœœ˜šŸœœ˜&Kšœ
œ
˜Kš	œ
œœ
œ
œ˜-Kšœœ˜0Kšœœ
œ
˜K˜Kšœœ
œœ˜<K˜K˜Kšœ˜—šŸœœ˜(Kš
œ$˜$K˜K˜—K˜Kšœ	œ
œ
˜Kšœœ
˜K˜Kšœœ.œ˜IKšœ˜—K˜šŸœœ$˜5Kš
œ_˜_Kšœœ˜Kšœ
œ
˜Kšœœ˜šŸœœ˜&Kšœ
œ
˜Kš	œ
œœ
œ
œ˜-Kšœœ˜0Kšœœ
œ
˜K˜Kšœœ
œœ˜<K˜K˜Kšœ˜—K˜Kšœ	œ
œ
˜Kšœœ
˜K˜Kšœ˜—K˜šŸ
œœ#˜6šœœ
˜Kšœ"œ˜*Kšœœ
˜Kšœœ
˜Kšœœ
˜—Kšœ	 œ!œ	œ˜LšŸœœ"˜3Kšœœ
œ
˜$K˜Kšœ˜—Kšœ2œœ˜SKšœœ˜Kšœœ˜8Kš
œ;˜;Kš
œ˜K˜$Kšœœ˜šŸœœ˜&Kšœ
œ
˜Kš	œ
œœ
œ
œ˜-Kšœ
œ˜*Kšœœ
œ
˜Kš
œ˜Kšœœ
œ˜.Kšœ
œ!œ
˜2Kšœ˜K˜	K˜K˜Kšœ˜—Kš
œœ
œ"œ
œ
˜DK˜Kšœ	œœ
œ
˜Kšœœ
˜ Kš
œ˜Kšœ˜
—K˜šŸœœ3˜>Kšœœ ˜(Kšœœ ˜(Kš	œ.œœœœ˜NKšœœœ
œ
˜+Kšœœœ
œ
˜+K˜—K˜Kšœ
˜—…—$<0T