XRopeImpl:
CEDAR
PROGRAM
IMPORTS Basics, XRope
EXPORTS XRope
SHARES XRope
= BEGIN OPEN XRope;
NonNeg:
PROC [
INT]
RETURNS [
INT] ~ Basics.NonNegative;
SingleSize:
PROC [base:
XROPE]
RETURNS [
INT, Text] ~
INLINE {
WITH base
SELECT
FROM text: Text =>
RETURN[text.size, text];
ENDCASE => RETURN[[(IF base=NIL THEN 0 ELSE base.size), NIL]];
};
CheckLongAdd:
PROC [x, y:
INT]
RETURNS [
INT] ~
INLINE {
RETURN[Basics.NonNegative[x+y]];
};
InlineDepth:
PROC [base:
XROPE]
RETURNS [
INTEGER] ~
TRUSTED
INLINE {
IF base=NIL THEN RETURN[0];
WITH x: base
SELECT
FROM
substr => RETURN [x.depth];
concat => RETURN [x.depth];
replace => RETURN [x.depth];
ENDCASE => RETURN [1];
};
errors peculiar to XRope
NoRope: PUBLIC ERROR = CODE;
emptyRope: Text ~
NEW[TextRep[0]];
Watch out for startup problems with literals. Don't use "" here!
NewText:
PUBLIC
PROC [size:
INT]
RETURNS [text: Text] =
TRUSTED {
procedure to allocate new Text objects
IF size = 0 THEN RETURN [emptyRope];
text ← NEW[TextRep[size]];
text.size ← size;
};
Substr:
PUBLIC
PROC [base:
XROPE, start:
INT ← 0, len:
INT ← MaxLen]
RETURNS [new:
XROPE] =
TRUSTED {
... returns a subrope of the base. BoundsFault occurs if start < 0 or start > Length[base].
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]];
At this point the resulting rope is large enough to need a separate node. The idea is to dive down through as many levels of rope objects until we get to the deepest such object that fully contains the specified rope.
(note: change base last, since it is aliased with x!)
DO
WITH x: x
SELECT
FROM
text => EXIT;
substr => {start ← start + x.start; base ← x.base};
concat => {
rem: INT ← x.pos - start;
IF rem > 0
THEN {IF len > rem THEN {depth ← x.depth; EXIT}; base ← x.base}
ELSE {start ← -rem; base ← x.rest};
};
replace => {
len1: INT ← x.start - start;
IF len1 > 0
THEN {
substr starts in 1st section
IF len > len1 THEN {depth ← x.depth; EXIT};
entirely in first section, so go deeper
base ← x.base}
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 {depth ← x.depth; EXIT};
entirely in middle section
start ← -len1;
base ← x.replace}
ELSE {
entirely in last section
start ← x.oldPos - len2;
base ← x.base};
};
};
object => {
no sub-structure
EXIT};
ENDCASE => ERROR NoRope;
IF start # 0 THEN LOOP;
IF len = InlineSize[base] THEN RETURN [base];
ENDLOOP;
[] ← NonNeg[start];
[] ← NonNeg[len];
new ←
NEW[XRopeRep.substr ←
[size: len, cases: substr[base: base, start: start, depth: depth + 1]]];
IF depth >= MaxDepth THEN new ← Balance[new];
};
Cat:
PUBLIC
PROC [r1, r2, r3, r4, r5:
XROPE ←
NIL]
RETURNS [
XROPE] ~ {
Return the concatenation of the given 5 ropes.
RETURN [Concat[Concat[r1,r2], Concat[Concat[r3, r4], r5]]];
};
Concat:
PUBLIC
PROC [base,rest:
XROPE ←
NIL]
RETURNS [new:
XROPE] ~ {
Return the concatenation of the two ropes. If the result is small enough, then it will be flat. Otherwise we need to create a new node.
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 {
The result is small enough to make it flat.
str: Text ~ NewText[size];
index: NAT ← 0;
AddChar: ActionType ~ { str[index] ← c; index ← index+1 };
IF baseStr =
NIL
THEN [] ← Map[base, 0, baseLen, AddChar]
ELSE FOR i: NAT IN [0..baseLen) DO str[index] ← baseStr[i]; index ← index+1 ENDLOOP;
IF restStr =
NIL
THEN [] ← Map[rest, 0, restLen, AddChar]
ELSE FOR i: NAT IN [0..restLen) DO str[index] ← restStr[i]; index ← index+1 ENDLOOP;
RETURN [str]};
SELECT
TRUE
FROM
Possibly can reduce depth by combining with a concat node.
restLen < FlatMax =>
WITH base
SELECT
FROM
x:
REF XRopeRep.concat =>
IF x.size-x.pos < FlatMax/2
THEN {
baseLen ← x.pos;
rest ← Concat[x.rest, rest];
base ← x.base;
};
ENDCASE;
baseLen < FlatMax =>
WITH base
SELECT
FROM
x:
REF XRopeRep.concat =>
IF x.pos < FlatMax/2
THEN {
rest ← x.rest;
baseLen ← x.pos+baseLen;
base ← Concat[base, x.base];
};
ENDCASE;
ENDCASE;
[] ← NonNeg[size-baseLen];
depth ← MAX[InlineDepth[base], InlineDepth[rest]] + 1;
new ←
NEW[XRopeRep.concat ←
[size: size, cases: concat[base: base, rest: rest, pos: baseLen, depth: depth]]];
IF depth > MaxDepth THEN new ← Balance[new];
};
Replace:
PUBLIC
PROC [base:
XROPE, start:
INT ← 0, len:
INT ← MaxLen, with:
XROPE ←
NIL]
RETURNS [new:
XROPE] ~ {
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[size];
index: NAT ← 0;
AddChar: ActionType ~ { str[index] ← c; index ← index+1 };
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]};
We need to make a new node. First, test for combining the replacement rope with a previous replacement rope, so that successive replacements at the same spot will not make ropes too deep.
(note: if you use unsafe discrimination here, change base last, since it is aliased with x!)
WITH base
SELECT
FROM
x:
REF XRopeRep.replace => {
xnewPos: INT ← x.newPos;
xstart: INT ← x.start;
SELECT
TRUE
FROM
start <= xstart
AND oldPos >= xnewPos => {
replacing the replacement string
oldPos ← x.oldPos + (oldPos - xnewPos);
base ← x.base;
};
start = xnewPos => {
adding to old replace string
IF repSize + (xnewPos - xstart) <= FlatMax
THEN {
with ← Concat[x.replace, with];
start ← xstart;
oldPos ← x.oldPos + len;
base ← x.base;
};
};
ENDCASE;
};
ENDCASE;
[] ← NonNeg[NonNeg[newPos] - NonNeg[start]];
[] ← NonNeg[NonNeg[oldPos] - start];
[] ← NonNeg[NonNeg[size] - newPos];
depth ← MAX[InlineDepth[base], InlineDepth[with]] + 1;
new ←
NEW[XRopeRep.replace ←
[size: size, cases: replace[base: base, replace: with, newPos: newPos, oldPos: oldPos, start: start,depth: depth]]];
IF depth > MaxDepth THEN new ← Balance[new];
};
Fetch:
PUBLIC
PROC [base:
XROPE, index:
INT ← 0]
RETURNS [
CHAR] ~ {
... fetches indexed character from given ropes. BoundsFault occurs if index < 0 or index is >= Length[base].
WITH base
SELECT
FROM
text: Text => RETURN[text[index]]; -- quick kill for a flat rope
ENDCASE => {
First time through, check the index against bounds
size: INT ~ IF base=NIL THEN 0 ELSE base.size;
[] ← NonNeg[index];
[] ← NonNeg[size-index-1];
};
Now we really don't need bounds checking, since checking the top level is sufficient. What we really need to do now is dive down to the right place as quickly as possible.
(note: change base last, since it is aliased with x!)
DO
WITH base
SELECT
FROM
x: REF XRopeRep.text => RETURN[x[index]];
x: REF XRopeRep.substr => {index ← index + x.start; base ← x.base};
x:
REF XRopeRep.concat => {
IF index < x.pos THEN {base ← x.base; LOOP};
index ← index - x.pos;
base ← x.rest};
x:
REF XRopeRep.replace => {
IF index < x.start THEN {base ← x.base; LOOP};
IF index < x.newPos
THEN {
index ← index - x.start;
base ← x.replace;
LOOP};
index ← index - x.newPos + x.oldPos;
base ← x.base};
x: REF XRopeRep.object => RETURN [x.fetch[x.base, index]];
ENDCASE => ERROR NoRope;
ENDLOOP;
};
Map:
PUBLIC
PROC [base:
XROPE, start:
INT ← 0, len:
INT ← MaxLen, action: ActionType]
RETURNS [
BOOL] =
TRUSTED {
... applies the action to the given range of characters in the rope. Returns TRUE when some action returns TRUE. BoundsFault occurs when start < 0 or start > Length[base].
rem: INT ← NonNeg[InlineSize[base] - NonNeg[start]];
IF len > rem THEN len ← rem;
WHILE len > 0
DO
WITH x: base
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 =>
(note: change base last, since it is aliased with x!)
WITH x: x
SELECT
FROM
substr => {start ← start + x.start; base ← x.base; 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 {start ← st; base ← x.replace; LOOP};
IF Map[x.replace, st, subLen, action] THEN RETURN [TRUE];
start ← xnew; len ← len - subLen};
start ← start - xnew + x.oldPos;
base ← x.base};
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];
};
Translate:
PUBLIC
PROC
[base:
XROPE, start:
INT ← 0, len:
INT ← MaxLen, translator: TranslatorType ←
NIL]
RETURNS [new:
XROPE] =
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
index: INT ← start;
intRem: INT ← NonNeg[InlineSize[base] - NonNeg[start]];
rem: NAT ← intRem;
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;
new ← text;
};
ENDCASE => {
each:
PROC
RETURNS [
CHAR] =
TRUSTED {
c: CHAR ← InlineFetch[base, index];
index ← index + 1;
IF translator # NIL THEN c ← translator[c];
RETURN [c];
};
RETURN [FromProc[rem, each]];
};
};
Flatten:
PUBLIC
PROC [base:
XROPE, start:
INT ← 0, len:
INT ← MaxLen]
RETURNS [rtn: 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 ← NewText[Short[len]];
rtn.length ← 0;
[] ← AppendChars[LOOPHOLE[rtn], base, start, len];
MakeRope:
PUBLIC
PROC
[base:
REF, size:
INT, fetch: FetchType, map: MapType, move: MoveType]
RETURNS [
XROPE] =
TRUSTED {
no optimization for user-supplied strings
IF size = 0 THEN RETURN [emptyRope];
RETURN [
NEW[Tobject ←
[node[size: size, cases: object[base: base, fetch: fetch, map: map, move: move]]]]];
FromProc:
PUBLIC
PROC [len:
INT, p:
PROC
RETURNS [
CHAR], maxPiece:
INT ← MaxLen]
RETURNS [
XROPE] =
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]}
ELSE {
Force proper evaluation order, since the compiler might get it backwards if left to its own devices.
left: XROPE ← FromProc[len/2, p, maxPiece];
right: XROPE ← 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, start:
NAT ← 0, len:
NAT ←
NAT.
LAST]
RETURNS [rtn: Text ←
NIL] =
TRUSTED {
IF s #
NIL
THEN {
rem: NAT ~ s.length-start;
IF rem<len THEN len ← rem;
IF len = 0 THEN RETURN [emptyRope];
rtn ← NewText[len];
IF start=0 THEN MoveAlignedChars[from: LOOPHOLE[s, Text], to: rtn, len: len]
ELSE FOR i: NAT IN[0..len) DO rtn[i] ← s[start+i] ENDLOOP;
};
ToRefText:
PUBLIC
PROC [base:
XROPE]
RETURNS [rtn:
REF
TEXT] =
TRUSTED {
len: NAT ← Short[InlineSize[base]];
rtn ← NEW[TEXT[len]];
IF len # 0
THEN {
r: Text = LOOPHOLE[rtn];
WITH base
SELECT
FROM
txt: Text => {
MoveAlignedChars[from: txt, to: LOOPHOLE[rtn, Text], len: len];
rtn.length ← len;
};
ENDCASE => {
[] ← AppendChars[rtn, base, 0, len];
};
};
};
MoveAlignedChars:
PROC [from: Text, to: Text, len:
NAT] =
TRUSTED INLINE {
PrincOpsUtils.LongCopy[
from: LOOPHOLE[from, LONG POINTER]+SIZE[TEXT[0]],
nwords: (len+charsPerWord-1) / charsPerWord,
to: LOOPHOLE[to, LONG POINTER]+SIZE[TEXT[0]] ];
};
DoMoveChars:
UNSAFE
PROC
[pointer:
LONG
POINTER, index:
INT, rope:
XROPE, start:
INT, len:
INT] ~ {
We assume start IN[0..size] AND len IN[0..size-start], where size=Size[rope]
The effect is ... FOR i: INT IN[0..len) DO pointer[index+i] ← rope.Fetch[start+i] ENDLOOP
WHILE len # 0
DO
base: XROPE; bStart, bLen: INT;
[base, bStart, bLen] ← ContainingPiece[rope, start];
grab the smallest piece of the rope containing the given start index
IF bLen > len
THEN bLen ← len;
this piece is longer than we need to finish the transfer
IF bLen = 0
THEN
ERROR NoRope;
this should not happen! it means that some calculation or invariant is bad!
IF index>
NAT.
LAST
THEN {
offset: INT ~ index/charsPerWord;
pointer ← pointer+offset;
index ← index-(offset*charsPerWord);
};
ensure index IN NAT
WITH base
SELECT
FROM
txt: Text => {
We are moving chars from a flat rope.
toPointer: LONG POINTER TO Basics.RawChars ~ LOOPHOLE[pointer];
toIndex: CARDINAL ← QShort[index];
fromIndex: NAT ← QShort[bStart];
nChars: NAT ← QShort[bLen];
IF nChars > 4
AND (fromIndex
MOD charsPerWord) = (toIndex
MOD charsPerWord)
THEN {
The source and destination are aligned, so we can BLT
WHILE (fromIndex
MOD charsPerWord) # 0
AND nChars # 0
DO
Not yet aligned to a word boundary
TRUSTED { toPointer[toIndex] ← QFetch[txt, fromIndex] };
fromIndex ← fromIndex + 1;
toIndex ← toIndex + 1;
nChars ← nChars - 1;
ENDLOOP;
IF nChars # 0
THEN
TRUSTED {
PrincOpsUtils.LongCopy[
from: LOOPHOLE[txt, LONG POINTER]+SIZE[TextRep[fromIndex]],
nwords: (nChars+charsPerWord-1) / charsPerWord,
to: LOOPHOLE[toPointer, LONG POINTER]+SIZE[Basics.RawChars[toIndex]]
];
};
}
ELSE {
The source and destination are not aligned, so we move chars slowly
FOR i:
NAT
IN [0..nChars)
DO
TRUSTED { toPointer[toIndex+i] ← QFetch[txt, fromIndex+i] };
ENDLOOP;
};
};
n:
REF node RopeRep => {
WITH n
SELECT
FROM
obj:
REF object node RopeRep =>
We are moving chars from a user-defined object.
SELECT
TRUE
FROM
obj.move #
NIL => {
The user has supplied a fast move routine, so use it.
moved: INT;
TRUSTED { moved ← obj.move[[pointer, index, bLen], obj.base, bStart] };
IF moved # bLen
THEN
ERROR NoRope;
We asked for a perfectly legitimate # of chars, and the user's move routine blew it! This rope is not reliable.
};
obj.map #
NIL => {
The user has supplied a fast map routine, so use it.
toPointer: LONG POINTER TO Basics.RawChars ← LOOPHOLE[pointer];
toIndex: CARDINAL ← QShort[index];
moved: INT ← 0;
action: ActionType =
TRUSTED {
IF toIndex>
NAT.
LAST
THEN {
offset: CARDINAL ~ toIndex/charsPerWord;
toPointer ← toPointer+offset;
toIndex ← toIndex-(offset*charsPerWord);
};
toPointer[toIndex] ← c;
toIndex ← toIndex + 1;
moved ← moved + 1;
};
[] ← obj.map[obj.base, bStart, bLen, action];
IF moved # bLen THEN ERROR NoRope; -- should not happen
};
ENDCASE => {
Sigh. We have to do this one ourselves.
toPointer: LONG POINTER TO Basics.RawChars ← LOOPHOLE[pointer];
toIndex: CARDINAL ← QShort[index];
fetch: FetchType ← obj.fetch;
data: REF ← obj.base;
FOR i:
INT
IN [0..bLen)
DO
IF toIndex>
NAT.
LAST
THEN {
offset: CARDINAL ~ toIndex/charsPerWord;
toPointer ← toPointer+offset;
toIndex ← toIndex-(offset*charsPerWord);
};
TRUSTED { toPointer[toIndex] ← fetch[data, bStart+i] };
toIndex ← toIndex + 1;
ENDLOOP;
};
ENDCASE => ERROR NoRope; -- this should not happen!
};
ENDCASE => ERROR NoRope; -- this should not happen!
len ← len - bLen;
update the # of chars left in the transfer
start ← start + bLen;
start is now the starting index for the next piece
index ← index + bLen;
index is now the destination index for the next piece
ENDLOOP;
};
AppendChars:
PUBLIC
PROC
[buffer:
REF
TEXT, rope:
XROPE, start:
INT ← 0, len:
INT ←
LAST[
INT]]
RETURNS [charsMoved:
NAT ← 0] = {
... appends characters to the end of a REF TEXT buffer, starting at start within the rope. The move stops if there are no more characters from the rope OR len characters have been moved OR the buffer is full (buffer.length = buffer.maxLength). charsMoved is always the # of characters appended. NOTE: the user is responsible for protecting buffer from concurrent modifications.
rem:
INT ← NonNeg[InlineSize[rope]-NonNeg[start]];
# of characters in rope after start
IF rem > len
THEN rem ← len;
The user may have specified a shorter run of characters
IF rem>0
AND buffer#
NIL
THEN {
bufPos:
NAT ← buffer.length;
position of next place to append character (cache for buffer.length)
bufRem:
NAT ← buffer.maxLength - bufPos;
# of chars remaining in the transfer
IF bufRem > rem
THEN bufRem ← QShort[rem];
the caller may have specified a shorter amount
TRUSTED { DoMoveChars[pointer: LOOPHOLE[buffer, LONG POINTER]+SIZE[TEXT[0]], index: bufPos, rope: rope, start: start, len: bufRem] };
buffer.length ← bufPos+bufRem;
RETURN [bufRem];
};
};
UnsafeMoveChars:
PUBLIC
UNSAFE
PROC
[block: Basics.UnsafeBlock, rope:
XROPE, start:
INT ← 0]
RETURNS [charsMoved:
INT ← 0] ~ {
... moves characters to an UnsafeBlock, starting at start within the rope. The move stops if there are no more characters from the rope OR block.count characters have been moved; charsMoved is always the # of characters moved. This UNSAFE operation is mainly for the implementation of IO.RIS. Most clients should use AppendChars.
rem:
INT ← NonNeg[InlineSize[rope]-NonNeg[start]];
# of characters in rope after start
IF rem > block.count
THEN rem ← block.count;
The user may have specified a shorter run of characters
IF rem>0
THEN {
TRUSTED { DoMoveChars[pointer: block.base, index: NonNeg[block.startIndex], rope: rope, start: start, len: rem] };
RETURN [rem];
};
};
Equal:
PUBLIC
PROC [s1, s2:
XROPE ←
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:
XROPE ←
NIL, case:
BOOL ←
TRUE]
RETURNS [Basics.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 {
The two ropes are both flat, so we don't have to discriminate for every character.
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 ← QFetch[str1, i];
c2: CHAR ← QFetch[str2, i];
IF c1 <= 'Z AND c1 >= 'A THEN c1 ← c1 + ('a-'A);
IF c2 <= 'Z AND c2 >= 'A THEN c2 ← c2 + ('a-'A);
IF c1 = c2 THEN LOOP;
IF c1 < c2 THEN RETURN [less] ELSE RETURN [greater];
ENDLOOP;
RETURN [Basics.CompareInt[sz1, sz2]];
};
{
At least one rope is not flat, so we do it the hard way.
r1,r2: XROPE ← NIL;
pos1,st1,sz1,lm1: INT ← 0;
pos2,st2,sz2,lm2: INT ← 0;
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: CHAR ← InlineFetch[r1, st1];
c2: CHAR ← InlineFetch[r2, st2];
IF c1 # c2
THEN {
IF
NOT case
THEN {
IF c1 <= 'Z AND c1 >= 'A THEN c1 ← c1 + ('a-'A);
IF c2 <= 'Z AND c2 >= 'A THEN c2 ← c2 + ('a-'A);
IF c1 = c2 THEN GO TO equal;
};
RETURN [Basics.CompareInt[ORD[c1], ORD[c2]]];
EXITS equal => {};
};
};
st1 ← st1 + 1; st2 ← st2 + 1;
ENDLOOP;
};
CompareSubstrs:
PUBLIC
PROC [
s1:
XROPE, start1:
INT ← 0, len1:
INT ← MaxLen,
s2:
XROPE, start2:
INT ← 0, len2:
INT ← MaxLen,
case:
BOOL ←
TRUE]
RETURNS [Basics.Comparison] ~ {
rem1: INT ← IF len1 <= 0 THEN 0 ELSE MIN[len1, NonNeg[InlineLength[s1]-NonNeg[start1]]];
rem2: INT ← IF len2 <= 0 THEN 0 ELSE MIN[len2, NonNeg[InlineLength[s2]-NonNeg[start2]]];
rem: INT ← MIN[rem1, rem2];
r1, r2: XROPE ← NIL;
st1, sz1, lm1: INT ← 0;
st2, sz2, lm2: INT ← 0;
WHILE rem # 0
DO
IF st1 = lm1
THEN {
need a new piece from s1
[r1, st1, sz1] ← ContainingPiece[s1, start1 ← start1 + sz1];
IF sz1 = 0 THEN EXIT;
lm1 ← st1 + sz1;
};
IF st2 = lm2
THEN {
need a new piece from s2
[r2, st2, sz2] ← ContainingPiece[s2, start2 ← start2 + sz2];
IF sz2 = 0 THEN EXIT;
lm2 ← st2 + sz2;
};
{
c1: CHAR ← InlineFetch[r1, st1];
c2: CHAR ← InlineFetch[r2, st2];
IF c1 # c2
THEN {
IF
NOT case
THEN {
IF c1 <= 'Z AND c1 >= 'A THEN c1 ← c1 + ('a-'A);
IF c2 <= 'Z AND c2 >= 'A THEN c2 ← c2 + ('a-'A);
IF c1 = c2 THEN GO TO equal;
};
RETURN [Basics.CompareInt[ORD[c1], ORD[c2]]];
EXITS equal => {};
};
};
st1 ← st1 + 1;
st2 ← st2 + 1;
rem ← rem - 1;
ENDLOOP;
RETURN [Basics.CompareInt[rem1, rem2]];
};
EqualSubstrs:
PUBLIC
PROC [
s1:
XROPE, start1:
INT ← 0, len1:
INT ← MaxLen,
s2:
XROPE, start2:
INT ← 0, len2:
INT ← MaxLen,
case:
BOOL ←
TRUE]
RETURNS [
BOOL] ~ {
rem1: INT ← IF len1 <= 0 THEN 0 ELSE MIN[len1, NonNeg[InlineLength[s1]-NonNeg[start1]]];
rem2: INT ← IF len2 <= 0 THEN 0 ELSE MIN[len2, NonNeg[InlineLength[s2]-NonNeg[start2]]];
IF rem1 = rem2
THEN {
r1, r2: XROPE ← NIL;
st1, sz1, lm1: INT ← 0;
st2, sz2, lm2: INT ← 0;
WHILE rem1 # 0
DO
IF st1 = lm1
THEN {
need a new piece from s1
[r1, st1, sz1] ← ContainingPiece[s1, start1 ← start1 + sz1];
IF sz1 = 0 THEN EXIT;
lm1 ← st1 + sz1;
};
IF st2 = lm2
THEN {
need a new piece from s2
[r2, st2, sz2] ← ContainingPiece[s2, start2 ← start2 + sz2];
IF sz2 = 0 THEN EXIT;
lm2 ← st2 + sz2;
};
{
c1: CHAR ← InlineFetch[r1, st1];
c2: CHAR ← InlineFetch[r2, st2];
IF c1 # c2
THEN {
IF
NOT case
THEN {
IF c1 <= 'Z AND c1 >= 'A THEN c1 ← c1 + ('a-'A);
IF c2 <= 'Z AND c2 >= 'A THEN c2 ← c2 + ('a-'A);
IF c1 = c2 THEN GO TO equal;
};
RETURN [FALSE];
EXITS equal => {};
};
};
st1 ← st1 + 1;
st2 ← st2 + 1;
rem1 ← rem1 - 1;
ENDLOOP;
RETURN [TRUE];
};
RETURN [FALSE];
};
ContainingPiece:
PUBLIC
PROC [rope:
XROPE, index:
INT ← 0]
RETURNS [base:
XROPE, 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[rope];
IF index < 0 OR index >= len THEN RETURN [NIL, 0, 0];
base ← rope;
start ← index;
len ← len - start;
DO
nlen: INT ← len;
WITH x: base
SELECT
FROM
(note: change base last, since it is aliased with x!)
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 {nlen ← del1; base ← x.base}
ELSE {nlen ← x.size - start; start ← -del1; base ← x.rest};
};
replace => {
del2: INT ← x.newPos - start;
del1: INT ← x.start - start;
SELECT
TRUE
FROM
del1 > 0 => {nlen ← del1; base ← x.base};
del2 > 0 => {start ← -del1; nlen ← del2; base ← x.replace};
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;
};
IsEmpty:
PUBLIC
PROC [r:
XROPE]
RETURNS [
BOOL] = {
RETURN [InlineSize[r] = 0];
};
Length:
PUBLIC
PROC [base:
XROPE]
RETURNS [
INT] = {
returns the length of the rope (Length[NIL] = 0)
RETURN [InlineSize[base]];
};
Size:
PUBLIC
PROC [base:
XROPE]
RETURNS [
INT] = {
Size[base] = Length[base]
RETURN [InlineSize[base]];
};
QShort:
PROC [x:
INT]
RETURNS [
CARDINAL] =
TRUSTED INLINE {
RETURN [Basics.LowHalf[x]];
};
Formerly in RopeImplExt
Run:
PUBLIC
PROC
[s1:
XROPE, pos1:
INT, s2:
XROPE, pos2:
INT, case:
BOOL ←
TRUE]
RETURNS [result:
INT ← 0] =
TRUSTED {
Returns the largest number of characters N such that s1 starting at pos1 is equal to s2 starting at pos2 for N characters. More formally: FOR i IN [0..N): s1[pos1+i] = s2[pos2+i]. If case is true, then case matters, otherwise upper and lower case characters are considered equal.
len1: INT;
str1: Text;
[len1, str1] ← SingleSize[s1];
IF NonNeg[pos1] < len1
THEN {
len2: INT;
str2: Text;
[len2, str2] ← SingleSize[s2];
IF NonNeg[pos2] < len2
THEN {
r1,r2: XROPE ← NIL;
st1,sz1,lm1: INT ← 0;
st2,sz2,lm2: INT ← 0;
DO
IF st1 = lm1
THEN {
need a new piece from s1
[r1, st1, sz1] ← ContainingPiece[s1, pos1 ← pos1 + sz1];
IF sz1 = 0 THEN RETURN;
lm1 ← st1 + sz1;
};
IF st2 = lm2
THEN {
need a new piece from s2
[r2, st2, sz2] ← ContainingPiece[s2, pos2 ← pos2 + sz2];
IF sz2 = 0 THEN RETURN;
lm2 ← st2 + sz2;
};
{
c1: CHAR ← InlineFetch[r1, st1];
c2: CHAR ← InlineFetch[r2, st2];
IF c1 # c2
THEN {
IF
NOT case
THEN {
IF c1 <= 'Z AND c1 >= 'A THEN c1 ← c1 + ('a-'A);
IF c2 <= 'Z AND c2 >= 'A THEN c2 ← c2 + ('a-'A);
IF c1 = c2 THEN GO TO equal;
};
RETURN;
EXITS equal => {};
};
};
result ← result + 1;
st1 ← st1 + 1; st2 ← st2 + 1;
ENDLOOP;
};
};
IsPrefix:
PUBLIC
PROC [prefix:
XROPE, subject:
XROPE, case:
BOOL ←
TRUE]
RETURNS [
BOOL] ~ {
RETURN [Run[prefix, 0, subject, 0, case]=InlineSize[prefix]];
};
Index:
PUBLIC
PROC
[s1:
XROPE, pos1:
INT, s2:
XROPE, case:
BOOL ←
TRUE]
RETURNS [
INT] =
TRUSTED {
Returns the smallest character position N such that s2 occurs in s1 at N and N >= pos1. If s2 does not occur in s1 at or after pos1, s1.length is returned. pos1 <= N < s1.length => FOR i IN [0..s2.length): s1[N+i] = s2[i]; N = s1.length => s2 does not occur in s1. If case is true, then case matters, otherwise upper and lower case characters are considered equal.
len1,len2, rem: INT; both: BOOL;
[len1,len2,both] ← DoubleSize[s1, s2];
rem ← IF pos1 >= len1 THEN 0 ELSE len1 - NonNeg[pos1];
IF rem >= len2
THEN {
c: CHAR;
IF len2 = 0 THEN RETURN [pos1];
c ← InlineFetch[s2, 0];
rem ← rem - len2 + 1;
IF case
THEN {
Cmp:
PROC [cc:
CHAR]
RETURNS [
BOOL] =
TRUSTED {
IF c = cc AND Run[s1, pos1+1, s2, 1, case]+1 = len2 THEN RETURN [TRUE];
pos1 ← pos1 + 1; RETURN [FALSE];
};
IF Map[s1, pos1, rem, Cmp] THEN RETURN [pos1]
}
ELSE {
LCmp:
PROC [cc:
CHAR]
RETURNS [
BOOL] =
TRUSTED {
IF cc <= 'Z AND cc >= 'A THEN cc ← cc + ('a-'A);
IF c = cc AND Run[s1, pos1+1, s2, 1, case]+1 = len2 THEN RETURN [TRUE];
pos1 ← pos1 + 1; RETURN [FALSE];
};
IF c <= 'Z AND c >= 'A THEN c ← c + ('a-'A);
IF Map[s1, pos1, rem, LCmp] THEN RETURN [pos1];
};
};
RETURN [len1];
};
Find:
PUBLIC
PROC [s1, s2:
XROPE, pos1:
INT ← 0, case:
BOOL ←
TRUE]
RETURNS [
INT] = {
index: INT ← Index[s1, pos1, s2, case];
IF index = InlineSize[s1] THEN RETURN [-1];
RETURN [index];
};
FindBackward:
PUBLIC
PROC
[s1, s2:
XROPE, pos1:
INT ← MaxLen, case:
BOOL ←
TRUE]
RETURNS [
INT] = {
len1,len2: INT; both: BOOL;
[len1,len2,both] ← DoubleSize[s1, s2];
IF NonNeg[pos1]>len1 THEN pos1 ← len1;
IF len2 = 0 THEN RETURN [pos1];
IF len1 >= len2
THEN {
c2: CHAR ← InlineFetch[s2, 0]; -- first char of pattern
rem2: INT ~ len2-1; -- remaining chars in pattern
IF (len1-pos1)<len2 THEN pos1 ← len1-len2;
IF case
THEN {
FOR i:
INT
DECREASING
IN[0..pos1]
DO
c1: CHAR ~ InlineFetch[s1, i];
IF c1=c2 AND (rem2=0 OR Run[s1, i+1, s2, 1, case]=rem2) THEN RETURN [i];
ENDLOOP;
}
ELSE {
IF c2 <= 'Z AND c2 >= 'A THEN c2 ← c2 + ('a-'A);
FOR i:
INT
DECREASING
IN[0..pos1]
DO
c1: CHAR ← InlineFetch[s1, i];
IF c1 <= 'Z AND c1 >= 'A THEN c1 ← c1 + ('a-'A);
IF c1=c2 AND (rem2=0 OR Run[s1, i+1, s2, 1, case]=rem2) THEN RETURN [i];
ENDLOOP;
};
};
RETURN [-1];
};
Match:
PUBLIC
PROC [pattern, object:
XROPE, case:
BOOL ←
TRUE]
RETURNS [
BOOL] =
TRUSTED {
Returns TRUE if the object matches the pattern, where the pattern may contain * to indicate that 0 or more characters will match. Returns FALSE otherwise. For example, using a*b as a pattern, some matching objects are: ab, a#b, a###b, and some not matching objects: abc, cde, bb, a, Ab. If case is true, then case matters, otherwise upper and lower case characters are considered equal.
submatch:
PROC [i1:
INT, len1:
INT, i2:
INT, len2:
INT]
RETURNS [
BOOL] =
TRUSTED {
WHILE len1 > 0
DO
c1: CHAR ← InlineFetch[pattern, i1];
IF c1 = '*
THEN {
quick kill for * at end of pattern
IF len1 = 1 THEN RETURN [TRUE];
else must take all combinations
{
-- first, accept the *
j1: INT ← i1 + 1;
nlen1: INT ← len1 - 1;
j2: INT ← i2;
nlen2: INT ← len2;
WHILE nlen2 >= 0
DO
IF submatch[j1, nlen1, j2, nlen2] THEN RETURN [TRUE];
j2 ← j2 + 1;
nlen2 ← nlen2 - 1;
ENDLOOP;
};
RETURN [FALSE];
};
IF len2 <= 0 THEN RETURN [FALSE];
at this point demand an exact match in both strings
{c2:
CHAR ← InlineFetch[object, i2];
IF
NOT case
THEN {
IF c1 <= 'Z AND c1 >= 'A THEN c1 ← c1 + ('a-'A);
IF c2 <= 'Z AND c2 >= 'A THEN c2 ← c2 + ('a-'A);
};
IF c1 # c2 THEN RETURN [FALSE];
};
i1 ← i1 + 1;
len1 ← len1 - 1;
i2 ← i2 + 1;
len2 ← len2 - 1;
ENDLOOP;
RETURN [len2 = 0];
};
len1: INT ← InlineSize[pattern];
len2: INT ← InlineSize[object];
First, strip off the common tails until they differ (quick kill false), or the pattern has a * at the tail. This strip is easy, because we just decrement the lengths.
WHILE len1 > 0
DO
n: INT ← len1 - 1;
c1: CHAR ← InlineFetch[pattern, n];
c2: CHAR;
IF c1 = '* THEN EXIT;
IF len2 = 0 THEN RETURN [FALSE];
len1 ← n;
len2 ← len2 - 1;
c2 ← InlineFetch[object, len2];
IF
NOT case
THEN {
IF c1 <= 'Z AND c1 >= 'A THEN c1 ← c1 + ('a-'A);
IF c2 <= 'Z AND c2 >= 'A THEN c2 ← c2 + ('a-'A);
};
IF c1 # c2 THEN RETURN [FALSE];
ENDLOOP;
RETURN [submatch [0, len1, 0, len2]];
};
SkipTo:
PUBLIC
PROC [s:
XROPE, pos:
INT, skip:
XROPE]
RETURNS [
INT] =
TRUSTED {
... returns the lowest position N in s such that s[N] is in the skip string and N >= pos. If no such character occurs in s, then return s.length.
len: INT ← InlineSize[s];
skipText: Rope.Text = InlineFlatten[skip];
skiplen: NAT ← IF skipText = NIL THEN 0 ELSE skipText.length;
IF pos < len
AND skiplen # 0
THEN {
CharMatch:
PROC [c:
CHAR]
RETURNS [
BOOL] =
TRUSTED {
FOR i:
NAT
IN [0..skiplen)
DO
IF c = skipText[i] THEN RETURN [TRUE];
ENDLOOP;
pos ← pos + 1;
RETURN [FALSE];
};
IF Map[s, pos, len - pos, CharMatch] THEN RETURN [pos];
};
RETURN [len];
};
SkipOver:
PUBLIC
PROC [s:
XROPE, pos:
INT, skip:
XROPE]
RETURNS [
INT] =
TRUSTED {
... return the lowest position N in s such that s[N] is NOT in the skip string and N >= pos. If no such character occurs in s, then return s.length.
len: INT ← InlineSize[s];
skipText: Rope.Text = InlineFlatten[skip];
skiplen: NAT ← IF skipText = NIL THEN 0 ELSE skipText.length;
IF pos >= len THEN RETURN [len];
IF skiplen # 0
THEN {
CharMatch:
PROC [c:
CHAR]
RETURNS [
BOOL] =
TRUSTED {
FOR i:
NAT
IN [0..skiplen)
DO
IF c = skipText[i] THEN GO TO found;
ENDLOOP;
RETURN [TRUE];
EXITS found => {pos ← pos + 1; RETURN [FALSE]};
};
IF Map[s, pos, len - pos, CharMatch] THEN RETURN [pos];
};
RETURN [pos];
};
VerifyStructure:
PUBLIC
PROC
[s:
XROPE]
RETURNS [leaves,nodes,maxDepth:
INT ← 0] =
TRUSTED {
... traverses the structure of the given rope object; extra checking is performed to verify invariants.
IF s = NIL THEN RETURN;
WITH x: s
SELECT
FROM
text => {
leaves ← 1;
IF x.length > x.max THEN ERROR VerifyFailed};
node =>
WITH x: x
SELECT
FROM
substr => {
ref: XROPE ← x.base;
len1: INT ← Size[x.base];
IF x.start < 0 OR x.size <= 0 THEN ERROR VerifyFailed;
IF len1 < x.start + x.size THEN ERROR VerifyFailed;
[leaves, nodes, maxDepth] ← VerifyStructure[ref];
nodes ← nodes + 1};
concat => {
leaves1,nodes1,maxDepth1: INT;
left: XROPE ← x.base;
lSize: INT ← Size[left];
right: XROPE ← x.rest;
rSize: INT ← Size[right];
[leaves1, nodes1, maxDepth1] ← VerifyStructure[left];
[leaves, nodes, maxDepth] ← VerifyStructure[right];
leaves ← leaves + leaves1;
nodes ← nodes + nodes1 + 1;
IF maxDepth1 > maxDepth THEN maxDepth ← maxDepth1;
IF x.size # lSize + rSize THEN ERROR VerifyFailed;
IF x.pos # lSize THEN ERROR VerifyFailed;
};
replace => {
leaves1,nodes1,maxDepth1: INT;
old: XROPE ← x.base;
oldSize: INT ← Size[old];
repl: XROPE ← x.replace;
replSize: INT ← Size[repl];
[leaves, nodes, maxDepth] ← VerifyStructure[old];
[leaves1, nodes1, maxDepth1] ← VerifyStructure[repl];
leaves ← leaves + leaves1;
nodes ← nodes + nodes1 + 1;
IF maxDepth < maxDepth1 THEN maxDepth ← maxDepth1;
IF x.start > x.oldPos OR x.start > x.newPos THEN ERROR VerifyFailed;
IF x.newPos - x.start # replSize THEN ERROR VerifyFailed;
IF x.start < 0 OR x.start > x.size THEN ERROR VerifyFailed;
IF x.oldPos > oldSize THEN ERROR VerifyFailed;
};
object => {
leaves ← 1;
IF x.size < 0 OR x.fetch = NIL THEN ERROR VerifyFailed;
};
ENDCASE => ERROR NoRope;
ENDCASE => ERROR NoRope;
maxDepth ← maxDepth + 1;
IF maxDepth # InlineDepth[s] THEN ERROR VerifyFailed;
};
VerifyFailed: PUBLIC ERROR = CODE;
***** New Balance implementation
This implementation is courtesy of Michael Plass (March 1985).
Stopper:
TYPE =
PROC [part: Part]
RETURNS [
BOOL];
Part:
TYPE ~
RECORD [base:
XROPE, start:
INT, end:
INT];
Must have 0 <= start <= end <= Size[base];
HeightArray: TYPE = ARRAY [0..RopePrivate.MaxDepth) OF INT;
minSizeForHeight: REF HeightArray ← NIL;
InitMinSizeForHeight:
PROC ~ {
Initializes the height array. Does not need monitoring, since the array is completely initialized by the time the assignment occurs, and REF assignment is atomic. Races can only cause a little extra allocation.
IF minSizeForHeight =
NIL
THEN {
h: REF HeightArray ← NEW[HeightArray];
h[0] ← 0;
A NIL rope has no characters and height 0.
h[1] ← 1;
A flat rope ought to have at least one character.
h[2] ← Rope.FlatMax+1;
Must be at least this big to warrant any non-flat structure.
FOR i:
NAT
IN [3..RopePrivate.MaxDepth)
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;
minSizeForHeight ← h;
};
};
PartIsBalanced: Stopper ~ {
Examines only the root.
size: INT ~ Rope.InlineSize[part.base];
height: INT ~ RopePrivate.InlineDepth[part.base];
IF part.start # 0
OR part.end # size
OR height >= RopePrivate.MaxDepth
THEN RETURN [FALSE];
IF minSizeForHeight = NIL THEN InitMinSizeForHeight[];
IF size < minSizeForHeight[height] THEN RETURN [FALSE];
WITH part.base
SELECT
FROM
substr: REF Rope.RopeRep.node.substr => RETURN [height<=1];
concat: REF Rope.RopeRep.node.concat => RETURN [TRUE];
replace: REF Rope.RopeRep.node.replace => RETURN [FALSE];
ENDCASE => RETURN [TRUE];
};
Balance:
PUBLIC
PROC [base:
XROPE, start:
INT ← 0, len:
INT ← MaxLen, flat:
INT ← FlatMax]
RETURNS [
XROPE] = {
This procedure is here mostly to match the new implementation against the old definition.
RETURN [Rope.Substr[NewBalance[base], start, len]];
};
d: NAT ~ 40;
ARep: TYPE ~ RECORD [index: INT𡤀, sub: ARRAY [0..d) OF AElement, rest: REF ARep←NIL];
AElement: TYPE ~ RECORD [base: XROPE, size: INT];
NewBalance:
PROC [rope:
XROPE]
RETURNS [
XROPE] ~ {
a: ARep; -- An extensible array that is very cheap if it is small.
accel: REF ARep ← NIL;
aN: INT ← 0;
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];
};
};
SavePart:
PROC [part: Part] ~ {
IF part.end > part.start
THEN {
rope: XROPE ← Rope.Substr[part.base, part.start, part.end-part.start];
StoreA[aN, [rope, Rope.InlineSize[rope]]];
aN ← aN + 1;
};
};
BalanceRange:
PROC [first:
INT, end:
INT, size:
INT]
RETURNS [
XROPE] ~ {
Balances pieces [first..end), whose sizes must sum to size.
SELECT
TRUE
FROM
first = end => RETURN[NIL];
end-first = 1 => RETURN[ASub[first].base];
ENDCASE => {
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[Rope.Concat[BalanceRange[first, i, sizetoi], BalanceRange[i, end, size-sizetoi]]];
}
};
part: Part ~ [rope, 0, Rope.Size[rope]];
MapParts[part, SavePart, PartIsBalanced];
RETURN [BalanceRange[0, aN, part.end-part.start]]
};
BadPart: SIGNAL ~ CODE;
MapParts:
PROC[part: Part, action:
PROC[Part], stopDescent: Stopper←
NIL] ~{
IF stopDescent#
NIL
AND stopDescent[part]
THEN action[part]
ELSE {
size: INT ~ Rope.InlineSize[part.base];
IF part.start < 0 OR part.end NOT IN [part.start..part.start+size] THEN ERROR BadPart;
WITH part.base
SELECT
FROM
substr:
REF Rope.RopeRep.node.substr => {
MapParts[[substr.base, substr.start+part.start, substr.start+part.end], action, stopDescent];
};
concat:
REF Rope.RopeRep.node.concat => {
IF part.start < concat.pos
THEN {
MapParts[[concat.base, part.start, MIN[part.end, concat.pos]], action, stopDescent];
};
IF part.end > concat.pos
THEN {
newStart: INT ← MAX[part.start-concat.pos, 0];
newEnd: INT ← part.end-concat.pos;
MapParts[[concat.rest, newStart, newEnd], action, stopDescent];
};
};
replace:
REF Rope.RopeRep.node.replace => {
len1: INT ~ replace.start;
len2: INT ~ replace.newPos-replace.start;
len3: INT ~ replace.size-replace.newPos;
offset3: INT ~ replace.oldPos;
IF part.start < len1
THEN {
MapParts[[replace.base, part.start, MIN[part.end, len1]], action, stopDescent];
};
IF part.start < len1+len2
AND part.end > len1
THEN {
newStart: INT ~ MAX[part.start-len1, 0];
newEnd: INT ~ MIN[part.end-len1, len2];
MapParts[[replace.replace, newStart, newEnd], action, stopDescent];
};
IF part.end > len1+len2
THEN {
newStart: INT ← MAX[part.start-(len1+len2), 0]+offset3;
newEnd: INT ← MIN[part.end-(len1+len2), len3]+offset3;
MapParts[[replace.base, newStart, newEnd], action, stopDescent];
};
};
ENDCASE => action[part];
};
};