humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

reorganise repository

Browse Source
This commit is contained in:
Humza Shahid
2024-05-27 13:28:09 +01:00
parent 1bc468238e
commit b5c70772fa
14 changed files with 3 additions and 459833 deletions
Download Patch File Download Diff File Expand all files Collapse all files

417
src/gap_buffer.sml Normal file
View File

@@ -0,0 +1,417 @@
signature GAP_BUFFER =
sig
type t = {idx: int, left: string list, right: string list}
val empty: t
val fromString: string -> t
val toString: t -> string
val insert: int * string * t -> t
val delete: int * int * t -> t
end
structure GapBuffer: GAP_BUFFER =
struct
type t = {idx: int, left: string list, right: string list}
val targetLength = 1024
val empty = {idx = 0, left = [], right = []}
fun fromString string =
{idx = String.size string, left = [string], right = []}
local
fun toList (acc, input) =
case input of
hd :: tl => toList (hd :: acc, tl)
| [] => acc
in
fun toString ({left, right, ...}: t) =
let val lst = toList (right, left)
in String.concat lst
end
end
fun isLessThanTarget (s1, s2) =
String.size s1 + String.size s2 <= targetLength
fun isThreeLessThanTarget (s1, s2, s3) =
String.size s1 + String.size s2 + String.size s3 <= targetLength
fun consLeft (curIdx, newString, left, right) =
{ idx = curIdx + String.size newString
, left = newString :: left
, right = right
}
fun joinEndOfLeft (newString, left) =
case left of
hd :: tail =>
if isLessThanTarget (newString, hd) then (hd ^ newString) :: tail
else newString :: left
| [] => newString :: left
fun joinStartOfRight (newString, right) =
case right of
hd :: tail =>
if isLessThanTarget (newString, hd) then (newString ^ hd) :: tail
else newString :: right
| [] => newString :: right
fun preferInsertLeft (curIdx, newString, left, right) =
case left of
hd :: tail =>
if isLessThanTarget (hd, newString) then
{ idx = curIdx + String.size newString
, left = (hd ^ newString) :: tail
, right = right
}
else
(case right of
hd :: tail =>
if isLessThanTarget (hd, newString) then
{idx = curIdx, left = left, right = (newString ^ hd) :: tail}
else
consLeft (curIdx, newString, left, right)
| [] => consLeft (curIdx, newString, left, right))
| [] => consLeft (curIdx, newString, left, right)
fun insLeft (prevIdx, idx, newString, curIdx, hd, tail, right) =
(* The requested index is either:
* - At the start of the left string
* - In the middle of the left string
* Find out which and split the middle of the string if necessary. *)
if idx = prevIdx then
(* At start of string. *)
{ idx = curIdx + String.size newString
, right = right
, left =
(* These two meant to look reversed,
* with respect to newString and hd.
*
* The line
* `newString ^ hd`
* places the contents of newString before hd,
* and the line
* `hd :: newString`
* in a zipper also places newString before hd.
*
* Using `newString ^ hd` with `newString :: hd` gives
* different contents in the case of a zipper.
* *)
if isLessThanTarget (newString, hd) then (newString ^ hd) :: tail
else hd :: newString :: tail
}
else
(* In middle of string. *)
let
val length = idx - prevIdx
val sub1 = String.substring (hd, 0, length)
val sub2 = String.substring (hd, length, String.size hd - length)
in
if isThreeLessThanTarget (sub1, newString, sub2) then
{ idx = curIdx + String.size newString
, left = (sub1 ^ newString ^ sub2) :: tail
, right = right
}
else if isLessThanTarget (sub1, newString) then
{ idx = prevIdx + String.size sub1 + String.size newString
, left = (sub1 ^ newString) :: tail
, right = joinStartOfRight (sub2, right)
}
else if isLessThanTarget (newString, sub2) then
{ idx = prevIdx + String.size sub1
, left = joinEndOfLeft (sub1, tail)
, right = (newString ^ sub2) :: right
}
else
{ idx = prevIdx
, left = tail
, right = sub1 :: newString :: sub2 :: right
}
end
fun insRight (nextIdx, idx, newString, curIdx, left, hd, tail) =
if idx = nextIdx then
(* At end of next string. *)
{ idx = curIdx
, left = left
, right =
if isLessThanTarget (newString, hd) then (hd ^ newString) :: tail
else hd :: (joinStartOfRight (newString, tail))
}
else
let
val length = idx - curIdx
val sub1 = String.substring (hd, 0, length)
val sub2 = String.substring (hd, length, String.size hd - length)
in
if isThreeLessThanTarget (sub1, newString, sub2) then
{ idx =
curIdx + String.size sub1 + String.size newString
+ String.size sub2
, left = (sub1 ^ newString ^ sub2) :: left
, right = tail
}
else if isLessThanTarget (sub1, newString) then
{ idx = curIdx + String.size sub1 + String.size newString
, left = (sub1 ^ newString) :: left
, right = joinStartOfRight (sub2, tail)
}
else if isLessThanTarget (newString, sub2) then
{ idx = curIdx + String.size sub1
, left = sub1 :: left
, right = (newString ^ sub2) :: tail
}
else
{ idx = curIdx + String.size sub1 + String.size newString
, left = newString :: sub1 :: left
, right = joinStartOfRight (sub2, tail)
}
end
fun ins (idx, newString, curIdx, left, right) : t =
if curIdx = idx then
preferInsertLeft (curIdx, newString, left, right)
else if idx < curIdx then
(* Need to insert on the left. *)
case left of
[] =>
(* If there is no string on the left, then add the new string there. *)
{idx = String.size newString, left = [newString], right = right}
| hd :: tail =>
let
val prevIdx = curIdx - String.size hd
in
if idx < prevIdx then
(* The requested index is prior to the string on the left,
* so move leftward one string. *)
ins (idx, newString, prevIdx, tail, joinStartOfRight (hd, right))
else
insLeft (prevIdx, idx, newString, curIdx, hd, tail, right)
end
else
(* Need to insert to the right. *)
case right of
[] => {idx = curIdx, left = left, right = [newString]}
| hd :: tail =>
let
val nextIdx = String.size hd + curIdx
in
if idx > nextIdx then
ins (idx, newString, nextIdx, joinEndOfLeft (hd, left), tail)
else
insRight (nextIdx, idx, newString, curIdx, left, hd, tail)
end
fun insert (idx, newString, buffer: t) =
ins (idx, newString, #idx buffer, #left buffer, #right buffer)
fun deleteRightFromHere (curIdx, finish, right) =
case right of
hd :: tail =>
let
val nextIdx = curIdx + String.size hd
in
if nextIdx < finish then
deleteRightFromHere (nextIdx, finish, tail)
else if nextIdx > finish then
let
val newStrStart = finish - curIdx
val newStr = String.substring
(hd, newStrStart, String.size hd - newStrStart)
in
newStr :: tail
end
else
(* nextIdx = finish
* Delete current head but no further. *)
tail
end
| [] => right
fun moveRightAndDelete (start, finish, curIdx, left, right) =
case right of
hd :: tail =>
let
val nextIdx = curIdx + String.size hd
in
if nextIdx < start then
(* Keep moving right: haven't reached start yet. *)
moveRightAndDelete
(start, finish, nextIdx, joinEndOfLeft (hd, left), tail)
else if nextIdx > start then
if nextIdx < finish then
(* Delete the start range contained in this string,
* and then continue deleting right. *)
let
val length = start - curIdx
val newString = String.substring (hd, 0, length)
in
{ idx = curIdx + String.size newString
, left = joinEndOfLeft (newString, left)
, right = deleteRightFromHere (nextIdx, finish, tail)
}
end
else if nextIdx > finish then
(* Have to delete from middle of string. *)
let
val sub1Length = start - curIdx
val sub1 = String.substring (hd, 0, sub1Length)
val sub2Start = finish - curIdx
val sub2 = String.substring
(hd, sub2Start, String.size hd - sub2Start)
in
{ idx = curIdx + sub1Length
, left = joinEndOfLeft (sub1, left)
, right = joinStartOfRight (sub2, tail)
}
end
else
(* nextIdx = finish
* Have to delete from end of this string. *)
let
val strLength = start - curIdx
val str = String.substring (hd, 0, strLength)
in
{ idx = curIdx + strLength
, left = joinEndOfLeft (str, left)
, right = tail
}
end
else
(* nextIdx = start
* The start range is contained fully at the next node,
* without having to remove part of a string at this node.*)
let
val newRight = deleteRightFromHere (nextIdx, finish, tail)
in
{ idx = curIdx
, left = left
, right = joinStartOfRight (hd, newRight)
}
end
end
| [] => {idx = curIdx, left = left, right = right}
fun deleteLeftFromHere (start, curIdx, left, right) =
case left of
hd :: tail =>
let
val prevIdx = curIdx - String.size hd
in
if start < prevIdx then
deleteLeftFromHere (start, prevIdx, tail, right)
else if start > prevIdx then
(* Need to delete from some part of this string. *)
let
val length = start - prevIdx
val newStr = String.substring (hd, 0, length)
in
{ idx = prevIdx
, left = tail
, right = joinStartOfRight (newStr, right)
}
end
else
(* if start = prevIdx
* Need to remove the current node without deleting any further. *)
{idx = prevIdx, left = tail, right = right}
end
| [] => {idx = curIdx, left = left, right = right}
fun deleteFromLeftAndRight (start, finish, curIdx, left, right) =
let val right = deleteRightFromHere (curIdx, finish, right)
in deleteLeftFromHere (start, curIdx, left, right)
end
fun moveLeftAndDelete (start, finish, curIdx, left, right) =
case left of
hd :: tail =>
let
val prevIdx = curIdx - String.size hd
in
if prevIdx > finish then
moveLeftAndDelete
(start, finish, prevIdx, tail, joinStartOfRight (hd, right))
else if prevIdx < finish then
if prevIdx > start then
(* Delete from start point of this string,
* and then call function to continue deleting leftward. *)
let
val hdStart = finish - prevIdx
val newHd = String.substring
(hd, hdStart, String.size hd - hdStart)
val right = joinStartOfRight (newHd, right)
in
deleteLeftFromHere (start, prevIdx, tail, right)
end
else if prevIdx < start then
(* We want to delete in the middle of this current string. *)
let
val sub1Length = start - prevIdx
val sub1 = String.substring (hd, 0, sub1Length)
val sub2Start = finish - prevIdx
val sub2 = String.substring
(hd, sub2Start, String.size hd - sub2Start)
in
{ idx = prevIdx + sub1Length
, left = joinEndOfLeft (sub1, tail)
, right = joinStartOfRight (sub2, right)
}
end
else
(* prevIdx = start
* We want to delete from the start of this string and stop. *)
let
val strStart = finish - prevIdx
val str = String.substring
(hd, strStart, String.size hd - strStart)
in
{ idx = prevIdx
, left = tail
, right = joinStartOfRight (str, right)
}
end
else
(* prevIdx = finish *)
deleteLeftFromHere
(start, prevIdx, tail, joinStartOfRight (hd, right))
end
| [] => {idx = curIdx, left = left, right = right}
fun del (start, finish, curIdx, left, right) : t =
if start > curIdx then
(* If start is greater than current index,
* then finish must be greater too.
* Move buffer rightwards until finish is reached,
* and delete along the way. *)
moveRightAndDelete (start, finish, curIdx, left, right)
else if start < curIdx then
(* If start is less than current index,
* then finish could be either less than or equal/greater
* than the current index.
* We can treat equal/greater than as one case. *)
if finish <= curIdx then
(* Move leftward and delete along the way. *)
moveLeftAndDelete (start, finish, curIdx, left, right)
else
(* Delete rightward up to finish index,
* and then delete leftward until start index.*)
deleteFromLeftAndRight (start, finish, curIdx, left, right)
else
(* If start is equal to the current index,
* then only examine the right list.
* Just need to delete until reaching the finish index. *)
{ idx = curIdx
, left = left
, right = deleteRightFromHere (curIdx, finish, right)
}
fun delete (start, length, buffer: t) =
if length > 0 then
del (start, start + length, #idx buffer, #left buffer, #right buffer)
else
buffer
end

795
src/rope.sml Normal file
View File

@@ -0,0 +1,795 @@
signature ROPE =
sig
type t
val empty: t
val fromString: string -> t
val toString: t -> string
(* The caller should not insert in the middle of a \r\n pair,
* or else line metadata will become invalid. *)
val insert: int * string * t -> t
(* The append and appendLine function both add a string to the end.
* The difference is that append calculates line metadata
* from the given string, while appendLine accepts
* (possibly incorrect) metadata from the caller. *)
val append: string * t -> t
val appendLine: string * int vector * t -> t
(* The caller should not delete only a single character in a \r\n pair,
* because then line metadata will become invalid. *)
val delete: int * int * t -> t
(* Folds over the characters in the rope starting from the index
* in the second parameter. *)
val foldFromIdx: (char * 'a -> 'a) * int * t * 'a -> 'a
(* Like the foldFromIdx function, but accepts a predicate as the second
* argument.
* If the predicate returns true, terminates and returns the result;
* else, continues folding until predicate returns true or until remaining
* characters have been traversed. *)
val foldFromIdxTerm: (char * 'a -> 'a) * ('a -> bool) * int * t * 'a -> 'a
(* This function folds over the characters in the rope,
* starting from a given line number.
* The second argument is a predicate indicating when to stop folding. *)
val foldLines: (char * 'a -> 'a) * ('a -> bool) * int * t * 'a -> 'a
(* This below function is just for testing.
* It verifies that line metadata is as expected,
* raising an exception if it is different,
* and returning true if it is the same. *)
val verifyLines: t -> bool
end
structure Rope :> ROPE =
struct
(* This function counts line breaks in reverse order,
* from the end of the string to the start.
* Reverse order is used for performance, as it avoids a List.rev at the end. *)
fun helpCountLineBreaks (pos, acc, str) =
if pos < 0 then
Vector.fromList acc
else
let
val chr = String.sub (str, pos)
in
if chr = #"\n" then
(* Is this a \r\n pair? Then the position of \r should be consed. *)
if pos = 0 then
Vector.fromList (0 :: acc)
else
let
val prevChar = String.sub (str, pos - 1)
in
if prevChar = #"\r" then
helpCountLineBreaks (pos - 2, (pos - 1) :: acc, str)
else
helpCountLineBreaks (pos - 2, pos :: acc, str)
end
else if chr = #"\r" then
helpCountLineBreaks (pos - 1, pos :: acc, str)
else
helpCountLineBreaks (pos - 1, acc, str)
end
fun countLineBreaks str =
helpCountLineBreaks (String.size str - 1, [], str)
(* Binary search. Used to find split point in vector. *)
fun binSearch (findNum, lines, low, high) =
if Vector.length lines = 0 then
0
else
let
val mid = low + ((high - low) div 2)
in
if high >= low then
let
val midVal = Vector.sub (lines, mid)
in
if midVal = findNum then
mid
else if midVal < findNum then
binSearch (findNum, lines, mid + 1, high)
else
binSearch (findNum, lines, low, mid - 1)
end
else
mid
end
datatype t =
N0 of string * int vector
| N1 of t
| N2 of t * int * int * t
| L2 of string * int vector * string * int vector
| N3 of t * t * t
exception AuxConstructor
exception Substring of int
fun foldrString (f, state, rope) =
case rope of
N2 (l, _, _, r) =>
let val state = foldrString (f, state, r)
in foldrString (f, state, l)
end
| N1 t => foldrString (f, state, t)
| N0 (s, _) => f (state, s)
| _ => raise AuxConstructor
fun toString rope =
let val strList = foldrString ((fn (acc, str) => str :: acc), [], rope)
in String.concat strList
end
fun foldr (f, state, rope) =
case rope of
N2 (l, _, _, r) =>
let val state = foldr (f, state, r)
in foldr (f, state, l)
end
| N1 t => foldr (f, state, t)
| N0 (s, v) => f (state, s, v)
| _ => raise AuxConstructor
datatype balance = AddedNode | DeletedNode | NoAction
val targetLength = 1024
val targetVecLength = 128
fun id x = x
val emptyVec = Vector.tabulate (0, id)
val empty = N0 ("", emptyVec)
fun fromString string =
let val lineBreaks = countLineBreaks string
in N0 (string, lineBreaks)
end
fun isLessThanTarget (str1, str2, vec1, vec2) =
String.size str1 + String.size str2 <= targetLength
andalso Vector.length vec1 + Vector.length vec2 <= targetVecLength
(* This function creates a new node in the rope, calculating right-metadata.
* This is equivalent to helpSize/size in tiny_rope.ml,
* but because the size function in tiny_rope.ml was only used
* by callers to construct N2 cases,
* it can be replaced with a function that constructs N2 cases
* instead of returning (int * int) metadata which results in
* an extra tuple allocation. *)
fun helpMakeN2 (idxAcc, lineAcc, left, right, rope) =
case rope of
N2 (_, lms, lmv, r) =>
helpMakeN2 (lms + idxAcc, lmv + lineAcc, left, right, r)
| N1 t => helpMakeN2 (idxAcc, lineAcc, left, right, t)
| N0 (str, lines) =>
let
val idxAcc = idxAcc + String.size str
val lineAcc = lineAcc + Vector.length lines
in
N2 (left, idxAcc, lineAcc, right)
end
| _ => raise AuxConstructor
(* Accumulate right-metadata for left rope. *)
fun makeN2 (left, right) =
helpMakeN2 (0, 0, left, right, left)
fun insL2 (s1, v1, s2, v2) =
let
val left = N0 (s1, v1)
val right = N0 (s2, v2)
in
N2 (left, String.size s1, Vector.length v1, right)
end
fun insN3 (t1, t2, t3) =
let
val left = makeN2 (t1, t2)
val right = N1 t3
in
makeN2 (left, right)
end
fun insRoot rope =
case rope of
L2 (s1, v1, s2, v2) => insL2 (s1, v1, s2, v2)
| N3 (t1, t2, t3) => insN3 (t1, t2, t3)
| t => t
fun delRoot rope =
case rope of
N1 t => t
| t => t
fun insN1 rope =
case rope of
L2 (s1, v1, s2, v2) => insL2 (s1, v1, s2, v2)
| N3 (t1, t2, t3) => insN3 (t1, t2, t3)
| t => N1 t
fun insN2Left (left, right) =
case (left, right) of
(L2 (s1, v1, s2, v2), t3) =>
let
val left = N0 (s1, v1)
val middle = N0 (s2, v2)
in
N3 (left, middle, t3)
end
| (N3 (t1, t2, t3), N1 t4) =>
let
val left = makeN2 (t1, t2)
val right = makeN2 (t3, t4)
in
makeN2 (left, right)
end
| (N3 (t1, t2, t3), t4) =>
let
val left = makeN2 (t1, t2)
val middle = N1 t3
in
N3 (left, middle, t4)
end
| (l, r) => makeN2 (l, r)
fun delN2Left (left, right) =
case (left, right) of
(N1 t1, N1 t2) => let val inner = makeN2 (t1, t2) in N1 inner end
| (N1 (N1 t1), N2 (N1 t2, _, _, (t3 as N2 _))) =>
let
val left = makeN2 (t1, t2)
val inner = makeN2 (left, t3)
in
N1 inner
end
| (N1 (N1 t1), N2 (N2 (t2, _, _, t3), _, _, N1 t4)) =>
let
val left = makeN2 (t1, t2)
val right = makeN2 (t3, t4)
val inner = makeN2 (left, right)
in
N1 inner
end
| (N1 (t1 as N1 _), N2 ((t2 as N2 _), _, _, (t3 as N2 _))) =>
let
val left = makeN2 (t1, t2)
val right = N1 t3
in
makeN2 (left, right)
end
| (l, r) => makeN2 (l, r)
fun insN2Right (left, right) =
case (left, right) of
(t1, L2 (s1, v1, s2, v2)) =>
let
val middle = N0 (s1, v1)
val right = N0 (s2, v2)
in
N3 (t1, middle, right)
end
| (N1 t1, N3 (t2, t3, t4)) =>
let
val left = makeN2 (t1, t2)
val right = makeN2 (t3, t4)
in
makeN2 (left, right)
end
| (t1, N3 (t2, t3, t4)) =>
let
val right = makeN2 (t3, t4)
val middle = N1 t2
in
N3 (t1, middle, right)
end
| (l, r) => makeN2 (l, r)
fun delN2Right (left, right) =
case (left, right) of
(N2 (N1 t1, _, _, N2 (t2, _, _, t3)), N1 (N1 t4)) =>
let
val left = makeN2 (t1, t2)
val right = makeN2 (t3, t4)
val inner = makeN2 (left, right)
in
N1 inner
end
| (N2 ((t1 as N2 _), lms, lmv, N1 t2), N1 (N1 t3)) =>
let
val right = makeN2 (t2, t3)
val inner = N2 (t1, lms, lmv, right)
in
N1 inner
end
| (N2 ((t1 as N2 _), _, _, (t2 as N2 _)), N1 (t3 as N1 _)) =>
let
val left = N1 t1
val right = makeN2 (t2, t3)
in
makeN2 (left, right)
end
| (l, r) => makeN2 (l, r)
fun insVecBefore (oldVec, newVec, newStr) =
let
val oldLen = Vector.length oldVec
val newLen = Vector.length newVec
val total = oldLen + newLen
val newStrLen = String.size newStr
in
Vector.tabulate (total, (fn idx =>
if idx < newLen then Vector.sub (newVec, idx)
else Vector.sub (oldVec, idx - newLen) + newStrLen))
end
fun insVecAfter (oldStr, oldVec, newVec) =
let
val oldLen = Vector.length oldVec
val newLen = Vector.length newVec
val total = oldLen + newLen
val oldStrLen = String.size oldStr
in
Vector.tabulate (total, (fn idx =>
if idx < oldLen then Vector.sub (oldVec, idx)
else Vector.sub (newVec, idx - oldLen) + oldStrLen))
end
fun preLeaf (oldStr, oldVec, newStr, newVec) =
if isLessThanTarget (oldStr, newStr, oldVec, newVec) then
let
val str = newStr ^ oldStr
val vec = insVecBefore (oldVec, newVec, newStr)
in
(N0 (str, vec), NoAction)
end
else
let val l2 = L2 (newStr, newVec, oldStr, oldVec)
in (l2, AddedNode)
end
fun appLeaf (oldStr, oldVec, newStr, newVec) =
if isLessThanTarget (oldStr, newStr, oldVec, newVec) then
let
val str = oldStr ^ newStr
val vec = insVecAfter (oldStr, oldVec, newVec)
in
(N0 (str, vec), NoAction)
end
else
let val l2 = L2 (oldStr, oldVec, newStr, newVec)
in (l2, AddedNode)
end
fun insLeaf (curIdx, newStr, newVec, oldStr, oldVec) =
if curIdx <= 0 then
preLeaf (oldStr, oldVec, newStr, newVec)
else if curIdx >= String.size oldStr then
appLeaf (oldStr, oldVec, newStr, newVec)
else
(* Need to split in middle of string. *)
let
val sub1 = String.substring (oldStr, 0, curIdx)
val sub2Len = String.size oldStr - curIdx
val sub2 = String.substring (oldStr, curIdx, sub2Len)
val oldVecLen = Vector.length oldVec
val midPoint = binSearch (String.size sub1, oldVec, 0, oldVecLen)
val newVecLen = Vector.length newVec
in
if
isLessThanTarget (oldStr, newStr, oldVec, newVec)
then
let
val str = sub1 ^ newStr ^ sub2
val totalVecLen = Vector.length oldVec + Vector.length newVec
val vec = Vector.tabulate (totalVecLen, (fn idx =>
if idx < midPoint then
Vector.sub (oldVec, idx)
else if idx < midPoint + newVecLen then
Vector.sub (newVec, idx - midPoint)
else
Vector.sub (oldVec, idx - newVecLen)))
in
(N0 (str, vec), NoAction)
end
else if
curIdx + String.size newStr <= targetLength
andalso midPoint + newVecLen <= targetVecLength
then
let
val str1 = sub1 ^ newStr
val vec1 = Vector.tabulate (midPoint + newVecLen, (fn idx =>
if idx < midPoint then Vector.sub (oldVec, idx)
else Vector.sub (newVec, idx - midPoint)))
val vec2 = Vector.tabulate (oldVecLen - midPoint, (fn idx =>
Vector.sub (oldVec, idx + midPoint)))
val l2 = L2 (str1, vec1, sub2, vec2)
in
(l2, AddedNode)
end
else if
((String.size oldStr) - curIdx) + String.size newStr <= targetLength
andalso (midPoint - oldVecLen) + newVecLen <= targetVecLength
then
let
val str2 = newStr ^ sub2
val newStrLen = String.size newStr
val vec2 =
Vector.tabulate ((midPoint - oldVecLen) + newVecLen, (fn idx =>
if idx < newVecLen then Vector.sub (newVec, idx)
else Vector.sub (oldVec, idx - newVecLen) + newStrLen))
val vec1 = Vector.tabulate (midPoint, (fn idx =>
Vector.sub (oldVec, idx)))
val l2 = L2 (sub1, vec1, str2, vec2)
in
(l2, AddedNode)
end
else
let
val vec1 =
if oldVecLen = 0 then
emptyVec
else
Vector.tabulate (midPoint, (fn idx => Vector.sub (oldVec, idx)))
val vec2 =
if oldVecLen = 0 orelse midPoint >= oldVecLen then
emptyVec
else
Vector.tabulate (oldVecLen - midPoint, (fn idx =>
Vector.sub (oldVec, midPoint + idx)))
val left = N0 (sub1, vec1)
val right = N0 (sub2, vec2)
val mid = N0 (newStr, newVec)
in
(N3 (left, right, mid), AddedNode)
end
end
fun insLMoreThanTarget (lms, newStr, lmv, newVec, l, r, action) =
let
val lms = lms + String.size newStr
val lmv = lmv + Vector.length newVec
val node = N2 (l, lms, lmv, r)
in
(node, action)
end
fun insLessThanTarget (s1, s2, v1, v2) =
let
val str = s1 ^ s2
val s1Len = String.size s1
val v1Len = Vector.length v1
val v2Len = Vector.length v2
val vec = Vector.tabulate (v1Len + v2Len, (fn idx =>
if idx < v1Len then Vector.sub (v1, idx)
else Vector.sub (v2, idx - v1Len) + s1Len))
val node = N0 (str, vec)
in
(node, DeletedNode)
end
fun insBalL (l, lms, lmv, newStr, newVec, r, action) =
(case action of
NoAction =>
(case (l, r) of
(N0 (s1, v1), N0 (s2, v2)) =>
if isLessThanTarget (s1, s2, v1, v2) then
insLessThanTarget (s1, s2, v1, v2)
else
insLMoreThanTarget (lms, newStr, lmv, newVec, l, r, action)
| _ => insLMoreThanTarget (lms, newStr, lmv, newVec, l, r, action))
| AddedNode => (insN2Left (l, r), action)
| DeletedNode => (delN2Left (l, r), action))
fun insBalR (l, r, action) =
(case action of
NoAction =>
(case (l, r) of
(N0 (s1, v1), N0 (s2, v2)) =>
if isLessThanTarget (s1, s2, v1, v2) then
insLessThanTarget (s1, s2, v1, v2)
else
(makeN2 (l, r), action)
| _ => (makeN2 (l, r), action))
| AddedNode => (insN2Right (l, r), action)
| DeletedNode => (delN2Right (l, r), action))
fun ins (curIdx, newStr, newVec, rope) =
case rope of
N2 (l, lms, lmv, r) =>
if curIdx < lms then
let val (l, action) = ins (curIdx, newStr, newVec, l)
in insBalL (l, lms, lmv, newStr, newVec, r, action)
end
else
let val (r, action) = ins (curIdx - lms, newStr, newVec, r)
in insBalR (l, r, action)
end
| N1 t =>
let
val (t, action) = ins (curIdx, newStr, newVec, t)
in
(case action of
AddedNode => (insN1 t, action)
| _ => (N1 t, action))
end
| N0 (oldStr, oldVec) => insLeaf (curIdx, newStr, newVec, oldStr, oldVec)
| _ => raise AuxConstructor
fun endInsert (rope, action) =
case action of
NoAction => rope
| AddedNode => insRoot rope
| DeletedNode => delRoot rope
fun insert (index, str, rope) =
let
val newVec = countLineBreaks str
val (rope, action) = ins (index, str, newVec, rope)
in
endInsert (rope, action)
end
fun app (newStr, newVec, rope) =
case rope of
N2 (l, lms, lmv, r) =>
let val (r, action) = app (newStr, newVec, r)
in insBalR (l, r, action)
end
| N1 t => app (newStr, newVec, t)
| N0 (oldStr, oldVec) => appLeaf (oldStr, oldVec, newStr, newVec)
| _ => raise AuxConstructor
fun append (newStr, rope) =
let
val newVec = countLineBreaks newStr
val (rope, action) = app (newStr, newVec, rope)
in
endInsert (rope, action)
end
fun appendLine (newStr, newVec, rope) =
let val (rope, action) = app (newStr, newVec, rope)
in endInsert (rope, action)
end
fun isDelLessThanTarget (str1, str2, vec, startPoint, endPoint) =
let
val vecLength = Vector.length vec - (endPoint - startPoint)
in
String.size str1 + String.size str2 <= targetLength
andalso vecLength <= targetVecLength
end
fun delLeaf (startIdx, endIdx, str, vec) =
if
startIdx <= 0 andalso endIdx >= String.size str
then
(empty, false)
else if
startIdx > 0 andalso endIdx < String.size str
then
let
val sub1 = String.substring (str, 0, startIdx)
val sub2 = String.substring (str, endIdx, (String.size str - endIdx))
val vecLength = Vector.length vec - 1
val startPoint = binSearch (startIdx, vec, 0, vecLength)
val endPoint = binSearch (endIdx, vec, 0, vecLength)
val difference = endIdx - startIdx
in
if isDelLessThanTarget (sub1, sub2, vec, startPoint, endPoint) then
let
val str = sub1 ^ sub2
val vecDifference = endPoint - startPoint
val vecLength = Vector.length vec - vecDifference
val vec = Vector.tabulate (vecLength, (fn idx =>
let val point = Vector.sub (vec, idx)
in if point < startIdx then point else point - difference
end))
in
(N0 (str, vec), false)
end
else
let
val vec1 =
if Vector.length vec = 0 then
emptyVec
else
Vector.tabulate (startPoint, (fn idx => Vector.sub (vec, idx)))
val vec2 =
if Vector.length vec = 0 then
emptyVec
else
Vector.tabulate (Vector.length vec - startPoint, (fn idx =>
Vector.sub (vec, idx + startPoint) - difference))
in
(L2 (sub1, vec1, sub2, vec2), true)
end
end
else if
startIdx >= 0 andalso startIdx <= String.size str
andalso endIdx >= String.size str
then
let
val str = String.substring (str, 0, startIdx)
val midPoint = binSearch (startIdx, vec, 0, Vector.length vec - 1)
val vec =
if Vector.length vec = 0 then emptyVec
else Vector.tabulate (midPoint, fn idx => Vector.sub (vec, idx))
in
(N0 (str, vec), false)
end
else
let
val str = String.substring (str, endIdx, String.size str - endIdx)
val midPoint = binSearch (endIdx, vec, 0, Vector.length vec - 1)
val vec =
if Vector.length vec = 0 then
emptyVec
else
Vector.tabulate (Vector.length vec - midPoint, fn idx =>
Vector.sub (vec, idx + midPoint))
in
(N0 (str, vec), false)
end
fun del (startIdx, endIdx, rope) =
case rope of
N2 (l, lms, lmv, r) =>
if lms > startIdx andalso lms > endIdx then
let
val (l, didIns) = del (startIdx, endIdx, l)
val rope = if didIns then insN2Left (l, r) else makeN2 (l, r)
in
(rope, didIns)
end
else if lms < startIdx andalso lms < endIdx then
let
val (r, didIns) = del (startIdx - lms, endIdx - lms, r)
val rope = if didIns then insN2Right (l, r) else makeN2 (l, r)
in
(rope, didIns)
end
else
let
val (l, _) = del (startIdx, endIdx, l)
val (r, _) = del (startIdx - lms, endIdx - lms, r)
in
(makeN2 (l, r), false)
end
| N1 t => del (startIdx, endIdx, t)
| N0 (str, vec) => delLeaf (startIdx, endIdx, str, vec)
| _ => raise AuxConstructor
fun delete (start, length, rope) =
let val (rope, didIns) = del (start, start + length, rope)
in if didIns then insRoot rope else rope
end
fun foldStringChars (apply, term, pos, str, strSize, acc) =
if pos < strSize then
if term acc then
acc
else
let
val chr = String.sub (str, pos)
val acc = apply (chr, acc)
in
foldStringChars (apply, term, pos + 1, str, strSize, acc)
end
else
acc
fun foldFromIdxTerm (apply, term, idx, rope, acc) =
case rope of
N2 (l, lm, _, r) =>
if idx < lm then
let
val acc = foldFromIdxTerm (apply, term, idx, l, acc)
in
if term acc then acc
else foldFromIdxTerm (apply, term, idx - lm, r, acc)
end
else
foldFromIdxTerm (apply, term, idx - lm, r, acc)
| N1 t => foldFromIdxTerm (apply, term, idx, t, acc)
| N0 (str, _) =>
foldStringChars (apply, term, idx, str, String.size str, acc)
| _ => raise AuxConstructor
fun noTerm _ = false
fun foldFromIdx (apply, idx, rope, acc) =
foldFromIdxTerm (apply, noTerm, idx, rope, acc)
fun foldLineCharsTerm (apply, term, pos, str, strSize, acc) =
if pos < strSize then
case term acc of
false =>
let
val chr = String.sub (str, pos)
val acc = apply (chr, acc)
in
foldLineCharsTerm (apply, term, pos + 1, str, strSize, acc)
end
| true => acc
else
acc
fun helpFoldLines (apply, term, lineNum, rope, acc) =
case rope of
N2 (l, _, lmv, r) =>
if lineNum < lmv then
let
val acc = helpFoldLines (apply, term, lineNum, rope, acc)
in
if term acc then acc
else helpFoldLines (apply, term, lineNum - lmv, r, acc)
end
else
helpFoldLines (apply, term, lineNum - lmv, r, acc)
| N1 t => helpFoldLines (apply, term, lineNum, t, acc)
| N0 (str, vec) =>
(* We have a few edge cases to handle here.
* 1. If lineNum is 0 or the vector has no elements,
* we should start folding from the start of the string.
* 2. Since the vector points to the start of a linebreak
* (which means either \r or \n when either is alone,
* or \r in a \r\n pair),
* we have to skip the linebreak or linebreak pair when folding
* over the string. That is more intuitive to the user. *)
if lineNum < 0 orelse Vector.length vec = 0 then
foldLineCharsTerm (apply, term, 0, str, String.size str, acc)
else
let
val idx = Vector.sub (vec, lineNum)
in
if idx + 1 < String.size str then
let
val chr = String.sub (str, idx)
val nextChr = String.sub (str, idx + 1)
in
if chr = #"\r" andalso nextChr = #"\n" then
foldLineCharsTerm
(apply, term, idx + 2, str, String.size str, acc)
else
foldLineCharsTerm
(apply, term, idx + 1, str, String.size str, acc)
end
else
acc
end
| _ => raise AuxConstructor
fun foldLines (apply, term, lineNum, rope, acc) =
helpFoldLines (apply, term, lineNum - 1, rope, acc)
fun verifyLines rope =
foldr
( (fn (_, str, vec) =>
let
val strVec = countLineBreaks str
val isSame = strVec = vec
in
if isSame then true else raise Empty
end)
, true
, rope
)
end

393
src/tiny_rope.sml Normal file
View File

@@ -0,0 +1,393 @@
signature TINY_ROPE =
sig
type t
val empty: t
val fromString: string -> t
val size: t -> int
val insert: int * string * t -> t
val append: string * t -> t
val delete: int * int * t -> t
val toString: t -> string
val foldFromIdxTerm: (char * 'a -> 'a) * ('a -> bool) * int * t * 'a -> 'a
val foldFromIdx: (char * 'a -> 'a) * int * t * 'a -> 'a
end
structure TinyRope :> TINY_ROPE =
struct
datatype t =
N0 of string
| N1 of t
| N2 of t * int * t
| L2 of string * string
| N3 of t * t * t
exception AuxConstructor
fun foldr (f, state, rope) =
case rope of
N2 (l, _, r) =>
let val state = foldr (f, state, r)
in foldr (f, state, l)
end
| N1 t => foldr (f, state, t)
| N0 s => f (state, s)
| _ => raise AuxConstructor
local
fun toListFolder (acc, str) = str :: acc
fun toList rope = foldr (toListFolder, [], rope)
in
fun toString rope =
let val lst = toList rope
in String.concat lst
end
end
datatype balance = AddedNode | DeletedNode | NoAction
val targetLength = 1024
val empty = N0 ""
fun fromString string = N0 string
fun isLessThanTarget (str1, str2) =
String.size str1 + String.size str2 <= targetLength
fun helpSize (acc, rope) =
case rope of
N0 s => acc + String.size s
| N1 t => helpSize (acc, t)
| N2 (_, lm, r) => helpSize (acc + lm, r)
| _ => raise AuxConstructor
fun size rope = helpSize (0, rope)
fun insRoot rope =
case rope of
L2 (s1, s2) => N2 (N0 s1, String.size s1, N0 s2)
| N3 (t1, t2, t3) =>
let val left = N2 (t1, size t1, t2)
in N2 (left, size left, N1 t3)
end
| t => t
fun delRoot rope =
case rope of
N1 t => t
| t => t
fun insN1 rope =
case rope of
L2 (s1, s2) => N2 (N0 s1, String.size s1, N0 s2)
| N3 (t1, t2, t3) =>
let val left = N2 (t1, size t1, t2)
in N2 (left, size left, N1 t3)
end
| t => N1 t
fun insN2Left (left, right) =
case (left, right) of
(L2 (s1, s2), t3) => N3 (N0 s1, N0 s2, t3)
| (N3 (t1, t2, t3), N1 t4) =>
let
val left = N2 (t1, size t1, t2)
val right = N2 (t3, size t3, t4)
in
N2 (left, size left, right)
end
| (N3 (t1, t2, t3), t4) =>
let val left = N2 (t1, size t1, t2)
in N3 (left, N1 t3, t4)
end
| (l, r) => N2 (l, size l, r)
fun delN2Left (left, right) =
case (left, right) of
(N1 t1, N1 t2) => N1 (N2 (t1, size t1, t2))
| (N1 (N1 t1), N2 (N1 t2, _, (t3 as N2 _))) =>
let
val left = N2 (t1, size t1, t2)
val inner = N2 (left, size left, t3)
in
N1 inner
end
| (N1 (N1 t1), N2 (N2 (t2, _, t3), _, N1 t4)) =>
let
val left = N2 (t1, size t1, t2)
val right = N2 (t3, size t3, t4)
val inner = N2 (left, size left, right)
in
N1 inner
end
| (N1 (t1 as N1 _), N2 ((t2 as N2 _), _, (t3 as N2 _))) =>
let
val left = N2 (t1, size t1, t2)
val right = N1 t3
in
N2 (left, size left, right)
end
| (l, r) => N2 (l, size l, r)
fun insN2Right (left, right) =
case (left, right) of
(t1, L2 (s1, s2)) => N3 (t1, N0 s1, N0 s2)
| (N1 t1, N3 (t2, t3, t4)) =>
let
val left = N2 (t1, size t1, t2)
val right = N2 (t3, size t3, t4)
in
N2 (left, size left, right)
end
| (t1, N3 (t2, t3, t4)) =>
let val right = N2 (t3, size t3, t4)
in N3 (t1, N1 t2, right)
end
| (l, r) => N2 (l, size l, r)
fun delN2Right (left, right) =
case (left, right) of
(N2 (N1 t1, _, N2 (t2, _, t3)), N1 (N1 t4)) =>
let
val left = N2 (t1, size t1, t2)
val right = N2 (t3, size t3, t4)
val inner = N2 (left, size left, right)
in
N1 inner
end
| (N2 ((t1 as N2 _), lm, N1 t2), N1 (N1 t3)) =>
let
val right = N2 (t2, size t2, t3)
val inner = N2 (t1, lm, right)
in
N1 inner
end
| (N2 ((t1 as N2 _), _, (t2 as N2 _)), N1 (t3 as N1 _)) =>
let
val left = N1 t1
val right = N2 (t2, size t2, t3)
in
N2 (left, size left, right)
end
| (l, r) => N2 (l, size l, r)
fun insLeaf (curIdx, newStr, rope, oldStr) =
if curIdx <= 0 then
if isLessThanTarget (oldStr, newStr) then (N0 (newStr ^ oldStr), NoAction)
else (L2 (newStr, oldStr), AddedNode)
else if curIdx >= String.size oldStr then
if isLessThanTarget (oldStr, newStr) then (N0 (oldStr ^ newStr), NoAction)
else (L2 (oldStr, newStr), AddedNode)
else
(* Need to split in middle of string. *)
let
val sub1 = String.substring (oldStr, 0, curIdx)
val sub2Len = String.size oldStr - curIdx
val sub2 = String.substring (oldStr, curIdx, sub2Len)
in
if
isLessThanTarget (oldStr, newStr)
then
(N0 (sub1 ^ newStr ^ sub2), NoAction)
else if
curIdx + String.size newStr <= targetLength
then
(L2 (sub1 ^ newStr, sub2), AddedNode)
else if
((String.size oldStr) - curIdx) + String.size newStr <= targetLength
then
(L2 (sub1, newStr ^ sub2), AddedNode)
else
(N3 (N0 sub1, N0 newStr, N0 sub2), AddedNode)
end
fun ins (curIdx, newStr, rope) =
case rope of
N2 (l, lm, r) =>
if curIdx < lm then
let
val (l, action) = ins (curIdx, newStr, l)
in
(case action of
NoAction =>
(case (l, r) of
(N0 s1, N0 s2) =>
if isLessThanTarget (s1, s2) then
(N0 (s1 ^ s2), DeletedNode)
else
(N2 (l, lm + String.size newStr, r), action)
| _ => (N2 (l, lm + String.size newStr, r), action))
| AddedNode => (insN2Left (l, r), action)
| DeletedNode => (delN2Left (l, r), action))
end
else
let
val (r, action) = ins (curIdx - lm, newStr, r)
in
(case action of
NoAction =>
(case (l, r) of
(N0 s1, N0 s2) =>
if isLessThanTarget (s1, s2) then
(N0 (s1 ^ s2), DeletedNode)
else
(N2 (l, lm, r), action)
| _ => (N2 (l, lm, r), action))
| AddedNode => (insN2Right (l, r), action)
| DeletedNode => (delN2Right (l, r), action))
end
| N1 t =>
let
val (t, action) = ins (curIdx, newStr, t)
in
(case action of
AddedNode => (insN1 t, action)
| _ => (N1 t, action))
end
| N0 oldStr => insLeaf (curIdx, newStr, rope, oldStr)
| _ => raise AuxConstructor
fun insert (index, str, rope) =
let
val (rope, action) = ins (index, str, rope)
in
(case action of
NoAction => rope
| AddedNode => insRoot rope
| DeletedNode => delRoot rope)
end
fun app (newStr, rope) =
case rope of
N2 (l, lm, r) =>
let
val (r, action) = app (newStr, r)
in
(case action of
NoAction =>
(case (l, r) of
(N0 s1, N0 s2) =>
if isLessThanTarget (s1, s2) then
(N0 (s1 ^ s2), DeletedNode)
else
(N2 (l, lm, r), action)
| _ => (N2 (l, lm, r), action))
| AddedNode => (insN2Right (l, r), action)
| DeletedNode => (delN2Right (l, r), action))
end
| N1 t =>
let
val (t, action) = app (newStr, t)
in
(case action of
AddedNode => (insN1 t, action)
| _ => (N1 t, action))
end
| N0 oldStr =>
if isLessThanTarget (oldStr, newStr) then
(N0 (oldStr ^ newStr), NoAction)
else
(L2 (oldStr, newStr), AddedNode)
| _ => raise AuxConstructor
fun append (str, rope) =
let
val (rope, action) = app (str, rope)
in
(case action of
NoAction => rope
| AddedNode => insRoot rope
| DeletedNode => delRoot rope)
end
fun delLeaf (startIdx, endIdx, str) =
if startIdx <= 0 andalso endIdx >= String.size str then
(empty, false)
else if startIdx >= 0 andalso endIdx <= String.size str then
let
val sub1 = String.substring (str, 0, startIdx)
val sub2 = String.substring (str, endIdx, (String.size str - endIdx))
in
if isLessThanTarget (sub1, sub2) then (N0 (sub1 ^ sub2), false)
else (L2 (sub1, sub2), true)
end
else if startIdx >= 0 andalso endIdx >= String.size str then
let val str = String.substring (str, 0, startIdx)
in (N0 str, false)
end
else
let val str = String.substring (str, endIdx, String.size str - endIdx)
in (N0 str, false)
end
fun del (startIdx, endIdx, rope) =
case rope of
N2 (l, lm, r) =>
if lm > startIdx andalso lm > endIdx then
let
val (l, didAdd) = del (startIdx, endIdx, l)
in
if didAdd then (insN2Left (l, r), didAdd)
else (N2 (l, size l, r), didAdd)
end
else if lm < startIdx andalso lm < endIdx then
let
val (r, didAdd) = del (startIdx - lm, endIdx - lm, r)
in
if didAdd then (insN2Right (l, r), didAdd)
else (N2 (l, lm, r), didAdd)
end
else
let
val (r, didAddR) = del (startIdx - lm, endIdx - lm, r)
val (l, didaddL) = del (startIdx, endIdx, l)
in
if didaddL then (insN2Left (l, r), didaddL)
else if didAddR then (insN2Right (l, r), didAddR)
else (N2 (l, size l, r), false)
end
| N1 t =>
let val (t, didAdd) = del (startIdx, endIdx, t)
in if didAdd then (insN1 t, didAdd) else (N1 t, didAdd)
end
| N0 str => delLeaf (startIdx, endIdx, str)
| _ => raise AuxConstructor
fun delete (start, length, rope) =
let val (rope, didAdd) = del (start, start + length, rope)
in if didAdd then insRoot rope else delRoot rope
end
fun foldStringChars (apply, term, pos, str, strSize, acc) =
if pos < strSize then
case term acc of
false =>
let
val chr = String.sub (str, pos)
val acc = apply (chr, acc)
in
foldStringChars (apply, term, pos + 1, str, strSize, acc)
end
| true => acc
else
acc
fun foldFromIdxTerm (apply, term, idx, rope, acc) =
case rope of
N2 (l, lm, r) =>
if idx < lm then
let
val acc = foldFromIdxTerm (apply, term, idx, l, acc)
in
if term acc then acc
else foldFromIdxTerm (apply, term, idx - lm, r, acc)
end
else
foldFromIdxTerm (apply, term, idx - lm, r, acc)
| N1 t => foldFromIdxTerm (apply, term, idx, t, acc)
| N0 str => foldStringChars (apply, term, idx, str, String.size str, acc)
| _ => raise AuxConstructor
fun noTerm _ = false
fun foldFromIdx (apply, idx, rope, acc) =
foldFromIdxTerm (apply, noTerm, idx, rope, acc)
end

283
src/tiny_rope23.sml Normal file
View File

@@ -0,0 +1,283 @@
structure TinyRope23 =
struct
(* Type of ropes. *)
datatype t =
Leaf of string
| N2 of t * int * t * int
| N3 of t * int * t * int * t * int
fun foldl f state rope =
case rope of
Leaf str => f (str, state)
| N2 (l, _, r, _) => let val state = foldl f state l in foldl f state r end
| N3 (l, _, m, _, r, _) =>
let
val state = foldl f state l
val state = foldl f state m
in
foldl f state r
end
fun foldr f state rope =
case rope of
Leaf str => f (str, state)
| N2 (l, _, r, _) => let val state = foldr f state r in foldr f state l end
| N3 (l, _, m, _, r, _) =>
let
val state = foldr f state r
val state = foldr f state m
in
foldr f state l
end
local
fun toListFolder (str, lst) = str :: lst
fun toList rope =
foldr toListFolder [] rope
in
fun toString rope =
let val lst = toList rope
in String.concat lst
end
end
(* Type used for balancing ropes, used only internally. *)
datatype treeI =
TI of t * int
| OF of t * int * t * int
val targetLength = 1024
val empty = Leaf ""
fun fromString string = Leaf string
fun size rope =
case rope of
Leaf str => String.size str
| N2 (_, lm, _, rm) => rm + rm
| N3 (_, lm, _, mm, _, rm) => lm + mm + rm
fun isLessThanTarget (str1, str2) =
String.size str1 + String.size str2 <= targetLength
fun insLeaf (curIdx, newStr, oldStr) =
if curIdx <= 0 then
if isLessThanTarget (oldStr, newStr) then
let val str = newStr ^ oldStr
in TI (Leaf str, String.size str)
end
else
OF (Leaf newStr, String.size newStr, Leaf oldStr, String.size oldStr)
else if curIdx >= String.size oldStr then
if isLessThanTarget (oldStr, newStr) then
let val str = oldStr ^ newStr
in TI (Leaf str, String.size str)
end
else
OF (Leaf oldStr, String.size oldStr, Leaf newStr, String.size newStr)
else
(* Need to split in middle of string. *)
let
val sub1 = String.substring (oldStr, 0, curIdx)
val sub2Len = String.size oldStr - curIdx
val sub2 = String.substring (oldStr, curIdx, sub2Len)
in
if
isLessThanTarget (oldStr, newStr)
then
let val str = sub1 ^ newStr ^ sub2
in TI (Leaf str, String.size str)
end
else if
curIdx + String.size newStr <= targetLength
then
let
val leftString = sub1 ^ newStr
in
OF
( Leaf leftString
, String.size leftString
, Leaf sub2
, String.size sub2
)
end
else if
((String.size oldStr) - curIdx) + String.size newStr <= targetLength
then
let
val rightString = newStr ^ sub2
in
OF
( Leaf sub1
, String.size sub1
, Leaf rightString
, String.size rightString
)
end
else
let
val left =
N2 (Leaf sub1, String.size sub1, Leaf newStr, String.size newStr)
val leftSize = String.size sub1 + String.size newStr
val right = N2 (Leaf sub2, String.size sub2, empty, 0)
val rightSize = String.size sub2
in
OF (left, leftSize, right, rightSize)
end
end
fun ins (curIdx, newStr, rope) =
case rope of
N2 (l, lm, r, rm) =>
if curIdx < lm then
(case ins (curIdx, newStr, l) of
TI (l, lm) => TI (N2 (l, lm, r, rm), lm + rm)
| OF (l1, lm1, l2, lm2) =>
TI (N3 (l1, lm1, l2, lm2, r, rm), lm1 + lm2 + rm))
else
(case (ins (curIdx - lm, newStr, r)) of
TI (r, rm) => TI (N2 (l, lm, r, rm), lm + rm)
| OF (r1, rm1, r2, rm2) =>
TI (N3 (l, lm, r1, rm1, r2, rm2), lm + rm1 + rm2))
| N3 (l, lm, m, mm, r, rm) =>
(*
* Ropes don't usually have N3 nodes so the way we accomodate this is:
* If current index is less than left metadata, use same strategy as
* recursing to the left as N2 nodes.
* Else if current index is less than (left + middle) metadata,
* recurse to middle node while subtracting left metadata.
* Else, recurse to right node while subtracting (left metadata +
* middle metadata).
* This simulates the mathematical operations that would take place
* for the following rope:
* (l, lm)
* / \
* (..., ...) (m, mm, r, rm)
*)
if curIdx < lm then
(case ins (curIdx, newStr, l) of
TI (l, lm) => TI (N3 (l, lm, m, mm, r, rm), lm + mm + rm)
| OF (l1, lm1, l2, lm2) =>
OF (N2 (l1, lm1, l2, lm2), lm1 + lm2, N2 (m, mm, r, rm), mm + rm))
else if curIdx < (lm + mm) then
(case ins (curIdx - lm, newStr, m) of
TI (m, mm) => TI (N3 (l, lm, m, mm, r, rm), lm + mm + rm)
| OF (m1, mm1, m2, mm2) =>
OF (N2 (l, lm, m1, mm1), lm + mm1, N2 (m2, mm2, r, rm), mm2 + rm))
else
(case ins (curIdx - (lm + mm), newStr, r) of
TI (r, rm) => TI (N3 (l, lm, m, mm, r, rm), lm + mm + rm)
| OF (r1, rm1, r2, rm2) =>
OF (N2 (l, lm, m, mm), lm + mm, N2 (r1, rm1, r2, rm2), rm1 + rm2))
| Leaf oldStr => insLeaf (curIdx, newStr, oldStr)
fun insRoot (TI (t, _)) = t
| insRoot (OF (l, lm, r, rm)) = N2 (l, lm, r, rm)
fun insert (idx, newStr, rope) =
insRoot (ins (idx, newStr, rope))
datatype treeD = TD of t | UF of t
exception RopeDeleteError
fun node21 (TD t1, t2) =
let val tree = N2 (t1, size t1, t2, size t2)
in TD (tree)
end
| node21 (UF t1, N2 (t2, t2m, t3, t3m)) =
let val tree = N3 (t1, size t1, t2, t2m, t3, t3m)
in UF (tree)
end
| node21 (UF t1, N3 (t2, t2m, t3, t3m, t4, t4m)) =
let
val t1m = size t1
val left = N2 (t1, t1m, t2, t2m)
val right = N2 (t3, t3m, t4, t4m)
val tree = N2 (left, t1m + t2m, right, t3m + t4m)
in
TD (tree)
end
| node21 _ = raise RopeDeleteError
fun node22 (t1, t1m, TD t2) =
TD (N2 (t1, t1m, t2, size t2))
| node22 (N2 (t1, t1m, t2, t2m), _, UF t3) =
UF (N3 (t1, t1m, t2, t2m, t3, size t3))
| node22 (N3 (t1, t1m, t2, t2m, t3, t3m), _, UF t4) =
let
val t4m = size t4
in
TD (N2
(N2 (t1, t1m, t2, t2m), t1m + t2m, N2 (t3, t3m, t4, t4m), t3m + t4m))
end
| node22 _ = raise RopeDeleteError
fun node31 (TD t1, t2, t2m, t3, t3m) =
TD (N3 (t1, size t1, t2, t2m, t3, t3m))
| node31 (UF t1, N2 (t2, t2m, t3, t3m), _, t4, t4m) =
let
val t1m = size t1
val left = N3 (t1, t1m, t2, t2m, t3, t3m)
val leftSize = t1m + t2m + t3m
val inner = N2 (left, leftSize, t4, t4m)
in
TD inner
end
| node31 (UF t1, N3 (t2, t2m, t3, t3m, t4, t4m), _, t5, t5m) =
let
val t1m = size t1
val left = N2 (t1, t1m, t2, t2m)
val leftSize = t1m + t2m
val middle = N2 (t3, t3m, t4, t4m)
val middleSize = t3m + t4m
val inner = N3 (left, leftSize, middle, middleSize, t5, t5m)
in
TD inner
end
| node31 _ = raise RopeDeleteError
fun node32 (t1, t1m, TD t2, t3) =
TD (N3 (t1, t1m, t2, size t2, t3, size t3))
| node32 (t1, t1m, UF t2, N2 (t3, t3m, t4, t4m)) =
let
val t2m = size t2
val right = N3 (t2, t2m, t3, t3m, t4, t4m)
val inner = N2 (t1, t1m, right, t2m + t3m + t4m)
in
TD inner
end
| node32 (t1, t1m, UF t2, N3 (t3, t3m, t4, t4m, t5, t5m)) =
let
val t2m = size t2
val mid = N2 (t2, t2m, t3, t3m)
val right = N2 (t4, t4m, t5, t5m)
val inner = N3 (t1, t1m, mid, t2m + t3m, right, t4m + t5m)
in
TD inner
end
| node32 _ = raise RopeDeleteError
fun node33 (t1, t1m, t2, t2m, TD t3) =
TD (N3 (t1, t1m, t2, t2m, t3, size t3))
| node33 (t1, t1m, N2 (t2, t2m, t3, t3m), _, UF t4) =
let val t4m = size t4
in TD (N2 (t1, t1m, N3 (t2, t2m, t3, t3m, t4, t4m), t2m + t3m + t4m))
end
| node33 (t1, t1m, N3 (t2, t2m, t3, t3m, t4, t4m), _, UF t5) =
let
val t5m = size t4
in
TD (N3
( t1
, t1m
, N2 (t2, t2m, t3, t3m)
, t2m + t3m
, N2 (t4, t4m, t5, t5m)
, t4m + t5m
))
end
| node33 _ = raise RopeDeleteError
end