-- RopeImpl.mesa, "Thick" string implementation
-- Russ Atkinson, September 9, 1982 3:27 pm
-- This implementation supports "lazy evaluation" for Substr, Concat, and Replace operations. It also allows the user to create arbitrary implementations for compatible Rope objects by supplying procedures for the defining operations.
DIRECTORY
Environment USING [Comparison],
Rope,
RopeInline USING
[BoundsFault, CheckLongAdd, InlineDepth,
InlineFetch, InlineSize, Lower, MaxDepth, NonNeg,
QFetch, QShort, QStore, RoundToFit, Short, SingleSize,
Tconcat, Tobject, Treplace, Tsubstr, Ttext],
SafeStorage USING [NewZone];
RopeImpl: CEDAR PROGRAM
IMPORTS RopeInline, SafeStorage
EXPORTS Rope, RopeInline
SHARES Rope
= BEGIN OPEN Rope, RopeInline, SafeStorage;
-- errors peculiar to Rope
NoRope: PUBLIC ERROR = CODE;
checking: BOOL ← TRUE;
qz: ZONE ← NewZone[quantized]; -- local zone for nodes and small text
pz: ZONE ← NewZone[prefixed]; -- local zone for text only
EmptyRope: Text ← "";
NewText: PUBLIC PROC [size: NAT] RETURNS [text: Text] = TRUSTED {
-- NOTE: exported to RopeInline, not Rope
-- internal proc to allocate new text objects
IF size = 0 THEN RETURN [EmptyRope];
IF size <= FlatMax
THEN
-- use the quantized zone, it's cheaper
text ← qz.NEW[Ttext[RoundToFit[size]]]
ELSE
-- might as well be prefixed
text ← pz.NEW[Ttext[size]];
text.length ← size;
};
Substr: PUBLIC PROC
[base: ROPE, start: INT ← 0, len: INT ← MaxLen] RETURNS [new: ROPE] = TRUSTED {
size: INT ← InlineSize[base];
rem: INT ← NonNeg[size - NonNeg[start]];
depth: INTEGER ← 1;
IF len <= 0 THEN RETURN [EmptyRope] ELSE IF len > rem THEN len ← rem;
IF start = 0 AND len = rem THEN RETURN [base];
IF len <= FlatMax THEN RETURN [Flatten[base, start, len]];
DO
x: ROPE = base;
WITH x: x SELECT FROM
text =>
{-- no sub-structure
EXIT};
node =>
WITH x: x SELECT FROM
substr =>
{base ← x.base; start ← start + x.start};
concat =>
{xpos: INT ← x.pos;
rem: INT ← xpos - start;
IF rem > 0
THEN {IF len > rem THEN
{-- crosses sections
depth ← x.depth; EXIT};
base ← x.base}
ELSE {base ← x.rest; start ← -rem}};
replace =>
{xstart: INT ← x.start;
len1: INT ← xstart - start;
IF len1 > 0
THEN -- substr starts in 1st section
{IF len > len1 THEN
{-- crosses low boundary
depth ← x.depth; EXIT};
base ← x.base} -- entirely in first section
ELSE -- substr starts in middle or last sections
{xnew: INT ← x.newPos;
len2: INT ← xnew - start;
IF len2 > 0
THEN -- substr starts in middle section
{IF len > len2 THEN
{-- crosses high boundary
depth ← x.depth; EXIT};
base ← x.replace; -- entirely in middle section
start ← -len1}
ELSE -- entirely in last section
{base ← x.base;
start ← x.oldPos - len2}}};
object =>
{-- no sub-structure
EXIT};
ENDCASE => ERROR NoRope;
ENDCASE => ERROR NoRope;
IF start = 0 AND len = InlineSize[base] THEN RETURN [base];
ENDLOOP;
IF checking THEN {
[] ← NonNeg[start];
[] ← NonNeg[len];
};
new ← qz.NEW[Tsubstr ←
[node[substr[base: base, start: start,
size: len, depth: depth + 1]]]];
IF depth > MaxDepth THEN new ← Balance[new];
};
Cat: PUBLIC PROC [r1, r2, r3, r4, r5, r6: ROPE ← NIL] RETURNS [ROPE] = TRUSTED {
RETURN [Concat[Concat[r1,r2], Concat[Concat[r3, r4], Concat[r5, r6]]]];
};
Concat: PUBLIC PROC [base,rest: ROPE ← NIL] RETURNS [new: ROPE] = TRUSTED {
baseStr, restStr: Text;
baseLen, restLen, size: INT;
depth: INTEGER ← 1;
IF rest = NIL THEN RETURN [base];
[baseLen, baseStr] ← SingleSize[base];
IF baseLen = 0 THEN RETURN [rest];
[restLen, restStr] ← SingleSize[rest];
IF restLen = 0 THEN RETURN [base];
size ← CheckLongAdd[baseLen,restLen];
IF size <= FlatMax THEN {
str: Text ← NewText[QShort[size]];
index: CARDINAL ← 0;
AddChar: PROC [c: CHAR] RETURNS [BOOL] = TRUSTED {
QStore[c, str, index]; index ← index + 1; RETURN [FALSE]};
IF baseStr = NIL
THEN [] ← Map[base, 0, baseLen, AddChar]
ELSE FOR i: CARDINAL IN [0..QShort[baseLen]) DO
QStore[QFetch[baseStr, i], str, index];
index ← index + 1;
ENDLOOP;
IF restStr = NIL
THEN [] ← Map[rest, 0, restLen, AddChar]
ELSE FOR i: CARDINAL IN [0..QShort[restLen]) DO
QStore[QFetch[restStr, i], str, index];
index ← index + 1;
ENDLOOP;
RETURN [str]};
IF restLen < FlatMax THEN
{x: ROPE ← base;
WITH x: x SELECT FROM
node => WITH x: x SELECT FROM
concat =>
IF x.size-x.pos < FlatMax/2 THEN {
base ← x.base; baseLen ← x.pos;
rest ← Concat[x.rest, rest]};
ENDCASE;
ENDCASE}
ELSE IF baseLen < FlatMax THEN
{x: ROPE ← base;
WITH x: base SELECT FROM
node => WITH x: x SELECT FROM
concat =>
IF x.pos < FlatMax/2 THEN {
rest ← x.rest;
baseLen ← x.pos+baseLen;
base ← Concat[base, x.base]};
ENDCASE;
ENDCASE};
IF checking THEN {
[] ← NonNeg[size-baseLen]};
depth ← MAX[InlineDepth[base], InlineDepth[rest]] + 1;
new ← qz.NEW[Tconcat ←
[node[concat[base: base, rest: rest,
size: size, pos: baseLen,
depth: depth]]]];
IF depth > MaxDepth THEN new ← Balance[new];
};
Replace: PUBLIC PROC
[base: ROPE, start: INT ← 0, len: INT ← MaxLen, with: ROPE ← NIL]
RETURNS [new: ROPE] = TRUSTED {
baseSize: INT ← InlineSize[base];
repSize: INT ← InlineSize[with];
rem: INT ← NonNeg[baseSize - NonNeg[start]];
depth: INTEGER ← 0;
oldPos: INT ← start +
(IF len < 0 THEN len ← 0 ELSE IF len > rem THEN len ← rem ELSE len);
newPos: INT ← CheckLongAdd[start,repSize];
size: INT ← CheckLongAdd[baseSize-len, repSize];
IF size = repSize THEN RETURN [with];
IF len = 0 AND repSize = 0 THEN RETURN [base]; -- identity check
IF size <= FlatMax THEN {
-- result is small enough to be flat
str: Text ← NewText[QShort[size]];
index: NAT ← 0;
AddChar: PROC [c: CHAR] RETURNS [BOOL] = TRUSTED {
QStore[c, str, index]; index ← index + 1; RETURN [FALSE]};
IF start > 0 THEN [] ← Map[base, 0, start, AddChar];
IF repSize > 0 THEN [] ← Map[with, 0, repSize, AddChar];
IF oldPos < baseSize THEN [] ← Map[base, oldPos, baseSize, AddChar];
RETURN [str]};
{x: ROPE ← base;
WITH x: x SELECT FROM
node =>
WITH x: x SELECT FROM
replace => {
xnewPos: INT ← x.newPos;
xstart: INT ← x.start;
IF start <= xstart AND oldPos >= xnewPos THEN {
-- replacing the replacement string
base ← x.base; oldPos ← x.oldPos + (oldPos - xnewPos);
} ELSE IF start = xnewPos THEN {
-- adding to old replace string
IF repSize + (xnewPos - xstart) <= FlatMax THEN
{with ← Concat[x.replace, with];
base ← x.base; start ← xstart;
oldPos ← x.oldPos + len};
}};
ENDCASE;
ENDCASE};
IF checking THEN {
[] ← NonNeg[NonNeg[newPos] - NonNeg[start]];
[] ← NonNeg[NonNeg[oldPos] - start];
[] ← NonNeg[NonNeg[size] - newPos];
};
depth ← MAX[InlineDepth[base], InlineDepth[with]] + 1;
new ← qz.NEW[Treplace ←
[node[replace[base: base, replace: with, size: size,
newPos: newPos, oldPos: oldPos, start: start,
depth: depth]]]];
IF depth > MaxDepth THEN new ← Balance[new];
};
Fetch: PUBLIC PROC [base: ROPE, index: INT ← 0] RETURNS [CHAR] = TRUSTED {
IF base = NIL THEN BoundsFault[];
WITH x: base SELECT FROM
text =>
{i: NAT ← Short[index];
IF i >= x.length THEN BoundsFault[];
RETURN[QFetch[@x, i]]};
node =>
{[] ← NonNeg[index];
WITH x: x SELECT FROM
substr => {[] ← NonNeg[x.size-index-1]};
concat => {[] ← NonNeg[x.size-index-1]};
replace => {[] ← NonNeg[x.size-index-1]};
object =>
{[] ← NonNeg[x.size-index-1];
RETURN [x.fetch[x.base, index]]};
ENDCASE => ERROR NoRope};
ENDCASE => ERROR NoRope;
DO
x: ROPE ← base;
WITH x: x SELECT FROM
text => {i: NAT ← QShort[index]; RETURN[QFetch[@x, i]]};
node =>
WITH x: x SELECT FROM
substr => {base ← x.base; index ← index + x.start};
concat =>
{IF index < x.pos THEN {base ← x.base; LOOP};
base ← x.rest; index ← index - x.pos};
replace =>
{IF index < x.start THEN {base ← x.base; LOOP};
IF index < x.newPos THEN
{base ← x.replace; index ← index - x.start; LOOP};
base ← x.base; index ← index - x.newPos + x.oldPos};
object => RETURN [x.fetch[x.base, index]];
ENDCASE => ERROR NoRope;
ENDCASE => ERROR NoRope;
ENDLOOP;
};
IsEmpty: PUBLIC PROC [r: ROPE] RETURNS [BOOL] = {
-- returns Length[r] = 0
RETURN [InlineSize[r] = 0];
};
Length: PUBLIC PROC [base: ROPE] RETURNS [INT] =
TRUSTED {RETURN[InlineSize[base]]};
Size: PUBLIC PROC [base: ROPE] RETURNS [INT] =
TRUSTED {RETURN[InlineSize[base]]};
Map: PUBLIC PROC
[base: ROPE, start: INT ← 0, len: INT ← MaxLen, action: ActionType]
RETURNS [BOOL] = TRUSTED {
size: INT ← InlineSize[base];
rem: INT ← NonNeg[size - NonNeg[start]];
IF len > rem THEN len ← rem;
WHILE len > 0 DO
x: ROPE ← base;
WITH x: x SELECT FROM
text =>
{st: NAT ← QShort[start];
FOR i: CARDINAL IN [st..st+QShort[len]) DO
IF action[QFetch[@x,i]] THEN RETURN [TRUE];
ENDLOOP;
RETURN [FALSE]};
node =>
WITH x: x SELECT FROM
substr =>
{base ← x.base; start ← start + x.start; LOOP};
concat =>
{xpos: INT ← x.pos;
IF start+len <= xpos THEN {base ← x.base; LOOP};
IF start < xpos THEN
{subLen: INT ← xpos-start;
IF Map[x.base, start, subLen, action]
THEN RETURN [TRUE];
start ← xpos; len ← len - subLen};
start ← start - xpos;
base ← x.rest;
};
replace =>
{xstart: INT ← x.start;
xnew: INT ← x.newPos;
IF start < xstart THEN
{subLen: INT ← xstart-start;
IF subLen >= len THEN {base ← x.base; LOOP};
IF Map[x.base, start, subLen, action]
THEN RETURN [TRUE];
start ← xstart; len ← len - subLen};
IF start < xnew THEN
{subLen: INT ← xnew-start;
st: INT ← start - xstart;
IF subLen >= len THEN
{base ← x.replace; start ← st; LOOP};
IF Map[x.replace, st, subLen, action]
THEN RETURN [TRUE];
start ← xnew; len ← len - subLen};
base ← x.base; start ← start - xnew + x.oldPos};
object =>
{map: MapType ← x.map;
data: REF ← x.base;
IF map # NIL THEN RETURN[map[data, start, len, action]];
{fetch: FetchType ← x.fetch;
FOR i: INT IN [start..start+len) DO
IF action[fetch[data, i]] THEN RETURN [TRUE];
ENDLOOP;
RETURN [FALSE]}};
ENDCASE => ERROR NoRope;
ENDCASE => ERROR NoRope;
ENDLOOP;
RETURN [FALSE];
};
PieceMap: PUBLIC PROC
[base: ROPE, start: INT ← 0, len: INT ← MaxLen,
action: PieceActionType, mapUser: BOOL]
RETURNS [BOOL] = TRUSTED {
size: INT ← InlineSize[base];
rem: INT ← NonNeg[size - NonNeg[start]];
IF len > rem THEN len ← rem;
WHILE len > 0 DO
x: ROPE ← base;
WITH x: x SELECT FROM
text =>
RETURN [action[base, start, len]];
node =>
WITH x: x SELECT FROM
substr =>
{base ← x.base; start ← start + x.start; LOOP};
concat =>
{subLen: INT ← x.pos - start;
IF subLen > 0 THEN
{IF len <= subLen THEN {base ← x.base; LOOP};
IF PieceMap[x.base, start, subLen, action, mapUser]
THEN RETURN [TRUE];
len ← len - subLen; start ← 0}
ELSE start ← -subLen;
base ← x.rest; LOOP};
replace =>
-- three pieces to consider (first, middle, last)
{xstart: INT ← x.start;
len1: INT ← xstart - start;
base ← x.base;
IF len1 > 0 THEN
{-- a piece in first section of rope
IF len1 >= len THEN LOOP; -- only in first section
IF PieceMap[base, start, len1, action, mapUser]
THEN RETURN [TRUE];
start ← xstart; len ← len - len1; len1 ← 0};
{xpos: INT ← x.newPos;
len2: INT ← xpos - start;
IF len2 <= 0 THEN
{-- no piece in middle section
start ← x.oldPos - len2; LOOP};
-- a piece in middle section of replace node
base ← x.replace; start ← -len1;
IF len2 >= len THEN LOOP; -- only in middle section
IF PieceMap[base, start, len2, action, mapUser]
THEN RETURN [TRUE];
base ← x.base; start ← x.oldPos; len ← len - len2;
}};
object =>
{map: PieceMapType ← x.pieceMap;
IF mapUser AND map # NIL THEN
RETURN[map[x.base, start, len, action]];
RETURN [action[base, start, len]]};
ENDCASE => ERROR NoRope;
ENDCASE => ERROR NoRope;
ENDLOOP;
RETURN [FALSE];
};
Translate: PUBLIC PROC
[base: ROPE, start: INT ← 0, len: INT ← MaxLen, translator: TranslatorType ← NIL]
RETURNS [new: ROPE] = TRUSTED {
-- applies the translation to get a new rope
-- if the resulting size > 0, then new does not share with the original rope!
-- if translator = NIL, the identity translation is performed
each: PROC RETURNS [CHAR] = TRUSTED {
c: CHAR ← RopeInline.InlineFetch[base, index];
index ← index + 1;
IF translator # NIL THEN c ← translator[c];
RETURN [c];
};
index: INT ← start;
rem: INT ← NonNeg[InlineSize[base] - NonNeg[start]];
text: Text ← NIL;
IF len <= 0 OR rem = 0 THEN RETURN [EmptyRope];
IF len < rem THEN rem ← len;
WITH base SELECT FROM
t: Text =>
{short: CARDINAL ← index;
text ← NewText[rem];
FOR i: NAT IN [0..rem) DO
c: CHAR ← QFetch[t, short];
IF translator # NIL THEN c ← translator[c];
text[i] ← c;
short ← short + 1;
ENDLOOP;
};
ENDCASE;
RETURN [FromProc[rem, each]];
};
Flatten: PUBLIC PROC
[base: ROPE, start: INT ← 0, len: INT ← MaxLen] RETURNS [Text] = TRUSTED {
size: INT ← InlineSize[base];
rem: INT ← NonNeg[size - NonNeg[start]];
IF len > rem THEN len ← rem;
IF start = 0 AND len = rem THEN
{IF base = NIL THEN RETURN [NIL];
IF base.tag = text THEN RETURN [LOOPHOLE[base]]};
IF len <= 0 THEN RETURN [EmptyRope];
{rtn: Text ← NewText[Short[len]];
index: CARDINAL ← 0;
AddChar: PROC [c: CHAR] RETURNS [BOOL] = TRUSTED {
QStore[c, rtn, index]; index ← index + 1; RETURN [FALSE]};
[] ← Map[base, start, len, AddChar];
RETURN [rtn]}};
MakeRope: PUBLIC PROC [base: REF, size: INT, fetch: FetchType,
map: MapType, pieceMap: PieceMapType] RETURNS [ROPE] = TRUSTED {
-- no optimization for user-supplied strings
IF size = 0 THEN RETURN [EmptyRope];
RETURN [qz.NEW[Tobject ←
[node[object[base: base, fetch: fetch, map: map,
pieceMap: pieceMap, size: size]]]]]};
FromProc: PUBLIC PROC [len: INT, p: PROC RETURNS [CHAR], maxPiece: INT ← MaxLen]
RETURNS [ROPE] = TRUSTED {
IF len <= 0 THEN RETURN [EmptyRope];
IF maxPiece < FlatMax
THEN maxPiece ← FlatMax
ELSE IF maxPiece > LAST[NAT] THEN maxPiece ← LAST[NAT];
IF len <= maxPiece THEN
{rtn: Text ← NewText[QShort[len]];
FOR i: NAT IN [0..QShort[len]) DO rtn[i] ← p[]; ENDLOOP;
RETURN [rtn]};
{left: ROPE ← FromProc[len/2, p, maxPiece];
right: ROPE ← FromProc[(len+1)/2, p, maxPiece];
RETURN [Concat[left, right]]}};
FromChar: PUBLIC PROC [c: CHAR] RETURNS [Text] = TRUSTED {
rtn: Text ← NewText[1];
rtn[0] ← c;
RETURN [rtn]};
FromRefText: PUBLIC PROC [s: REF READONLY TEXT] RETURNS [Text] = TRUSTED {
len: NAT ← IF s = NIL THEN 0 ELSE s.length;
IF len = 0 THEN RETURN [EmptyRope];
{rtn: Text ← NewText[len];
FOR i: NAT IN [0..len) DO
QStore[QFetch[LOOPHOLE[s], i], rtn, i]; ENDLOOP;
RETURN [rtn]}};
ToRefText: PUBLIC PROC [base: ROPE] RETURNS [REF TEXT] = TRUSTED {
size: INT ← InlineSize[base];
rtn: REF TEXT ← pz.NEW[TEXT[Short[size]]];
r: Text = LOOPHOLE[rtn];
index: CARDINAL ← 0;
AddChar: PROC [c: CHAR] RETURNS [BOOL] = TRUSTED {
QStore[c, r, index]; index ← index + 1; RETURN [FALSE]};
[] ← Map[base, 0, size, AddChar];
r.length ← index;
RETURN [rtn]};
-- The comparison operations only handle REFs
Equal: PUBLIC PROC
[s1, s2: ROPE ← NIL, case: BOOL ← TRUE] RETURNS [BOOL] = TRUSTED {
-- contents equality of s1 and s2
len1,len2: INT;
str1, str2: Text;
[len1, str1] ← SingleSize[s1];
[len2, str2] ← SingleSize[s2];
IF len1 # len2 THEN RETURN [FALSE];
IF s1 = s2 OR len1 = 0 THEN RETURN [TRUE];
IF case AND str1 # NIL AND str2 # NIL THEN {
-- relatively cheap test for equality
FOR i: CARDINAL IN [0..QShort[len1]) DO
IF QFetch[str1, i] # QFetch[str2, i] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE]};
RETURN [Compare[s1,s2,case] = equal]};
Compare: PUBLIC PROC
[s1, s2: ROPE ← NIL, case: BOOL ← TRUE]
RETURNS [Environment.Comparison] = TRUSTED {
-- contents comparison of s1 and s2 (less(0), equal(1), greater(2))
-- if NOT case, then upper case chars = lower case chars
-- contents equality of s1 and s2
len1,len2: INT;
str1, str2: Text;
[len1, str1] ← SingleSize[s1];
[len2, str2] ← SingleSize[s2];
IF str1 # NIL AND str2 # NIL THEN {
sz1: CARDINAL ← QShort[len1];
sz2: CARDINAL ← QShort[len2];
sz: CARDINAL ← MIN[sz1, sz2];
IF case
THEN
FOR i: NAT IN [0..sz) DO
c1: CHAR ← QFetch[str1, i];
c2: CHAR ← QFetch[str2, i];
IF c1 = c2 THEN LOOP;
IF c1 < c2 THEN RETURN [less] ELSE RETURN [greater];
ENDLOOP
ELSE
FOR i: NAT IN [0..sz) DO
c1: CHAR ← Lower[QFetch[str1, i]];
c2: CHAR ← Lower[QFetch[str2, i]];
IF c1 = c2 THEN LOOP;
IF c1 < c2 THEN RETURN [less] ELSE RETURN [greater];
ENDLOOP;
IF sz1 > sz2 THEN RETURN [greater];
IF sz1 < sz2 THEN RETURN [less];
RETURN [equal];
};
{r1,r2: ROPE ← NIL;
pos1,st1,sz1,lm1: INT ← 0;
pos2,st2,sz2,lm2: INT ← 0;
c1,c2: CHAR;
DO
IF st1 = lm1 THEN {
-- need a new piece from s1
IF (pos1 ← pos1 + sz1) = len1
THEN RETURN [IF pos1 = len2 THEN equal ELSE less];
[r1, st1, sz1] ← ContainingPiece[s1, pos1];
IF sz1 = 0 THEN ERROR;
lm1 ← st1 + sz1};
IF st2 = lm2 THEN {
-- need a new piece from s2
IF (pos2 ← pos2 + sz2) = len2 THEN RETURN [greater];
[r2, st2, sz2] ← ContainingPiece[s2, pos2];
IF sz2 = 0 THEN ERROR;
lm2 ← st2 + sz2};
c1 ← InlineFetch[r1, st1];
c2 ← InlineFetch[r2, st2];
IF NOT case THEN {c1 ← Lower[c1]; c2 ← Lower[c2]};
IF c1 # c2 THEN RETURN [IF c1 < c2 THEN less ELSE greater];
st1 ← st1 + 1; st2 ← st2 + 1;
ENDLOOP;
}};
ContainingPiece: PUBLIC PROC
[ref: ROPE, index: INT ← 0]
RETURNS [base: ROPE, start: INT, len: INT] = TRUSTED {
-- find the largest piece containg the given index
-- such that the resulting rope is either the text or the object variant
-- (NIL, 0, 0) is returned if the index is NOT in the given rope
len ← InlineSize[ref];
IF index < 0 OR index >= len THEN RETURN [NIL, 0, 0];
base ← ref;
start ← index;
len ← len - start;
DO
nlen: INT ← len;
x: ROPE ← base;
WITH x: x SELECT FROM
text => {RETURN};
node =>
WITH x: x SELECT FROM
substr => {
nlen ← x.size - start;
start ← start + x.start;
base ← x.base};
concat => {
del1: INT ← x.pos - start;
IF del1 > 0
THEN {base ← x.base; nlen ← del1}
ELSE {nlen ← x.size - start; base ← x.rest; start ← -del1};
};
replace => {
del2: INT ← x.newPos - start;
del1: INT ← x.start - start;
SELECT TRUE FROM
del1 > 0 => {base ← x.base; nlen ← del1};
del2 > 0 => {base ← x.replace; start ← -del1; nlen ← del2};
ENDCASE =>
{nlen ← x.size - start;
start ← x.oldPos - del2;
base ← x.base};
};
object => {RETURN};
ENDCASE => ERROR NoRope;
ENDCASE => ERROR NoRope;
IF nlen < len THEN len ← NonNeg[nlen];
ENDLOOP;
};
Balance: PUBLIC PROC
[base: ROPE, start: INT ← 0, len: INT ← MaxLen, flat: INT ← FlatMax]
RETURNS [ROPE] = TRUSTED {
leaf: ROPE ← NIL;
st,sz: INT ← 0;
size: INT ← Size[base];
split: INT ← size - start;
leafy: BOOL ← FALSE;
IF split < 0 OR start < 0 THEN ERROR;
IF len <= 0
THEN RETURN [EmptyRope]
ELSE IF split < len THEN IF (len ← split) = 0 THEN RETURN [EmptyRope];
IF flat < FlatMax
THEN flat ← FlatMax
ELSE IF flat > LAST[NAT] THEN flat ← LAST[NAT];
IF len <= flat THEN RETURN [Flatten[base, start, len]];
DO -- strip away extra levels from base
x: ROPE = base;
WITH x: x SELECT FROM
text => {leafy ← TRUE; EXIT}; -- no sub-structure
node =>
WITH x: x SELECT FROM
substr =>
{base ← x.base; start ← start + x.start};
concat =>
{xpos: INT ← x.pos;
split ← xpos - start;
IF split > 0
THEN {IF len > split THEN EXIT; -- crosses sections
base ← x.base}
ELSE {base ← x.rest; start ← -split}};
replace =>
{xstart: INT ← x.start;
len1: INT ← xstart - start;
IF len1 > 0
THEN -- substr starts in 1st section
{IF len > len1 THEN {split ← len1; EXIT}; -- crosses low boundary
base ← x.base} -- entirely in first section
ELSE -- substr starts in middle or last sections
{xnew: INT ← x.newPos;
split ← xnew - start;
IF split > 0
THEN -- substr starts in middle section
{IF len > split THEN EXIT; -- crosses high boundary
base ← x.replace; -- entirely in middle section
start ← -len1}
ELSE -- entirely in last section
{base ← x.base;
start ← x.oldPos - split}}};
object => {leafy ← TRUE; EXIT};
ENDCASE => ERROR;
ENDCASE => ERROR;
ENDLOOP;
IF leafy THEN RETURN [Substr[base, start, len]];
[leaf, st, sz] ← ContainingPiece[base, start];
IF sz >= len THEN RETURN [Substr[leaf, st, len]];
split ← (len+1)/2;
IF sz >= split THEN split ← sz;
base ← Concat[Balance[base, start, split, flat],
Balance[base, start+split, len-split, flat]];
RETURN [base];
};
END.
26-Feb-81, Russ Atkinson, fixed bug in Substr (REF Tconcat case) found by Paxton
31-Mar-81, Russ Atkinson, fixed bug in Map (overlarge len to user's map) found by Morris
8-Apr-81, Russ Atkinson, fixed bug in Substr (REF Tconcat case) found by Paxton
11-May-81, Russ Atkinson, converted to use variant record representation
23-May-81, Russ Atkinson, added Balance, ContainingPiece
12-Jul-81, Russ Atkinson, added FromChar, fixed FromProc
22-Sep-81, Russ Atkinson, removed dependence on CedarString
14-Oct-81, Russ Atkinson, added stuff for depth maintenance
30-Oct-81 17:21:35, Russ Atkinson, added pz & changes to match new specs
November 24, 1981 12:11 pm, Russ Atkinson, fixed ContainingPiece and some defaults
17-Feb-82 14:50:00, Russ Atkinson, minor defs changes
19-Feb-82 12:00:25, Russ Atkinson, try to avoid returning NIL
April 8, 1982, Russ Atkinson, fix Compare bug
June 7, 1982, Russ Atkinson, convert to Cedar 3.2
September 9, 1982, Russ Atkinson, convert to Cedar 3.4 (Compare returns Comparison)