<> <> <> <> DIRECTORY Inline, Rope, RunReader, TiogaLooks, TiogaLooksOps, TiogaLooksSupport; TiogaLooksImpl: CEDAR PROGRAM IMPORTS TiogaLooksOps, TiogaLooksSupport, Rope, RunReader, Inline EXPORTS TiogaLooksOps, TiogaLooksSupport SHARES TiogaLooksOps = BEGIN OPEN TiogaLooks, TiogaLooksOps, TiogaLooksSupport; OutOfBounds: PUBLIC ERROR = CODE; <> LooksToRope: PUBLIC PROC [looks: Looks] RETURNS [rope: Rope.ROPE] = { FOR lk: Look IN Look DO IF looks[lk] THEN rope _ Rope.Cat[rope,Rope.FromChar[lk]]; ENDLOOP }; RopeToLooks: PUBLIC PROC [rope: Rope.ROPE] RETURNS [looks: Looks] = { looks _ noLooks; FOR i: INT IN [0..Rope.Size[rope]) DO char: CHAR _ Rope.Fetch[rope,i]; IF char IN Look THEN looks[char] _ TRUE; ENDLOOP }; <> Substr: PUBLIC PROC [base: Runs, start: Offset, len: Offset] RETURNS [new: Runs] = TRUSTED { DO IF base=NIL OR len=0 THEN RETURN[NIL]; WITH x:base SELECT FROM base => { rem: Offset; IF (rem _ TbaseSize[@x]-start) <= len THEN IF start = 0 THEN RETURN [base] ELSE len _ rem}; node => WITH x:x SELECT FROM substr => { rem: Offset; IF (rem _ CheckLongSub[x.size, start]) <= len THEN IF start = 0 THEN RETURN [base] ELSE len _ rem; start _ start + x.start; base _ x.base; LOOP}; concat => { xpos, rem: Offset; IF (rem _ CheckLongSub[x.size, start]) <= len THEN IF start = 0 THEN RETURN [base] ELSE len _ rem; IF start >= (xpos _ x.pos) THEN { start _ start - xpos; base _ x.rest; LOOP}; IF xpos >= start+len THEN {base _ x.base; LOOP}}; replace => { xstart, xnew, rem: Offset; IF (rem _ CheckLongSub[x.size, start]) <= len THEN IF start = 0 THEN RETURN [base] ELSE len _ rem; IF start >= (xnew _ x.newPos) THEN { start _ start - xnew + x.oldPos; base _ x.base; LOOP}; IF (rem _ start+len) <= (xstart _ x.start) THEN { base _ x.base; LOOP}; IF start >= xstart AND rem <= xnew THEN { start _ start - xstart; base _ x.replace; LOOP}}; change => { xstart: Offset _ x.start; xend: Offset _ xstart+x.len; IF start >= xend OR start+len <= xstart THEN { base _ x.base; LOOP}}; ENDCASE => ERROR; ENDCASE => ERROR; IF (new _ TryFlatSubstr[base,start,len]) # NIL THEN RETURN; EXIT; ENDLOOP; IF base=NIL THEN ERROR; RETURN [NEW[Tsubstr _ [node[substr[len,base,start]]]]]}; TryFlatSubstr: PUBLIC PROC [base: Runs, start, len: Offset, limit: Offset _ FlatMax] RETURNS [BaseRuns] = { -- return NIL if couldn't flatten count: Offset; numruns: NAT; flat: BaseRuns; [count,,] _ CountRuns[base, start, len, limit]; IF count > limit THEN RETURN [NIL]; flat _ NewBase[numruns_Short[count]]; IF ExtractRuns[flat, base, start, len] # numruns THEN ERROR; IF flat[numruns-1].after # len THEN ERROR; RETURN [flat] }; Flatten: PUBLIC PROC [base: Runs] RETURNS [new: Runs] = TRUSTED { size, half: Offset; IF base=NIL THEN RETURN [NIL]; WITH x:base SELECT FROM base => RETURN [@x]; -- already flat ENDCASE; new _ TryFlatSubstr[base,0,Size[base],8000]; IF new#NIL THEN RETURN; -- else was too big to flatten in one piece half _ (size _ Size[base])/2; -- flatten the halves RETURN [Concat[ Flatten[Substr[base,0,half]], Flatten[Substr[base,half,size]], half, size-half]] }; Concat: PUBLIC PROC [base, rest: Runs, baseLen, restLen: Offset] RETURNS [new: Runs] = TRUSTED { c, numRuns, size, flatLen: Offset; split: NAT; merge: BOOLEAN; looks: Looks; IF base=NIL AND rest=NIL THEN RETURN[NIL]; IF restLen=0 THEN RETURN [base]; IF baseLen=0 THEN RETURN [rest]; size _ baseLen+restLen; [numRuns, merge, looks] _ CountRuns[base, 0, baseLen, FlatMax]; IF numRuns <= FlatMax THEN { -- try flattening base IF (new _ TryFlatConcatRest[base,rest,baseLen,restLen, numRuns,merge,looks]) # NIL THEN RETURN; <> IF rest # NIL THEN WITH x:rest SELECT FROM node => WITH x:x SELECT FROM concat => { -- try to combine base & rest.base [c,,] _ CountRuns[x.base,0,x.pos,FlatMax-numRuns,merge,looks]; IF (numRuns _ numRuns+c) <= FlatMax THEN { -- flatten numruns: NAT; flat: BaseRuns _ NewBase[numruns_Short[numRuns]]; split _ ExtractRuns[flat,base,0,baseLen]; IF ExtractRuns[flat,x.base,0,x.pos,split] # numruns THEN ERROR; flatLen _ baseLen+x.pos; IF flat[numruns-1].after # flatLen THEN ERROR; RETURN[NEW[Tconcat _ [node[concat [size,flat,x.rest,flatLen]]]]]}}; ENDCASE; ENDCASE }; IF base # NIL THEN WITH x:base SELECT FROM node => WITH x:x SELECT FROM concat => { -- try to combine base.rest & rest baseRestLen: Offset _ baseLen-x.pos; [numRuns, merge, looks] _ CountRuns[x.rest,0,baseRestLen,FlatMax]; IF numRuns <= FlatMax THEN { [c,,] _ CountRuns[rest,0,restLen,FlatMax-numRuns,merge,looks]; IF (numRuns _ numRuns+c) <= FlatMax THEN { -- flatten numruns: NAT; flat: BaseRuns _ NewBase[numruns_Short[numRuns]]; split _ ExtractRuns[flat,x.rest,0,baseRestLen]; IF ExtractRuns[flat,rest,0,restLen,split] # numruns THEN ERROR; IF flat[numruns-1].after # baseRestLen+restLen THEN ERROR; RETURN[NEW[Tconcat _ [node[concat [size,x.base,flat,x.pos]]]]]}}}; substr => -- see if doing concat of adjacent substr's IF rest # NIL THEN WITH y:rest SELECT FROM node => WITH y:y SELECT FROM substr => -- see if adjacent to x IF x.base = y.base AND x.start+x.size = y.start THEN -- join them RETURN[NEW[Tsubstr _ [node[substr[size,x.base,x.start]]]]]; ENDCASE; ENDCASE; ENDCASE; ENDCASE; IF base=NIL THEN base _ MakeRun[baseLen]; IF rest=NIL THEN rest _ MakeRun[restLen]; RETURN[NEW[Tconcat _ [node[concat[size,base,rest,baseLen]]]]]}; TryFlatConcat: PUBLIC PROC [base, rest: Runs, baseLen, restLen: Offset] RETURNS [new: BaseRuns] = { -- returns NIL if too big to flatten numRuns: Offset; merge: BOOLEAN; looks: Looks; [numRuns, merge, looks] _ CountRuns[base, 0, baseLen, FlatMax]; IF numRuns > FlatMax THEN RETURN [NIL]; RETURN [TryFlatConcatRest[base,rest,baseLen,restLen,numRuns,merge,looks]]}; TryFlatConcatRest: PUBLIC PROC [base, rest: Runs, baseLen, restLen, numRuns: Offset, merge: BOOLEAN, looks: Looks] RETURNS [BaseRuns] = { -- returns NIL if too big to flatten c: Offset; split, numruns: NAT; flat: BaseRuns; [c,,] _ CountRuns[rest,0,restLen,FlatMax-numRuns,merge,looks]; IF (numRuns _ numRuns+c) > FlatMax THEN RETURN [NIL]; flat _ NewBase[numruns_Short[numRuns]]; split _ ExtractRuns[flat,base,0,baseLen]; IF ExtractRuns[flat,rest,0,restLen,split] # numruns THEN ERROR; IF flat[numruns-1].after # baseLen+restLen THEN ERROR; RETURN [flat]}; Replace: PUBLIC PROC [ base: Runs, start, len: Offset, replace: Runs, baseSize, repSize: Offset, tryFlat: BOOLEAN _ TRUE] RETURNS [new: Runs] = TRUSTED { oldPos, newPos, size: Offset; IF base=NIL AND replace=NIL THEN RETURN [NIL]; oldPos _ start+len; newPos _ start+repSize; size _ baseSize-len+repSize; IF repSize=0 THEN -- deleting IF base=NIL OR (start=0 AND len=baseSize) THEN RETURN[NIL] ELSE IF len=0 THEN RETURN[base]; IF tryFlat THEN { merge: BOOLEAN _ FALSE; flat: BaseRuns; looks: Looks; c, numRuns: Offset; split, numruns: NAT; Count: PROC [r: Runs, start,len: Offset] RETURNS [Offset] = TRUSTED { IF len=0 THEN RETURN[numRuns]; [c,merge,looks] _ CountRuns[r,start,len,FlatMax-numRuns,merge,looks]; RETURN [numRuns_numRuns+c]}; Extract: PROC [r: Runs, start, len: Offset] = TRUSTED { IF len > 0 THEN split _ ExtractRuns[flat,r,start,len,split] }; numRuns _ 0; IF Count[base,0,start] <= FlatMax AND Count[replace,0,repSize] <= FlatMax AND Count[base,oldPos,baseSize-oldPos] <= FlatMax THEN { flat _ NewBase[numruns_Short[numRuns]]; split _ 0; Extract[base,0,start]; Extract[replace,0,repSize]; Extract[base,oldPos,baseSize-oldPos]; IF split # numruns THEN ERROR; IF flat[numruns-1].after # size THEN ERROR; RETURN [flat] }}; WHILE base # NIL DO WITH x:base SELECT FROM node => WITH x:x SELECT FROM replace => { xnewPos: Offset _ x.newPos; xstart: Offset _ x.start; xsize: Offset; IF start <= xstart AND oldPos >= xnewPos THEN { <> oldPos _ x.oldPos+(oldPos-xnewPos); len _ oldPos-start; base _ x.base; LOOP} ELSE IF repSize = 0 AND start > xstart AND oldPos = xnewPos AND -- deleting end of prior replacement (new _ TryFlatSubstr[x.replace,0,start-xstart])#NIL THEN { newPos _ start; oldPos _ x.oldPos; start _ xstart; replace _ new; base _ x.base} ELSE IF repSize = 0 AND start = xstart AND oldPos < xnewPos AND -- deleting start of prior replacement (new _ TryFlatSubstr[x.replace,len,xnewPos-oldPos])#NIL THEN { newPos _ start+xnewPos-oldPos; oldPos _ x.oldPos; replace _ new; base _ x.base} ELSE IF start = xnewPos AND -- replacing just after prior replacement (new _ TryFlatConcat[x.replace,replace,xsize_xnewPos-xstart,repSize])#NIL THEN { start _ xstart; len _ len+x.oldPos-xstart; oldPos _ start+len; repSize _ xsize+repSize; newPos _ start+repSize; replace _ new; base _ x.base; LOOP} ELSE IF start+len = xstart AND -- replacing just before prior replacement (new _ TryFlatConcat[replace,x.replace,repSize,xsize_xnewPos-xstart])#NIL THEN { len _ len+x.oldPos-xstart; oldPos _ start+len; repSize _ xsize+repSize; newPos _ start+repSize; replace _ new; base _ x.base; LOOP}}; concat => { xpos: Offset _ x.pos; IF start=xpos AND len=0 THEN { -- insert between base&rest <> IF (new _ TryFlatConcat[x.base,replace,xpos,repSize])#NIL THEN RETURN [NEW[Tconcat _ [node[concat[size, new, x.rest, xpos+repSize]]]]]; <> IF (new _ TryFlatConcat[replace,x.rest,repSize,x.size-xpos])#NIL THEN RETURN [NEW[Tconcat _ [node[concat[size, x.base, new, x.pos]]]]]}}; ENDCASE; ENDCASE; EXIT; ENDLOOP; IF base=NIL THEN base _ MakeRun[baseSize]; IF replace=NIL THEN replace _ MakeRun[repSize]; RETURN [NEW[Treplace _ [node[replace[size,base,replace,start,oldPos,newPos]]]]]}; Copy: PUBLIC PROC [ dest: Runs, destLoc: Offset, source: Runs, start, len, destSize: Offset] RETURNS [Runs] = { merge: BOOLEAN _ FALSE; flat: BaseRuns; looks: Looks; c, numRuns: Offset; split, numruns: NAT; Count: PROC [base: Runs, start,len: Offset] RETURNS [Offset] = { IF len=0 THEN RETURN[numRuns]; [c,merge,looks] _ CountRuns[base,start,len,FlatMax-numRuns,merge,looks]; RETURN [numRuns_numRuns+c]}; Extract: PROC [base: Runs, start, len: Offset] = { IF len > 0 THEN split _ ExtractRuns[flat,base,start,len,split] }; IF dest=NIL AND source=NIL THEN RETURN[NIL]; numRuns _ 0; IF Count[dest,0,destLoc] > FlatMax OR Count[source,start,len] > FlatMax OR Count[dest,destLoc,destSize-destLoc] > FlatMax THEN RETURN [ Replace[dest,destLoc,0,Substr[source,start,len],destSize,len,FALSE]]; IF numRuns=0 THEN RETURN [NIL]; flat _ NewBase[numruns_Short[numRuns]]; split _ 0; Extract[dest,0,destLoc]; Extract[source,start,len]; Extract[dest,destLoc,destSize-destLoc]; IF split # numruns THEN ERROR; IF flat[numruns-1].after # destSize+len THEN ERROR; RETURN [flat] }; <<**** General operations ****>> CreateRun: PUBLIC PROC [len: Offset, looks: Looks _ noLooks] RETURNS [new: Runs] = { base: BaseRuns; IF looks=noLooks OR len=0 THEN RETURN [NIL]; base _ NewBase[1]; base[0] _ [len,looks]; RETURN [base]}; MakeRun: PUBLIC PROC [len: Offset] RETURNS [new: Runs] = { base: BaseRuns; IF len=0 THEN RETURN [NIL]; base _ NewBase[1]; base[0] _ [len,noLooks]; RETURN [base]}; FetchLooks: PUBLIC PROC [runs: Runs, index: Offset] RETURNS [Looks] = TRUSTED { <> remove, add: Looks _ noLooks; changeLooks: BOOLEAN _ FALSE; DO IF runs=NIL THEN RETURN [noLooks]; WITH x:runs SELECT FROM base => { looks: Looks _ x[BaseRun[@x,index]].looks; IF changeLooks THEN looks _ ModifyLooks[looks, remove, add]; RETURN [looks]}; node => WITH x:x SELECT FROM substr => IF index < x.size THEN { index _ index + x.start; runs _ x.base; LOOP}; concat => IF index < x.size THEN IF index < x.pos THEN {runs _ x.base; LOOP} ELSE {index _ index - x.pos; runs _ x.rest; LOOP}; replace => IF index < x.size THEN { IF index < x.start THEN {runs _ x.base; LOOP}; IF index < x.newPos THEN { index _ index - x.start; runs _ x.replace; LOOP}; index _ index - x.newPos + x.oldPos; runs _ x.base; LOOP}; change => { IF index IN [x.start..x.start+x.len) THEN { [remove, add] _ MergeChanges[x.remove, x.add, remove, add]; IF remove=allLooks THEN RETURN [add]; changeLooks _ TRUE}; runs _ x.base; LOOP}; ENDCASE => ERROR; ENDCASE => ERROR; ERROR OutOfBounds; ENDLOOP}; <<**** Operation to change looks ****>> ChangeLooks: PUBLIC PROC [ runs: Runs, size: Offset, remove, add: Looks, start: Offset _ 0, len: Offset _ MaxOffset] RETURNS [new: Runs] = TRUSTED { c, numRuns, end: Offset; merge: BOOLEAN; looks: Looks; IF runs=NIL AND add=noLooks THEN RETURN [NIL]; IF start >= size OR len=0 THEN RETURN [runs]; end _ start + (len _ MIN[len, size-start]); IF runs # NIL THEN { -- see if not really changing anything OPEN Inline; Pair: TYPE = RECORD [low, high: CARDINAL]; changed: BOOLEAN _ FALSE; loc, runLen: Offset _ start; addLow, addHigh, remLow, remHigh: CARDINAL; noLooksLow: CARDINAL = 0; noLooksHigh: CARDINAL = 0; runrdr: RunReader.Ref _ RunReader.GetRunReader[]; RunReader.SetPosition[runrdr,runs,start]; addLow _ LOOPHOLE[add,Pair].low; addHigh _ LOOPHOLE[add,Pair].high; remLow _ LOOPHOLE[remove,Pair].low; remHigh _ LOOPHOLE[remove,Pair].high; UNTIL loc >= end DO -- check the runs in the section to be changed lks: Looks; lksLow, lksHigh: CARDINAL; [runLen,lks] _ RunReader.Get[runrdr]; lksLow _ LOOPHOLE[lks,Pair].low; lksHigh _ LOOPHOLE[lks,Pair].high; IF LOOPHOLE[BITAND[lksLow,addLow],CARDINAL] # addLow OR LOOPHOLE[BITAND[lksHigh,addHigh],CARDINAL] # addHigh OR LOOPHOLE[BITAND[lksLow,remLow],CARDINAL] # noLooksLow OR LOOPHOLE[BITAND[lksHigh,remHigh],CARDINAL] # noLooksHigh THEN { changed _ TRUE; EXIT }; loc _ loc+runLen; ENDLOOP; RunReader.FreeRunReader[runrdr]; IF ~changed THEN RETURN [runs] }; [numRuns, merge, looks] _ CountRuns[runs, 0, start, FlatMax]; IF numRuns <= FlatMax THEN { [c, merge, looks] _ CountRunsAfterChanges[ runs, start, len, FlatMax-numRuns, remove, add, merge, looks]; IF (numRuns _ numRuns+c) <= FlatMax THEN { [c,,] _ CountRuns[runs,end,size-end,FlatMax-numRuns,merge,looks]; IF (numRuns _ numRuns+c) <= FlatMax THEN { split, numruns: NAT; flat: BaseRuns _ NewBase[numruns_Short[numRuns]]; split _ ExtractRuns[flat,runs,0,start]; split _ ExtractRunsAfterChanges[flat,runs,remove,add,start,len,split]; IF ExtractRuns[flat,runs,end,size-end,split] # numruns THEN ERROR; IF flat[numruns-1].after # size THEN ERROR; RETURN [flat] }}}; IF runs # NIL THEN WITH x:runs SELECT FROM node => WITH x:x SELECT FROM change => IF x.start=start AND x.len=len THEN { [remove,add] _ MergeChanges[x.remove, x.add, remove, add]; runs _ x.base }; ENDCASE; ENDCASE; IF runs = NIL THEN runs _ MakeRun[size]; RETURN[NEW[Tchange _ [node[change[size,runs,remove,add,start,len]]]]]}; END.