DIRECTORY
Basics USING [charsPerWord, Comparison, LowHalf],
PrincOpsUtils USING [LongCopy],
Rope,
RopePrivate USING [BoundsFault, CheckLongAdd, InlineDepth, MaxDepth, NonNeg, QStore, Short, SingleSize, Tconcat, Tobject, Treplace, Tsubstr, Ttext];

RopeImpl: CEDAR PROGRAM
IMPORTS Basics, PrincOpsUtils, Rope, RopePrivate
EXPORTS Rope
SHARES  Rope
= BEGIN OPEN Rope, RopePrivate;

charsPerWord: NAT = Basics.charsPerWord;

NoRope: PUBLIC ERROR = CODE;

emptyRope: Rope.Text = NEW[Ttext[0]];

NewText: PUBLIC PROC [size: NAT] RETURNS [text: Text] = TRUSTED {
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 {
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 
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 {
IF len > len1 THEN {depth _ x.depth; EXIT};
base _ x.base}
ELSE {
xnew: INT _ x.newPos;
len2: INT _ xnew - start;
IF len2 > 0
THEN {
IF len > len2 THEN {depth _ x.depth; EXIT};
start _ -len1;
base _ x.replace}
ELSE {
start _ x.oldPos - len2;
base _ x.base};
};
};
object => {
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 [Concat[Concat[r1,r2], Concat[Concat[r3, r4], r5]]]; 
};

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]};
SELECT TRUE FROM
restLen < FlatMax => {
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 => {
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 {
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]};
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 => {
oldPos _ x.oldPos + (oldPos - xnewPos);
base _ x.base;
};
start = xnewPos => {
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 {
IF base = NIL THEN BoundsFault[];
WITH x: base SELECT FROM
text => {RETURN[QFX[base, index, x.length]]};
node => {
[] _ NonNeg[index];
[] _ NonNeg[x.size-index-1];
};
ENDCASE;
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 {
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 =>
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 { 
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 {
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 {
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 {
rem: INT _ NonNeg[InlineSize[rope]-NonNeg[start]];
IF rem > len THEN rem _ len;
IF buffer # NIL THEN {
bufPos: NAT _ buffer.length;
bufRem: NAT _ buffer.maxLength - bufPos;

IF bufRem > rem THEN bufRem _ QShort[rem];
charsMoved _ charsMoved + bufRem;

WHILE bufRem # 0 DO
nRem: NAT _ bufRem;
base: ROPE;
bStart, bLen: INT;
[base, bStart, bLen] _ ContainingPiece[rope, start];
IF bLen < nRem THEN nRem _ QShort[bLen];
IF nRem = 0 THEN ERROR NoRope;
bufRem _ bufRem - nRem;
start _ start + nRem;
WITH base SELECT FROM
txt: Text => {
bPos: NAT _ QShort[bStart];
IF nRem > 4 AND (bPos MOD charsPerWord) = (bufPos MOD charsPerWord)
THEN {
WHILE (bPos MOD charsPerWord) # 0 AND nRem # 0 DO
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 {
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 =>
SELECT TRUE FROM
obj.append # NIL => {
moved: NAT;
buffer.length _ bufPos;
moved _ obj.append[buffer, obj.base, bStart, nRem];
IF moved # nRem THEN ERROR NoRope;
};
obj.map # NIL => {
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 => {
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 {
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 {
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 {
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 _ 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];
};
{
r1,r2: ROPE _ NIL;
pos1,st1,sz1,lm1: INT _ 0;
pos2,st2,sz2,lm2: INT _ 0;
c1,c2: CHAR;
DO
IF st1 = lm1 THEN {
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 {
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 {
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
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] = {
RETURN [InlineSize[base]];
};

Size: PUBLIC PROC [base: ROPE] RETURNS [INT] = {
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
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 {
IF len > len1 THEN {split _ len1; EXIT};
base _ x.base}
ELSE {
xnew: INT _ x.newPos;
split _ xnew - start;
IF split > 0
THEN {
IF len > split THEN EXIT; -- crosses high boundary
start _ -len1;
base _ x.replace; -- entirely in middle section
}
ELSE {
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]];
};

END.

@RopeImpl.mesa, "Thick" string implementation
Copyright c 1984, 1985 by Xerox Corporation.  All rights reserved.
Russ Atkinson, March 8, 1985 4:20:23 pm PST
Paul Rovner, August 8, 1983 12:35 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.
errors peculiar to Rope
Watch out for startup problems with literals.  Don't use "" here!
procedure to allocate new Rope.Text objects
... 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.
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!)
substr starts in 1st section
entirely in first section, so go deeper
substr starts in middle or last sections
substr starts in middle section
entirely in middle section
entirely in last section
no sub-structure
Return the concatenation of the given 5 ropes.
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.
The result is small enough to make it flat.
Possibly can reduce depth by combining with a concat node.
Possibly can reduce depth by combining with a concat node.
result is small enough to be flat
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!)
replacing the replacement string
adding to old replace string
... fetches indexed character from given ropes.  BoundsFault occurs if index < 0 or index is >= Length[base].
This first discrimination does the bounds checking and the quick kill for a flat rope.
First time through, check the index against bounds
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!)
... 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].
(note: change base last, since it is aliased with x!)
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
no optimization for user-supplied strings
Force proper evaluation order, since the compiler might get it backwards if left to its own devices.
... 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.
# of characters in rope after start
The user may have specified a shorter run of characters
position of next place to append character (cache for buffer.length)
# of chars remaining in the transfer
the caller may have specified a shorter amount
update the # of chars moved, even though we have not yet moved them
There are characters to move and room in the buffer.
nRem will have # of chars to move this time around the loop, it defaults to amount of chars left in the transfer
grab the smallest piece of the rope containing the given index
this piece may not fulfill the transfer
this should not happen!  it means that some calculation or invariant is bad!
update the # of chars left in the transfer
start is now the starting index for the next piece
We are appending from a flat rope to a REF TEXT.
The source and destination are aligned, so we can BLT
Not yet aligned to a word boundary
The source and desitination are not aligned, so we move chars slowly
We are appending from a user-defined object to a REF TEXT.
The user has supplied a fast append routine, so use it.
The append routine needs buffer.length set properly
We asked for a perfectly legitimate # of chars, and the user's append routine blew it!  This rope is not reliable.
The user has supplied a fast map routine, so use it.
Sigh.  We have to do this one ourselves.
contents equality of s1 and s2
relatively cheap test for equality
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
The two ropes are both flat, so we don't have to discriminate for every character.
At least one rope is not flat, so we do it the hard way.
need a new piece from s1
need a new piece from s2
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
(note: change base last, since it is aliased with x!)
returns the length of the rope (Length[NIL] = 0)
Size[base] = Length[base]
strip away extra levels from base
(note: change base last, since it is aliased with x!)
substr starts in 1st section
entirely in first section
substr starts in middle or last sections
substr starts in middle section
entirely in last section
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)
December 20, 1984, Russ Atkinson, formatting cleanup & performance improvements
Russ Atkinson (RRA) January 29, 1985 4:09:50 pm PST
Removed PieceMap and its support, added AppendChars and its support.  Other small changes to use AppendChars internally (like in Flatten).

ΚG˜
codeš
œ,™,Kšœ
Οm
œ7™BKš
œ+™+Kš
œ$™$—˜Kš
œθ
™θ
—K˜š
Οk	˜	Kšœžœ%˜1Kšœžœ˜Kš
œ˜šœžœƒ
˜”
K˜——šœ
žœ
ž˜Kšžœ)˜0Kšžœ˜Kšžœ˜Kšœžœ
žœ˜K˜Kšœžœ˜(K˜Kš
œ™Kšœžœ
žœžœ
˜K˜šœžœ˜%Kš
œA™A—K˜šΟnœžœ
žœžœžœžœ˜AKš
œ+™+Kšžœ
žœ
žœ
˜$Kšœžœ˜K˜K˜K˜—šŸœžœ
žœžœ	žœžœžœžœžœ˜cKš
œ…™…Kšœžœ˜Kšœžœ ˜(Kšœžœ˜Kšžœ
žœ
žœ
žœ
žœžœ˜EKšžœžœžœ
žœ˜.Kšžœžœ
žœ˜:š
œΪ
™Ϊ
K™5—šžœ
˜šžœ	žœ
ž˜Kšœžœ
˜
˜šžœžœ
ž˜K˜3š
œ˜Kšœžœ˜šžœ˜
Kšžœžœžœžœ˜?Kšžœ˜#—Kš
œ˜—š
œ˜Kšœžœ˜šžœ	˜šžœ˜Kš
œ™Kšžœžœžœ˜+Kš
œ'™'Kš
œ˜—šžœ˜Kš
œ(™(Kšœžœ˜Kšœžœ˜šžœ	˜šžœ˜Kš
œ™Kšžœžœžœ˜+Kš
œ™Kš
œ˜Kš
œ˜—šžœ˜Kš
œ™K˜K˜——K˜——K˜—˜Kš
œ™Kšžœ˜—Kšžœžœ˜——Kšžœžœ˜—Kšžœžœ
žœ
˜Kšžœžœ
žœ˜-Kšžœ
˜—Kš
œ˜Kš
œ˜šœžœ
˜K˜N—Kšžœžœ˜2K˜K˜—šŸœžœ
žœžœžœžœžœžœ˜LKš
œ.™.Kšžœ6˜<K˜K˜—šŸœžœ
žœ
žœžœžœžœžœ˜KKš
œ‰
™‰
K˜Kšœžœ
˜Kšœžœ˜Kšžœžœ
žœ
žœ˜!K˜&Kšžœ
žœ
žœ˜"K˜&Kšžœ
žœ
žœ˜"K˜%šžœžœ˜Kš
œ+™+K˜"Kšœžœ˜šŸœžœžœžœžœžœ˜2Kšœ*žœžœ˜:—šžœž˜Kšžœ$˜(š	žœ
žœžœ
žœž˜/K˜'K˜Kšžœ
˜——šžœž˜Kšžœ$˜(š	žœ
žœžœ
žœž˜/K˜'K˜Kšžœ
˜——Kšžœ˜—šžœ
žœ
ž˜š
œ˜Kš
œ:™:šžœ	žœ
ž˜šœžœžœ
ž˜˜	šžœžœ˜"K˜K˜K˜K˜——Kšžœ
˜—Kšžœ
˜—K˜—š
œ˜Kš
œ:™:šžœ	žœ
ž˜šœžœžœ
ž˜˜	šžœžœ˜K˜K˜K˜——Kšžœ
˜—Kšžœ
˜—Kš
œ˜—Kšžœ
˜—Kš
œ˜Kšœžœ+˜6šœžœ
˜K˜W—Kšžœžœ˜1K˜K˜—šŸœžœ
žœžœ	žœžœžœžœ
žœžœžœ˜vKšœ
žœ˜!Kšœ
žœ˜!Kšœžœ$˜,Kšœžœ˜šœžœ
˜Kš
œ
žœ	žœ	žœ
žœžœžœ˜D—Kšœžœ˜*Kšœžœ'˜0Kšžœžœ
žœ˜%Kš	žœ	žœ
žœ
žœ
Οc˜Ašžœžœ˜Kš
œ!™!K˜"Kšœžœ˜šŸœžœžœžœžœžœ˜2Kšœ*žœžœ˜:—Kšžœžœ#˜4Kšžœ
žœ%˜8Kšžœžœ+˜DKšžœ˜—š
œΌ
™Ό
K™5—šžœ	žœ
ž˜˜šžœžœ
ž˜˜Kšœ	žœ˜Kšœžœ˜šžœ
žœ
ž˜šœžœ˜*Kš
œ ™ K˜'K˜Kš
œ˜—š
œ˜Kš
œ™šžœ)žœ˜1Kš
œ˜K˜K˜K˜K˜—K˜—Kšžœ
˜—K˜—Kšžœ
˜——Kšžœ
˜—K˜,K˜$K˜#Kšœžœ+˜6šœžœ˜K˜z—Kšžœžœ˜1K˜K˜—šŸœžœ
žœžœ	žœžœžœžœ˜JKš
œm™mKšžœžœ
žœ˜!Kš
œV™Všžœ	žœ
ž˜Kšœ	žœ
žœ˜-˜	Kš
œ2™2K˜K˜K˜—Kšžœ
˜—š
œ­
™­
K™5—š
ž˜šžœ	žœ
ž˜Kšœ	žœ
žœ˜-˜šžœžœ
ž˜K˜3š
œ˜Kšžœžœžœ˜,K˜K˜—š
œ˜Kšžœžœžœ˜.šžœžœ˜Kš
œ˜Kš
œ˜Kšžœ˜—K˜$K˜—Kšœ
žœ˜*Kšžœžœ˜——Kšžœžœ˜—Kšžœ
˜—K˜K˜—šŸœžœ
žœžœ	žœžœžœžœžœ˜pKšœNžœžœ=™­
Kšœžœ,˜4Kšžœžœ˜šžœ	ž˜šžœ	žœ
ž˜š
œ	˜	Kšœžœ˜šžœžœ
žœž˜*Kšžœžœ
žœžœ˜+Kšžœ
˜—Kšžœžœ˜—˜K™5šžœžœ
ž˜Kšœ3žœ˜9š
œ˜Kšœžœ	˜Kšžœžœžœ˜0šžœžœ˜Kšœžœ˜Kšžœ#žœ
žœžœ˜9K˜"—K˜K˜K˜—š
œ˜Kšœžœ˜Kšœžœ˜šžœžœ˜Kšœžœ˜Kšžœžœžœ˜,Kšžœ#žœ
žœžœ˜9K˜$—šžœžœ˜Kšœžœ˜Kšœžœ˜Kšžœžœ žœ˜;Kšžœ#žœ
žœžœ˜9K˜"—K˜ K˜—˜K˜Kšœžœ
˜Kšžœžœ
žœ
žœ ˜8˜šžœžœ
žœž˜#Kšžœžœ
žœžœ˜-Kšžœ
˜—Kšžœžœ˜——Kšžœžœ˜——Kšžœžœ˜—Kšžœ
˜—Kšžœžœ˜K˜K˜—šŸ	œžœ
žœžœ	žœžœ(žœ
žœžœžœ˜‰
Kš
œ)™)Kš
œJ™JKš
œ:™:Kšœžœ	˜Kšœžœ,˜7Kšœžœ
˜Kšœ
žœ
˜Kšžœ
žœ	žœ
žœ
˜/Kšžœžœ˜šžœžœ
ž˜š
œ˜Kšœžœ	˜K˜šžœžœ
žœ
ž˜Kšœžœ˜Kšžœžœ
žœ˜+K˜K˜Kšžœ
˜—Kš
œ˜K˜—šžœ˜š	œžœ
žœžœžœ˜%Kšœžœ˜#K˜Kšžœžœ
žœ˜+Kšžœ˜K˜—Kšžœ˜Kš
œ˜——K˜K˜—šŸœžœ
žœžœ	žœžœžœžœ˜dKšœžœ˜Kšœžœ ˜(Kšžœžœ˜šžœžœžœ˜!Kš
žœžœ
žœ
žœžœ˜ Kšžœžœ
žœžœ˜0Kš
œ˜—Kšžœ
žœ
žœ
˜$K˜K˜Kšœžœ˜2˜K˜——šŸœžœ
žœžœžœ;žœžœžœ˜€
Kš
œ)™)Kšžœ
žœ
žœ
˜$šžœžœ
˜Kš
œX˜X—š
œ˜K˜——šŸœžœ
žœžœžœ
žœžœ
žœžœžœžœ˜kKšžœ
žœ
žœ
˜$šžœ˜Kšžœ˜Kšžœ
žœžœ
žœžœžœ
žœ˜7—šžœ˜šžœ˜Kš
œ!˜!Kš
žœžœ
žœžœžœ
˜8Kšžœ˜
—šžœ˜Kš
œd™dKšœžœ ˜*Kšœžœ$˜/Kšžœ˜——š
œ˜K˜——šŸœžœ
žœžœžœ
žœ˜:K˜K˜Kšžœ˜
Kš
œ˜K˜—šŸœžœ
žœžœ
žœ
žœžœžœžœ˜Ušžœžœ
žœ˜Kšœžœ˜Kšžœ	žœ
žœ
˜#K˜Kšœžœ˜=K˜—˜K˜——šŸ	œžœ
žœžœžœžœ
žœžœ˜GKšœžœ˜#Kšœžœ
žœ˜šžœ	žœ˜Kšœ
žœ˜šžœžœ
ž˜˜Kšœ žœ˜?Kš
œ˜K˜—šžœ˜Kš
œ$˜$K˜——K˜—Kš
œ˜K˜—šŸœžœžœžœ˜J˜Kšœžœžœ
žœžœ
žœ˜1Kš
œ,˜,Kšœžœžœ
žœžœ
žœ˜/—K˜K˜—šŸœžœ
žœ	žœ
žœžœ	žœžœžœ
žœžœžœžœ˜†
Kšœ'žœ
žœΝ™όšœžœ*˜2Kš
œ#™#—šžœžœ˜Kš
œ7™7—šžœ
žœ
žœ˜šœžœ˜Kš
œD™D—šœžœ˜(Kš
œ$™$—K˜šžœžœ˜*Kš
œ.™.—š
œ!˜!Kš
œC™C—K˜šžœž˜Kš
œ4™4šœžœ
˜Kš
œp™p—Kšœžœ
˜Kšœžœ
˜š
œ4˜4Kš
œ>™>—šžœ
žœ˜(Kš
œ'™'—šžœ
žœ
žœ˜Kš
œL™L—š
œ˜Kš
œ*™*—š
œ˜Kš
œ2™2—šžœžœ
ž˜˜Kšœ'žœ
žœ
™0Kšœžœ˜šžœ
žœžœžœ˜Cšžœ˜Kš
œ5™5šžœžœžœ
ž˜1Kš
œ"™"Kšœžœ˜4Kš
œ˜Kš
œ˜Kš
œ˜Kšžœ
˜—šžœ
žœ˜˜Kšœžœžœ
žœžœ
žœ˜3Kš
œ-˜-Kšœžœ	žœ
žœžœ
žœ˜8—K˜—K˜
—šžœ˜Kš
œD™Dšžœžœ
žœž˜Kšœžœ˜8Kšžœ
˜—K˜——K˜—šœžœ˜šžœžœ
ž˜šœžœ˜Kšœ1žœ
žœ
™:šžœ
žœ
ž˜šœ
žœ˜Kš
œ7™7Kšœžœ
˜˜Kš
œ3™3—Kš
œ3˜3šžœžœ
žœ˜"Kš
œr™r—K˜—šœ
žœ˜Kš
œ4™4šœžœ˜Kšœ
žœ˜$Kš
œ˜K˜K˜—Kš
œ-˜-Kšžœ
žœ
žœ	 ˜3K˜—šžœ˜Kš
œ(™(Kš
œ˜Kšœžœ˜šžœžœ
žœž˜Kšœžœ˜:Kšžœ
˜—K˜———Kšžœžœ	 ˜3—K˜—Kšžœžœ	 ˜3—Kš
œ˜Kšžœ
˜—K˜K˜—K˜K˜—šŸœžœ
žœ
žœžœžœžœžœžœžœ˜UKš
œ™Kšœžœ˜K˜K˜K˜Kšžœ
žœ
žœžœ˜#Kš
žœ	žœ
žœ
žœžœ˜*šžœžœžœ
žœžœ
žœ˜,Kš
œ"™"šžœžœ
žœž˜'Kšžœ#žœ
žœžœ˜9Kšžœ
˜—Kšžœžœ˜—Kšžœ˜%Kš
œ˜K˜—šŸœžœ
žœ
žœžœžœžœ
žœžœ˜dKš
œ@™@Kš
œ5™5Kš
œ™Kšœžœ˜K˜K˜K˜š
žœžœ
žœžœ
žœ˜#Kš
œR™RKšœžœ˜Kšœžœ˜Kšœžœžœ˜šžœ˜šžœ
˜šžœžœ
žœ	ž˜Kšœžœ˜Kšœžœ˜Kšžœ	žœ
žœ
˜Kš
žœ	žœ
žœžœ
žœ˜4Kš
ž˜——šžœ
˜šžœžœ
žœ	ž˜Kšœžœ˜Kšœžœ˜Kšžœ
žœ
žœ˜0Kšžœ
žœ
žœ˜0Kšžœ	žœ
žœ
˜Kš
žœ	žœ
žœžœ
žœ˜4Kšžœ
˜———Kšžœžœ
žœ˜#Kšžœžœ
žœ˜ Kšžœ	˜K˜—š
œ
˜
Kš
œ8™8Kšœžœžœ
˜Kšœžœ˜Kšœžœ˜Kšœžœ
˜š
ž˜šžœžœ˜Kš
œ™šžœ˜Kš
žœ
žœžœ
žœžœ˜2—K˜+Kšžœ	žœ
žœ
˜K˜—šžœžœ˜Kš
œ™Kšžœžœ
žœ˜4K˜+Kšžœ	žœ
žœ
˜K˜—K˜K˜šžœ
žœžœ˜Kšžœ
žœ
žœ˜0Kšžœ
žœ
žœ˜0Kš
œ˜—Kšžœ	žœ
žœžœ	žœžœ
˜;K˜Kšžœ
˜—K˜—˜K˜——šŸœžœ
žœžœ	žœžœžœ	žœžœžœ˜pKš
œ/™/Kš
œE™EKš
œ=™=Kš
œ˜Kš
žœžœžœ
žœžœ˜5Kš
œ˜K˜K˜š
ž˜Kšœžœ˜šžœ	žœ
ž˜K™5Kšœžœ
˜˜šžœžœ
ž˜˜K˜K˜K˜—˜Kšœžœ˜šžœ	˜Kšžœ˜!Kšžœ7˜;—K˜—˜Kšœžœ˜Kšœžœ˜šžœ
žœ
ž˜K˜)K˜;šžœ˜Kš
œ˜K˜K˜——K˜—Kšœžœ˜Kšžœžœ˜——Kšžœžœ˜—Kšžœžœ˜&Kšžœ
˜—K˜K˜—šŸœžœ
žœžœžœžœ˜1Kšžœ˜Kš
œ˜—K˜šŸœžœ
žœžœžœžœ˜2Kš
œ0™0Kšžœ˜Kš
œ˜—K˜šŸœžœ
žœžœžœžœ˜0Kš
œ™Kšžœ˜Kš
œ˜K˜—šŸ
œžœ
žœžœ	žœžœžœžœžœžœ˜wKšœžœžœ
˜Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœžœžœ
˜Kšžœžœžœ
žœ
˜%šžœ	˜Kšžœ
žœ˜Kšžœ
žœ
žœ
žœžœ
žœ
˜F—šžœ˜Kšžœ˜Kšžœ
žœžœ
žœžœžœ
žœ˜/—Kšžœ
žœ
žœ˜7š
ž˜š
œ!™!K™5—šžœ	žœ
ž˜Kšœžœžœ ˜1˜šžœžœ
ž˜K˜3š
œ˜Kšœžœ	˜K˜šžœ
˜Kšžœžœ
žœ
žœ˜.Kšžœ"˜&——š
œ˜Kšœžœ˜Kšœžœ˜šžœ	˜šžœ˜Kš
œ™Kšžœžœžœ˜(Kš
œ™Kš
œ˜—šžœ˜Kš
œ(™(Kšœžœ˜K˜šžœ
˜šžœ˜Kš
œ™Kšžœ
žœ
žœ ˜2K˜Kšœ ˜/K˜
—šžœ˜Kš
œ™K˜Kš
œ˜Kš
œ˜—————Kšœžœžœ˜Kšžœžœ
˜——Kšžœžœ
˜—Kšžœ
˜—Kšžœžœ
žœ˜0K˜.Kšžœžœ
žœ˜1K˜Kšžœ
žœ˜K˜^Kšžœ˜K˜K˜—šŸœžœžœžœžœžœ˜;Kšžœ˜Kš
œ˜K˜——šžœ
˜K˜—Kšœ/žœ™P™XKšœ.žœ™O—K™HK™8K™8K™;K™;K™HK™RK™5Kšœ:ž™=K™-K™1K™SK™O™3K™Š
—K™—…—Enυ