DIRECTORY Asserting, Basics, Convert, IO, LichenDataStructure, LichenOps, LichenTransforms, LichenTransformsPrivate, Rope;

LichenNestArrays: CEDAR PROGRAM
IMPORTS IO, LichenDataStructure, LichenOps
EXPORTS LichenOps

= BEGIN OPEN LichenDataStructure, LichenOps, LichenTransforms, LichenTransformsPrivate;

XForm: TYPE = RECORD [
mirror: ARRAY Dim OF BOOL,
shift: ArrayIndex,
variant: SELECT transpose: BOOL FROM
FALSE, TRUE => [],
ENDCASE
] _ [[FALSE, FALSE], [0, 0], FALSE[]];

SimpleXForm: TYPE = XForm[FALSE];

id: SimpleXForm = [[FALSE, FALSE], [0, 0], FALSE[]];

NestCellTypes: PROC [outer: CellType] RETURNS [results: Results] = {
oa: Array _ outer.asArray;
inner: CellType;
ia, nested: Array;
IF oa = NIL THEN RETURN;
inner _ oa.eltType;
ia _ inner.asArray;
IF ia = NIL THEN RETURN;
[nested, results] _ NestArrays[oa, ia];
IF nested # NIL THEN outer.asArray _ nested;
};

NestArrays: PROC [outer, inner: Array] RETURNS [nested: Array, results: Results] = {
Try: PROC [t0: XForm] RETURNS [success: BOOL] = {
ia: Array _ Apply[t0, inner];
r: Result _ TryToNest[outer, ia];
results[t0.mirror[Foo]][t0.mirror[Bar]][t0.transpose] _ r;
IF (success _ r.code = $success) THEN nested _ ia;
};
innerSize: ArrayIndex = [
Foo: inner.shape[Foo].maxPlusOne - inner.shape[Foo].min,
Bar: inner.shape[Bar].maxPlusOne - inner.shape[Bar].min];
s00: ArrayIndex = [
Foo: outer.shape[Foo].min * innerSize[Foo],
Bar: outer.shape[Bar].min * innerSize[Bar]];
s01: ArrayIndex = [Foo: s00[Bar], Bar: s00[Foo]];
FOR mf0: BOOL IN BOOL DO FOR mb0: BOOL IN BOOL DO
IF Try[[[mf0, mb0], s00, FALSE[]]] THEN RETURN;
IF Try[[[mf0, mb0], s01, TRUE[]]] THEN RETURN;
ENDLOOP ENDLOOP;
nested _ NIL;
};

Results: TYPE = ARRAY BOOL--mf-- OF ARRAY BOOL--mb-- OF ARRAY BOOL--t-- OF Result _ ALL[ALL[ALL[nyet]]];

Result: TYPE = RECORD [code: ATOM, explanation: ROPE];

ok: Result = [$success, "success"];
nyet: Result = [$notYet, "notYet"];

TryToNest: PROC [outer, inner: Array] RETURNS [result: Result] = {
outerSize: ArrayIndex = [
Foo: outer.shape[Foo].maxPlusOne - outer.shape[Foo].min,
Bar: outer.shape[Bar].maxPlusOne - outer.shape[Bar].min];
innerSize: ArrayIndex = [
Foo: inner.shape[Foo].maxPlusOne - inner.shape[Foo].min,
Bar: inner.shape[Bar].maxPlusOne - inner.shape[Bar].min];
FOR d: Dim IN Dim DO FOR perp: EO IN EO DO FOR parl: EO IN EO DO
od: Dim = OtherDim[d];
oj: Joint _ outer.joints[d][perp][parl];
derive: BOOL _ FALSE;
EnumerateRelevantMinorJoints: PROC
[PerJoint: PROC [mD: Dim, mPerp, mParl: EO, iLow, iHigh: ArrayIndex] RETURNS [r: Result]]
RETURNS [r: Result] = {
i: ArrayIndex _ [Foo: inner.shape[Foo].min, Bar: inner.shape[Bar].min];
nPar: INT _ SELECT parl FROM Odd => 1, Even => 2, ENDCASE => ERROR;
nPer: INT _ innerSize[od];
r _ ok;
i[d] _ i[d] + nPar * innerSize[d];
THROUGH [0 .. nPer) DO
iLow: ArrayIndex _ i;
iLow[d] _ iLow[d] - 1;
r _ PerJoint[mD: d, mPerp: EOOfInt[i[od]], mParl: EOOfInt[i[d]], iLow: iLow, iHigh: i];
IF r.code # $success THEN RETURN;
i[od] _ i[od] + 1;
ENDLOOP;
r _ r;
};
EnumerateConnectionsFromMajor: PROC
[PerConnection: PROC [lopi, hopi: PortIndex, lowRange, highRange: SideConnection] RETURNS [r: Result]]
RETURNS [r: Result] = {
r _ ok;
FOR lopi: PortIndex IN [0 .. oj.eltPorts) DO
hopi: PortIndex _ oj[lopi].high;
IF hopi = NullPortIndex THEN LOOP;
r _ PerConnection[
lopi: lopi, hopi: hopi,
lowRange: inner.portConnections[lopi][high][d],
highRange: inner.portConnections[hopi][low][d]];
IF r.code # $success THEN RETURN;
ENDLOOP;
};
InnerJointsDefined: PROC RETURNS [defined: BOOL] = {
someDefined: BOOL _ FALSE;
allDefined: BOOL _ TRUE;
PerJoint: PROC [mD: Dim, mPerp, mParl: EO, iLow, iHigh: ArrayIndex] RETURNS [r: Result] = {
r _ ok;
IF inner.joints[mD][mPerp][mParl] # NIL
THEN someDefined _ TRUE
ELSE {allDefined _ FALSE; inner.joints[mD][mPerp][mParl] _ NewJoint[]}
};
NewJoint: PROC RETURNS [j: Joint] = {
j _ NEW [JointSeq[inner.eltType.ports.length]];
FOR pi: PortIndex IN [0 .. j.eltPorts) DO
j[pi] _ [NullPortIndex, NullPortIndex];
ENDLOOP;
};
[] _ EnumerateRelevantMinorJoints[PerJoint];
IF someDefined # allDefined THEN ERROR;
defined _ someDefined;
};
MinorsFromMajor: PROC RETURNS [result: Result] = {
PerConnection: PROC [lopi, hopi: PortIndex, lowRange, highRange: SideConnection] RETURNS [r: Result] = {
EnumerateOverlap: PROC
[PerPair: PROC [low, high: ArraySocket] RETURNS [r: Result]]
RETURNS [r: Result] = {
min: INT _ MAX[lowRange.range.min, highRange.range.min];
maxPlusOne: INT _ MIN[lowRange.range.maxPlusOne, highRange.range.maxPlusOne];
Burn: PROC [sc: SideConnection] RETURNS [asl: ArraySocketList] = {
asl _ sc.sockets;
THROUGH [sc.range.min .. min) DO asl _ asl.rest ENDLOOP;
};
lsl, hsl: ArraySocketList;
r _ ok;
IF min >= maxPlusOne THEN RETURN [[
$subtlyWrong,
IO.PutFR["no inner overlap in outer connection %g",
IO.rope[DescribeConnection[outer.eltType, lopi, hopi, d, perp, parl]]
]
]];
lsl _ Burn[lowRange];
hsl _ Burn[highRange];
WHILE min < maxPlusOne DO
r _ PerPair[lsl.first, hsl.first];
IF r.code # $success THEN RETURN;
lsl _ lsl.rest;
hsl _ hsl.rest;
min _ min + 1;
ENDLOOP;
};
PerPair: PROC [low, high: ArraySocket] RETURNS [r: Result] = {
j: Joint;
mPerp, mParl: EO;
[j, mPerp, mParl] _ ArrayJoint[inner, high.ai, d];
SELECT derive FROM
FALSE => {
IF j[low.pi].high # high.pi THEN RETURN [[
$subtlyWrong,
IO.PutFR["outer connection %g missing in inner joint %g",
IO.rope[DescribeConnection[outer.eltType, lopi, hopi, d, perp, parl]],
IO.rope[DescribeJointDetails[d, mPerp, mParl]]
]
]];
};
TRUE => {
j[low.pi].high _ high.pi; j[high.pi].low _ low.pi;
};
ENDCASE => ERROR;
r _ ok;
};
r _ EnumerateOverlap[PerPair];
};
result _ EnumerateConnectionsFromMajor[PerConnection];
};
CheckMinorsInMajor: PROC RETURNS [result: Result] = {
PerJoint: PROC [mD: Dim, mPerp, mParl: EO, iLow, iHigh: ArrayIndex] RETURNS [r: Result] = {
j: Joint _ inner.joints[mD][mPerp][mParl];
r _ ok;
FOR lipi: PortIndex--on inner elts-- IN [0 .. j.eltPorts) DO
hipi: PortIndex _ j[lopi].high;
lopi, hopi: PortIndex--on inner array--;
IF hipi = NullPortIndex THEN LOOP;
lopi _ GetArrayPort[inner, iLow, lipi];
hopi _ GetArrayPort[inner, iHigh, hipi];
IF oj[lopi].high # hopi THEN RETURN [[
$subtlyWrong,
IO.PutFR["inner connection %g missing in outer joint %g",
IO.rope[DescribeConnection[inner.eltType, lipi, hipi, mD, mPerp, mParl]],
IO.rope[DescribeJointDetails[d, perp, parl]]
]
]];
ENDLOOP;
};
result _ EnumerateRelevantMinorJoints[PerJoint];
};
IF oj = NIL THEN LOOP;
derive _ NOT InnerJointsDefined[];
result _ MinorsFromMajor[];
IF result.code # $success THEN RETURN;
result _ CheckMinorsInMajor[];
IF result.code # $success THEN RETURN;
ENDLOOP ENDLOOP ENDLOOP;
{
nested: Array = NEW [ArrayRep[inner.eltType.ports.length]];
SCUnion: PROC [sc: SideConnection, tail: ArraySocketList, oai: ArrayIndex, isc: SideConnection, od: Dim] RETURNS [usc: SideConnection, uTail: ArraySocketList] = {
Di: ArrayIndex = [Foo: innerSize[Foo]*oai[Foo], Bar: innerSize[Bar]*oai[Bar]];
usc _ sc;
uTail _ tail;
isc.range _ [
min: isc.range.min + Di[od],
maxPlusOne: isc.range.maxPlusOne + Di[od]];
IF usc.range.min = usc.range.maxPlusOne
THEN {
usc.range _ isc.range;
}
ELSE {
IF usc.range.maxPlusOne # isc.range.min THEN ERROR;
usc.range.maxPlusOne _ isc.range.maxPlusOne;
};
WHILE isc.sockets # NIL DO
this: ArraySocketList _ LIST[isc.sockets.first];
this.first.ai[Foo] _ this.first.ai[Foo] + Di[Foo];
this.first.ai[Bar] _ this.first.ai[Bar] + Di[Bar];
IF uTail = NIL THEN usc.sockets _ this ELSE uTail.rest _ this;
uTail _ this;
isc.sockets _ isc.sockets.rest;
ENDLOOP;
};
nested.eltType _ inner.eltType;
nested.shape _ [
Foo: [
min: inner.shape[Foo].min,
maxPlusOne: inner.shape[Foo].min + innerSize[Foo]*outerSize[Foo]],
Bar: [
min: inner.shape[Bar].min,
maxPlusOne: inner.shape[Bar].min + innerSize[Bar]*outerSize[Bar]]
];
nested.joints _ inner.joints;
nested.portConnections _ NEW [ArrayPortConnectionSeq[outer.portConnections.arrayPorts]];
FOR epi: PortIndex IN [0 .. nested.eltType.ports.length) DO
Check: PROC [f, b: INT] = {
oi: ArrayIndex = [
Foo: (f-nested.shape[Foo].min)/innerSize[Foo]+outer.shape[Foo].min,
Bar: (b-nested.shape[Bar].min)/innerSize[Bar]+outer.shape[Bar].min
];
ii: ArrayIndex = [Foo: f - oi[Foo]*innerSize[Foo], Bar: b - oi[Bar]*innerSize[Bar]];
mpi: PortIndex _ GetArrayPort[inner, ii, epi];
IF mpi # NullPortIndex THEN {
api: PortIndex _ GetArrayPort[outer, oi, mpi];
IF api # NullPortIndex THEN {
IF nested.porting[epi] = notPorted THEN nested.porting[epi] _ NewDetailedPorting[nested.shape];
SetArrayPort[nested, [f, b], epi, api];
};
};
};
nested.porting[epi] _ notPorted;
IF inner.porting[epi] # notPorted THEN {
Check[nested.shape[Foo].min, nested.shape[Bar].min];
Check[nested.shape[Foo].min, nested.shape[Bar].maxPlusOne-1];
Check[nested.shape[Foo].maxPlusOne-1, nested.shape[Bar].min];
Check[nested.shape[Foo].maxPlusOne-1, nested.shape[Bar].maxPlusOne-1];
FOR e: End IN End DO FOR d: Dim IN Dim DO
od: Dim = OtherDim[d];
FOR i: INT IN [nested.shape[od].min .. nested.shape[od].maxPlusOne) DO
index: ArrayIndex _ ALL[0];
index[d] _ SELECT e FROM low => nested.shape[d].min, high => nested.shape[d].maxPlusOne-1, ENDCASE => ERROR;
index[od] _ i;
Check[index[Foo], index[Bar]];
ENDLOOP;
ENDLOOP ENDLOOP;
};
ENDLOOP;
FOR opi: PortIndex IN [0 .. outer.portConnections.arrayPorts) DO
FOR e: End IN End DO FOR d: Dim IN Dim DO
sc: SideConnection _ [[0, 0], NIL];
tail: ArraySocketList _ NIL;
FOR oasl: ArraySocketList _ outer.portConnections[opi][e][d].sockets, oasl.rest WHILE oasl # NIL DO
[sc, tail] _ SCUnion[sc, tail, oasl.first.ai, inner.portConnections[oasl.first.pi][e][d], OtherDim[d]];
ENDLOOP;
nested.portConnections[opi][e][d] _ sc;
ENDLOOP ENDLOOP;
ENDLOOP;
};
};

ArrayJoint: PROC [a: Array, index: ArrayIndex, d: Dim] RETURNS [j: Joint, perp, parl: EO] = {
perp _ EOOfInt[index[OtherDim[d]]];
parl _ EOOfInt[index[d]];
j _ a.joints[d][perp][parl]};

GetArrayPort: PUBLIC PROC [a: Array, index: ArrayIndex, eltPortIndex: PortIndex] RETURNS [arrayPortIndex: PortIndex] = {
Get: PROC [ppi: PortIndexPtr] = TRUSTED {arrayPortIndex _ IF ppi # NIL THEN ppi^ ELSE NullPortIndex};
ForArrayPort[a, index, eltPortIndex, Get]};

SetArrayPort: PROC [a: Array, index: ArrayIndex, eltPortIndex, arrayPortIndex: PortIndex] = {
Set: PROC [ppi: PortIndexPtr] = TRUSTED {IF ppi # NIL THEN ppi^ _ arrayPortIndex ELSE ERROR};
ForArrayPort[a, index, eltPortIndex, Set]};

PortIndexPtr: TYPE = LONG POINTER TO PortIndex;

ForArrayPort: PROC [a: Array, index: ArrayIndex, eltPortIndex: PortIndex, p: PROC [ppi: PortIndexPtr]] = TRUSTED {
SELECT a.porting[eltPortIndex] FROM
notPorted => p[NIL];
unknownPorting => ERROR;
ENDCASE => {dp: DetailedPorting _ NARROW[a.porting[eltPortIndex]];
For: PROC [si: SideIndex, offset: NAT] = TRUSTED {
s: NAT _ si.firstSlot;
IF NOT si.same THEN s _ s + offset;
p[@dp.slots[s]]};
wF: Where = WhereIs[index[Foo], a.shape[Foo]];
wB: Where = WhereIs[index[Bar], a.shape[Bar]];
WITH f: wF SELECT FROM
end => WITH b: wB SELECT FROM
end => p[@dp.corners[f.end][b.end]];
center => For[dp.sideIndices[f.end][Bar], b.offset];
ENDCASE => ERROR;
center => WITH b: wB SELECT FROM
end => For[dp.sideIndices[b.end][Foo], f.offset];
center => ERROR;
ENDCASE => ERROR;
ENDCASE => ERROR;
};
};

Where: TYPE = RECORD [
variant: SELECT kind: * FROM
end => [end: End],
center => [offset: NAT],
ENDCASE];

WhereIs: PROC [i: INT, r: Range] RETURNS [w: Where] = {
i _ r.min + ((i - r.min) MOD (r.maxPlusOne - r.min));
SELECT TRUE FROM
i = r.min => RETURN [[end[low]]];
i+1 = r.maxPlusOne => RETURN [[end[high]]];
ENDCASE => RETURN [[center[i - (r.min+1)]]];
};

Apply: PROC [x: XForm, a: Array] RETURNS [xa: Array] = {
xa _ CopyArray[a];
FOR d: Dim IN Dim DO IF x.mirror[d] THEN Mirror[xa, d] ENDLOOP;
Shift[xa, x.shift];
IF x.transpose THEN Transpose[xa];
};

Mirror: PROC [a: Array, d: Dim] = {
od: Dim _ OtherDim[d];
parlSize: INT _ a.shape[d].maxPlusOne - a.shape[d].min;
parlEO: EO _ EOOfInt[parlSize];
MirrorIndex: PROC [i: INT] RETURNS [j: INT] =
{j _ a.shape[d].maxPlusOne-1 - (i - a.shape[d].min)};
MirrorJoint: PROC [j: Joint] RETURNS [k: Joint] = {
IF j = NIL THEN RETURN [j];
k _ NEW [JointSeq[j.eltPorts]];
FOR pi: PortIndex IN [0 .. j.eltPorts) DO
k[pi] _ [low: j[pi].high, high: j[pi].low];
ENDLOOP;
};
FOR jd: Dim IN Dim DO FOR eo: EO IN EO DO
perp2: EO _ eo;
parl2: EO _ eo;
MirrorParl: PROC [eo: EO] RETURNS [meo: EO] = {
meo _ SELECT parlEO FROM Even => eo, Odd => OtherEO[eo], ENDCASE => ERROR;
};
MirrorPerp: PROC [eo: EO] RETURNS [meo: EO] = {
meo _ SELECT parlEO FROM Even => OtherEO[eo], Odd => eo, ENDCASE => ERROR;
};
SELECT jd FROM
 d => parl2 _ MirrorParl[eo];
od => perp2 _ MirrorPerp[eo];
ENDCASE => ERROR;
[a.joints[jd][eo][eo], a.joints[jd][perp2][parl2]] _ JSwap[a.joints[jd][eo][eo], a.joints[jd][perp2][parl2]];
ENDLOOP ENDLOOP;
FOR perp: EO IN EO DO FOR parl: EO IN EO DO
a.joints[d][perp][parl] _ MirrorJoint[a.joints[d][perp][parl]];
ENDLOOP ENDLOOP;
FOR api: PortIndex IN [0 .. a.portConnections.arrayPorts) DO
MirrorSC: PROC [sc: SideConnection] RETURNS [msc: SideConnection] = {
msc.range.min _ MirrorIndex[sc.range.maxPlusOne-1];
msc.range.maxPlusOne _ MirrorIndex[sc.range.min]+1;
msc.sockets _ NIL;
WHILE sc.sockets # NIL DO
msc.sockets _ CONS[sc.sockets.first, msc.sockets];
msc.sockets.first.ai[d] _ MirrorIndex[msc.sockets.first.ai[d]];
sc.sockets _ sc.sockets.rest;
ENDLOOP;
};
tsc: SideConnection _ a.portConnections[api][low][d];
a.portConnections[api][low][d] _ a.portConnections[api][high][d];
a.portConnections[api][high][d] _ tsc;
a.portConnections[api][low][od] _ MirrorSC[a.portConnections[api][low][od]];
a.portConnections[api][high][od] _ MirrorSC[a.portConnections[api][high][od]];
ENDLOOP;
FOR epi: PortIndex IN [0 .. a.eltType.ports.length) DO
SELECT a.porting[epi] FROM
notPorted => NULL;
unknownPorting => NULL;
ENDCASE => {dp: DetailedPorting _ NARROW[a.porting[epi]];
MirrorSI: PROC [si: SideIndex] = {
s0: INT _ si.firstSlot;
sf: INT _ s0 + parlSize - 3;
IF si.same THEN RETURN;
FOR i: INT IN [0 .. parlSize/2 - 1) DO
[dp.slots[s0+i], dp.slots[sf-i]] _ PISwap[dp.slots[s0+i], dp.slots[sf-i]];
ENDLOOP;
};
FOR e: End IN End DO
ef: End _ e;
eb: End _ e;
SELECT d FROM
Foo => ef _ OtherEnd[e];
Bar => eb _ OtherEnd[e];
ENDCASE => ERROR;
[dp.corners[e][e], dp.corners[ef][eb]] _ PISwap[dp.corners[e][e], dp.corners[ef][eb]];
[dp.sideIndices[low][d], dp.sideIndices[high][d]] _ SISwap[dp.sideIndices[low][d], dp.sideIndices[high][d]];
MirrorSI[dp.sideIndices[low][od]];
MirrorSI[dp.sideIndices[high][od]];
ENDLOOP;
};
ENDLOOP;
};

JSwap: PROC [a, b: Joint] RETURNS [c, d: Joint] = {c _ b; d _ a};
SISwap: PROC [a, b: SideIndex] RETURNS [c, d: SideIndex] = {c _ b; d _ a};
PISwap: PROC [a, b: PortIndex] RETURNS [c, d: PortIndex] = {c _ b; d _ a};

OffsetRange: PROC [r: Range, Di: INT] RETURNS [s: Range] =
{s _ [min: r.min + Di, maxPlusOne: r.maxPlusOne + Di]};

Shift: PROC [a: Array, Di: ArrayIndex] = {
eos: ARRAY Dim OF EO = [Foo: EOOfInt[Di[Foo]], Bar: EOOfInt[Di[Bar]]];
a.shape[Foo] _ OffsetRange[a.shape[Foo], Di[Foo]];
a.shape[Bar] _ OffsetRange[a.shape[Bar], Di[Bar]];
FOR d: Dim IN Dim DO FOR eo: EO IN EO DO
od: Dim = OtherDim[d];
IF eos[od] = Odd THEN [a.joints[d][Even][eo], a.joints[d][Odd][eo]] _ JSwap[a.joints[d][Even][eo], a.joints[d][Odd][eo]];
ENDLOOP ENDLOOP;
FOR d: Dim IN Dim DO FOR eo: EO IN EO DO
od: Dim = OtherDim[d];
IF eos[d] = Odd THEN [a.joints[d][eo][Even], a.joints[d][eo][Odd]] _ JSwap[a.joints[d][eo][Even], a.joints[d][eo][Odd]];
ENDLOOP ENDLOOP;
FOR api: PortIndex IN [0 .. a.portConnections.arrayPorts) DO
FOR e: End IN End DO FOR d: Dim IN Dim DO
od: Dim = OtherDim[d];
a.portConnections[api][e][d].range _ OffsetRange[a.portConnections[api][e][d].range, Di[od]];
FOR asl: ArraySocketList _ a.portConnections[api][e][d].sockets, asl.rest WHILE asl # NIL DO
asl.first.ai[Foo] _ asl.first.ai[Foo] + Di[Foo];
asl.first.ai[Bar] _ asl.first.ai[Bar] + Di[Bar];
ENDLOOP;
ENDLOOP ENDLOOP;
ENDLOOP;
};

Transpose: PROC [a: Array] = {
r: Range _ a.shape[Foo];
js: ARRAY EO OF ARRAY EO OF Joint _ a.joints[Foo];
a.shape[Foo] _ a.shape[Bar];
a.shape[Bar] _ r;
a.joints[Foo] _ a.joints[Bar];
a.joints[Bar] _ js;
FOR api: PortIndex IN [0 .. a.portConnections.arrayPorts) DO
SCSwapAndTranspose: PROC [a, b: SideConnection] RETURNS [c, d: SideConnection] = {
SCTranspose: PROC [sc: SideConnection] = {
FOR asl: ArraySocketList _ sc.sockets, asl.rest WHILE asl # NIL DO
asl.first.ai _ TransposeIndex[asl.first.ai];
ENDLOOP;
};
SCTranspose[d _ a];
SCTranspose[c _ b];
};
FOR e: End IN End DO
[a.portConnections[api][e][Foo], a.portConnections[api][e][Bar]] _ SCSwapAndTranspose[a.portConnections[api][e][Foo], a.portConnections[api][e][Bar]];
ENDLOOP;
ENDLOOP;
FOR epi: PortIndex IN [0 .. a.eltType.ports.length) DO
SELECT a.porting[epi] FROM
notPorted => NULL;
unknownPorting => NULL;
ENDCASE => {dp: DetailedPorting _ NARROW[a.porting[epi]];
[dp.corners[low][high], dp.corners[high][low]] _ PISwap[dp.corners[low][high], dp.corners[high][low]];
FOR e: End IN End DO
[dp.sideIndices[e][Foo], dp.sideIndices[e][Bar]] _ SISwap[dp.sideIndices[e][Foo], dp.sideIndices[e][Bar]];
ENDLOOP;
};
ENDLOOP;
};

TransposeIndex: PROC [ai: ArrayIndex] RETURNS [tai: ArrayIndex] =
{tai _ [Foo: ai[Bar], Bar: ai[Foo]]};

CopyArray: PROC [a: Array] RETURNS [xa: Array] = {
xa _ NEW [ArrayRep[a.eltPorts]];
xa.eltType _ a.eltType;
xa.shape _ a.shape;
FOR d: Dim IN Dim DO FOR eo1: EO IN EO DO FOR eo2: EO IN EO DO
xa.joints[d][eo1][eo2] _ CopyJoint[a.joints[d][eo1][eo2]];
ENDLOOP ENDLOOP ENDLOOP;
FOR pi: PortIndex IN [0 .. a.eltType.ports.length) DO
xa.porting[pi] _ CopyPorting[a.porting[pi]];
ENDLOOP;
xa.portConnections _ NEW [ArrayPortConnectionSeq[a.portConnections.arrayPorts]];
FOR api: PortIndex IN [0 .. xa.portConnections.arrayPorts) DO
FOR e: End IN End DO FOR d: Dim IN Dim DO
xa.portConnections[api][e][d] _ CopySideConnection[a.portConnections[api][e][d]];
ENDLOOP ENDLOOP;
ENDLOOP;
};

CopySideConnection: PROC [sc: SideConnection] RETURNS [csc: SideConnection] = {
last: ArraySocketList _ NIL;
csc _ sc;
WHILE sc.sockets # NIL DO
this: ArraySocketList _ LIST[sc.sockets.first];
IF last = NIL THEN csc.sockets _ this ELSE last.rest _ this;
last _ this;
sc.sockets _ sc.sockets.rest;
ENDLOOP;
};

CopyJoint: PROC [j: Joint] RETURNS [k: Joint] = {
IF j = NIL THEN RETURN [NIL];
k _ NEW [JointSeq[j.eltPorts]];
FOR pi: PortIndex IN [0 .. j.eltPorts) DO
k[pi] _ j[pi];
ENDLOOP;
};

CopyPorting: PROC [p: Porting] RETURNS [q: Porting] = {
dp, dq: DetailedPorting;
IF p = notPorted OR p = unknownPorting THEN RETURN [p];
dp _ NARROW[p];
q _ dq _ NEW [DetailedPortingRep[dp.length]];
dq.corners _ dp.corners;
dq.sideIndices _ dp.sideIndices;
FOR s: NAT IN [0 .. dp.length) DO dq.slots[s] _ dp.slots[s] ENDLOOP;
};

DescribeConnection: PROC [eltType: CellType, lpi, hpi: PortIndex, d: Dim, perp, parl: EO] RETURNS [r: ROPE] =
{r _ IO.PutFR["%g - %g across [%g, %g, %g]",
IO.refAny[PickAName[eltType.ports[lpi].names]],
IO.refAny[PickAName[eltType.ports[hpi].names]],
IO.rope[DimName[d]],
IO.rope[EOName[perp]],
IO.rope[EOName[parl]]]};

DescribeJointDetails: PROC [d: Dim, perp, parl: EO] RETURNS [r: ROPE] =
{r _ IO.PutFR["[%g, %g, %g]", IO.rope[DimName[d]], IO.rope[EOName[perp]], IO.rope[EOName[parl]]]};

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];

END.

DLichenNestArrays.Mesa
Last Edited by: Spreitzer, July 11, 1985 9:01:03 pm PDT
Array theorems:
TA1: Each connection across a boundary involves one port from each of an uninterrupted range of elements on either side, with some overlap, and each pairing in that overlap is represented in the joints.

Now we make nested
Κθ–

"cedar" style˜Icode™J™7K˜KšΟk	œœR˜zK˜šΠbxœœ
˜Kšœ
œ ˜*Kšœ
˜K˜Kšœœ
œK˜WK˜™K™Κ
—K™šœœœ˜Kšœœœ
œ
˜Kš
œ˜šœ	œœ
˜$Kšœœ˜Kš
˜—Kšœœœœ˜&—K˜Kšœ
œ	œ˜!K˜Kšœœœœ˜4K˜šΟn
œœœ˜DK˜K˜K˜Kšœœ
œ
œ
˜K˜K˜Kšœœ
œ
œ
˜Kš
œ'˜'Kšœ
œ
œ˜,K˜—K˜šŸ
œœœ&˜TšŸœœ
œœ˜1K˜Kš
œ!˜!Kš
œ:˜:Kšœœ
˜2K˜—š
œ˜Kš
œ8˜8Kš
œ9˜9—š
œ˜K˜+K˜,—Kš
œ1˜1šœœ
œ
œ
œ
œœ
œ
œ
˜1Kšœœœ
œ
˜/Kšœœœ
œ
˜.Kšœ
œ
˜—Kšœ	œ
˜
K˜—K˜Kšœ	œœ
Οcœ
œ
œ
 œ
œ
œ
 œ
œ
œ
œ
œ	˜hK˜Kš	œœœœœ˜6K˜K˜#Kš
œ#˜#K˜šŸ	œœœ˜Bš
œ˜Kš
œ8˜8Kš
œ9˜9—š
œ˜Kš
œ8˜8Kš
œ9˜9—šœœœ
œœ
œ
œ
œ
œœ
œ
œ
˜@K˜K˜(Kšœœœ
˜šŸœ˜"Kš	œ
Ÿœœœœ
˜YKšœ˜Kš
œG˜GKšœœœœœœ
˜CKšœœ˜K˜K˜"šœ
˜Kš
œ˜K˜K˜WKšœœ
œ
˜!K˜Kšœ
˜—K˜K˜—šŸœ˜#Kšœ
Ÿ
œœ>œ
˜fKšœ˜K˜šœœ˜,K˜ Kšœœ
œ
˜"š
œ˜K˜Kš
œ/˜/Kš
œ0˜0—Kšœœ
œ
˜!Kšœ
˜—K˜—šŸœœ
œœ˜4Kšœ
œœ
˜Kšœœœ
˜šŸœœœœ˜[K˜šœ"˜'Kšœ˜Kšœœ.˜F—K˜—šŸœœ
œ˜%Kšœœ(˜/šœœ˜)K˜'Kšœ
˜—K˜—Kš
œ,˜,Kšœœ
œ
˜'Kš
œ˜K˜—šŸœœ
œ˜2šŸ
œœ>œ˜hšŸœ˜Kšœ
Ÿœœœ
˜<Kšœ˜Kšœœœ*˜8Kšœœœ8˜MšŸœœœ˜BK˜Kšœœœ
˜8K˜—K˜K˜šœœ
œ˜#Kš
œ
˜
šœ1˜3KšœC˜EK˜
—Kš
œ˜—Kš
œ˜Kš
œ˜šœ˜K˜"Kšœœ
œ
˜!K˜K˜K˜Kšœ
˜—K˜—šŸœœœ˜>Kš
œ	˜	Kšœœ
˜Kš
œ2˜2šœ˜šœ˜
šœœ
œ˜*Kš
œ
˜
šœ7˜9KšœD˜FKšœ,˜.K˜
—Kš
œ˜—K˜—šœ˜	K˜2K˜—Kšœœ
˜—K˜K˜—K˜K˜—Kš
œ6˜6K˜—šŸœœ
œ˜5šŸœœœœ˜[K˜*K˜šœ œ
œ˜<Kš
œ˜Kšœ œ
˜(Kšœœ
œ
˜"Kš
œ'˜'Kš
œ(˜(šœœ
œ˜&Kš
œ
˜
šœ7˜9Kš
œI˜IKšœ*˜,K˜
—Kš
œ˜—Kšœ
˜—K˜—Kš
œ0˜0K˜—Kšœœ
œ
œ
˜Kšœ	œ˜"Kš
œ˜Kšœœ
œ
˜&Kš
œ˜Kšœœ
œ
˜&Kšœ
œ
œ
˜—™K˜
Kšœœ(˜;šŸœœ\œ2˜’
KšΟg
œM˜NK˜	K˜
š
œ
˜
Kšœ‘
œ˜Kšœ#‘
œ˜+—šœ%˜'šœ˜K˜K˜
—šœ˜Kšœ&œ
œ
˜3Kš
œ,˜,K˜——šœœ
˜Kšœœ˜0Kšœ*‘
œ˜2Kšœ*‘
œ˜2Kšœ	œ
œœ˜>Kš
œ
˜
Kš
œ˜Kšœ
˜—K˜—K˜˜˜K˜K˜B—˜K˜K˜A—K˜—K˜Kšœœ<˜Xšœœ$˜;šŸœœœ˜š
œ˜Kš
œC˜CKš
œB˜BKš
œ˜—K˜TK˜.šœœ˜K˜.šœœ˜Kšœ!œ8˜_K˜'K˜—K˜—K˜—Kš
œ ˜ šœ œ˜(K˜4Kš
œ=˜=Kš
œ=˜=Kš
œF˜Fšœœœ
œœ˜)K˜šœœ
œ7˜FKšœœ˜Kš	œœœCœœ
˜lK˜K˜Kšœ
˜—Kšœ
œ
˜—K˜—Kšœ
˜—šœœ)˜@šœœœ
œœ˜)Kšœœ˜#Kšœœ
˜šœMœœ
˜cK˜gKšœ
˜—Kš
œ'˜'Kšœ
œ
˜—Kšœ
˜—K˜—K˜—K˜šŸ
œœ'œœ˜]K˜#K˜K˜—K˜šŸœœ
œ8œ ˜xKšŸœœœœœ
œœ˜eKš
œ+˜+—K˜šŸœœK˜]KšŸœœœœœ
œœ
œ˜]Kš
œ+˜+—K˜Kš	œœœ
œ
œ˜/K˜šŸœœ;œœ˜ršœ˜#Kšœœ˜Kšœœ
˜šœœ˜BšŸœœœœ˜2Kšœœ˜Kšœ
œ	œ˜#K˜—K˜.K˜.šœœ
˜šœœœ
˜Kš
œ$˜$Kš
œ4˜4Kšœœ
˜—šœ
œœ
˜ Kš
œ1˜1Kšœ
œ
˜Kšœœ
˜—Kšœœ
˜—K˜——K˜—K˜šœœœ˜šœ	œ	˜K˜Kšœœ˜Kšœ˜	——K˜šŸœœœœ˜7Kšœœ˜5šœ
œ
˜Kšœ
œ˜!Kšœœ˜+Kšœœ˜,—K˜—K˜šŸœœœ˜8Kš
œ˜Kšœœœ
œ
œœ
˜?K˜Kšœ
œ˜"Kš
œ˜—K˜šŸœœ˜#K˜Kšœ
œ*˜7Kšœœ˜š
Ÿœœœœœ˜-K˜5—šŸœœœ˜3Kšœœ
œ
œ˜Kšœœ˜šœœ˜)K˜+Kšœ
˜—K˜—šœ	œœ
œœ
œ
œ
˜)Kšœœ˜Kšœœ˜š
Ÿ
œœœœœ˜/Kš	œœœ!œœ
˜JK˜—š
Ÿ
œœœœœ˜/Kš	œœœ!œœ
˜JK˜—šœ˜Kš
œ˜Kš
œ˜Kšœœ
˜—K˜mKšœ
œ
˜—šœœ
œ
œ
œ
œœ
œ
œ
˜+Kš
œ?˜?Kšœ
œ
˜—šœœ%˜<šŸœœœ˜EK˜3K˜3Kšœœ
˜šœœ
˜Kšœœ ˜2K˜?Kš
œ˜Kšœ
˜—K˜—Kš
œ5˜5Kš
œA˜AKš
œ&˜&Kš
œL˜LKš
œN˜NKšœ
˜—šœœ˜6šœ˜Kšœ
œ
˜Kšœœ
˜šœœ˜9šŸœœ˜"Kšœœ˜Kšœœ˜Kšœ	œ
œ
˜šœœ
œ˜&Kš
œJ˜JKšœ
˜—K˜—šœœ˜K˜K˜šœ˜
K˜K˜Kšœœ
˜—K˜VK˜lK˜"K˜#Kšœ
˜—K˜——Kšœ
˜—K˜—K˜KšŸœœœ ˜AKšŸœœœ$˜JKšŸœœœ$˜JK˜š
Ÿœœ‘
œœœ
˜:Kšœ‘
œ‘
œ˜7—K˜šŸœœ‘
œ˜*Kšœœœ
œ‘
œ‘
œ	˜FKšœ)‘
œ˜2Kšœ)‘
œ˜2šœœœ
œœ
œ
œ
˜(K˜Kšœœd˜yKšœ
œ
˜—šœœœ
œœ
œ
œ
˜(K˜Kšœœd˜xKšœ
œ
˜—šœœ%˜<šœœœ
œœ˜)K˜KšœU‘
œ˜]šœGœœ
˜\Kšœ(‘
œ˜0Kšœ(‘
œ˜0Kšœ
˜—Kšœ
œ
˜—Kšœ
˜—K˜—K˜šŸ	œœ˜K˜Kš
œœ
œ
œ
œ
œ
œ˜2K˜K˜K˜K˜šœœ%˜<šŸœœœ˜RšŸœœ˜*šœ-œœ
˜BK˜,Kšœ
˜—K˜—Kš
œ˜Kš
œ˜Kš
œ˜—šœœ˜Kš
œ–
˜–
Kšœ
˜—Kšœ
˜—šœœ˜6šœ˜Kšœ
œ
˜Kšœœ
˜šœœ˜9K˜fšœœ˜K˜jKšœ
˜—K˜——Kšœ
˜—K˜—K˜šŸœœœ˜AK˜%—K˜šŸ	œœœ˜2Kšœœ˜ K˜Kš
œ˜šœœœ
œœ
œ
œ
œ
œœ
œ
œ
˜>K˜:Kšœ
œ
œ
˜—šœœ˜5K˜,Kšœ
˜—Kšœœ8˜Pšœœ&˜=šœœœ
œœ˜)Kš
œQ˜QKšœ
œ
˜—Kšœ
˜—K˜—K˜šŸœœœ˜OKšœœ
˜K˜	šœœ
˜Kšœœ˜/Kšœœ
œœ˜<K˜K˜Kšœ
˜—K˜—K˜šŸ	œœœ˜1Kš
œœ
œ
œœ˜Kšœœ˜šœœ˜)K˜Kšœ
˜—K˜—K˜šŸœœœ˜7Kš
œ˜Kšœœœ
œ˜7Kšœœ˜Kšœ	œ!˜-K˜Kš
œ ˜ Kš
œœ
œœœ
˜DK˜—K˜š
Ÿœœ>œœœ˜mšœœ%˜,Kšœ-˜/Kšœ-˜/Kšœ˜Kšœ˜Kšœ˜——K˜š
Ÿœœœœœ˜GKš	œœœœœ˜b—K˜š
Ÿœœœœœ˜)Kšœœœœœœ˜A—K˜Kšœœ
œ
œ˜/K˜Kšœ
˜——…—K~cͺ