LichenNewArrayImpl1.Mesa
Last tweaked by Mike Spreitzer on September 30, 1987 10:21:11 am PDT
DIRECTORY Collections, LichenArrayStuff, LichenDataStructure, PairCollections, Rope;
LichenNewArrayImpl1:
CEDAR
PROGRAM
IMPORTS Collections, LichenDataStructure, PairCollections
EXPORTS LichenArrayStuff
=
BEGIN OPEN LichenDataStructure, LichenArrayStuff, PairColls:PairCollections, Colls:Collections;
LNAT: TYPE ~ INT--actually [0 .. INT.LAST], but the compiler's too stupid--;
InclRange: TYPE ~ RECORD [min, max: INT];
Basis: TYPE ~ RECORD [order: NATURAL, vecs: ARRAY [0 .. 2) OF Int2];
CreateArrayRep:
PUBLIC
PROC [eltType: CellType, size, jointsPeriod: Size2, borders:
ARRAY Dim
OF
ARRAY End
OF
NAT]
RETURNS [Array] ~ {
nj: INT = jointsPeriod[Foo] * jointsPeriod[Bar];
gps: GroupingParmses = [
Foo: ComputeGroupingParms[size[Foo], jointsPeriod[Foo], borders[Foo]],
Bar: ComputeGroupingParms[size[Bar], jointsPeriod[Bar], borders[Bar]]];
middlea: Range2 = [gps[Foo].middle, gps[Bar].middle];
ngi: NAT = gps[Foo].sum * gps[Bar].sum;
a: Array =
NEW [ArrayPrivate ← [
eltType: eltType,
prevArray: NIL,
nextArray: NIL,
size: size,
jointsPeriod: jointsPeriod,
groupingParmses: gps,
wirePats: Colls.CreateHashSet[],
wirePatCxns: Colls.CreateHashSet[],
portUses: PairColls.CreateHashFn[invable: FALSE],
exports: PairColls.CreateHashFn[invable: FALSE]
]];
RETURN [a]};
ArrayEltPortsConnected:
PUBLIC
PROC [a: Array, ai1, ai2: ArrayIndex, ep1, ep2: Port]
RETURNS [
BOOL] ~ {
pat1: ArrayWirePattern ~ PatFromEPAndAI[a, ep1, ai1, FALSE];
pat2: ArrayWirePattern ~ PatFromEPAndAI[a, ep2, ai2, FALSE];
IF pat1.part=pat2.part
THEN {
IF pat1#pat2 THEN RETURN [FALSE];
RETURN [CanonizeShift[pat1, Int2Sub[ai1, ai2]] = [0, 0]];
};
ERROR nyet};
EnumerateConnectedPatterns:
PROC [a: Array, patA: ArrayWirePattern, shiftA: Shift,
Consume:
PROC [patB: ArrayWirePattern, shiftB: Shift]] ~ {
seen: Set--of ArrayWirePattern-- ~ Colls.CreateHashSet[];
Work:
PROC [patA: ArrayWirePattern, shiftA: Shift] ~ {
IF NOT seen.AddElt[patA] THEN RETURN;
Consume[patA, shiftA];
FOR pi: PartIndex
IN PartIndex
DO
IF pi#patA.partIndex
THEN {
cxn: ArrayWirePatternConnection ~ patA.cxns[pi];
b: BOOL ~ ComparePartIndices[patA.partIndex, pi]=less;
patB: ArrayWirePattern ~ cxn.pats[b];
s0: Shift ~ IF b THEN shiftA ELSE Int2Sub[shiftA, cxn.dShift];
IF NOT Int2InRange[s0, cxn.s0r] THEN LOOP;
ERROR nyet;
}ENDLOOP;
};
Work[patA, shiftA];
RETURN};
MakeArrayNewConnection:
PUBLIC
PROC [act: CellType, rangeA: Range2, delta: KingMove, epA, epB: Port, may:
BOOL]
RETURNS [connected:
BOOL] ~ {
a: Array ~ act.asArray;
rangeB: Range2 ~ Range2Off[rangeA, delta];
PerGiA:
PROC [part: ArrayPart, gi2: Nat2, gi:
NATURAL, air: Range2] ~ {
gi2A: Nat2 ~ gi2;
partA: ArrayPart ~ part;
patA: ArrayWirePattern ~ PatFromEPAndGI[a, epA, gi2, gi, TRUE];
locA: ArrayIndex ~ LocFromEPAndGI[patA, epA, gi2A];
PerGiB:
PROC [aiA, aiB: ArrayIndex, partB: ArrayPart, gi2B: Nat2, giB:
NATURAL] ~ {
patB: ArrayWirePattern ~ PatFromEPAndGI[a, epB, gi2B, giB, TRUE];
locB: ArrayIndex ~ LocFromEPAndGI[patB, epB, gi2B];
shiftA: Int2 ~ Int2Sub[aiA, locA];
shiftB: Int2 ~ Int2Sub[aiB, locB];
dShift: Int2 ~ Int2Sub[shiftB, shiftA];
IF partA#partB THEN {IF NOT MakePatConnection[a, patA, patB, locA, locB, Int2Sub[shiftB, shiftA], delta, may] THEN connected ← FALSE}
ELSE IF patA#patB THEN {IF may THEN JoinPats[a, patA, patB, dShift] ELSE connected ← FALSE}
ELSE {IF NOT EnsurePeriod[a, patA, dShift, may] THEN connected ← FALSE};
RETURN};
IF NOT Range2Included[air, rangeA] THEN ERROR;
EnumCharacteristicDeltoid[a, gi2A, delta, PerGiB];
RETURN};
IF NOT Range2Included[rangeA, Range2Intersection[SizeRange[a.size], Range2Off[SizeRange[a.size], Int2Neg[delta]]]] THEN ERROR;
connected ← TRUE;
EnumCharacteristic[a, rangeA, PerGiA];
IF may AND NOT connected THEN ERROR;
RETURN};
MakePatConnection:
PROC [a: Array, patA, patB: ArrayWirePattern, locA, locB,
dShift, delta: Int2, may:
BOOL]
RETURNS [connected:
BOOL ←
TRUE] ~ {
SELECT CompareArrayParts[patA.part, patB.part]
FROM
less => NULL;
equal => ERROR;
greater => {
{patC: ArrayWirePattern ~ patA; patA ← patB; patB ← patC};
{locC: Int2 ~ locA; locA ← locB; locB ← locC};
dShift ← Int2Neg[dShift]; delta ← Int2Neg[delta]};
ENDCASE => ERROR;
IF patA.part=patB.part THEN ERROR;
{s0r: Range2 ~ Range2Off[
Range2Intersection[
IndicesForPart[a, patA.part],
Range2Off[IndicesForPart[a, patB.part], Int2Neg[delta]]],
Int2Neg[locA]
];
cxnA: ArrayWirePatternConnection ~ patA.cxns[IndexOfPart[patB.part]];
cxnB: ArrayWirePatternConnection ~ patB.cxns[IndexOfPart[patA.part]];
IF cxnA#NIL AND cxnA.pats[FALSE]#patA THEN ERROR;
IF cxnB#NIL AND cxnB.pats[TRUE]#patB THEN ERROR;
SELECT
TRUE
FROM
cxnA=cxnB =>
SELECT
TRUE
FROM
cxnA#
NIL => {
cShift: Shift ~ CanonizeShift[patB, Int2Sub[dShift, cxnA.dShift]];
IF cShift # [0, 0] THEN {IF may THEN ERROR ELSE RETURN [FALSE]};
IF NOT Range2Included[s0r, cxnA.s0r] THEN {IF may THEN ERROR ELSE RETURN [FALSE]};
};
NOT may => RETURN [FALSE];
ENDCASE => {
DirectConnect[a, patA, patB, dShift, s0r];
FOR pia: PartIndex
IN PartIndex
DO
IF pia=patA.partIndex OR pia=patB.partIndex OR patA.cxns[pia]=NIL THEN LOOP;
{cxnA: ArrayWirePatternConnection ~ patA.cxns[pia];
ba: BOOL ~ ComparePartIndices[patA.partIndex, pia]=less;
oPatA: ArrayWirePattern ~ cxnA.pats[ba];
dsa: Shift--from patA to oPatA-- ~ IF ba THEN cxnA.dShift ELSE Int2Neg[cxnA.dShift];
sa: Shift--from oPatA to patB-- ~ Int2Sub[dShift, dsa];
s0roa: Range2--of shifts of oPatA-- ~ Range2Off[s0r, dsa];
s0roai: Range2 ~ ClipRangeModPat[s0roa, IF ba THEN Range2Off[cxnA.s0r, cxnA.dShift] ELSE cxnA.s0r, oPatA];
IF Range2Empty[s0roai] THEN LOOP;
FOR pib: PartIndex
IN PartIndex
DO
IF pib=patA.partIndex OR pib=patB.partIndex OR patB.cxns[pib]=NIL THEN LOOP;
{cxnB: ArrayWirePatternConnection ~ patB.cxns[pib];
bb: BOOL ~ ComparePartIndices[patB.partIndex, pib]=less;
oPatB: ArrayWirePattern ~ cxnB.pats[bb];
dsb: Shift--from patB to oPatB-- ~ IF bb THEN cxnB.dShift ELSE Int2Neg[cxnB.dShift];
sab: Shift--from oPatA to oPatB-- ~ Int2Add[sa, dsb];
sac: Shift--from oPatA to cxnB.pats[FALSE]-- ~ IF bb THEN sa ELSE sab;
s0rcb: Range2--of shifts of cxnB.pats[FALSE]-- ~ Range2Off[s0roai, sac];
s0rcbi: Range2 ~ ClipRangeModPat[s0rcb, cxnB.s0r, cxnB.pats[FALSE]];
IF NOT Range2Empty[s0rcbi] THEN DirectConnect[a, oPatA, oPatB, sab, s0rcbi];
}ENDLOOP;
}ENDLOOP;
a ← a};
NOT may => RETURN [FALSE];
cxnA=NIL => JoinPats[a, patA, cxnB.pats[FALSE], Int2Sub[dShift, cxnB.dShift]];
cxnB=NIL => JoinPats[a, patB, cxnA.pats[TRUE], Int2Sub[cxnA.dShift, dShift]];
cxnA#cxnB => {
IF patA=cxnB.pats[FALSE] OR patB=cxnA.pats[TRUE] THEN ERROR;
IF patA#cxnA.pats[FALSE] OR patB#cxnB.pats[TRUE] THEN ERROR;
JoinPats[a, patA, cxnB.pats[FALSE], Int2Sub[dShift, cxnB.dShift]];
};
ENDCASE => ERROR;
RETURN}};
DirectConnect:
PROC [a: Array, patA, patB: ArrayWirePattern,
dShift: Int2, s0r: Range2] ~ {
cxn: ArrayWirePatternConnection~
NEW[ArrayWirePatternConnectionPrivate ← [
pats: [FALSE: patA, TRUE: patB],
dShift: dShift,
s0r: s0r
]];
FOR b:
BOOL
IN
BOOL
DO
cxn.pats[b].cxns[IndexOfPart[cxn.pats[NOT b].part]] ← cxn;
ENDLOOP;
IF NOT a.wirePatCxns.AddElt[cxn] THEN ERROR;
RETURN};
JoinPats:
PROC [a: Array, patA, patB: ArrayWirePattern,
dShift: Int2] ~ {
MoveMember:
PROC [pair: PairColls.Pair] ~ {
ep: Port ~ NARROW[pair[left]];
locsB: Int2Seq--relative gi b ArrayIndex-- ~ NARROW[pair[right]];
locsA: Int2Seq ← NARROW[patA.memLocs.Apply[ep].DVal];
useSeq: RefSeq--gi b ArrayWirePattern-- ~ NARROW[a.portUses.Apply[ep].val];
IF locsA=NIL THEN patA.memLocs.AddNewPair[[ep, locsA ← CreateInt2Seq[patA.ngi, nullAI]]];
IF locsA.length#locsB.length THEN ERROR;
FOR rgi
f:
NATURAL
IN [0 .. patA.ngi2[Foo])
DO
FOR rgi
b:
NATURAL
IN [0 .. patA.ngi2[Bar])
DO
rgi: NATURAL ~ ComposeRGI[patA, [Foo: rgif, Bar: rgib]];
IF (locsA[rgi]=nullAI) = (locsB[rgi]=nullAI) THEN ERROR;
IF locsB[rgi]=nullAI THEN LOOP;
locsA[rgi] ← locsB[rgi];
{gi2: Nat2 ~ GIFromRGI[patA, [Foo: rgif, Bar: rgib]];
gi: NATURAL ~ ComposeGI[a, gi2];
IF useSeq[gi]#patB THEN ERROR;
useSeq[gi] ← patA;
}ENDLOOP ENDLOOP;
RETURN};
MovePort:
PROC [pair: PairColls.Pair] ~ {
ap: Port ~ NARROW[pair[left]];
refShift: REF Shift ~ NARROW[pair[right]];
IF a.exports.AddPair[[ap, NEW [PairColls.Pair ← [refShift, patA]]], PairColls.addIfOld].news[leftToRight]#different THEN ERROR;
RETURN};
FOR i: NAT IN [0 .. patB.order) DO IF NOT EnsurePeriod[a, patA, patB.periods[i], TRUE] THEN ERROR ENDLOOP;
UnderShiftPat[a, patB, dShift];
patB.memLocs.Enumerate[MoveMember];
patA.ports.AddNewColl[patB.ports];
patB.ports.Enumerate[MovePort];
FOR pi: PartIndex
IN PartIndex
DO
IF pi=patA.partIndex THEN LOOP;
{b: BOOL ~ ComparePartIndices[pi, patA.partIndex]=less;
cxnA: ArrayWirePatternConnection ~ patA.cxns[pi];
cxnB: ArrayWirePatternConnection ~ patB.cxns[pi];
SELECT
TRUE
FROM
cxnB=NIL => NULL;
cxnA=cxnB => ERROR;
cxnA=
NIL => {
cxnB.pats[b] ← patA;
patA.cxns[pi] ← cxnB;
};
cxnA#
NIL => {
IF cxnA.pats[~b] = cxnB.pats[~b] THEN ERROR;
JoinPats[a, cxnA.pats[~b], cxnB.pats[~b], IF b THEN Int2Sub[cxnA.dShift, cxnB.dShift] ELSE Int2Sub[cxnB.dShift, cxnA.dShift]];
};
ENDCASE => ERROR;
a ← a}ENDLOOP;
IF NOT a.wirePats.RemoveElt[patB] THEN ERROR;
RETURN};
UnderShiftPat:
PROC [a: Array, pat: ArrayWirePattern, shift: Int2] ~ {
ShiftEP:
PROC [pair: PairColls.Pair] ~ {
ep: Port ~ NARROW[pair[left]];
locs: Int2Seq --relative gi b ArrayIndex-- ~ NARROW[pair[right]];
FOR rgi:
NATURAL
IN [0 .. pat.ngi)
DO
IF locs[rgi]#nullAI THEN locs[rgi] ← Int2Add[locs[rgi], shift];
ENDLOOP;
RETURN};
ShiftAP:
PROC [pair: PairColls.Pair] ~ {
ap: Port ~ NARROW[pair[left]];
rShift: REF Shift ~ NARROW[pair[right]];
rShift^ ← Int2Sub[rShift^, shift];
RETURN};
pat.memLocs.Enumerate[ShiftEP];
pat.ports.Enumerate[ShiftAP];
FOR pi: PartIndex
IN PartIndex
DO
IF pi=pat.partIndex THEN LOOP;
{cxn: ArrayWirePatternConnection ~ pat.cxns[pi];
b: BOOL ~ ComparePartIndices[pi, pat.partIndex]=less;
IF cxn.pats[b]#pat THEN ERROR;
IF b
THEN cxn.dShift ← Int2Sub[cxn.dShift, shift]
ELSE cxn.dShift ← Int2Add[cxn.dShift, shift];
}ENDLOOP;
RETURN};
EnsurePeriod:
PROC [a: Array, pat: ArrayWirePattern, shift: Int2, may:
BOOL]
RETURNS [connected:
BOOL ←
TRUE] ~ {
IF shift = [0, 0] THEN RETURN;
shift ← CanonizeShift[pat, shift];
IF shift = [0, 0] THEN RETURN;
IF NOT may THEN RETURN [FALSE];
SELECT pat.order
FROM
0 => {Set1[pat, shift]; RETURN};
1 => {
basis: Basis ~ FindBasis[[pat.periods[0], shift, [0, 0]]];
SELECT basis.order
FROM
1 => Set1[pat, basis.vecs[0]];
2 => Set2[pat, basis.vecs[0], basis.vecs[1]];
ENDCASE => ERROR;
RETURN};
2 => {
basis: Basis ~ FindBasis[[pat.periods[0], pat.periods[1], shift]];
IF basis.order#2 THEN ERROR;
Set2[pat, basis.vecs[0], basis.vecs[1]];
RETURN};
ENDCASE => ERROR;
};
Set1:
PROC [awp: ArrayWirePattern, p0: Int2] ~ {
awp.order ← 1;
awp.periods[0] ←
SELECT p0[Foo]
FROM
<0 => Int2Neg[p0],
=0 =>
SELECT p0[Bar]
FROM
<0 => Int2Neg[p0],
=0 => ERROR,
>0 => p0,
ENDCASE => ERROR,
>0 => p0,
ENDCASE => ERROR;
RETURN};
Set2:
PROC [awp: ArrayWirePattern, p0, p1: Int2] ~ {
area: INT ~ ABS[Int2Cross[p0, p1]];
gcd: Int2 ~ Gcd2[p0, p1, Bar];
awp.order ← 1;
awp.periods[1] ← [Foo: area/gcd[Bar], Bar: 0];
awp.periods[0] ← Int2Sub[gcd, Int2Scale[awp.periods[1], FloorDiv[gcd[Foo], awp.periods[1][Foo]]]];
RETURN};
PatFromEPAndAI:
PROC [a: Array, ep: Port, ai: ArrayIndex, mayAdd:
BOOL]
RETURNS [awp: ArrayWirePattern] ~ {
gi2: Nat2;
gi: NATURAL;
[gi2, gi] ← ComputeGI[a, ai];
awp ← PatFromEPAndGI[a, ep, gi2, gi, mayAdd];
RETURN};
PatFromEPAndGI:
PROC [a: Array, ep: Port, gi2: Nat2, gi:
NATURAL, mayAdd:
BOOL]
RETURNS [awp: ArrayWirePattern] ~ {
byGI: RefSeq--gi b ArrayWirePattern-- ← NARROW[a.portUses.Apply[ep].DVal];
IF byGI=
NIL
AND mayAdd
THEN {
byGI ← CreateRefSeq[a.groupingParmses[Foo].sum * a.groupingParmses[Bar].sum];
a.portUses.AddNewPair[[ep, byGI]];
FOR gi
f:
NATURAL
IN [0 .. a.groupingParmses[Foo].sum)
DO
FOR gi
b:
NATURAL
IN [0 .. a.groupingParmses[Bar].sum)
DO
gi2: Nat2 ~ [Foo: gif, Bar: gib];
cgi: NATURAL ~ ComposeGI[a, gi2];
part: ArrayPart ~ PartifyGI2[a, gi2];
awp: ArrayWirePattern ~
NEW [ArrayWirePatternPrivate ← [
memLocs: PairColls.CreateHashFn[invable: FALSE],
part: part,
partIndex: IndexOfPart[part],
partClass: ClassOfPart[part],
order: 0,
ports: PairColls.CreateHashFn[invable: FALSE]
]];
cai: ArrayIndex ~ GI2ToCharacteristic[a, gi2];
[awp.gi2Min, awp.ngi2, awp.ngi] ← GisForPart[a, part];
byGI[cgi] ← awp;
IF NOT a.wirePats.AddElt[awp] THEN ERROR;
{locs: Int2Seq ~ CreateInt2Seq[awp.ngi, nullAI];
IF cgi=gi THEN locs[RelativizeGI[awp, gi2].rgi] ← GI2ToCharacteristic[a, gi2];
awp.memLocs.AddNewPair[[ep, locs]];
}ENDLOOP ENDLOOP;
a ← a;
};
RETURN [NARROW[byGI[gi]]]};
LocFromEPAndGI:
PROC [pat: ArrayWirePattern, ep: Port, gi2: Nat2]
RETURNS [loc: ArrayIndex] ~ {
locs: Int2Seq--relative gi b ArrayIndex-- ~ NARROW[pat.memLocs.Apply[ep].val];
rgi: NATURAL ~ ComposeRGI[pat, Nat2Sub[gi2, pat.gi2Min]];
loc ← locs[rgi];
RETURN};
EnumCharacteristic:
PUBLIC
PROC [a: Array, range: Range2,
Consume:
PROC [part: ArrayPart, gi2: Nat2, gi:
NATURAL, air: Range2]] ~ {
Enum1:
PROC [d: Dim,
Consume:
PROC [
NATURAL, InclRange, Part1]] ~ {
t: NATURAL = a.jointsPeriod[d];
FOR ai:
INT
IN [range[d].min .. a.groupingParmses[d].middle.min)
DO
Consume[ai, [ai, ai], low];
a ← a;ENDLOOP;
FOR gi:
INT
IN [a.groupingParmses[d].middle.min ..
MIN[a.groupingParmses[d].middle.min+
t, range[d].maxPlusOne, a.groupingParmses[d].middle.maxPlusOne])
DO
Consume[gi, Gi1ToInclRange[a, gi, d], mid];
a ← a;ENDLOOP;
FOR ai:
INT
IN [a.groupingParmses[d].middle.maxPlusOne .. range[d].maxPlusOne)
DO
gi: NATURAL ~ ai + a.groupingParmses[d].d;
Consume[gi, [ai, ai], high];
a ← a;ENDLOOP;
RETURN};
Outer:
PROC [gi
f:
NATURAL, air
f: InclRange, part
f: Part1] ~ {
Inner:
PROC [gi
b:
NATURAL, air
b: InclRange, part
b: Part1] ~ {
Consume[part: [partf, partb], gi2: [gif, gib], gi: ComposeGI[a, [gif, gib]], air: [[airf.min, airf.max+1], [airb.min, airb.max+1]]];
RETURN};
Enum1[Bar, Inner];
RETURN};
Enum1[Foo, Outer];
RETURN};
EnumCharacteristicDeltoid:
PUBLIC
PROC [a: Array, gi2A: Nat2, delta: KingMove,
PerGi:
PROC [aiA, aiB: ArrayIndex, partB: ArrayPart, gi2B: Nat2, giB:
NATURAL]] ~ {
Enum1:
PROC [d: Dim,
Consume:
PROC [
NATURAL,
INT, Part1]] ~ {
rA: InclRange ~ Gi1ToInclRange[a, gi2A[d], d];
rB: InclRange ~ [
min: MAX[rA.min+delta[d], 0],
max: MIN[rA.min+delta[d], a.size[d]-1]];
IF rB.min <= rB.max
THEN {
giB1, giB2: NATURAL;
partB1, partB2: Part1;
[giB1, partB1] ← Ai1ToGi1[a, rB.min, d];
[giB2, partB2] ← Ai1ToGi1[a, rB.max, d];
Consume[giB1, rB.min, partB1];
IF giB2#giB1 THEN Consume[giB2, rB.max, partB2];
};
RETURN};
Outer:
PROC [gi
f:
NATURAL, aiB
f:
INT, partB
f: Part1] ~ {
Inner:
PROC [gi
b:
NATURAL, aiB
b:
INT, partB
b: Part1] ~ {
PerGi[aiA: [aiBf-delta[Foo], aiBb-delta[Bar]], aiB: [aiBf, aiBb], partB: [partBf, partBb], gi2B: [gif, gib], giB: ComposeGI[a, [gif, gib]]];
RETURN};
Enum1[Bar, Inner];
RETURN};
Enum1[Foo, Outer];
RETURN};
ClipRangeModPat:
PROC [r, c: Range2, pat: ArrayWirePattern]
RETURNS [cr: Range2] ~ {
s: Shift ~ CanonizeShift[pat, Int2Sub[Range2Min[r], Range2Min[c]];
ERROR nyet;
};
CanonizeShift:
PUBLIC
PROC [pat: ArrayWirePattern, shift: Int2]
RETURNS [Int2] ~ {
SELECT pat.order
FROM
0 => NULL;
1 =>
SELECT pat.periods[0][Foo]
FROM
>0 => {
n0: INT ~ FloorDiv[shift[Foo], pat.periods[0][Foo]];
shift ← Int2Sub[shift, Int2Scale[pat.periods[0], n0]]};
=0 => {
n0: INT ~ FloorDiv[shift[Bar], pat.periods[0][Bar]];
shift ← Int2Sub[shift, Int2Scale[pat.periods[0], n0]]};
ENDCASE => ERROR;
2 => {
n0: INT ~ FloorDiv[shift[Bar], pat.periods[0][Bar]];
shift ← Int2Sub[shift, Int2Scale[pat.periods[0], n0]];
{n1: INT ~ FloorDiv[shift[Foo], pat.periods[1][Foo]];
shift ← Int2Sub[shift, Int2Scale[pat.periods[1], n1]]}};
ENDCASE => ERROR;
RETURN [shift]};
FindBasis:
PROC [vs:
ARRAY [0 .. 3)
OF Int2]
RETURNS [basis: Basis] ~ {
basis.order ← 0;
FOR i:
NATURAL
IN [0 .. 3)
DO
u: Int2 ← vs[i];
IF u = [0, 0] THEN LOOP;
FOR j:
NATURAL
IN [0 .. basis.order)
DO
v: Int2 ← basis.vecs[j];
nz: NATURAL ← 0;
UNTIL u=[0,0]
OR nz=2
DO
uu: INT ~ Int2Dot[u, u];
vu: INT ~ Int2Dot[v, u];
n: INT ~ FloorDiv[vu, uu];
t: Int2 ~ Int2Sub[v, Int2Scale[u, n]];
v ← u; u ← t;
IF n=0 THEN nz ← nz+1 ELSE nz ← 0;
ENDLOOP;
basis.vecs[j] ← v;
IF u = [0, 0] THEN EXIT;
REPEAT
FINISHED => {
basis.vecs[basis.order] ← u;
basis.order ← basis.order+1;
};
ENDLOOP;
ENDLOOP;
RETURN};
Gcd2:
PROC [a, b: Int2, d: Dim]
RETURNS [Int2] ~ {
WHILE a[d]#0
DO
c: Int2 ~ Int2Sub[b, Int2Scale[a, b[d]/a[d]]];
b ← a;
a ← c;
ENDLOOP;
IF b[d]<0 THEN b ← Int2Neg[b];
RETURN [b]};
PartifyGI2:
PROC [a: Array, gi2: Nat2]
RETURNS [part: ArrayPart] ~
INLINE {
RETURN [[Foo: PartifyGI1[a.groupingParmses[Foo], gi2[Foo]], Bar: PartifyGI1[a.groupingParmses[Bar], gi2[Bar]]]]};
PartifyGI1:
PROC [groupingParms: GroupingParms, gi1:
NATURAL]
RETURNS [part1: Part1] ~
INLINE {
RETURN [
SELECT gi1
FROM
< NAT[groupingParms.middle.min] => low,
>= groupingParms.firstHigh => high,
ENDCASE => mid];
};
GI2ToCharacteristic:
PUBLIC
PROC [a: Array, gi2: Nat2]
RETURNS [ArrayIndex] ~ {
RETURN [[
Foo: Gi1ToInclRange[a, gi2[Foo], Foo].air.min,
Bar: Gi1ToInclRange[a, gi2[Bar], Bar].air.min]]};
IndicesForPart:
PUBLIC
PROC [a: Array, part: ArrayPart]
RETURNS [air: Range2] ~ {
FOR d: Dim
IN Dim
DO
air[d] ←
SELECT part[d]
FROM
low => [min: 0, maxPlusOne: a.groupingParmses[d].middle.min],
mid => a.groupingParmses[d].middle,
high => [min: a.groupingParmses[d].middle.maxPlusOne, maxPlusOne: a.size[d]],
ENDCASE => ERROR;
ENDLOOP;
RETURN};
GisForPart:
PUBLIC
PROC [a: Array, part: ArrayPart]
RETURNS [gi2Min, ngi2: Nat2, ngi:
NATURAL] ~ {
FOR d: Dim
IN Dim
DO
SELECT part[d]
FROM
low => {gi2Min[d] ← 0; ngi2[d] ← a.groupingParmses[d].middle.min};
mid => {gi2Min[d] ← a.groupingParmses[d].middle.min; ngi2[d] ← a.jointsPeriod[d]};
high => {gi2Min[d] ← a.groupingParmses[d].firstHigh; ngi2[d] ← a.size[d] - a.groupingParmses[d].middle.maxPlusOne};
ENDCASE => ERROR;
ENDLOOP;
ngi ← ngi2[Foo]*ngi2[Bar];
RETURN};
ComputeGroupingParms:
PROC [size, jointsPeriod:
NAT, borders:
ARRAY End
OF
NAT]
RETURNS [gp: GroupingParms] = {
peculiar: NAT = borders[low] + borders[high];
IF peculiar >= size
THEN
RETURN [[
middle: [size, size],
firstHigh: size,
sum: size,
d: 0]];
{firstHighGI: NAT = borders[low] + jointsPeriod;
firstHighI: NAT = size - borders[high];
gp ← [
middle: [borders[low], firstHighI],
firstHigh: firstHighGI,
sum: peculiar + jointsPeriod,
d: firstHighGI - firstHighI];
RETURN [gp];
}};
Gi1ToInclRange:
PROC [a: Array, gi1:
NATURAL, d: Dim]
RETURNS [air: InclRange] ~ {
SELECT gi1
FROM
< NAT[a.groupingParmses[d].middle.min] => RETURN [[gi1, gi1]];
>= a.groupingParmses[d].firstHigh => air.min ← air.max ← gi1-a.groupingParmses[d].d;
ENDCASE => {
t: NATURAL ~ a.jointsPeriod[d];
f: NATURAL ~ gi1 - a.groupingParmses[d].middle.min;
qr: InclRange ~ InclRange1Div[[min: a.groupingParmses[d].middle.min, max: a.groupingParmses[d].middle.maxPlusOne-1], t, f];
RETURN InclRange1Mul[qr, t, f]};
};
ComputeGI:
PROC [a: Array, ai: ArrayIndex]
RETURNS [gi2: Nat2, gi:
NATURAL] ~ {
gi2 ← [
Foo: Ai1ToGi1[a, ai[Foo], Foo].gi1,
Bar: Ai1ToGi1[a, ai[Bar], Bar].gi1];
gi ← ComposeGI[a, gi2];
RETURN};
Ai1ToGi1:
PROC [a: Array, ai1:
INT, d: Dim]
RETURNS [gi1:
NATURAL, part1: Part1] ~ {
SELECT ai1
FROM
< a.groupingParmses[d].middle.min => RETURN [ai1, low];
>= a.groupingParmses[d].middle.maxPlusOne => RETURN [ai1 - a.groupingParmses[d].d, high];
ENDCASE => {
f: NATURAL ~ ai1 MOD a.jointsPeriod[d];
RETURN [a.groupingParmses[d].middle.min + f, mid]};
};
FloorDiv:
PROC [num:
INT, den:
LNAT]
RETURNS [
INT] ~
INLINE {
IF num>0 THEN RETURN [num/den];
RETURN [(num+1-den)/den]};
InclRange1Div:
PROC [r: InclRange,
t,
f:
NAT]
RETURNS [InclRange] ~ {
RETURN [[
min: CeilDiv[r.min-f, t],
max: FloorDiv[r.max-f, t]]]};
InclRange1Mul:
PROC [r: InclRange,
t,
f:
NAT]
RETURNS [InclRange] ~ {
RETURN [[min: r.min*t + f, max: r.max*t + f]]};
END.