LichenRecognizeArrays:
CEDAR
PROGRAM
IMPORTS Asserting, AssertingIO, Convert, IO, LichenDataStructure, LichenOps, LichenTransformsPrivate, RedBlackTree, Rope
EXPORTS LichenDataStructure, LichenOps
= BEGIN OPEN LichenDataStructure, LichenOps, LichenTransforms, LichenTransformsPrivate;
JointAccount: TYPE = LIST OF JointAccounting;
JointAccounting: TYPE = REF JointAccountingRep;
JointAccountingRep:
TYPE =
RECORD [
low, high: PortIndex,
eo: EO,
used:
SEQUENCE length:
NAT
OF
BOOL
used[ui] says whether e[i].pl é e[i+1].ph seen
];
notPorted: PUBLIC Porting ← NEW [ROPE ← "Not ported"];
unknownPorting: PUBLIC Porting ← NEW [ROPE ← "Unknown porting"];
EOName: PUBLIC ARRAY EO OF ROPE ← [Even: "even", Odd: "odd"];
DimName: PUBLIC ARRAY Dim OF ROPE ← [Foo: "Foo", Bar: "Bar"];
EndName: PUBLIC ARRAY End OF ROPE ← [low: "low", high: "high"];
Fail: ERROR [why: ROPE] = CODE;
indexFn: REF ANY ← NEW [ROPE ← "the function from a cell Vertex to its index"];
joinFns:
ARRAY
EO
OF
ARRAY
BOOL
--to high--
OF
REF
ANY ← [
Even: [
TRUE: NEW [ROPE ← "from low to high across even joint"],
FALSE: NEW [ROPE ← "from high to low across even joint"]],
Odd: [
TRUE: NEW [ROPE ← "from low to high across odd joint"],
FALSE: NEW [ROPE ← "from high to low across odd joint"]]];
Arrayify:
PROC [ct: CellType]
RETURNS [whyNot:
ROPE ←
NIL] = {
ENABLE Fail => {whyNot ← why; CONTINUE};
a: Array;
elts: VertexS;
EnsureParts[ct];
IF NOT ExpansionKnown[ct] THEN ERROR;
[a, elts] ← InitialSurvey[ct];
MakeConnections[ct, a, elts];
ct.parts ← NIL;
ct.mirror ← NIL;
ct.asArray ← a;
};
InitialSurvey:
PROC [ct: CellType]
RETURNS [a: Array, elts: VertexS] = {
et: CellType;
prefix, postfix: ROPE ← NIL;
prefixLength, postfixLength: INT ← 0;
insides: SymbolTable ← RedBlackTree.Create[GetIDKey, CompareRopes];
nCells, nNets: INT ← 0;
SurveyPart:
PROC [v: Vertex] = {
name: ROPE ← PickAName[v.names];
SELECT v.class
FROM
net => {
nNets ← nNets + 1;
};
cell => {
nCells ← nCells + 1;
v.other ← Asserting.AssertFn1[fn: indexFn, val: NIL, inAdditionTo: v.other];
SELECT nCells
FROM
=1 => {
et ← v.type;
prefix ← name;
prefixLength ← prefix.Length[];
};
=2 => {
nameLength: INT ← name.Length[];
prematch, postmatch: INT;
middle: ROPE;
IF et # v.type THEN Fail[IO.PutFR["Non-homogeneous (cell types %g and %g present)", IO.rope[PickAName[et.names]], IO.rope[PickAName[v.type.names]]]];
FOR
prematch ← 0, prematch + 1
WHILE
(prematch < nameLength) AND
(prematch < prefixLength) AND
(prefix.Fetch[prematch] = name.Fetch[prematch])
DO NULL ENDLOOP;
FOR
postmatch ← 0, postmatch + 1
WHILE
(postmatch < nameLength) AND
(postmatch < prefixLength) AND
(prefix.Fetch[prefixLength-1-postmatch] = name.Fetch[nameLength-1-postmatch])
DO NULL ENDLOOP;
IF prematch + postmatch > nameLength THEN Fail[IO.PutFR["Overlapping match between %g and %g", IO.rope[prefix], IO.rope[name]]];
middle ← prefix.Substr[start: prematch, len: prefixLength - (prematch + postmatch)];
insides.Insert[middle, middle];
postfix ← prefix.Substr[start: prefixLength - postmatch];
prefix ← prefix.Substr[len: prematch];
middle ← name.Substr[start: prematch, len: nameLength - (prematch + postmatch)];
insides.Insert[middle, middle];
prefixLength ← prematch;
postfixLength ← postmatch;
};
>2 => {
nameLength: INT ← name.Length[];
prematch, postmatch: INT;
middle: ROPE;
IF et # v.type THEN Fail[IO.PutFR["Non-homogeneous (cell types %g and %g present)", IO.rope[PickAName[et.names]], IO.rope[PickAName[v.type.names]]]];
FOR
prematch ← 0, prematch + 1
WHILE
(prematch < nameLength) AND
(prematch < prefixLength) AND
(prefix.Fetch[prematch] = name.Fetch[prematch])
DO NULL ENDLOOP;
FOR
postmatch ← 0, postmatch + 1
WHILE
(postmatch < nameLength) AND
(postmatch < postfixLength) AND
(postfix.Fetch[postfixLength-1-postmatch] = name.Fetch[nameLength-1-postmatch])
DO NULL ENDLOOP;
IF prematch + postmatch > nameLength THEN Fail[IO.PutFR["Overlapping match between <%g,,%g> and %g", IO.rope[prefix], IO.rope[postfix], IO.rope[name]]];
IF prematch < prefixLength
OR postmatch < postfixLength
THEN {
newInsides: SymbolTable ← RedBlackTree.Create[GetIDKey, CompareRopes];
pretail: ROPE ← prefix.Substr[start: prematch];
posthead: ROPE ← postfix.Substr[len: postfixLength - postmatch];
Enlarge:
PROC [ra:
REF
ANY]
RETURNS [stop:
BOOL] = {
oldInside: ROPE ← NARROW[ra];
newInside: ROPE ← pretail.Cat[oldInside, posthead];
newInsides.Insert[newInside, newInside];
stop ← FALSE};
insides.EnumerateIncreasing[Enlarge];
insides ← newInsides;
prefix ← prefix.Substr[len: prematch];
postfix ← postfix.Substr[start: postfixLength - postmatch];
prefixLength← prematch;
postfixLength ← postmatch;
};
middle ← name.Substr[start: prematch, len: nameLength - (prematch + postmatch)];
insides.Insert[middle, middle];
};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
};
IndexIt:
PROC [ra:
REF
ANY]
RETURNS [stop:
BOOL] = {
inside: ROPE ← NARROW[ra];
name: ROPE ← prefix.Cat[inside, postfix];
index: INT ← Convert.CardFromDecimalLiteral[inside !Convert.Error => Fail[IO.PutFR["Couldn't parse integer in %g[%g]%g", IO.rope[prefix], IO.rope[inside], IO.rope[postfix]]]];
v: Vertex ← ToVertex[ct, name];
IF v = NIL OR v.class # cell THEN ERROR;
stop ← FALSE;
v.other ← Asserting.AssertFn1[fn: indexFn, val: NEW [INT ← index], inAdditionTo: v.other];
IF a.shape[Foo].min >= a.shape[Foo].maxPlusOne
THEN {
a.shape[Foo].min ← index;
a.shape[Foo].maxPlusOne ← index + 1;
elts[0] ← v;
}
ELSE {
IF index < a.shape[Foo].min
THEN {
delta: NAT ← a.shape[Foo].min - index;
FOR i:
NAT
DECREASING
IN [delta .. elts.length)
DO
elts[i] ← elts[i - delta];
ENDLOOP;
FOR i: NAT IN [0 .. delta) DO elts[i] ← NIL ENDLOOP;
a.shape[Foo].min ← a.shape[Foo].min - delta;
a.shape[Foo].maxPlusOne ← a.shape[Foo].maxPlusOne - delta;
};
IF index >= a.shape[Foo].maxPlusOne
THEN {
a.shape[Foo].maxPlusOne ← index + 1;
IF a.shape[Foo].maxPlusOne - a.shape[Foo].min > elts.length THEN Fail[IO.PutFR["Non dense index set: at least [%g .. %g)", IO.int[a.shape[Foo].min], IO.int[a.shape[Foo].maxPlusOne]]]
};
IF elts[index - a.shape[Foo].min] # NIL THEN Fail[IO.PutFR["Double occupancy of index %g", IO.int[index]]];
elts[index - a.shape[Foo].min] ← v;
};
};
EnumerateParts[ct, SurveyPart];
a ← NEW [ArrayRep[et.ports.length]];
a.eltType ← et;
a.shape ← [Foo: [0, 0], Bar: [0, 1]];
a.joints ← ALL[ALL[ALL[NIL]]];
a.portConnections ← NEW [ArrayPortConnectionSeq[ct.ports.length]];
FOR pi: PortIndex IN [0 .. ct.ports.length) DO a.portConnections[pi] ← ALL[ALL[[[0, 0], NIL]]] ENDLOOP;
FOR pi: PortIndex IN [0 .. a.eltPorts) DO a[pi] ← unknownPorting ENDLOOP;
elts ← NEW [VertexSeq[nCells]];
FOR i: NAT IN [0 .. elts.length) DO elts[i] ← NIL ENDLOOP;
insides.EnumerateIncreasing[IndexIt];
IF a.shape[Foo].maxPlusOne - a.shape[Foo].min # nCells THEN ERROR --should have been guaranteed by code in IndexIt--;
};
MakeConnections:
PROC [ct: CellType, a: Array, elts: VertexS] = {
accounts: JointAccount ← NIL;
vpSize: NAT ← a.shape[Foo].maxPlusOne - a.shape[Foo].min - 2;
Describe:
PROC [ja: JointAccounting]
RETURNS [r:
ROPE] =
{r ← IF ja = NIL THEN "notYetConnected" ELSE IO.PutFR["%g - %g [Foo, Even, %g]", IO.refAny[PickAName[a.eltType.ports[ja.low].names]], IO.refAny[PickAName[a.eltType.ports[ja.high].names]], IO.rope[EOName[ja.eo]]]};
ClearIndex: PROC [v: Vertex] = {v.other ← Asserting.AssertFn1[fn: indexFn, val: NIL, inAdditionTo: v.other]};
PerPart:
PROC [v: Vertex] = {
edges: SymbolTable ← RedBlackTree.Create[GetIDKey, CompareEdgesByIndex];
lastCellIndex: INT;
lastPortIndex: PortIndex;
first: BOOL ← TRUE;
exportIndex: PortIndex ← NullPortIndex;
EnsureJointed:
PROC [ra:
REF
ANY]
RETURNS [stop:
BOOL] = {
e: Edge ← NARROW[ra];
cell: Vertex ← e.sides[cell].v;
nextCellIndex: INT ← CellIndex[cell];
nextPortIndex: INT ← e.portIndex;
dp: DetailedPorting ← NARROW[a.porting[nextPortIndex]];
s1: NAT ← dp.sideIndices[low][Bar].firstSlot;
s2: NAT ← dp.sideIndices[high][Bar].firstSlot;
stop ← FALSE;
SELECT nextCellIndex
FROM
a.shape[Foo].min => {
dp.corners[low] ← ALL[exportIndex];
IF exportIndex # NullPortIndex THEN a.portConnections[exportIndex][low][Foo].sockets ← InsertAS[[[nextCellIndex, 0], nextPortIndex], a.portConnections[exportIndex][low][Foo].sockets];
};
a.shape[Foo].maxPlusOne-1 => {
dp.corners[high] ← ALL[exportIndex];
IF exportIndex # NullPortIndex THEN a.portConnections[exportIndex][high][Foo].sockets ← InsertAS[[[nextCellIndex, 0], nextPortIndex], a.portConnections[exportIndex][high][Foo].sockets];
};
IN (a.shape[Foo].min .. a.shape[Foo].maxPlusOne-1) => {
dp.slots[s1 + nextCellIndex - (a.shape[Foo].min+1)] ← dp.slots[s2 + nextCellIndex - (a.shape[Foo].min+1)] ← exportIndex;
};
ENDCASE => ERROR;
IF exportIndex # NullPortIndex
THEN {
a.portConnections[exportIndex][low][Bar].sockets ← InsertAS[[[nextCellIndex, 0], nextPortIndex], a.portConnections[exportIndex][low][Bar].sockets];
a.portConnections[exportIndex][high][Bar].sockets ← InsertAS[[[nextCellIndex, 0], nextPortIndex], a.portConnections[exportIndex][high][Bar].sockets];
};
IF first
THEN first ←
FALSE
ELSE {
eo: EO ← EOOfInt[nextCellIndex];
Bitch:
PROC =
{Fail[IO.PutFR["Non-uniform connection across %g joint: %g-%g, %g, and %g", IO.rope[EOName[eo]], IO.rope[PickAName[lowPort.names]], IO.rope[PickAName[highPort.names]], IO.rope[Describe[toLow]], IO.rope[Describe[toHigh]]]]};
toLow, toHigh: JointAccounting ← NIL;
lowPort: Port ← a.eltType.ports[lastPortIndex];
highPort: Port ← a.eltType.ports[nextPortIndex];
ui: NAT ← UseIndex[a, lastCellIndex];
IF nextCellIndex # lastCellIndex + 1 THEN Fail[IO.PutFR["Non neighborly connection between %g.%g and %g.%g", IO.int[lastCellIndex], IO.rope[PickAName[lowPort.names]], IO.int[nextCellIndex], IO.rope[PickAName[highPort.names]]]];
toHigh ← NARROW[Asserting.FnVal[fn: joinFns[eo][TRUE], from: lowPort.other]];
toLow ← NARROW[Asserting.FnVal[fn: joinFns[eo][FALSE], from: highPort.other]];
IF toHigh # toLow THEN Bitch[]
ELSE
IF toHigh =
NIL
THEN {
jaSize: NAT ← JASize[a, eo];
ja: JointAccounting ← NEW [JointAccountingRep[jaSize]];
ja.low ← lastPortIndex;
ja.high ← nextPortIndex;
ja.eo ← eo;
FOR i: NAT IN [0 .. ja.length) DO ja[i] ← i = ui ENDLOOP;
IF a.joints[Foo][Even][eo] =
NIL
THEN {
a.joints[Foo][Even][eo] ← NEW [JointSeq[a.eltType.ports.length]];
FOR pi: PortIndex
IN [0 .. a.eltType.ports.length)
DO
a.joints[Foo][Even][eo][pi] ← [NullPortIndex, NullPortIndex];
ENDLOOP;
};
IF a.joints[Foo][Even][eo][lastPortIndex].high # NullPortIndex OR a.joints[Foo][Even][eo][nextPortIndex].low # NullPortIndex THEN ERROR;
a.joints[Foo][Even][eo][lastPortIndex].high ← nextPortIndex;
a.joints[Foo][Even][eo][nextPortIndex].low ← lastPortIndex;
accounts ← CONS[ja, accounts];
a.eltType.ports[lastPortIndex].other ← Asserting.AssertFn1[fn: joinFns[eo][TRUE], val: ja, inAdditionTo: lowPort.other];
a.eltType.ports[nextPortIndex].other ← Asserting.AssertFn1[fn: joinFns[eo][FALSE], val: ja, inAdditionTo: highPort.other];
}
ELSE {
IF toHigh.high # nextPortIndex OR toHigh.low # lastPortIndex THEN Bitch[];
IF toHigh.used[ui] THEN ERROR;
toHigh.used[ui] ← TRUE;
};
};
lastCellIndex ← nextCellIndex;
lastPortIndex ← nextPortIndex;
};
SELECT v.class
FROM
net => NULL;
cell => RETURN;
ENDCASE => ERROR;
FOR e: Edge ← v.firstEdge, e.sides[net].next
WHILE e #
NIL
DO
IF e.sides[net].v # v THEN ERROR;
IF IsMirror[e.sides[cell].v]
THEN {
IF exportIndex # NullPortIndex THEN ERROR --we assume ANPortsMergedI--;
exportIndex ← e.portIndex;
}
ELSE edges.Insert[e, e !RedBlackTree.DuplicateKey => Fail[IO.PutFR["Multiple connections to the same element: %g", IO.rope[PickAName[e.sides[cell].v.names]]]]];
ENDLOOP;
edges.EnumerateIncreasing[EnsureJointed];
};
ClearPortAssocs:
PROC = {
FOR pi: PortIndex
IN [0 .. a.eltType.ports.length)
DO
FOR eo:
EO
IN
EO
DO
FOR b:
BOOL
IN
BOOL
DO
a.eltType.ports[pi].other ← Asserting.AssertFn1[fn: joinFns[eo][b], val: NIL, inAdditionTo: a.eltType.ports[pi].other];
ENDLOOP ENDLOOP;
ENDLOOP;
};
FOR pi: PortIndex
IN [0 .. a.eltType.ports.length)
DO
a.porting[pi] ← NewDetailedPorting[a.shape];
ENDLOOP;
IF a.joints # ALL[ALL[ALL[NIL]]] THEN ERROR;
ClearPortAssocs[];
EnumerateParts[ct, PerPart];
FOR accounts ← accounts, accounts.rest
WHILE accounts #
NIL
DO
ja: JointAccounting ← accounts.first;
FOR i:
NAT
IN [0 .. ja.length)
DO
IF NOT ja.used[i] THEN Fail[IO.PutFR["Failed to use %'th instance of %g", IO.int[i], IO.rope[Describe[ja]]]];
ENDLOOP;
ENDLOOP;
FOR pi: PortIndex
IN [0 .. a.eltType.ports.length)
DO
dp: DetailedPorting ← NARROW[a.porting[pi]];
none: BOOL ← dp.corners = ALL[ALL[NullPortIndex]];
FOR e: End
IN End
DO
FOR d: Dim
IN Dim
DO
s0: NAT ← dp.sideIndices[e][d].firstSlot;
inners: NAT ← MAX[a.shape[d].maxPlusOne - a.shape[d].min, 2] - 2;
thePort: PortIndex ← IF inners>0 THEN dp.slots[s0] ELSE NullPortIndex;
midsSame: BOOL ← TRUE;
midsNull: BOOL ← thePort = NullPortIndex;
Check:
PROC [epi: PortIndex] = {
midsSame ← midsSame AND epi = thePort;
midsNull ← midsNull AND epi = NullPortIndex;
};
FOR i: NAT IN (0 .. inners) DO Check[dp.slots[s0+i]] ENDLOOP;
dp.sideIndices[e][d].same ← midsSame;
IF NOT midsNull THEN none ← FALSE;
ENDLOOP ENDLOOP;
IF none THEN a.porting[pi] ← notPorted;
ENDLOOP;
FOR pi: PortIndex
IN [0 .. ct.ports.length)
DO
FOR e: End
IN End
DO
FOR d: Dim
IN Dim
DO
a.portConnections[pi][e][d].range ← SummarizeASL[a.portConnections[pi][e][d].sockets, OtherDim[d]];
ENDLOOP ENDLOOP;
ENDLOOP;
};
NewDetailedPorting:
PUBLIC
PROC [shape:
ARRAY Dim
OF Range]
RETURNS [dp: DetailedPorting] = {
inner:
ARRAY Dim
OF
NAT ← [
Foo: MAX[shape[Foo].maxPlusOne - shape[Foo].min, 2] - 2,
Bar: MAX[shape[Bar].maxPlusOne - shape[Bar].min, 2] - 2];
fullDetails: NAT ← 2 * (inner[Foo] + inner[Bar]);
s0: NAT ← 0;
dp ← NEW [DetailedPortingRep[fullDetails]];
FOR e: End
IN End
DO
FOR d: Dim
IN Dim
DO
dp.sideIndices[e][d] ← [FALSE, s0];
s0 ← s0 + inner[OtherDim[d]];
ENDLOOP;
ENDLOOP;
dp.corners ← ALL[ALL[NullPortIndex]];
FOR s: NAT IN [0 .. s0) DO dp[s] ← NullPortIndex ENDLOOP;
};
InsertAS:
PROC [as: ArraySocket, asl: ArraySocketList]
RETURNS [bsl: ArraySocketList] = {
LE: PROC [a, b: ArrayIndex] RETURNS [le: BOOL] = {le ← a[Foo] <= b[Foo] AND a[Bar] <= b[Bar]};
last: ArraySocketList ← NIL;
this: ArraySocketList ← LIST[as];
bsl ← asl;
FOR asl ← asl, asl.rest UNTIL asl = NIL OR LE[as.ai, asl.first.ai] DO last ← asl ENDLOOP;
IF last = NIL THEN bsl ← this ELSE last.rest ← this;
this.rest ← asl;
};
SummarizeASL:
PROC [asl: ArraySocketList, d: Dim]
RETURNS [r: Range] = {
n: INT ← 0;
r ← [0, 0];
FOR asl ← asl, asl.rest
WHILE asl #
NIL
DO
SELECT n
FROM
=0 => r.maxPlusOne ← 1 + (r.min ← asl.first.ai[d]);
>0 => r.maxPlusOne ← MAX[r.maxPlusOne, asl.first.ai[d]+1];
ENDCASE => ERROR;
n ← n + 1;
ENDLOOP;
SELECT r.maxPlusOne - r.min
FROM
1 => NULL;
n => NULL;
ENDCASE => ERROR;
};
EqualJoints:
PROC [a, b: Joint]
RETURNS [equal:
BOOL] = {
minLen: NAT ← MIN[a.eltPorts, b.eltPorts];
EndCheck:
PROC [j: Joint] = {
FOR p: PortIndex
IN [minLen .. j.eltPorts)
DO
IF j[p] # [NullPortIndex, NullPortIndex] THEN {equal ← FALSE; EXIT};
ENDLOOP;
};
equal ← TRUE;
FOR p: PortIndex
IN [0 .. minLen)
DO
IF a[p].low # b[p].low OR a[p].high # b[p].high THEN RETURN [FALSE];
ENDLOOP;
IF a.eltPorts > minLen THEN EndCheck[a];
IF b.eltPorts > minLen THEN EndCheck[b];
};
CellIndex:
PROC [cell: Vertex]
RETURNS [index:
INT] = {
ri: REF INT ← NARROW[Asserting.FnVal[fn: indexFn, from: cell.other]];
index ← ri^};
UseIndex:
PROC [a: Array, lowCellIndex:
INT]
RETURNS [ui:
NAT] = {
ui ← (lowCellIndex - (a.shape[Foo].min+1))/2;
};
JASize:
PROC [a: Array, eo:
EO]
RETURNS [length:
NAT] = {
highMod: [0 .. 1] ← Mods[eo];
lowMod: [0 .. 1] ← 1 - Mods[eo];
highest: INT ← a.shape[Foo].maxPlusOne - (IF ((a.shape[Foo].maxPlusOne-1) MOD 2) = highMod THEN 1 ELSE 2);
lowest: INT ← a.shape[Foo].min + (IF ((a.shape[Foo].min) MOD 2) = lowMod THEN 0 ELSE 1);
length ← (highest + 1 - lowest)/2;
};
CompareEdgesByIndex:
PROC [k, data:
REF
ANY]
RETURNS [c: Basics.Comparison]
--RedBlackTree.Compare-- = {
Key:
PROC [ref:
REF
ANY]
RETURNS [index:
INT] = {
e: Edge ← NARROW[ref];
index ← CellIndex[e.sides[cell].v]};
k1: INT ← Key[k];
k2: INT ← Key[data];
c ←
SELECT k1
FROM
< k2 => less,
= k2 => equal,
> k2 => greater,
ENDCASE => ERROR;
};
EOOfInt:
PROC [i:
INT]
RETURNS [eo:
EO] =
{eo ← SELECT i MOD 2 FROM 0 => Even, 1 => Odd, ENDCASE => ERROR};
Mods: ARRAY EO OF [0 .. 1] ← [Even: 0, Odd: 1];
Start:
PROC = {
dontWrite: REF ANY ← NEW [AssertingIO.WriteProc ← AssertingIO.DontWrite];
AssertingIO.writers ← Asserting.AssertFn1[indexFn, dontWrite, AssertingIO.writers, NIL, TRUE];
FOR eo:
EO
IN
EO
DO
FOR b:
BOOL
IN
BOOL
DO
AssertingIO.writers ← Asserting.AssertFn1[joinFns[eo][b], dontWrite, AssertingIO.writers, NIL, TRUE];
ENDLOOP ENDLOOP;
};
Start[];
END.