RosaryImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Michael Plass, January 29, 1986 5:50:47 pm PST
DIRECTORY
AMBridge USING [IsRemote, ReadOnlyRefFromTV, TVForATOM, TVForReadOnlyReferent, TVForROPE],
AMTypes USING [TV],
Basics USING [NonNegative],
IO USING [PutRope],
PrintTV USING [Print, RefPrintProc, RegisterTVPrintProc, TVPrintProc],
Rope USING [ROPE],
Rosary USING [ActionType, Buffer, bufferSize, Item, MapRunsProc, maxHeight, nullSegment, RosaryRep, ROSARY, Run, RunActionType, Segment, SubstrProc];
RosaryImpl: CEDAR PROGRAM
IMPORTS AMBridge, Basics, IO, PrintTV
EXPORTS Rosary ~ BEGIN OPEN Rosary;
Malformed: PUBLIC ERROR ~ CODE;
NonNeg: PROC [value: INT] RETURNS [INT] ~ Basics.NonNegative;
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 => {
it: Item ← NIL;
a: PROC [item: Item, repeat: INT] RETURNS [quit: BOOLEANTRUE] ~ {it ← item};
[] ← o.mapRuns[[base, index, 1], a];
RETURN [it];
};
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: Run ← [NIL, 0];
a: PROC [item: Item, repeat: INT] RETURNS [quit: BOOLEANTRUE] ~ {
run ← [item, repeat]
};
[] ← o.mapRuns[FixSegment[[base, index]], a];
RETURN [run]
};
ENDCASE => ERROR Malformed;
ENDLOOP;
};
FromItem: PUBLIC PROC [item: Item, repeat: INT] RETURNS [ROSARY] ~ {
r: REF RosaryRep.leaf ← NEW[RosaryRep.leaf];
r.size ← repeat;
r.height ← 1;
r.item ← item;
RETURN [r];
};
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𡤀, 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�l.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: INTMAX[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 [FromProcProc[p]];
};
FromProcProc: PUBLIC PROC [p: PROC[q: PROC[item: Item, repeat: INT]]] RETURNS [ROSARYNIL] ~ {
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: ROSARYNIL;
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]𡤌.rest; stackSize←stackSize+1; currentBase𡤌.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: BOOLEANFALSE] ~ {
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 {
s.size ← NonNeg[MIN[s.size, s.base.size-s.start]];
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.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]𡤌.rest; stackSize←stackSize + 1; base𡤌.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: BOOLEANFALSE] ~ {
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 [FromProcProc[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;
};
RETURN [head.rest];
};
DefaultSubstr: PROC [base: ROSARY, start: INT, len: INT] RETURNS [ROSARY] ~ {
p: PROC[q: PROC[item: REF, repeat: INT]] ~ {
a: PROC [item: Item, repeat: INT] RETURNS [quit: BOOLEANFALSE] ~ { q[item, repeat] };
[] ← MapRuns[[base, start, len], a];
};
RETURN [FromProcProc[p]]
};
FromObject: PUBLIC PROC [size: INT, data: REF ANY, mapRuns: MapRunsProc, substr: SubstrProc] RETURNS [ROSARY] ~ {
IF substr = NIL THEN substr ← DefaultSubstr;
RETURN [NEW[RosaryRep.object ← [size: size, height: 1, var: object[data: data, 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.