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