CompareNestArrays.Mesa
Last Edited by: Spreitzer, June 3, 1985 3:21:25 pm PDT
DIRECTORY Asserting, Basics, CompareDataStructure, CompareOps, CompareTransforms, CompareTransformsPrivate, Convert, IO, OrderedSymbolTableRef, Rope;
CompareNestArrays: CEDAR PROGRAM
IMPORTS CompareDataStructure, CompareOps, IO
EXPORTS CompareOps
= BEGIN OPEN CompareDataStructure, CompareOps, CompareTransforms, CompareTransformsPrivate;
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.
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: BOOLFALSE;
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: INTSELECT 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: BOOLFALSE;
allDefined: BOOLTRUE;
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: INTMAX[lowRange.range.min, highRange.range.min];
maxPlusOne: INTMIN[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;
Now we make nested
{
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.