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 {
raises bounds fault if i > 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] ~ {
Never trys to rebalance.
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] ~ {
Tries to pull the last item back into b, if it will coalese with the new one.
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] ~ {
Balances pieces [first..end), whose sizes must sum to size.
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] ~ {
Examines only the root.
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
Use Fibonacci recurrence to compute rest.
Be careful about overflow here...
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;
The contents of the current node is represented by the concatenation of ropes in order by decreasing index, together with the contents of b. The size of a[i] is either 0 or approximately flatMax*2**i; building the ROSARY this way yields a balanced 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;
The stack holds rosaries that still need to be traversed, after finishing with the current segment; the topmost (i.e. stack[stackSize-1]) needs to be traversed first.
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 ~ {
PROC [s: Segment, action: RunActionType] RETURNS [quit: BOOLEAN];
segmentEnd: INT ~ s.start+FixSegment[s].size;
index: INT ¬ s.start;
WHILE index<segmentEnd
DO
interval: ContainingRun ~ FetchContainingRun[s.base, index];
end: INT ~ MIN[interval.end, segmentEnd];
IF action[interval.item, end-index] THEN RETURN[TRUE];
index ¬ end;
ENDLOOP;
RETURN[FALSE];
};
DefaultSubstr: SubstrProc ~ {
p:
PROC[q:
PROC[item:
REF, repeat:
INT]] ~ {
a: PROC [item: Item, repeat: INT] RETURNS [quit: BOOLEAN ¬ FALSE] ~ { q[item, repeat] };
[] ¬ MapRuns[[base, start, len], a];
};
RETURN [FromRuns[p]]
};
FromObject:
PUBLIC
PROC [size:
INT, data:
REF
ANY, fetchContainingRun: FetchContainingRunProc,
mapRuns: MapRunsProc, substr: SubstrProc]
RETURNS [
ROSARY] ~ {
IF mapRuns = NIL THEN mapRuns ¬ DefaultMapRuns;
IF substr = NIL THEN substr ¬ DefaultSubstr;
RETURN [NEW[RosaryRep.object ¬ [size: size, height: 1, var: object[data: data,
fetchContainingRun: fetchContainingRun, mapRuns: mapRuns, substr: substr]]]];
};
TVPrint: PrintTV.TVPrintProc ~ TRUSTED {
IF NOT AMBridge.IsRemote[tv] THEN RETURN [RefPrint[AMBridge.ReadOnlyRefFromTV[tv], NIL, stream, depth, width, verbose]];
};
RefPrint: PrintTV.RefPrintProc ~ TRUSTED {
WITH LOOPHOLE[ref, REF] SELECT FROM
r: ROSARY => {
size: INT ~ Size[r];
i: INT ← 0;
action: ActionType ~ TRUSTED {
itemTV: AMTypes.TV;
WITH item SELECT FROM
atom: ATOM => itemTV ← AMBridge.TVForATOM[atom];
rope: Rope.ROPE => itemTV ← AMBridge.TVForROPE[rope];
ENDCASE => {
itemTV ← AMBridge.TVForReadOnlyReferent[item];
IF item # NIL THEN IO.PutRope[stream, "^"];
};
PrintTV.Print[tv: itemTV, put: stream, depth: depth-1, width: width, verbose: verbose];
i ← i + 1;
IF i # size THEN IO.PutRope[stream, ", "];
quit ← (i >= width);
};
IO.PutRope[stream, "ROSARY["];
IF Map[[r],action] THEN IO.PutRope[stream, "..."];
IO.PutRope[stream, "]"];
RETURN [useOld: FALSE];
};
ENDCASE => NULL;
RETURN [useOld: TRUE];
};
PrintTV.RegisterTVPrintProc[[CODE[RosaryRep]], TVPrint];
END.