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 _ ArrayIndex-- ~ NARROW[pair[right]];
locsA: Int2Seq _ NARROW[patA.memLocs.Apply[ep].DVal];
useSeq: RefSeq--gi _ 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 rgif: NATURAL IN [0 .. patA.ngi2[Foo]) DO FOR rgib: 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 _ 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 _ 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 gif: NATURAL IN [0 .. a.groupingParmses[Foo].sum) DO FOR gib: 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 _ 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 [gif: NATURAL, airf: InclRange, partf: Part1] ~ {
Inner: PROC [gib: NATURAL, airb: InclRange, partb: 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 [gif: NATURAL, aiBf: INT, partBf: Part1] ~ {
Inner: PROC [gib: NATURAL, aiBb: INT, partBb: 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.
dLichenNewArrayImpl1.Mesa
Last tweaked by Mike Spreitzer on September 30, 1987 10:21:11 am PDT
Κ™–

"cedar" style˜
code™K™D—K˜KšΟk	œK˜TK˜šΟnœœ
˜"Kšœ2˜9Kšœ˜K˜
—K˜Kšœ
œ(ž	œžœ
˜_K˜KšœœΟc;œ
˜LKšœœœœ˜)Kšœœœ	œœ
œ˜DK˜šžœœ
œ9œœ
œœ
œœ˜†
Kšœœ)˜0š
œ˜KšžœC˜FKšžœD˜G—KšœΟd
œ.˜5Kšœœ˜'šœœ˜ K˜Kšœœ
˜Kšœœ
˜K˜Kš
œ˜Kš
œ˜K˜ Kš
œ#˜#Kšœ*œ˜1Kšœ)œ
˜/K˜—Kšœ˜—K˜š
žœœ
œ2œœ˜gKšœ5œ˜<Kšœ5œ˜<šœœ˜Kšœœ
œœ˜!Kšœ3˜9K˜—Kšœ˜—K˜šžœœ3žœœ-˜
Kšœ	Ÿœ˜9šžœœ,˜6Kšœ
œœ
œ
˜%K˜š
œœœ
œœ˜=Kš
œ0˜0Kšœœ/˜6Kš
œ%˜%Kš	œœœœΟg
œ˜>Kšœ
œœ
œ
˜*Kšœ˜Kšœ
œ
˜	—K˜—K˜Kšœ˜—K˜šžœœ
œGœœ
œ˜
K˜K˜*šžœœ"œ˜GK˜Kš
œ˜Kšœ9œ˜?K˜3šžœœ;œ˜SKšœ;œ˜AKš
œ3˜3Kš
œ"˜"Kš
œ"˜"Kš‘
œ&˜'Kšœ
œœ
œ<‘œœ
œ
˜…
Kšœ
œœœœ‘
œœ
œ
˜[Kšœœ
œ‘
œœ
œ˜HKšœ˜—Kšœ
œœ
œ
˜.K˜2Kšœ˜—Kšœ
œmœ
œ
˜~Kšœœ
˜Kš
œ&˜&Kš
œœ
œœ
œ
˜$Kšœ˜—K˜šžœœ6‘
œœœ
œœ˜‘
šœ)˜3Kšœœ
˜
Kšœ	œ
˜˜Kš
œ:˜:Kš
œ.˜.Kš‘
œ‘
œ ˜2—Kšœœ
˜—Kšœœ
œ
˜"š
œ˜š
œ˜K˜Kš
œ9˜9—K˜
K˜—Kš
œE˜EKš
œE˜EKšœœ
œœœ
œ
˜1Kšœœ
œœœ
œ
˜0šœ
œ
˜šœ
œ
œ
˜šœœ˜
Kšœ,‘
œ‘
œ˜BKšœœœœ
œ
œ
œœ˜@Kšœ
œœœœ
œ
œ
œœ˜RK˜—Kšœœœ˜šœ˜Kšœ‘
œ˜*šœœ˜"Kšœœœœ
œ
œ
˜LKš
œ3˜3Kšœœ0˜8Kš
œ(˜(Kš
œ
Ÿœœœ‘
œœ‘
œ˜TKšœ	Ÿœ‘
œ˜7Kšœ
Ÿœ˜:Kšœ(œœ"œ˜jKšœœ
œ
˜!šœœ˜"Kšœœœœ
œ
œ
˜LKš
œ3˜3Kšœœ0˜8Kš
œ(˜(Kš
œ
Ÿœœœ‘
œœ‘
œ˜TKšœ
Ÿœ˜5Kš	œ
Ÿ"œœœœ˜FKšœ
Ÿ!œ˜HKšœ<œ˜DKšœ
œœ-˜LKšœ
œ
˜	—Kšœ
œ
˜	—K˜——Kšœœœ˜Kš	œœ œ‘
œ‘
œ˜NKš	œœ œ‘
œ‘
œ˜Mš
œ˜Kšœœœœœ
œ
˜<Kšœœœœœ
œ
˜<Kšœœ‘
œ‘
œ˜BK˜—Kšœœ
˜—Kšœ˜	—K˜šž
œœ*‘
œ˜[šœ!œ&˜JKšœœœ˜ Kš‘
œ‘
œ˜Kš
œ˜K˜—š	œœ
œ
œ
˜Kšœ&œ˜:Kšœ
˜—Kšœ
œœ
œ
˜,Kšœ˜—K˜šžœœ*‘
œ˜Išž
œœ˜+Kšœœ
˜KšœŸΠcm
Ÿ
œœ˜AKšœœ˜5KšœŸ’
Ÿœœ˜KKšœœ
œH˜YKšœœ
œ
˜(šœ 
œœ
œœ
œ 
œœ
œ˜[Kšœœ 
œ
 
œ˜8Kšœ+œ
œ
˜8Kšœœ
œ
˜Kš
œ˜Kšœ& 
œ
 
œ˜5Kšœœ˜ Kšœœ
œ
˜K˜Kšœ
œ
œ
˜—Kšœ˜—šžœœ˜)Kšœœ
˜Kšœ
œ	œ˜*KšœœWœ
œ
˜Kšœ˜—Kšœœ
œœ
œ
œ(œœ
œ
œ
˜jKšœ‘
œ˜Kš
œ#˜#Kš
œ"˜"K˜šœœ˜!Kšœœ
œ
˜Kšœœ/˜7Kš
œ1˜1Kš
œ1˜1šœ
œ
˜Kšœœœ
˜Kšœ
œ
˜šœœ˜
K˜K˜K˜—šœœ˜
Kšœœ
œ
˜,Kšœ*œœ‘
œ‘
œœ‘
œ‘
œ˜~K˜—Kšœœ
˜—Kšœœ
˜—Kšœ
œœ
œ
˜-Kšœ˜—K˜šž
œœ3˜Fšžœœ˜(Kšœœ
˜KšœŸ’
Ÿ
œœ˜Ašœœ
œ˜%Kšœœ'˜?Kšœ
˜—Kšœ˜—šžœœ˜(Kšœœ
˜Kšœœ	œ˜(K˜"Kšœ˜—Kš
œ˜Kš
œ˜šœœ˜!Kšœœ
œ
˜Kš
œ0˜0Kšœœ.˜5Kšœœ
œ
˜šœ˜Kšœ‘
œ‘
œ
˜,Kšœ‘
œ‘
œ˜-—Kšœ
œ
˜	—Kšœ˜—K˜šžœœ5œœ
œœ˜qKšœœ
œ
˜Kš
œ"˜"Kšœœ
œ
˜Kš
œ
œœ
œœ˜šœ˜Kšœœ˜ ˜K˜:šœ
˜K˜K˜-Kšœœ
˜—Kšœ˜—˜K˜BKšœœ
œ
˜K˜(Kšœ˜—Kšœœ
˜—Kš
œ˜—K˜šžœœ&˜0K˜šœœ	˜$K˜šœœ	˜K˜Kšœœ
˜K˜	Kšœœ
˜—K˜	Kšœœ
˜—Kšœ˜—K˜šžœœ*˜4Kšœœœ˜#K˜K˜K˜.Kš
œb˜bKšœ˜—K˜šžœœ.œœ˜kKš
œ
˜
Kšœœ
˜Kš
œ˜Kš
œ-˜-Kšœ˜—K˜š
žœœ%œ
œœ˜sKšœŸ’
Ÿœœ˜Jšœœ
œœ˜Kš
œM˜MKš
œ"˜"šœ 
œœ
œ#œ
œ 
œœ
œ#˜qKšœ 
œ	 
œ˜!Kšœœ˜!Kš
œ%˜%šœœ˜8Kšœ)œ˜0Kš
œ˜K˜Kš
œ˜K˜	Kšœ'œ
˜-K˜—Kš
œ.˜.K˜6Kš
œ˜Kšœ
œœ
œ
˜)K˜0Kšœœ@˜NKš
œ#˜#Kšœ
œ
œ
˜—K˜K˜—Kšœœ
˜—K˜šžœœ.œ˜_Kšœ
Ÿ’
Ÿ
œœ˜NKšœœ-˜9K˜Kšœ˜—K˜šžœœ
œžœœ"œ˜ƒ
š
žœœ
žœœœ˜CKš‘
œœ˜šœœ
œ3˜CK˜Kšœœ
˜—šœœ
œ%œ!‘
œ@˜š
Kš
œ+˜+Kšœœ
˜—šœœ
œA˜QKšœœ‘
œ
˜*K˜Kšœœ
˜—Kšœ˜—šžœœ 
œœ 
œ 
œ˜=šžœœ 
œœ 
œ 
œ˜=Kšœ 
œ 
œ 
œ 
œ 
œ 
œ 
œ	 
œ
 
œ	 
œ
˜„
Kšœ˜—Kš
œ˜Kšœ˜—K˜Kšœ˜—K˜šžœœ
œ)žœœ;œ˜’
šžœœ
žœœœœ
˜=Kš
œ.˜.š
œ˜Kšœœ˜Kšœœ ˜(—šœœ˜Kšœœ
˜K˜Kš
œ(˜(Kš
œ(˜(K˜Kšœœ˜0K˜—Kšœ˜—šžœœ 
œœ 
œœ 
œ˜8šžœœ 
œœ 
œœ 
œ˜8Kšœ 
œ 
œ 
œ 
œ 
œ 
œ 
œ 
œ 
œ 
œ˜Œ
Kšœ˜—K˜Kšœ˜—K˜Kšœ˜—K˜šžœœ'œ˜TKš
œB˜BKšœ˜K˜—K˜šž
œœ
œ&œ˜Ršœ˜Kšœœ
˜
šœœ˜$˜Kšœœ-˜4Kš
œ7˜7—˜Kšœœ-˜4K˜7—Kšœœ
˜—˜Kšœœ-˜4K˜6Kšœœ-˜5Kš
œ8˜8—Kšœœ
˜—Kšœ
˜—K˜š
ž	œœœ
œœ˜GK˜šœœ
œ
˜K˜Kšœœ
œ
˜šœœ
œ˜'K˜Kšœœ˜šœ	œ˜Kšœœ˜Kšœœ˜Kšœœ˜Kš
œ&˜&Kš
œ
˜
Kšœœœ˜"Kšœ
˜—K˜Kšœœ
œ
˜Kš
˜šœ˜
Kš
œ˜Kš
œ˜Kš
œ˜—Kšœ
˜—Kšœ
˜—Kšœ˜—K˜šžœœœ˜2šœ˜Kš
œ.˜.K˜K˜Kšœ
˜—Kšœœ˜Kšœ˜—K˜šž
œœœœ˜KKšœžœ0žœ2˜q—K˜š
ž
œœ%œœœ˜_šœœ˜Kšœœ"˜(Kš
œ#˜#Kšœ	˜—K˜—K˜šžœœ
œœ˜Ošœ˜	Kšžœ+˜.Kšžœ.˜1——K˜šžœœ
œœ˜Qšœœ˜šœ	œ	˜Kš
œ=˜=Kš
œ#˜#Kš
œM˜MKšœœ
˜—Kšœ
˜—Kšœ˜—K˜š
ž
œœ
œœœ˜bšœœ˜šœ	˜Kš
œB˜BKš
œR˜RKš
œs˜sKšœœ
˜—Kšœ
˜—K˜Kšœ˜—K˜šžœœœœœ
œœ˜oKšœ
œ ˜-šœœ
œ˜"K˜K˜K˜
Kš‘
œ˜—Kšœœ˜0Kšœœ˜'˜Kš
œ#˜#Kš
œ˜Kš
œ˜Kš‘
œ˜—Kšœ˜K˜—K˜šžœœœ
œ˜Ršœ˜Kšœœ%œ˜?KšœR‘
œ
˜Tšœ˜Kš‘
œœ˜Kš‘
œœ)˜3Kšœu‘
œ‘
œ˜{Kšœ‘
œ‘
œ˜ ——K˜—K˜šž	œœœœ˜O˜Kšžœ ˜#Kšžœ!˜$—K˜Kšœ˜—K˜š
žœœœ
œœ˜Tšœ˜Kšœ&œ˜8Kšœ-œ‘
œ˜Yšœ˜Kš‘
œœœ˜'Kšœ$‘
œ˜3——K˜—K˜šžœœœœœœœ˜=Kšœœ
œ˜Kšœ˜—K˜šž
œœ‘
œ‘
œœœ˜Ešœ˜	Kšœ‘
œ‘
œ˜Kšœ‘
œ‘
œ˜——K˜šž
œœ‘
œ‘
œœœ˜EKš
œ‘
œ‘
œ
‘
œ‘
œ˜/—K˜Kšœ
˜—…—Lφeσ