RopeImpl:
CEDAR
PROGRAM
IMPORTS Basics, PrincOpsUtils, Rope, RopePrivate
EXPORTS Rope
SHARES Rope
= BEGIN OPEN Rope, RopePrivate;
charsPerWord: NAT = Basics.charsPerWord;
errors peculiar to Rope
NoRope: PUBLIC ERROR = CODE;
emptyRope: Rope.Text =
NEW[Ttext[0]];
Watch out for startup problems with literals. Don't use "" here!
NewText:
PUBLIC
PROC [size:
NAT]
RETURNS [text: Text] =
TRUSTED {
procedure to allocate new Rope.Text objects
IF size = 0 THEN RETURN [emptyRope];
text ← NEW[Ttext[size]];
text.length ← size;
};
Substr:
PUBLIC
PROC [base:
ROPE, start:
INT ← 0, len:
INT ← MaxLen]
RETURNS [new:
ROPE] =
TRUSTED {
... returns the smallest character position N such that N >= pos1 and Equal[Substr[s1, N, Length[s2], s2, case]. If s2 does not occur in s1 at or after pos1, Length[s1] is returned. case => case of characters is significant. BoundsFault occurs when pos1 < 0.
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: base
SELECT
FROM
text => EXIT;
node =>
WITH x: x
SELECT
FROM
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;
ENDCASE => ERROR NoRope;
IF start # 0 THEN LOOP;
IF len = InlineSize[base] THEN RETURN [base];
ENDLOOP;
[] ← NonNeg[start];
[] ← NonNeg[len];
new ←
NEW[Tsubstr ←
[node[size: len, cases: substr[base: base, start: start, depth: depth + 1]]]];
IF depth >= MaxDepth THEN new ← Rope.Balance[new];
};
Cat:
PUBLIC
PROC [r1, r2, r3, r4, r5:
ROPE ←
NIL]
RETURNS [
ROPE] =
TRUSTED {
Return the concatenation of the given 5 ropes.
RETURN [Concat[Concat[r1,r2], Concat[Concat[r3, r4], r5]]];
};
Concat:
PUBLIC
PROC [base,rest:
ROPE ←
NIL]
RETURNS [new:
ROPE] =
TRUSTED {
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[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]};
SELECT
TRUE
FROM
restLen < FlatMax => {
Possibly can reduce depth by combining with a concat node.
WITH x: base
SELECT
FROM
node =>
WITH x: x
SELECT
FROM
concat =>
IF x.size-x.pos < FlatMax/2
THEN {
baseLen ← x.pos;
rest ← Concat[x.rest, rest];
base ← x.base;
};
ENDCASE;
ENDCASE;
};
baseLen < FlatMax => {
Possibly can reduce depth by combining with a concat node.
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;
};
ENDCASE;
[] ← NonNeg[size-baseLen];
depth ← MAX[InlineDepth[base], InlineDepth[rest]] + 1;
new ←
NEW[Tconcat ←
[node[size: size, cases: concat[base: base, rest: rest, pos: baseLen, depth: depth]]]];
IF depth > MaxDepth THEN new ← Rope.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]};
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: change base last, since it is aliased with x!)
WITH x: base
SELECT
FROM
node =>
WITH x: x
SELECT
FROM
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;
ENDCASE;
[] ← NonNeg[NonNeg[newPos] - NonNeg[start]];
[] ← NonNeg[NonNeg[oldPos] - start];
[] ← NonNeg[NonNeg[size] - newPos];
depth ← MAX[InlineDepth[base], InlineDepth[with]] + 1;
new ←
NEW[Treplace ←
[node[size: size, cases: replace[base: base, replace: with, newPos: newPos, oldPos: oldPos, start: start,depth: depth]]]];
IF depth > MaxDepth THEN new ← Rope.Balance[new];
};
Fetch:
PUBLIC
PROC [base:
ROPE, index:
INT ← 0]
RETURNS [
CHAR] =
TRUSTED {
... fetches indexed character from given ropes. BoundsFault occurs if index < 0 or index is >= Length[base].
IF base = NIL THEN BoundsFault[];
This first discrimination does the bounds checking and the quick kill for a flat rope.
WITH x: base
SELECT
FROM
text => {RETURN[QFX[base, index, x.length]]};
node => {
First time through, check the index against bounds
[] ← NonNeg[index];
[] ← NonNeg[x.size-index-1];
};
ENDCASE;
Now we really don't need bounds checking, since checking the tope 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 x: base
SELECT
FROM
text => {RETURN[QFX[base, index, x.length]]};
node =>
WITH x: x
SELECT
FROM
substr => {index ← index + x.start; base ← x.base};
concat => {
IF index < x.pos THEN {base ← x.base; LOOP};
index ← index - x.pos;
base ← x.rest};
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};
object => RETURN [x.fetch[x.base, index]];
ENDCASE => ERROR NoRope;
ENDCASE => ERROR NoRope;
ENDLOOP;
};
Map:
PUBLIC
PROC [base:
ROPE, 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:
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
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:
ROPE, 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, append: AppendCharsType]
RETURNS [
ROPE] =
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, append: append]]]]];
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]}
ELSE {
Force proper evaluation order, since the compiler might get it backwards if left to its own devices.
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 [rtn: Text ←
NIL] =
TRUSTED {
IF s #
NIL
THEN {
len: NAT ← s.length;
IF len = 0 THEN RETURN [emptyRope];
rtn ← NewText[len];
MoveAlignedChars[from: LOOPHOLE[s, Text], to: rtn, len: len];
};
ToRefText:
PUBLIC
PROC [base:
ROPE]
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]] ];
};
AppendChars:
PUBLIC
PROC[buffer:
REF
TEXT, rope:
ROPE, start:
INT ← 0, len:
INT ←
LAST[
INT]]
RETURNS [charsMoved:
NAT ← 0] =
TRUSTED {
... 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 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
charsMoved ← charsMoved + bufRem;
update the # of chars moved, even though we have not yet moved them
WHILE bufRem # 0
DO
There are characters to move and room in the buffer.
nRem:
NAT ← bufRem;
nRem will have # of chars to move this time around the loop, it defaults to amount of chars left in the transfer
base: ROPE;
bStart, bLen: INT;
[base, bStart, bLen] ← ContainingPiece[rope, start];
grab the smallest piece of the rope containing the given index
IF bLen < nRem
THEN nRem ← QShort[bLen];
this piece may not fulfill the transfer
IF nRem = 0
THEN
ERROR NoRope;
this should not happen! it means that some calculation or invariant is bad!
bufRem ← bufRem - nRem;
update the # of chars left in the transfer
start ← start + nRem;
start is now the starting index for the next piece
WITH base
SELECT
FROM
txt: Text => {
We are appending from a flat rope to a REF TEXT.
bPos: NAT ← QShort[bStart];
IF nRem > 4
AND (bPos
MOD charsPerWord) = (bufPos
MOD charsPerWord)
THEN {
The source and destination are aligned, so we can BLT
WHILE (bPos
MOD charsPerWord) # 0
AND nRem # 0
DO
Not yet aligned to a word boundary
QStore[QFetch[txt, bPos], LOOPHOLE[buffer], bufPos];
bPos ← bPos + 1;
bufPos ← bufPos + 1;
nRem ← nRem - 1;
ENDLOOP;
IF nRem # 0
THEN {
PrincOpsUtils.LongCopy[
from: LOOPHOLE[txt, LONG POINTER]+SIZE[TEXT[bPos]],
nwords: (nRem+charsPerWord-1) / charsPerWord,
to: LOOPHOLE[buffer, LONG POINTER]+SIZE[TEXT[bufPos]] ];
};
}
ELSE {
The source and desitination are not aligned, so we move chars slowly
FOR i:
NAT
IN [0..nRem)
DO
QStore[QFetch[txt, bPos+i], LOOPHOLE[buffer], bufPos+i];
ENDLOOP;
};
};
n:
REF node RopeRep => {
WITH n
SELECT
FROM
obj:
REF object node RopeRep =>
We are appending from a user-defined object to a REF TEXT.
SELECT
TRUE
FROM
obj.append #
NIL => {
The user has supplied a fast append routine, so use it.
moved: NAT;
buffer.length ← bufPos;
The append routine needs buffer.length set properly
moved ← obj.append[buffer, obj.base, bStart, nRem];
IF moved # nRem
THEN
ERROR NoRope;
We asked for a perfectly legitimate # of chars, and the user's append routine blew it! This rope is not reliable.
};
obj.map #
NIL => {
The user has supplied a fast map routine, so use it.
action: ActionType =
TRUSTED {
QStore[c, LOOPHOLE[buffer], bufPos];
bufPos ← bufPos + 1;
nRem ← nRem - 1;
};
[] ← obj.map[obj.base, bStart, nRem, action];
IF nRem # 0 THEN ERROR NoRope; -- should not happen
};
ENDCASE => {
Sigh. We have to do this one ourselves.
fetch: FetchType ← obj.fetch;
data: REF ← obj.base;
FOR i:
NAT
IN [0..nRem)
DO
QStore[fetch[data, bStart+i], LOOPHOLE[buffer], bufPos+i];
ENDLOOP;
};
ENDCASE => ERROR NoRope; -- this should not happen!
};
ENDCASE => ERROR NoRope; -- this should not happen!
bufPos ← bufPos + nRem;
ENDLOOP;
buffer.length ← bufPos;
};
};
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 [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;
IF sz1 > sz2 THEN RETURN [greater];
IF sz1 < sz2 THEN RETURN [less];
RETURN [equal];
};
{
At least one rope is not flat, so we do it the hard way.
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 {
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 [IF c1 < c2 THEN less ELSE greater];
st1 ← st1 + 1; st2 ← st2 + 1;
ENDLOOP;
};
ContainingPiece:
PUBLIC
PROC [rope:
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[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:
ROPE]
RETURNS [
BOOL] = {
RETURN [InlineSize[r] = 0];
};
Length:
PUBLIC
PROC [base:
ROPE]
RETURNS [
INT] = {
returns the length of the rope (Length[NIL] = 0)
RETURN [InlineSize[base]];
};
Size:
PUBLIC
PROC [base:
ROPE]
RETURNS [
INT] = {
Size[base] = Length[base]
RETURN [InlineSize[base]];
};
OldBalance:
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
(note: change base last, since it is aliased with x!)
WITH x: base
SELECT
FROM
text => {leafy ← TRUE; EXIT}; -- no sub-structure
node =>
WITH x: x
SELECT
FROM
substr => {start ← start + x.start; base ← x.base};
concat => {
xpos: INT ← x.pos;
split ← xpos - start;
IF split > 0
THEN {IF len > split THEN EXIT; base ← x.base}
ELSE {start ← -split; base ← x.rest}};
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};
entirely in first section
base ← x.base}
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
start ← -len1;
base ← x.replace; -- entirely in middle section
}
ELSE {
entirely in last section
start ← x.oldPos - split;
base ← x.base;
}}};
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];
};
QShort:
PROC [x:
INT]
RETURNS [
CARDINAL] =
TRUSTED INLINE {
RETURN [Basics.LowHalf[x]];
};