<<>> <> <> <> <> <> <<>> DIRECTORY Basics USING [NonNegative], Rosary USING [ActionType, Buffer, BufferRep, bufferSize, ContainingRun, FetchContainingRunProc, Item, MapRunsProc, maxHeight, nullSegment, ROSARY, RosaryRep, Run, RunActionType, Segment, SubstrProc]; RosaryImpl: CEDAR PROGRAM IMPORTS Basics EXPORTS Rosary ~ BEGIN OPEN Rosary; Malformed: PUBLIC ERROR ~ CODE; NonNeg: PROC [value: INT] RETURNS [INT] ~ INLINE {RETURN[Basics.NonNegative[value]]}; Size: PUBLIC PROC [r: ROSARY] RETURNS [INT] ~ { RETURN [IF r = NIL THEN 0 ELSE r.size] }; InlineSize: PROC [r: ROSARY] RETURNS [INT] ~ INLINE { RETURN [IF r = NIL THEN 0 ELSE r.size] }; BoundsCheck: PROC [i: INT, max: INT] ~ INLINE { < max or i < 0;>> boundsCheck: [0..0] ~ MIN[max-NonNeg[i], 0]; }; Fetch: PUBLIC PROC [base: ROSARY, index: INT] RETURNS [Item] ~ { BoundsCheck[index, InlineSize[base]-1]; DO WITH base SELECT FROM f: REF RosaryRep.leaf => RETURN [f.item]; c: REF RosaryRep.concat => { pos: INT ~ c.base.size; IF index < pos THEN base ¬ c.base ELSE {base ¬ c.rest; index ¬ index-pos}; }; o: REF RosaryRep.object => { RETURN [o.fetchContainingRun[base, index].item]; }; ENDCASE => ERROR Malformed; ENDLOOP; }; FetchRun: PUBLIC PROC [base: ROSARY, index: INT] RETURNS [Run] ~ { BoundsCheck[index, InlineSize[base]-1]; DO WITH base SELECT FROM f: REF RosaryRep.leaf => RETURN [[f.item, f.size-index]]; c: REF RosaryRep.concat => { pos: INT ~ c.base.size; IF index < pos THEN base ¬ c.base ELSE {base ¬ c.rest; index ¬ index-pos}; }; o: REF RosaryRep.object => { run: ContainingRun ~ o.fetchContainingRun[base, index]; RETURN[[run.item, run.end-index]]; }; ENDCASE => ERROR Malformed; ENDLOOP; }; FetchContainingRun: PUBLIC PROC [base: ROSARY, index: INT] RETURNS [ContainingRun] ~ { start: INT ¬ 0; BoundsCheck[index, InlineSize[base]-1]; DO WITH base SELECT FROM f: REF RosaryRep.leaf => RETURN [[f.item, start, start+f.size]]; c: REF RosaryRep.concat => { pos: INT ~ start+c.base.size; IF index < pos THEN base ¬ c.base ELSE {base ¬ c.rest; start ¬ pos}; }; o: REF RosaryRep.object => { run: ContainingRun ~ o.fetchContainingRun[base, index-start]; RETURN[[run.item, start+run.start, start+run.end]]; }; ENDCASE => ERROR Malformed; ENDLOOP; }; FromItem: PUBLIC PROC [item: Item, repeat: INT] RETURNS [ROSARY] ~ { size: [0..INT.LAST] ~ repeat; -- ensure non-negative RETURN[NEW[RosaryRep.leaf ¬ [size: size, height: 1, var: leaf[item: item]]]]; }; Substr: PUBLIC PROC [base: ROSARY, start: INT, len: INT] RETURNS [ROSARY] ~ { [[base, start, len]] ¬ FixSegment[[base, start, len]]; IF base = NIL OR (start = 0 AND len = base.size) THEN RETURN [base]; RETURN [CatSegments[[base, start, len], nullSegment, nullSegment]]; }; LazyConcat: PROC [base, rest: ROSARY] RETURNS [ROSARY] ~ { <> IF base=NIL THEN RETURN [rest]; IF rest=NIL THEN RETURN [base]; BoundsCheck[base.size, LAST[INT]-NonNeg[rest.size]]; IF base=NIL THEN RETURN [rest] ELSE IF rest=NIL THEN RETURN [base] ELSE { r: REF RosaryRep.concat ¬ NEW[RosaryRep.concat]; r.size ¬ base.size + rest.size; r.height ¬ 1+MAX[base.height, rest.height]; r.base ¬ base; r.rest ¬ rest; RETURN [r]; }; }; Concat: PUBLIC PROC [base, rest: ROSARY] RETURNS [ROSARY] ~ { IF base=NIL THEN RETURN [rest]; IF rest=NIL THEN RETURN [base]; IF base.height >= maxHeight-1 OR rest.height >= maxHeight-1 THEN { RETURN [CatSegments[[base], [rest], nullSegment]]; } ELSE RETURN [LazyConcat[base, rest]]; }; Cat: PUBLIC PROC [r0, r1, r2, r3, r4: ROSARY] RETURNS [ROSARY] ~ { RETURN [Concat[Concat[r0,r1], Concat[Concat[r2, r3], r4]]]; }; CatSegments: PUBLIC PROC [s0, s1, s2: Segment] RETURNS [ROSARY] ~ { a: ARep; -- An extensible array that is very cheap if it is small. aN: INT ¬ 0; AElement: TYPE ~ ROSARY; d: NAT ~ 40; ARep: TYPE ~ RECORD[index: INT¬0, sub: ARRAY [0..d) OF AElement, rest: REF ARep¬NIL]; accel: REF ARep ¬ NIL; StoreA: PROC [i: INT, e: AElement] ~ { IF i-a.index < d THEN a.sub[i-a.index] ¬ e ELSE { IF a.rest = NIL THEN {a.rest ¬ accel ¬ NEW[ARep]; accel.index ¬ d}; IF i < accel.index THEN accel ¬ a.rest; WHILE i-accel.index >= d DO IF accel.rest = NIL THEN {accel.rest ¬ NEW[ARep]; accel.rest.index¬accel.index+d}; accel ¬ accel.rest; ENDLOOP; accel.sub[i-accel.index] ¬ e; }; }; ASub: PROC [i: INT] RETURNS [e: AElement] ~ { IF i-a.index < d THEN e ¬ a.sub[i-a.index] ELSE { IF i < accel.index THEN accel ¬ a.rest; WHILE i-accel.index >= d DO accel ¬ accel.rest ENDLOOP; e ¬ accel.sub[i-accel.index]; }; }; nb: INT ¬ 0; b: Item ¬ NIL; Flush: PROC ~ { IF nb > 0 THEN { f: REF RosaryRep.leaf ¬ NEW[RosaryRep.leaf]; f.size ¬ nb; f.height ¬ 1; f.item ¬ b; nb ¬ 0; b ¬ NIL; StoreA[aN, f]; aN ¬ aN + 1; }; }; CheckItem: PROC[new: Item] ~ { <> IF nb = 0 AND aN > 0 THEN { WITH ASub[aN-1] SELECT FROM f: REF RosaryRep.leaf => { IF f.item = new THEN { b ¬ new; nb ¬ f.size; aN ¬ aN - 1; }; }; ENDCASE => NULL; }; }; SaveSegment: PROC [segment: Segment] ~ { IF segment.base # NIL THEN WITH segment.base SELECT FROM f: REF RosaryRep.leaf => { CheckItem[f.item]; IF nb > 0 AND b = f.item THEN nb ¬ nb + segment.size ELSE { Flush[]; IF segment.start = 0 AND segment.size = f.size THEN {StoreA[aN, f]; aN ¬ aN + 1} ELSE {b ¬ f.item; nb ¬ segment.size}; }; }; ENDCASE => { IF segment.start = 0 AND segment.size = segment.base.size THEN NULL ELSE ERROR; Flush[]; StoreA[aN, segment.base]; aN ¬ aN + 1; }; }; BalanceRange: PROC [first: INT, end: INT, size: INT] RETURNS [ROSARY] ~ { <> Dbl: PROC [int: INT] RETURNS [INT] ~ INLINE { IF int > LAST[INT]/2 THEN RETURN [LAST[INT]] ELSE RETURN [int+int]; }; IF first = end THEN RETURN[NIL] ELSE IF end-first = 1 THEN RETURN[ASub[first]] ELSE { i: INT ¬ first+1; sizetoi: INT ¬ ASub[first].size; FOR sizei: INT ¬ ASub[i].size, ASub[i].size WHILE i < end-1 AND ((sizetoi+sizei)*2 < size OR ABS[sizetoi*2-size] > ABS[(sizetoi+sizei)*2-size]) DO sizetoi ¬ sizetoi + sizei; i ¬ i + 1; ENDLOOP; RETURN[LazyConcat[BalanceRange[first, i, sizetoi], BalanceRange[i, end, size-sizetoi]]]; }; }; s0 ¬ FixSegment[s0]; s1 ¬ FixSegment[s1]; s2 ¬ FixSegment[s2]; BoundsCheck[s1.size, LAST[INT]-s0.size]; BoundsCheck[s2.size, LAST[INT]-(s0.size+s1.size)]; MapSegments[s0, SaveSegment, SegmentIsBalanced]; MapSegments[s1, SaveSegment, SegmentIsBalanced]; MapSegments[s2, SaveSegment, SegmentIsBalanced]; Flush[]; RETURN [BalanceRange[0, aN, s0.size+s1.size+s2.size]] }; FixSegment: PROC [s: Segment] RETURNS [Segment] ~ { [] ¬ NonNeg[s.start]; [] ¬ NonNeg[s.size]; IF s.base = NIL THEN {[] ¬ NonNeg[-s.start]; s.size ¬ 0} ELSE {s.size ¬ NonNeg[MIN[s.size, s.base.size-s.start]]}; RETURN [s]; }; BadSegment: SIGNAL ~ CODE; SegmentIsBalanced: PROC [segment: Segment] RETURNS [BOOL] ~ { <> IF segment.base = NIL THEN RETURN [TRUE] ELSE { size: INT ~ segment.base.size; height: INT ~ segment.base.height; IF segment.start # 0 OR segment.size # size OR height > maxHeight OR size < minSizeForHeight[height] THEN RETURN [FALSE] ELSE RETURN [TRUE] }; }; minSizeForHeight: ARRAY [0..maxHeight) OF INT ~ InitMinSizeForHeight[]; InitMinSizeForHeight: PROC RETURNS [h: ARRAY [0..maxHeight) OF INT] ~ { h[0] ¬ 0; -- NIL has height 0, size 0. h[1] ¬ 1; -- Must have at least one element to warrant any allocation. h[2] ¬ 2; -- Must be at least this big to warrant any concat nodes. FOR i: NAT IN [3..maxHeight) DO <> <> IF INT.LAST - h[i-1] < h[i-2] THEN h[i] ¬ INT.LAST ELSE h[i] ¬ h[i-1] + h[i-2]; ENDLOOP; }; MapSegments: PROC [segment: Segment, action: PROC[Segment], stopDescent: PROC[Segment]RETURNS[BOOL]¬NIL] ~{ IF stopDescent#NIL AND stopDescent[segment] THEN action[segment] ELSE { size: INT ~ InlineSize[segment.base]; end: INT ~ segment.start+segment.size; IF segment.start < 0 OR end NOT IN [segment.start..size] THEN ERROR BadSegment; WITH segment.base SELECT FROM concat: REF RosaryRep.concat => { pos: INT ~ concat.base.size; IF segment.start < pos THEN { MapSegments[[concat.base, segment.start, MIN[end, pos]-segment.start], action, stopDescent]; }; IF end > pos THEN { newStart: INT ¬ MAX[segment.start-pos, 0]; newEnd: INT ¬ end-pos; MapSegments[[concat.rest, newStart, newEnd-newStart], action, stopDescent]; }; }; object: REF RosaryRep.object => { s: ROSARY ~ object.substr[segment.base, segment.start, segment.size]; IF InlineSize[s] # segment.size THEN ERROR Malformed; action[[s, 0, segment.size]]; }; ENDCASE => action[segment]; }; }; FromProc: PUBLIC PROC [size: INT, proc: PUBLIC PROC RETURNS[Item]] RETURNS [ROSARY] ~ { p: PROC[q: PROC[item: Item, repeat: INT ¬ 1]] ~ { FOR i: INT IN [0..size) DO q[proc[], 1]; ENDLOOP; }; RETURN [FromRuns[p]]; }; FromRuns: PUBLIC PROC [p: PROC[q: PROC[item: Item, repeat: INT]]] RETURNS [ROSARY ¬ NIL] ~ { a: ARRAY [0..maxHeight] OF ROSARY; <> nb: INT ¬ 0; b: Item ¬ NIL; Fold: PROC [new: ROSARY] ~ { i: NAT ¬ 0; DO IF a[i] = NIL THEN {a[i] ¬ new; EXIT}; new ¬ LazyConcat[a[i], new]; a[i] ¬ NIL; IF i < maxHeight THEN i ¬ i + 1; ENDLOOP; }; Flush: PROC ~ { IF nb > 0 THEN { f: REF RosaryRep.leaf ¬ NEW[RosaryRep.leaf]; f.size ¬ nb; f.height ¬ 1; f.item ¬ b; nb ¬ 0; Fold[f]; }; }; q: PROC[item: Item, repeat: INT] ~ { IF nb > 0 AND item = b THEN {nb ¬ nb + repeat} ELSE {Flush[]; b ¬ item; nb ¬ repeat}; }; ref: ROSARY ¬ NIL; p[q]; Flush[]; FOR i: NAT IN [0..maxHeight] DO IF a[i] # NIL THEN { ref ¬ LazyConcat[a[i], ref]; }; ENDLOOP; RETURN [ref]; }; Map: PUBLIC PROC [s: Segment, action: ActionType] RETURNS [BOOLEAN] ~ { fixedSegment: Segment ~ FixSegment[s]; stack: ARRAY [0..maxHeight) OF ROSARY; stackSize: [0..maxHeight] ¬ 0; <> currentBase: ROSARY ¬ fixedSegment.base; currentIndex: INT ¬ fixedSegment.start; residual: INT ¬ fixedSegment.size; IF residual = 0 THEN RETURN [FALSE]; DO -- exit by RETURN WITH currentBase SELECT FROM c: REF RosaryRep.concat => { pos: INT ~ c.base.size; IF currentIndex < pos THEN {stack[stackSize]¬c.rest; stackSize¬stackSize+1; currentBase¬c.base} ELSE {currentIndex ¬ currentIndex - pos; currentBase ¬ c.rest}; }; t: REF RosaryRep.leaf => { WHILE currentIndex < t.size DO IF action[t.item] THEN RETURN [TRUE]; currentIndex ¬ currentIndex + 1; IF (residual ¬ residual - 1) = 0 THEN RETURN [FALSE]; ENDLOOP; IF stackSize = 0 THEN RETURN [FALSE]; stackSize ¬ stackSize - 1; currentBase ¬ stack[stackSize]; currentIndex ¬ 0; }; o: REF RosaryRep.object => { a: PROC [item: Item, repeat: INT] RETURNS [quit: BOOLEAN ¬ FALSE] ~ { FOR k: INT IN [0..repeat) DO IF action[item] THEN RETURN [TRUE]; currentIndex ¬ currentIndex + 1; IF (residual ¬ residual - 1) = 0 THEN RETURN [TRUE]; ENDLOOP; }; IF o.mapRuns[FixSegment[[currentBase, currentIndex, residual]], a] THEN RETURN [residual#0]; IF stackSize = 0 THEN RETURN [FALSE]; stackSize ¬ stackSize - 1; currentBase ¬ stack[stackSize]; currentIndex ¬ 0; }; ENDCASE => RETURN [FALSE]; ENDLOOP; }; MapRuns: PUBLIC PROC [s: Segment, action: RunActionType] RETURNS [quit: BOOLEAN] ~ { s ¬ FixSegment[s]; IF s.base # NIL THEN { DO WITH s.base SELECT FROM f: REF RosaryRep.leaf => { IF action[f.item, s.size] THEN RETURN [TRUE]; EXIT; }; c: REF RosaryRep.concat => { IF s.start < c.base.size THEN { IF MapRuns[[c.base, s.start, s.size], action].quit THEN RETURN [TRUE]; }; s.start ¬ s.start - c.base.size; IF s.start < 0 THEN { s.size ¬ s.size + s.start; s.start ¬ 0; }; s.base ¬ c.rest; IF s.size <= 0 THEN EXIT; }; o: REF RosaryRep.object => { IF o.mapRuns[FixSegment[s], action] THEN RETURN [TRUE]; EXIT; }; ENDCASE => ERROR Malformed; ENDLOOP; }; RETURN [FALSE]; }; FetchBuffer: PUBLIC PROC [base: ROSARY, index: INT, maxCount: [0..bufferSize]] RETURNS [b: Buffer] ~ { stack: ARRAY [0..maxHeight) OF ROSARY; stackSize: [0..maxHeight] ¬ 0; BoundsCheck[index, InlineSize[base]]; b ¬ NEW[BufferRep ¬ [count: 0]]; DO -- exit by RETURN WITH base SELECT FROM c: REF RosaryRep.concat => { pos: INT ~ c.base.size; IF index < pos THEN {stack[stackSize]¬c.rest; stackSize¬stackSize + 1; base¬c.base} ELSE {index ¬ index - pos; base ¬ c.rest}; }; t: REF RosaryRep.leaf => { WHILE index < t.size DO IF b.count = maxCount THEN RETURN; b.a[b.count] ¬ t.item; index ¬ index + 1; b.count ¬ b.count + 1; ENDLOOP; IF stackSize = 0 THEN RETURN; stackSize ¬ stackSize - 1; base ¬ stack[stackSize]; index ¬ 0; }; o: REF RosaryRep.object => { a: PROC [item: Item, repeat: INT] RETURNS [quit: BOOLEAN ¬ FALSE] ~ { FOR k: INT IN [0..repeat) DO IF b.count = maxCount THEN RETURN [TRUE]; b.a[b.count] ¬ item; index ¬ index + 1; b.count ¬ b.count + 1; ENDLOOP; }; IF o.mapRuns[FixSegment[[base, index]], a] THEN RETURN; IF stackSize = 0 THEN RETURN; stackSize ¬ stackSize - 1; base ¬ stack[stackSize]; index ¬ 0; }; ENDCASE => RETURN; ENDLOOP; }; FromList: PUBLIC PROC [list: LIST OF REF] RETURNS [ROSARY] ~ { p: PROC[q: PROC[item: REF, repeat: INT ¬ 1]] ~ { FOR l: LIST OF REF ¬ list, l.rest UNTIL l = NIL DO q[l.first]; ENDLOOP; }; RETURN [FromRuns[p]] }; ToList: PUBLIC PROC [r: ROSARY] RETURNS [LIST OF REF] ~ { head: LIST OF REF ~ LIST[NIL]; tail: LIST OF REF ¬ head; action: ActionType ~ { tail.rest ¬ LIST[item]; tail ¬ tail.rest; }; [] ¬ Map[[r], action]; RETURN [head.rest]; }; DefaultMapRuns: MapRunsProc ~ { <> segmentEnd: INT ~ s.start+FixSegment[s].size; index: INT ¬ s.start; WHILE index> <> <<};>> <<>> <> <> < {>> <> <> <> <> <> < itemTV _ AMBridge.TVForATOM[atom];>> < itemTV _ AMBridge.TVForROPE[rope];>> < {>> <> <> <<};>> <> <> <> <= width);>> <<};>> <> <> <> <> <<};>> < NULL;>> <> <<};>> <<>> <> END.