<> <> DIRECTORY Basics, Convert, InterpreterOps, IO, LichenArrayStuff, LichenCollections, LichenDataOps, LichenDataStructure, LichenPairCollections, List, LRUCache, Rope; LichenArray2Impl: CEDAR PROGRAM IMPORTS Convert, LichenArrayStuff, LichenCollections, LichenDataOps, LichenDataStructure, LichenPairCollections, List, LRUCache, Rope EXPORTS LichenArrayStuff = BEGIN OPEN LichenDataStructure, LichenArrayStuff, LichenDataOps, Colls:LichenCollections, PairColls:LichenPairCollections; Abort: ERROR = CODE; Jgi2ToLair: PUBLIC PROC [a: Array, phase: Nat2, j: Joint, jgi2: Nat2] RETURNS [lair, jiir: Range2, jCount: NAT] = { Do1: PROC [d: Dim] RETURNS [jiir: Range] = { SELECT TRUE FROM jgi2[d] < j.groupingParmses[d].middle.min => RETURN [[jgi2[d], jgi2[d]+1]]; jgi2[d] >= j.groupingParmses[d].firstHigh => { jiir.min _ jgi2[d] - j.groupingParmses[d]. RETURN [[jiir.min, jiir.min+1]]}; ENDCASE => RETURN [j.groupingParmses[d].middle]; }; jiir _ [Foo: Do1[Foo], Bar: Do1[Bar]]; jCount _ RangeArea[jiir]; lair _ Range2Mul[jiir, a.jointsPeriod, phase]; }; EnumJgiOfGi: PUBLIC PROC [a: Array, gi2: Nat2, Consume: PROC [d: Dim, j: Joint, side: End, jgi2, phase: Nat2]] = { phase: Nat2; air: Range2 = Gi2ToAir[a, gi2].air; FOR d: Dim IN Dim DO phase[d] _ SELECT TRUE FROM gi2[d] < a.groupingParmses[d].middle.min => gi2[d] MOD a.jointsPeriod[d], gi2[d] >= a.groupingParmses[d].firstHigh => NAT[(gi2[d]-a.groupingParmses[d]. ENDCASE => gi2[d] - NAT[a.groupingParmses[d].middle.min]; ENDLOOP; FOR dj: Dim IN Dim DO lairMax: Range2 = SizeRange[Nat2Tweak[a.size, dj, -1]]; j: Joint = GetArrayJoint[a, dj, phase]; FOR side: End IN End DO lair: Range2 = Range2Intersection[lairMax, IF side = low THEN air ELSE Range2Off[air, ConsInt2[dj, -1, 0]]]; l jir: Range2 = Range2Div[lair, a.jointsPeriod, l Enum: PROC [de: Dim, Consume: PROC [NAT]] = { mid: Range ~ [ min: MAX[jir[de].min, j.groupingParmses[de].middle.min], maxPlusOne: MIN[jir[de].maxPlusOne, j.groupingParmses[de].middle.maxPlusOne]]; FOR jgi: INT IN [jir[de].min .. mid.min) DO Consume[jgi] ENDLOOP; FOR jgi: INT IN [mid.maxPlusOne .. jir[de].maxPlusOne) DO Consume[jgi+j.groupingParmses[de]. IF mid.min < mid.maxPlusOne THEN Consume[j.groupingParmses[de].middle.min]; }; Med: PROC [jgif: NAT] = { Inner: PROC [jgib: NAT] = {Consume[dj, j, side, [jgif, jgib], phase]}; Enum[Bar, Inner]}; Enum[Foo, Med]; ENDLOOP; ENDLOOP; }; Gi2ToAir: PUBLIC PROC [a: Array, gi2: Nat2] RETURNS [air: Range2, ngii2: Nat2, ngii: NAT] = { Do1: PROC [d: Dim] RETURNS [air: Range, n: NATURAL] = { SELECT TRUE FROM gi2[d] RETURN [[gi2[d], gi2[d]+1], 1]; gi2[d]>=a.groupingParmses[d].firstHigh => { air.min _ gi2[d] - a.groupingParmses[d]. RETURN [[air.min, air.min+1], 1]}; ENDCASE => { jiir: Range = Range1Div[a.groupingParmses[d].middle, a.jointsPeriod[d], RETURN [Range1Mul[jiir, a.jointsPeriod[d], }; }; [air[Foo], ngii2[Foo]] _ Do1[Foo]; [air[Bar], ngii2[Bar]] _ Do1[Bar]; ngii _ ngii2[Foo] * ngii2[Bar]; }; EnumerateJoints: PUBLIC PROC [a: Array, Consume: PROC [d: Dim, phase: Nat2, j: Joint]] ~ { FOR d: Dim IN Dim DO FOR phase: Nat2 ~ [ j: Joint ~ GetArrayJoint[a, d, phase]; Consume[d, phase, j]; ENDLOOP ENDLOOP; ENDLOOP; }; EnumerateTies: PUBLIC PROC [a: Array, Consume: PROC [d: Dim, phase: Nat2, jgi: NATURAL, jgi2: Nat2, j: Joint, tie: Tie]] ~ { Refine: PROC [d: Dim, phase: Nat2, j: Joint] ~ { jgi: NAT _ 0; FOR jgif: NAT IN [0 .. j.groupingParmses[Foo].sum) DO FOR jgib: NAT IN [0 .. j.groupingParmses[Bar].sum) DO jgi2: Nat2 ~ [jgif, jgib]; ties: Set--of Tie-- ~ FetchTies[j, jgi]; PassTie: PROC [ra: REF ANY] ~ {Consume[d, phase, jgi, jgi2, j, NARROW[ra]]}; ties.Enumerate[PassTie]; jgi _ jgi + 1; ENDLOOP; ENDLOOP; IF jgi # j.ties.length THEN ERROR; }; EnumerateJoints[a, Refine]; }; EnumerateTiesOfGroup: PUBLIC PROC [a: Array, gi2: Nat2, g: Group, Consume: PROC [d: Dim, phase: Nat2, jgi: NATURAL, jgi2: Nat2, j: Joint, tie: Tie, side: End]] ~ { PerJgi: PROC [d: Dim, j: Joint, side: End, jgi2: Nat2, phase: Nat2] ~ { jgi: NATURAL ~ ComposeJgi[j, jgi2]; ties: Set--of Tie-- ~ FetchTies[j, jgi]; PassTie: PROC [ra: REF ANY] ~ { tie: Tie ~ NARROW[ra]; side: End; SELECT g FROM tie.groups[low] => side _ low; tie.groups[high] => side _ high; ENDCASE => RETURN; Consume[d, phase, jgi, jgi2, j, tie, side]; }; ties.Enumerate[PassTie]; a _ a; }; EnumJgiOfGi[a, gi2, PerJgi]; a _ a; }; IsIncompleteArray: PUBLIC PROC [ct: CellType] RETURNS [incomplete: BOOL] = { a: Array = ct.asArray; incomplete _ FALSE; IF a = NIL THEN RETURN; FOR d: Dim IN Dim DO FOR cphase: INT IN [0 .. a.joints[d].length) DO j: Joint = NARROW[a.joints[d][cphase]]; njgi: NAT = j.groupingParmses[Foo].sum * j.groupingParmses[Bar].sum; FOR jgi: NAT IN [0 .. njgi) DO ties: Set--of Tie-- = FetchTies[j, jgi]; TestTie: PROC [ra: REF ANY] = { tie: Tie = NARROW[ra]; IF tie.completion # NIL THEN incomplete _ TRUE; }; ties.Enumerate[TestTie]; IF incomplete THEN RETURN; ENDLOOP; ENDLOOP; ENDLOOP; incomplete _ incomplete; }; GroupInWireAt: PUBLIC PROC [a: Array, gi2: Nat2, g: Group, aw: ArrayWire, ai: ArrayIndex] RETURNS [BOOL] ~ { bs: BoolSeq ~ NARROW[aw.members.Apply[g].DVal]; IF bs = NIL THEN RETURN [FALSE]; {air: Range2 ~ Gi2ToAir[a, gi2].air; shape: Nat2 ~ RangeShape[air]; gii: Nat2 ~ Nat2Div[Int2SubN[ai, Range2Min[air]], a.jointsPeriod]; index: NAT ~ shape[Bar] * gii[Foo] + gii[Bar]; RETURN [bs[index]]; }}; HasUnusedGroups: PROC [ct: CellType] RETURNS [has: BOOL] = { ENABLE Abort => {has _ TRUE; CONTINUE}; a: Array = ct.asArray; has _ FALSE; IF a = NIL THEN RETURN; FOR gif: NAT IN [0 .. a.groupingParmses[Foo].sum) DO FOR gib: NAT IN [0 .. a.groupingParmses[Bar].sum) DO gi2: Nat2 = [gif, gib]; gi: NAT = ComposeGI[a, gi2]; gs: Groupings = NARROW[a.groupingses[gi]]; PerGroup: PROC [ra: REF ANY] = { g: Group = NARROW[ra]; PerJgi: PROC [d: Dim, j: Joint, side: End, jgi2, phase: Nat2] = { jgi: NAT ~ ComposeJgi[j, jgi2]; IF FetchTie[j, side, jgi, g] # NIL THEN ERROR Abort[]; }; EnumJgiOfGi[a, gi2, PerJgi !Abort => GOTO Used]; ERROR Abort[]; EXITS Used => ra _ ra; }; gs.groups.Enumerate[PerGroup]; IF has THEN RETURN; ENDLOOP ENDLOOP; has _ FALSE; }; GetArrayPortForPort: PUBLIC PROC [act: CellType, a: Array, index: ArrayIndex, ep: Port, mayAdd: BOOL] RETURNS [arrayPort: Port] = { gi: NAT = ComputeGroupingsIndex[a, index].gi; g: Group = PortToGroup[a, gi, ep]; IF g # NIL THEN { arrayPort _ GetArrayPortForGroup[act, a, index, g, FALSE]; IF arrayPort # NIL THEN RETURN; }; IF mayAdd THEN { portName: SteppyName ~ List.Append[NameIndex[a, index], SteppyDescribe[ep, a.eltType.port]]; arrayPort _ FullyAddPort[[parent: act.port, names: CreateSteppyNames[LIST[portName]]]].port; SetArrayPortForPort[a, index, ep, arrayPort]; } ELSE arrayPort _ NIL; }; GetArrayPortForGroup: PUBLIC PROC [act: CellType, a: Array, index: ArrayIndex, g: Group, mayAdd: BOOL] RETURNS [arrayPort: Port] = { gi: NAT = ComputeGroupingsIndex[a, index].gi; aw: ArrayWire = ArrayWireForGroup[a, index, gi, g, mayAdd]; PerPort: PROC [ra: REF ANY] = { IF (arrayPort _ NARROW[ra]) = NIL THEN ERROR; }; arrayPort _ NIL; IF aw # NIL THEN aw.ports.Enumerate[PerPort]; IF arrayPort=NIL AND mayAdd THEN { ep: Port ~ g.ports.first; portName: SteppyName ~ List.Append[NameIndex[a, index], SteppyDescribe[ep, a.eltType.port]]; arrayPort _ FullyAddPort[[parent: act.port, names: CreateSteppyNames[LIST[portName]]]].port; SetArrayPortForGroup[a, index, gi, g, arrayPort]; }; arrayPort _ arrayPort; }; SetArrayPortForPort: PUBLIC PROC [a: Array, index: ArrayIndex, ep, ap: Port] = { gi: NAT = ComputeGroupingsIndex[a, index].gi; g: Group = GetGroup[a, gi, ep, TRUE]; SetArrayPortForGroup[a, index, gi, g, ap]; }; SetArrayPortForGroup: PUBLIC PROC [a: Array, index: ArrayIndex, gi: NAT, g: Group, ap: Port] = { aw: ArrayWire = ArrayWireForGroup[a, index, gi, g, TRUE]; IF NOT aw.ports.AddElt[ap] THEN ERROR; IF NOT a.portWire.Insert[ap, aw] THEN ERROR; }; EnumerateGroupsContainingPort: PUBLIC PROC [a: Array, ep: Port, Consume: PROC [gi2: Nat2, gi: NATURAL, g: Group]] ~ { FOR gif: NATURAL IN [0 .. a.groupingParmses[Foo].sum) DO FOR gib: NATURAL IN [0 .. a.groupingParmses[Bar].sum) DO gi: NATURAL ~ ComposeGI[a, [Foo: gif, Bar: gib]]; gs: Groupings ~ NARROW[a.groupingses[gi]]; g: Group ~ NARROW[gs.toGroup.Fetch[ep].val]; IF g#NIL THEN Consume[[Foo: gif, Bar: gib], gi, g]; a _ a; ENDLOOP; ENDLOOP; RETURN}; EnumerateArrayWiresContainingGroup: PUBLIC PROC [a: Array, gi2: Nat2, gi: NATURAL, g: Group, Consume: PROC [ArrayWire], addIfMissing: BOOL] ~ { seen: Set--of ArrayWire-- ~ Colls.CreateHashSet[]; air: Range2 ~ Gi2ToAir[a, gi2].air; FOR f: INT IN [air[Foo].min .. air[Foo].maxPlusOne) DO FOR b: INT IN [air[Bar].min .. air[Bar].maxPlusOne) DO aw: ArrayWire ~ ArrayWireForGroup[a, [Foo: f, Bar: b], gi, g, addIfMissing]; IF seen.AddElt[aw] THEN Consume[aw]; a _ a; ENDLOOP ENDLOOP; RETURN}; EnumerateGroupsOfArrayWire: PUBLIC PROC [a: Array, aw: ArrayWire, Consume: PROC [gi2: Nat2, gi: NATURAL, g: Group, membership: BoolSeq--group instance index PerGroup: PROC [pair: PairColls.Pair] ~ { g: Group ~ NARROW[pair[left]]; membership: BoolSeq--group instance index gi: NATURAL ~ ComposeGI[a, g.gi2]; Consume[g.gi2, gi, g, membership]; RETURN}; aw.members.Enumerate[PerGroup]; RETURN}; FlushArrayWires: PUBLIC PROC [a: Array, doomedArrayPorts: VarSet--of port of a--] ~ { portToAWE: VarFunction--array port RememberExPort: PROC [ra: REF ANY] ~ { aw: ArrayWire ~ NARROW[ra]; awe: REF ArrayWireElt _ NIL; IF aw.ports.Size[] # 0 THEN { TryGroup: PROC [pair: PairColls.Pair] ~ { g: Group ~ NARROW[pair[left]]; bs: BoolSeq ~ NARROW[pair[right]]; air: Range2; gii, ngii: NATURAL _ 0; IF g.ports=NIL THEN RETURN; [air, , ngii] _ Gi2ToAir[a, g.gi2]; FOR foo: INT _ air[Foo].min, foo+a.jointsPeriod[Foo] WHILE foo < air[Foo].maxPlusOne DO FOR bar: INT _ air[Bar].min, bar+a.jointsPeriod[Bar] WHILE bar < air[Bar].maxPlusOne DO IF bs[gii] THEN { awe _ NEW [ArrayWireElt _ [g, [foo, bar]]]; ERROR GotIt; }; gii _ gii+1; ENDLOOP ENDLOOP; IF gii # ngii THEN ERROR; }; aw.members.Enumerate[TryGroup !GotIt => GOTO Gotit]; {NoteDoomedPort: PROC [ra: REF ANY] ~ { IF NOT doomedArrayPorts.AddElt[ra] THEN ERROR; }; aw.ports.Enumerate[NoteDoomedPort]; }; EXITS Gotit => { NotePortAns: PROC [ra: REF ANY] ~ { IF NOT portToAWE.Store[[ra, awe]] THEN ERROR; }; aw.ports.Enumerate[NotePortAns]; awe _ awe; }; }; }; ExPortNewWire: PROC [pair: PairColls.Pair] ~ { ap: Port ~ NARROW[pair[left]]; awe: REF ArrayWireElt ~ NARROW[pair[right]]; gi: NAT ~ ComputeGroupingsIndex[a, awe.ai].gi; aw: ArrayWire ~ ArrayWireForGroup[a, awe.ai, gi, awe.g, TRUE]; IF NOT a.portWire.Replace[ap, aw] THEN ERROR; IF NOT aw.ports.AddElt[ap] THEN ERROR; }; a.wires.Enumerate[RememberExPort]; a.toWire.Erase[]; a.wires.Erase[]; portToAWE.Enumerate[ExPortNewWire]; }; GotIt: ERROR = CODE; TieSpec: TYPE = REF TieSpecPrivate; TieSpecPrivate: TYPE = RECORD [ j: Joint, jgi: NATURAL, tie: Tie ]; tieSpecs: Colls.Space ~ NEW [Colls.SpacePrivate _ [Equal: EqualTieSpecs, Hash: HashTieSpec]]; HashTieSpec: PROC [data, elt: REF ANY] RETURNS [CARDINAL] --HashProc-- ~ { ts: TieSpec ~ NARROW[elt]; RETURN [Colls.HashRefI[ts.j]+Colls.HashRefI[ts.tie]+ts.jgi]; }; EqualTieSpecs: PROC [data, elt1, elt2: REF ANY] RETURNS [BOOL] --EqualProc-- ~ { ts1: TieSpec ~ NARROW[elt1]; ts2: TieSpec ~ NARROW[elt2]; RETURN [ts1^ = ts2^]; }; TrimEmptyGroups: PUBLIC PROC [a: Array] ~ { doomedGroups: Set--of Group-- ~ Colls.CreateHashSet[]; doomedTies: Set--of TieSpec-- ~ Colls.CreateHashSet[tieSpecs]; KillTie: PROC [ra: REF ANY] ~ { ts: TieSpec ~ NARROW[ra]; DeleteTie[ts.j, ts.jgi, ts.tie]; }; KillGroup: PROC [ra: REF ANY] ~ { g: Group ~ NARROW[ra]; DeleteGroup[a, g]; }; FOR gif: NATURAL IN [0 .. a.groupingParmses[Foo].sum) DO FOR gib: NATURAL IN [0 .. a.groupingParmses[Bar].sum) DO gi2: Nat2 ~ [gif, gib]; gi: NATURAL ~ ComposeGI[a, gi2]; gs: Groupings ~ NARROW[a.groupingses[gi]]; ExploreFrom: PROC [ra: REF ANY] ~ {IF ~doomedGroups.HasMember[ra] THEN { g: Group ~ NARROW[ra]; nonempties: LIST OF Group _ NIL; stack: LIST OF RECORD [g: Group, t: Tie] _ NIL; cyclic: BOOL _ FALSE; IF g.ports=NIL THEN { stack _ CONS[[g, NIL], stack]; IF NOT doomedGroups.AddElt[g] THEN ERROR; }; WHILE stack#NIL DO h: Group ~ stack.first.g; avoid: Tie ~ stack.first.t; CrossTie: PROC [d: Dim, phase: Nat2, jgi: NATURAL, jgi2: Nat2, j: Joint, tie: Tie, side: End] ~ { IF tie=NIL THEN ERROR; IF tie#avoid THEN { i: Group ~ tie.groups[OtherEnd[side]]; IF tie.groups[side]#h THEN ERROR; IF i=NIL THEN NULL ELSE IF i.ports=NIL THEN { ts: TieSpec ~ NEW [TieSpecPrivate _ [j, jgi, tie]]; [] _ doomedTies.AddElt[ts]; IF doomedGroups.AddElt[i] THEN stack _ CONS[[i, tie], stack] ELSE cyclic _ TRUE; } ELSE nonempties _ CONS[i, nonempties]; }; }; stack _ stack.rest; IF h=NIL THEN ERROR; EnumerateTiesOfGroup[a, h.gi2, h, CrossTie]; ENDLOOP; IF nonempties=NIL THEN NULL ELSE IF nonempties.rest=NIL AND NOT cyclic THEN NULL ELSE ERROR nyet; }}; gs.groups.Enumerate[ExploreFrom]; ENDLOOP ENDLOOP; doomedTies.Enumerate[KillTie]; doomedGroups.Enumerate[KillGroup]; }; TrimArray: PUBLIC PROC [a: Array] = { FOR d: Dim IN Dim DO FOR phase: Nat2 = [ j: Joint = GetArrayJoint[a, d, phase]; FOR jgi: NAT IN [0 .. j.ties.length) DO ties: VarSet--of Tie-- = FetchTies[j, jgi]; PruneTie: PROC [ra: REF ANY] = { tie: Tie = NARROW[ra]; IF tie.completion = NIL AND (tie.groups[low] = NIL OR tie.groups[high] = NIL) THEN DeleteTie[j, jgi, tie]; }; ties.Enumerate[PruneTie]; ENDLOOP; ENDLOOP ENDLOOP; ENDLOOP; FOR d: Dim IN Dim DO FOR index: NAT IN [0 .. a.roles[d].length) DO rpd: SidedPortData ~ NARROW[a.roles[d].refs[index]]; IF rpd=NIL THEN --it's a deleted index--LOOP; IF rpd.links # NIL AND NOT RPDNeedsLinks[a, d, rpd] THEN rpd.links _ NIL; ENDLOOP; ENDLOOP; }; NameIndex: PUBLIC PROC [a: Array, index: ArrayIndex] RETURNS [SteppyName] = { SELECT TRUE FROM a.size[Foo]=1 => RETURN [LIST[NewInt[index[Bar]]]]; a.size[Bar]=1 => RETURN [LIST[NewInt[index[Foo]]]]; ENDCASE => RETURN [LIST[NewInt[index[Foo]], NewInt[index[Bar]]]]; }; FmtIndex: PUBLIC PROC [a: Array, index: ArrayIndex] RETURNS [asRope: ROPE] = { asRope _ SELECT TRUE FROM a.size[Foo]=1 => Subscript[NIL, index[Bar]], a.size[Bar]=1 => Subscript[NIL, index[Foo]], ENDCASE => Subscript2[NIL, index]; }; sublen: NATURAL ~ 64; subs: ARRAY [0 .. sublen) OF ROPE _ ALL[NIL]; Subscript: PUBLIC PROC [base: ROPE, index: INT] RETURNS [sub: ROPE] ~ { sub _ IF index < sublen THEN sub _ subs[index] ELSE sub _ Convert.RopeFromInt[index].Concat["/"]; IF base.Length#0 THEN sub _ base.Cat["/", sub]; RETURN}; sub2len: NATURAL _ 2050; sub2Ps: LRUCache.Handle _ LRUCache.Create[sub2len, HashAI, EqualAI]; sub2Rs: RefSeq _ CreateRefSeq[sub2len]; s2probes, s2misses: CARD _ 0; HashAI: PROC [ra: REF ANY] RETURNS [CARDINAL] --LRUCache.HashProc-- ~ { rai: REF ArrayIndex ~ NARROW[ra]; lnF: Basics.LongNumber ~ [li[rai[Foo]]]; lnB: Basics.LongNumber ~ [li[rai[Bar]]]; ln: Basics.LongNumber ~ [lc[lnF.lo + lnF.hi*3 + lnB.lo*5 + lnB.hi*7]]; RETURN [ln.lo+ln.hi]; }; EqualAI: PROC [r1, r2: REF ANY] RETURNS [BOOL] --LRUCache.EqualProc-- ~ { rai1: REF ArrayIndex ~ NARROW[r1]; rai2: REF ArrayIndex ~ NARROW[r2]; RETURN [rai1^ = rai2^]}; Subscript2: PUBLIC PROC [base: ROPE, index: ArrayIndex] RETURNS [sub: ROPE] ~ { rai: REF ArrayIndex ~ NEW [ArrayIndex _ index]; p: NATURAL; news: BOOL; [p, news, ] _ sub2Ps.Include[rai]; s2probes _ s2probes+1; IF news THEN { sub2Rs[p] _ Rope.Cat[Convert.RopeFromInt[index[Foo]], "/", Convert.RopeFromInt[index[Bar]], "/"]; s2misses _ s2misses+1; }; sub _ NARROW[sub2Rs[p]]; IF base.Length#0 THEN sub _ base.Cat["/", sub]; RETURN}; Start: PROC ~ { FOR index: NATURAL IN [0 .. sublen) DO subs[index] _ Convert.RopeFromInt[index].Concat["/"]; ENDLOOP; RETURN}; Start[]; END.