<> <> <> <> <> 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 { <<... 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]]; <> <<(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 { <> 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]}; <> <<(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 => { <> 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 { <<... fetches indexed character from given ropes. BoundsFault occurs if index < 0 or index is >= Length[base].>> 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; <> <<(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 { <> < 0, then new does not share with the original rope!>> <> 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 { <<... 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; <> IF buffer # NIL THEN { bufPos: NAT _ buffer.length; <> bufRem: NAT _ buffer.maxLength - bufPos; <<# of chars remaining in the transfer>> 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 { <> <> <<(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] = { <> 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 <> <<(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 { <> 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. <<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>> <> <<17-Feb-82 14:50:00, Russ Atkinson, minor defs changes>> <<19-Feb-82 12:00:25, Russ Atkinson, try to avoid returning NIL>> <> <> <> <> <> <> <<>>