Add 'brolib-sml/' from commit 'fd96032949434207dda3b288f48d7fe579f59e4e'
git-subtree-dir: brolib-sml git-subtree-mainline:64471ecf7fgit-subtree-split:fd96032949
This commit is contained in:
416
brolib-sml/src/gap_buffer.sml
Normal file
416
brolib-sml/src/gap_buffer.sml
Normal file
@@ -0,0 +1,416 @@
|
||||
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
|
||||
1034
brolib-sml/src/gap_map.sml
Normal file
1034
brolib-sml/src/gap_map.sml
Normal file
File diff suppressed because it is too large
Load Diff
773
brolib-sml/src/gap_set.sml
Normal file
773
brolib-sml/src/gap_set.sml
Normal file
@@ -0,0 +1,773 @@
|
||||
signature GAP_SET_ELEMENT =
|
||||
sig
|
||||
type key
|
||||
|
||||
val l: key * key -> bool
|
||||
val eq: key * key -> bool
|
||||
val g: key * key -> bool
|
||||
|
||||
val maxNodeSize: int
|
||||
end
|
||||
|
||||
signature GAP_SET =
|
||||
sig
|
||||
structure Fn: GAP_SET_ELEMENT
|
||||
|
||||
type t
|
||||
|
||||
val empty: t
|
||||
val isEmpty: t -> bool
|
||||
|
||||
val singleton: Fn.key -> t
|
||||
|
||||
val add: Fn.key * t -> t
|
||||
val remove: Fn.key * t -> t
|
||||
val removeMany: Fn.key * Fn.key * t -> t
|
||||
|
||||
val fromList: Fn.key list -> t
|
||||
val toVector: t -> Fn.key vector
|
||||
|
||||
val exists: Fn.key * t -> bool
|
||||
val min: t -> Fn.key option
|
||||
val max: t -> Fn.key option
|
||||
|
||||
val moveToStart: t -> t
|
||||
val moveToEnd: t -> t
|
||||
val moveTo: Fn.key * t -> t
|
||||
end
|
||||
|
||||
functor MakeGapSet(Fn: GAP_SET_ELEMENT): GAP_SET =
|
||||
struct
|
||||
structure Fn = Fn
|
||||
|
||||
type t = {left: Fn.key vector list, right: Fn.key vector list}
|
||||
|
||||
val empty = {left = [], right = []}
|
||||
|
||||
fun isEmpty {left = [], right = []} = true
|
||||
| isEmpty _ = false
|
||||
|
||||
fun singleton x =
|
||||
{left = [], right = [Vector.fromList [x]]}
|
||||
|
||||
fun isLessThanTarget (v1, v2) =
|
||||
Vector.length v1 + Vector.length v2 <= Fn.maxNodeSize
|
||||
|
||||
fun joinEndOfLeft (new, left) =
|
||||
case left of
|
||||
hd :: tail =>
|
||||
if isLessThanTarget (new, hd) then
|
||||
let val newHd = Vector.concat [hd, new]
|
||||
in newHd :: tail
|
||||
end
|
||||
else
|
||||
new :: left
|
||||
| [] => new :: left
|
||||
|
||||
fun joinStartOfRight (new, right) =
|
||||
case right of
|
||||
hd :: tail =>
|
||||
if isLessThanTarget (new, hd) then
|
||||
let val newHd = Vector.concat [new, hd]
|
||||
in newHd :: tail
|
||||
end
|
||||
else
|
||||
new :: right
|
||||
| [] => new :: right
|
||||
|
||||
fun reverseLinearSearch (pos, findNum, vec) =
|
||||
if pos < 0 then
|
||||
~1
|
||||
else
|
||||
let
|
||||
val curNum = Vector.sub (vec, pos)
|
||||
in
|
||||
if Fn.l (findNum, curNum) then pos
|
||||
else reverseLinearSearch (pos - 1, findNum, vec)
|
||||
end
|
||||
|
||||
fun forwardLinearSearch (pos, findNum, vec) =
|
||||
if pos = Vector.length vec then
|
||||
Vector.length vec
|
||||
else
|
||||
let
|
||||
val curNum = Vector.sub (vec, pos)
|
||||
in
|
||||
if Fn.g (findNum, curNum) then pos + 1
|
||||
else forwardLinearSearch (pos + 1, findNum, vec)
|
||||
end
|
||||
|
||||
fun helpFindInsPos (findNum, vec, low, high, prevMid) =
|
||||
if high >= low then
|
||||
let
|
||||
val mid = low + ((high - low) div 2)
|
||||
val curNum = Vector.sub (vec, mid)
|
||||
in
|
||||
if Fn.eq (curNum, findNum) then
|
||||
mid
|
||||
else if Fn.l (curNum, findNum) then
|
||||
helpFindInsPos (findNum, vec, mid + 1, high, mid)
|
||||
else
|
||||
helpFindInsPos (findNum, vec, low, mid - 1, mid)
|
||||
end
|
||||
else
|
||||
let
|
||||
val curNum = Vector.sub (vec, prevMid)
|
||||
in
|
||||
if Fn.g (findNum, curNum) then
|
||||
forwardLinearSearch (prevMid, findNum, vec)
|
||||
else
|
||||
reverseLinearSearch (prevMid, findNum, vec)
|
||||
end
|
||||
|
||||
fun findInsPos (findNum, vec) =
|
||||
if Vector.length vec = 0 then ~1
|
||||
else helpFindInsPos (findNum, vec, 0, Vector.length vec - 1, 0)
|
||||
|
||||
fun insWithPos (vec, elem, insPos) =
|
||||
if insPos < 0 then
|
||||
Vector.concat [Vector.fromList [elem], vec]
|
||||
else if insPos = Vector.length vec then
|
||||
Vector.concat [vec, Vector.fromList [elem]]
|
||||
else
|
||||
let
|
||||
val elem = Vector.fromList [elem]
|
||||
val elem = VectorSlice.full elem
|
||||
|
||||
val s2len = Vector.length vec - insPos
|
||||
val slice1 = VectorSlice.slice (vec, 0, SOME insPos)
|
||||
val slice2 = VectorSlice.slice (vec, insPos, SOME s2len)
|
||||
in
|
||||
VectorSlice.concat [slice1, elem, slice2]
|
||||
end
|
||||
|
||||
fun insMiddle (hd, insPos, new, left, right) =
|
||||
(* insert in middle *)
|
||||
if Fn.eq (Vector.sub (hd, insPos), new) then
|
||||
(* already have this key so no need to insert again *)
|
||||
{left = left, right = right}
|
||||
else if Vector.length hd + 1 > Fn.maxNodeSize then
|
||||
let
|
||||
(* split into two vectors and join with new *)
|
||||
val lhd = VectorSlice.slice (hd, 0, SOME insPos)
|
||||
val rhdLen = Vector.length hd - insPos
|
||||
val rhd = VectorSlice.slice (hd, insPos, SOME rhdLen)
|
||||
|
||||
val lhd = VectorSlice.vector lhd
|
||||
val new = Vector.fromList [new]
|
||||
val new = VectorSlice.full new
|
||||
val rhd = VectorSlice.concat [new, rhd]
|
||||
in
|
||||
{left = joinEndOfLeft (lhd, left), right = rhd :: right}
|
||||
end
|
||||
else
|
||||
let
|
||||
(* insert without splitting *)
|
||||
val newHd = insWithPos (hd, new, insPos)
|
||||
in
|
||||
{left = joinEndOfLeft (newHd, left), right = right}
|
||||
end
|
||||
|
||||
fun insLeft (new, left, right) =
|
||||
case left of
|
||||
hd :: tl =>
|
||||
let
|
||||
val insPos = findInsPos (new, hd)
|
||||
in
|
||||
if insPos = ~1 then
|
||||
insLeft (new, tl, joinStartOfRight (hd, right))
|
||||
else if insPos = Vector.length hd then
|
||||
(* insert at end *)
|
||||
if Vector.length hd + 1 > Fn.maxNodeSize then
|
||||
let
|
||||
(* hd is full so join new to start of right *)
|
||||
val right = joinStartOfRight (Vector.fromList [new], right)
|
||||
in
|
||||
{left = left, right = right}
|
||||
end
|
||||
else
|
||||
let
|
||||
(* join to end without splitting *)
|
||||
val lhd = Vector.concat [hd, Vector.fromList [new]]
|
||||
in
|
||||
{left = joinEndOfLeft (lhd, tl), right = right}
|
||||
end
|
||||
else
|
||||
insMiddle (hd, insPos, new, left, right)
|
||||
end
|
||||
| [] =>
|
||||
let val new = Vector.fromList [new]
|
||||
in {left = left, right = joinStartOfRight (new, right)}
|
||||
end
|
||||
|
||||
fun insRight (new, left, right) =
|
||||
case right of
|
||||
hd :: tl =>
|
||||
let
|
||||
val insPos = findInsPos (new, hd)
|
||||
in
|
||||
if insPos = Vector.length hd then
|
||||
insRight (new, joinEndOfLeft (hd, left), tl)
|
||||
else if insPos < 0 then
|
||||
(* insert at start *)
|
||||
if Vector.length hd + 1 > Fn.maxNodeSize then
|
||||
let
|
||||
(* hd is full so join new to end of left *)
|
||||
val left = joinEndOfLeft (Vector.fromList [new], left)
|
||||
in
|
||||
{left = left, right = right}
|
||||
end
|
||||
else
|
||||
let
|
||||
(* join to start without splitting *)
|
||||
val rhd = Vector.concat [Vector.fromList [new], hd]
|
||||
in
|
||||
{left = left, right = joinStartOfRight (rhd, tl)}
|
||||
end
|
||||
else
|
||||
insMiddle (hd, insPos, new, left, right)
|
||||
end
|
||||
| [] =>
|
||||
let val new = Vector.fromList [new]
|
||||
in {left = joinEndOfLeft (new, left), right = right}
|
||||
end
|
||||
|
||||
fun add (new, {left, right}: t) =
|
||||
(* look at elements to see which way to traverse *)
|
||||
case right of
|
||||
hd :: _ =>
|
||||
let
|
||||
val rfirst = Vector.sub (hd, 0)
|
||||
in
|
||||
if Fn.g (new, rfirst) then insRight (new, left, right)
|
||||
else if Fn.l (new, rfirst) then insLeft (new, left, right)
|
||||
else {left = left, right = right}
|
||||
end
|
||||
| [] => insLeft (new, left, right)
|
||||
|
||||
fun helpMoveToStart (left, right) =
|
||||
case left of
|
||||
hd :: tl => helpMoveToStart (tl, joinStartOfRight (hd, right))
|
||||
| [] => {left = left, right = right}
|
||||
|
||||
fun moveToStart {left, right} =
|
||||
case left of
|
||||
hd :: tl => helpMoveToStart (tl, joinStartOfRight (hd, right))
|
||||
| [] => {left = left, right = right}
|
||||
|
||||
fun helpMoveToEnd (left, right) =
|
||||
case right of
|
||||
hd :: tl => helpMoveToEnd (joinEndOfLeft (hd, left), tl)
|
||||
| [] => {left = left, right = right}
|
||||
|
||||
fun moveToEnd {left, right} =
|
||||
case right of
|
||||
hd :: tl => helpMoveToEnd (joinEndOfLeft (hd, left), tl)
|
||||
| [] => {left = left, right = right}
|
||||
|
||||
fun moveLeft (to, left, right) =
|
||||
case left of
|
||||
hd :: tl =>
|
||||
let
|
||||
val first = Vector.sub (hd, 0)
|
||||
in
|
||||
if Fn.l (to, first) then
|
||||
moveLeft (to, tl, joinStartOfRight (hd, right))
|
||||
else
|
||||
{left = left, right = right}
|
||||
end
|
||||
| [] => {left = left, right = right}
|
||||
|
||||
fun moveRight (to, left, right) =
|
||||
case right of
|
||||
hd :: tl =>
|
||||
let
|
||||
val last = Vector.sub (hd, Vector.length hd - 1)
|
||||
in
|
||||
if Fn.g (to, last) then moveRight (to, joinEndOfLeft (hd, left), tl)
|
||||
else {left = left, right = right}
|
||||
end
|
||||
| [] => {left = left, right = right}
|
||||
|
||||
fun moveToWhenRightIsEmpty (to, left, right) =
|
||||
case left of
|
||||
hd :: _ =>
|
||||
let
|
||||
val llast = Vector.sub (hd, Vector.length hd - 1)
|
||||
in
|
||||
if Fn.l (to, llast) then moveLeft (to, left, right)
|
||||
else {left = left, right = right}
|
||||
end
|
||||
| [] => {left = left, right = right}
|
||||
|
||||
fun moveTo (to, {left, right}) =
|
||||
case right of
|
||||
hd :: _ =>
|
||||
let
|
||||
val rfirst = Vector.sub (hd, 0)
|
||||
in
|
||||
if Fn.g (to, rfirst) then moveRight (to, left, right)
|
||||
else if Fn.l (to, rfirst) then moveLeft (to, left, right)
|
||||
else {left = left, right = right}
|
||||
end
|
||||
| [] => moveToWhenRightIsEmpty (to, left, right)
|
||||
|
||||
fun helpMin (hd :: tl, prevHd) = helpMin (tl, hd)
|
||||
| helpMin ([], prevHd) =
|
||||
SOME (Vector.sub (prevHd, 0))
|
||||
|
||||
fun min {left = hd :: tl, right = _} = helpMin (tl, hd)
|
||||
| min {left = [], right = hd :: _} =
|
||||
SOME (Vector.sub (hd, 0))
|
||||
| min {left = [], right = []} = NONE
|
||||
|
||||
fun helpMax (_, hd :: tl) = helpMax (hd, tl)
|
||||
| helpMax (hd, []) =
|
||||
SOME (Vector.sub (hd, Vector.length hd - 1))
|
||||
|
||||
fun max {left = _, right = hd :: tl} = helpMax (hd, tl)
|
||||
| max {left = hd :: _, right = []} =
|
||||
SOME (Vector.sub (hd, Vector.length hd - 1))
|
||||
| max {left = [], right = []} = NONE
|
||||
|
||||
fun existsLeft (check, hd :: tl) =
|
||||
let
|
||||
val pos = findInsPos (check, hd)
|
||||
in
|
||||
if pos < 0 then existsLeft (check, tl)
|
||||
else if pos = Vector.length hd then false
|
||||
else Fn.eq (Vector.sub (hd, pos), check)
|
||||
end
|
||||
| existsLeft (_, []) = false
|
||||
|
||||
fun existsRight (check, hd :: tl) =
|
||||
let
|
||||
val pos = findInsPos (check, hd)
|
||||
in
|
||||
if pos = Vector.length hd then existsRight (check, tl)
|
||||
else if pos < 0 then false
|
||||
else Fn.eq (Vector.sub (hd, pos), check)
|
||||
end
|
||||
| existsRight (_, []) = false
|
||||
|
||||
fun exists (check, {left, right}) =
|
||||
case right of
|
||||
hd :: tl =>
|
||||
let
|
||||
val first = Vector.sub (hd, 0)
|
||||
in
|
||||
if Fn.g (check, first) then existsRight (check, tl)
|
||||
else if Fn.eq (check, first) then true
|
||||
else existsLeft (check, left)
|
||||
end
|
||||
| [] => existsLeft (check, left)
|
||||
|
||||
fun removeLeft (toRemove, left, right) =
|
||||
case left of
|
||||
hd :: tl =>
|
||||
let
|
||||
val insPos = findInsPos (toRemove, hd)
|
||||
in
|
||||
if insPos < 0 then
|
||||
removeLeft (toRemove, tl, joinStartOfRight (hd, right))
|
||||
else if insPos = Vector.length hd then
|
||||
{left = tl, right = joinStartOfRight (hd, right)}
|
||||
else if Fn.eq (toRemove, Vector.sub (hd, insPos)) then
|
||||
let
|
||||
val lhd = VectorSlice.slice (hd, 0, SOME insPos)
|
||||
val rhdLen = Vector.length hd - insPos
|
||||
val rhd = VectorSlice.slice (hd, insPos, SOME rhdLen)
|
||||
|
||||
val lhd = VectorSlice.vector lhd
|
||||
val rhd = VectorSlice.vector rhd
|
||||
in
|
||||
{ left = joinEndOfLeft (lhd, tl)
|
||||
, right = joinStartOfRight (rhd, right)
|
||||
}
|
||||
end
|
||||
else
|
||||
{left = tl, right = joinStartOfRight (hd, right)}
|
||||
end
|
||||
| [] => {left = left, right = right}
|
||||
|
||||
fun removeRight (toRemove, left, right) =
|
||||
case right of
|
||||
hd :: tl =>
|
||||
let
|
||||
val insPos = findInsPos (toRemove, hd)
|
||||
in
|
||||
if insPos = Vector.length hd then
|
||||
removeRight (toRemove, joinEndOfLeft (hd, left), right)
|
||||
else if insPos < 0 then
|
||||
{left = joinEndOfLeft (hd, left), right = right}
|
||||
else if Fn.eq (toRemove, Vector.sub (hd, insPos)) then
|
||||
let
|
||||
val lhd = VectorSlice.slice (hd, 0, SOME insPos)
|
||||
val rhdLen = Vector.length hd - insPos
|
||||
val rhd = VectorSlice.slice (hd, insPos, SOME rhdLen)
|
||||
|
||||
val lhd = VectorSlice.vector lhd
|
||||
val rhd = VectorSlice.vector rhd
|
||||
in
|
||||
{ left = joinEndOfLeft (lhd, left)
|
||||
, right = joinStartOfRight (rhd, tl)
|
||||
}
|
||||
end
|
||||
else
|
||||
{left = joinEndOfLeft (hd, left), right = tl}
|
||||
end
|
||||
| [] => {left = left, right = right}
|
||||
|
||||
fun remove (toRemove, {left, right}) =
|
||||
case right of
|
||||
hd :: tl =>
|
||||
let
|
||||
val rfirst = Vector.sub (hd, 0)
|
||||
in
|
||||
if Fn.g (toRemove, rfirst) then
|
||||
removeRight (toRemove, left, right)
|
||||
else if Fn.l (toRemove, rfirst) then
|
||||
removeLeft (toRemove, left, right)
|
||||
else
|
||||
let
|
||||
val len = Vector.length hd - 1
|
||||
val hd = VectorSlice.slice (hd, 1, SOME len)
|
||||
val hd = VectorSlice.vector hd
|
||||
in
|
||||
{left = left, right = joinStartOfRight (hd, tl)}
|
||||
end
|
||||
end
|
||||
| [] => removeLeft (toRemove, left, right)
|
||||
|
||||
fun removeRightFromHere (finish, right) =
|
||||
case right of
|
||||
hd :: tl =>
|
||||
let
|
||||
val finishPos = findInsPos (finish, hd)
|
||||
in
|
||||
if finishPos = Vector.length hd then
|
||||
removeRightFromHere (finish, tl)
|
||||
else if finishPos < 0 then
|
||||
right
|
||||
else
|
||||
let
|
||||
(* keep second half of hd / remove first part of hd *)
|
||||
val finishPos =
|
||||
if Fn.eq (finish, Vector.sub (hd, finishPos)) then finishPos + 1
|
||||
else finishPos
|
||||
val len = Vector.length hd - finishPos
|
||||
val slice = VectorSlice.slice (hd, finishPos, SOME len)
|
||||
val newHd = VectorSlice.vector slice
|
||||
in
|
||||
joinStartOfRight (newHd, tl)
|
||||
end
|
||||
end
|
||||
| [] => right
|
||||
|
||||
fun removeLeftFromHere (start, left) =
|
||||
case left of
|
||||
hd :: tl =>
|
||||
let
|
||||
val startPos = findInsPos (start, hd)
|
||||
in
|
||||
if startPos < 0 then
|
||||
removeLeftFromHere (start, tl)
|
||||
else if startPos = Vector.length hd then
|
||||
left
|
||||
else
|
||||
let
|
||||
(* keep first half of hd / remove last part of hd *)
|
||||
val slice = VectorSlice.slice (hd, 0, SOME startPos)
|
||||
val newHd = VectorSlice.vector slice
|
||||
in
|
||||
joinEndOfLeft (newHd, tl)
|
||||
end
|
||||
end
|
||||
| [] => left
|
||||
|
||||
fun removeManyFromHd (startPos, finish, finishPos, hd, left, right) =
|
||||
let
|
||||
val lhd = VectorSlice.slice (hd, 0, SOME startPos)
|
||||
|
||||
val rStart =
|
||||
if Fn.eq (finish, Vector.sub (hd, finishPos)) then finishPos + 1
|
||||
else finishPos
|
||||
val rlen = Vector.length hd - rStart
|
||||
val rhd = VectorSlice.slice (hd, rStart, SOME rlen)
|
||||
|
||||
val lhd = VectorSlice.vector lhd
|
||||
val rhd = VectorSlice.vector rhd
|
||||
in
|
||||
{left = joinEndOfLeft (lhd, left), right = joinStartOfRight (rhd, right)}
|
||||
end
|
||||
|
||||
fun moveLeftAndRemove (start, finish, left, right) =
|
||||
case left of
|
||||
hd :: tl =>
|
||||
let
|
||||
val finishPos = findInsPos (finish, hd)
|
||||
in
|
||||
if finishPos < 0 then
|
||||
moveLeftAndRemove (start, finish, tl, joinStartOfRight (hd, right))
|
||||
else if finishPos = Vector.length hd then
|
||||
let
|
||||
val startPos = findInsPos (start, hd)
|
||||
in
|
||||
if startPos < 0 then
|
||||
(* remove hd and continue removing leftwards *)
|
||||
let val left = removeLeftFromHere (start, left)
|
||||
in {left = left, right = right}
|
||||
end
|
||||
else if startPos = Vector.length hd then
|
||||
(* return, not removing anything,
|
||||
* because there are no elements
|
||||
* between start and finish.
|
||||
* We do still join hd to tl if pssible for performace reasons. *)
|
||||
{left = joinEndOfLeft (hd, tl), right = right}
|
||||
else
|
||||
(* have to delete from last part of hd *)
|
||||
let
|
||||
val slice = VectorSlice.slice (hd, 0, SOME startPos)
|
||||
val newHd = VectorSlice.vector slice
|
||||
in
|
||||
{left = joinEndOfLeft (newHd, tl), right = right}
|
||||
end
|
||||
end
|
||||
else
|
||||
(* finish pos is somewhere in middle of hd
|
||||
* but have to check where startPos is. *)
|
||||
let
|
||||
val startPos = findInsPos (start, hd)
|
||||
in
|
||||
if startPos < 0 then
|
||||
let
|
||||
val slice = VectorSlice.slice (hd, 0, SOME finishPos)
|
||||
val newHd = VectorSlice.vector slice
|
||||
val left = removeLeftFromHere (start, tl)
|
||||
in
|
||||
{left = left, right = right}
|
||||
end
|
||||
else
|
||||
(* startPos is in middle of hd.
|
||||
* Does not make sense for startPos = Vector.length hd
|
||||
* because finishPos is in middle as well.
|
||||
* So, delete from middle. *)
|
||||
removeManyFromHd (startPos, finish, finishPos, hd, tl, right)
|
||||
end
|
||||
end
|
||||
| [] => {left = left, right = right}
|
||||
|
||||
fun moveRightAndRemove (start, finish, left, right) =
|
||||
case right of
|
||||
hd :: tl =>
|
||||
let
|
||||
val startPos = findInsPos (start, hd)
|
||||
in
|
||||
if startPos = Vector.length hd then
|
||||
(* keep moving rightwards *)
|
||||
moveRightAndRemove (start, finish, joinEndOfLeft (hd, left), tl)
|
||||
else if startPos < 0 then
|
||||
(* start does not exist as it is before this node.
|
||||
* Does finish exist, and if it does, what is its position? *)
|
||||
let
|
||||
val finishPos = findInsPos (finish, hd)
|
||||
in
|
||||
if finishPos = Vector.length hd then
|
||||
(* remove this node and delete right from here. *)
|
||||
let val right = removeRightFromHere (finish, tl)
|
||||
in {left = left, right = right}
|
||||
end
|
||||
else if finishPos < 0 then
|
||||
(* finish is less than first element in this node,
|
||||
* so return. *)
|
||||
{left = left, right = right}
|
||||
else
|
||||
(* have to delete first part of the hd *)
|
||||
let
|
||||
val lhd = VectorSlice.slice (hd, 0, SOME startPos)
|
||||
|
||||
val rStart =
|
||||
if Fn.eq (Vector.sub (hd, finishPos), finish) then
|
||||
finishPos + 1
|
||||
else
|
||||
finishPos
|
||||
val rLen = Vector.length hd - rStart
|
||||
val rhd = VectorSlice.slice (hd, rStart, SOME rLen)
|
||||
val lhd = VectorSlice.vector lhd
|
||||
val rhd = VectorSlice.vector rhd
|
||||
in
|
||||
{ left = joinEndOfLeft (lhd, left)
|
||||
, right = joinStartOfRight (rhd, right)
|
||||
}
|
||||
end
|
||||
end
|
||||
else
|
||||
(* have to delete starting from this node.
|
||||
* End depends on the `finish` value. *)
|
||||
let
|
||||
val finishPos = findInsPos (finish, hd)
|
||||
in
|
||||
if finishPos = Vector.length hd then
|
||||
(* delete last part of this node
|
||||
* and continue deleting rightwards *)
|
||||
let
|
||||
val hd = VectorSlice.slice (hd, 0, SOME startPos)
|
||||
val hd = VectorSlice.vector hd
|
||||
val tl = removeRightFromHere (finish, tl)
|
||||
in
|
||||
{left = left, right = joinStartOfRight (hd, tl)}
|
||||
end
|
||||
else
|
||||
(* we already checked and found that
|
||||
* start is somewhere in the middle.
|
||||
* This means `finish` must be in the middle too,
|
||||
* if finish is not equal to `Vector.length hd`.
|
||||
* So we only need to delete some part from the middle of hd. *)
|
||||
removeManyFromHd (startPos, finish, finishPos, hd, left, tl)
|
||||
end
|
||||
end
|
||||
| [] => {left = left, right = right}
|
||||
|
||||
fun removeWhenStartIsLessThanRFirst (start, finish, left, right, rfirst) =
|
||||
case left of
|
||||
lhd :: _ =>
|
||||
let
|
||||
val llast = Vector.sub (lhd, Vector.length lhd - 1)
|
||||
in
|
||||
if Fn.l (start, llast) then
|
||||
if Fn.g (finish, llast) then
|
||||
(* have to delete left from here and right from here *)
|
||||
let
|
||||
val left = removeLeftFromHere (start, left)
|
||||
(* removeRightFromHere will not remove anything
|
||||
* if finish < rfirst *)
|
||||
val right = removeRightFromHere (finish, right)
|
||||
in
|
||||
{left = left, right = right}
|
||||
end
|
||||
else
|
||||
(* either finish < llast or finish = llast
|
||||
* which means move left and delete
|
||||
* since finish may be before lhd *)
|
||||
moveLeftAndRemove (start, finish, left, right)
|
||||
else if Fn.eq (start, llast) then
|
||||
if
|
||||
Fn.eq (finish, llast)
|
||||
then
|
||||
(* just need to remove llast as both start and finish range
|
||||
* are contained in left *)
|
||||
let val left = removeLeftFromHere (start, left)
|
||||
in {left = left, right = right}
|
||||
end
|
||||
else (* finish > llast
|
||||
* as finish < llast case is impossible
|
||||
* since start = llast.
|
||||
* Check how finish compares to rfirst. *) if
|
||||
Fn.l (finish, rfirst)
|
||||
then
|
||||
(* don't do anything with finish/rfirst,
|
||||
* because finish is less than rfirst
|
||||
* but do remove llast from left
|
||||
* because llast is equal to start *)
|
||||
let val left = removeLeftFromHere (start, left)
|
||||
in {left = left, right = right}
|
||||
end
|
||||
else
|
||||
(* finish >= rfirst; in either case, we need to remove
|
||||
* some elements which are in right. *)
|
||||
let
|
||||
val left = removeLeftFromHere (start, left)
|
||||
val right = removeRightFromHere (finish, right)
|
||||
in
|
||||
{left = left, right = right}
|
||||
end
|
||||
else (* start > llast *) if Fn.l (finish, rfirst) then
|
||||
(* no elements in range between start and finish *)
|
||||
{left = left, right = right}
|
||||
else
|
||||
(* whether finish > rfirst or finish = rfirst,
|
||||
* we have some elements to delete from the right *)
|
||||
let val right = removeRightFromHere (finish, right)
|
||||
in {left = left, right = right}
|
||||
end
|
||||
end
|
||||
| [] => {left = left, right = right}
|
||||
|
||||
fun removeWhenRightIsEmpty (start, finish, left, right) =
|
||||
case left of
|
||||
hd :: tl =>
|
||||
let
|
||||
val finishPos = findInsPos (finish, hd)
|
||||
val startPos = findInsPos (start, hd)
|
||||
in
|
||||
if
|
||||
finishPos = Vector.length hd
|
||||
then
|
||||
if startPos = Vector.length hd then
|
||||
{left = left, right = right}
|
||||
else if startPos < 0 then
|
||||
(* remove hd, and continue removing leftwards *)
|
||||
let val left = removeLeftFromHere (start, left)
|
||||
in {left = left, right = right}
|
||||
end
|
||||
else
|
||||
(* remove last part of hd, keeping first part *)
|
||||
let
|
||||
val slice = VectorSlice.slice (hd, 0, SOME startPos)
|
||||
val newHd = VectorSlice.vector slice
|
||||
in
|
||||
{left = tl, right = [newHd]}
|
||||
end
|
||||
else if
|
||||
finishPos < 0
|
||||
then
|
||||
moveLeftAndRemove (start, finish, tl, [hd])
|
||||
else (* finishPos is in middle; what about startPos? *) if
|
||||
startPos < 0
|
||||
then
|
||||
moveLeftAndRemove (start, finish, left, right)
|
||||
else
|
||||
(* startPos is in middle because `start = Vector.length hd`
|
||||
* is impossible, as finish is in middle already. *)
|
||||
removeManyFromHd (startPos, finish, finishPos, hd, tl, right)
|
||||
end
|
||||
| [] => {left = left, right = right}
|
||||
|
||||
(* assumption: 'start' is the minimum element to delete and 'finish' is the
|
||||
* last element to delete.
|
||||
* Reason for this assumption is because we don't ask the user for a function
|
||||
* like `Int.min` or `Int.max` which can be used to get the minimum/maximum.
|
||||
* So, if the user passes in a `start` that is greater than a `finish`,
|
||||
* then that's a user error. *)
|
||||
fun removeMany (start, finish, {left, right}) =
|
||||
case right of
|
||||
rhd :: _ =>
|
||||
let
|
||||
val rfirst = Vector.sub (rhd, 0)
|
||||
in
|
||||
if Fn.g (start, rfirst) then
|
||||
(* Will need to move rightwards and delete. *)
|
||||
moveRightAndRemove (start, finish, left, right)
|
||||
else if Fn.eq (start, rfirst) then
|
||||
(* need to delete right from here *)
|
||||
let val right = removeRightFromHere (finish, right)
|
||||
in {left = left, right = right}
|
||||
end
|
||||
else
|
||||
removeWhenStartIsLessThanRFirst (start, finish, left, right, rfirst)
|
||||
end
|
||||
| [] => removeWhenRightIsEmpty (start, finish, left, right)
|
||||
|
||||
fun helpFromList (lst, acc) =
|
||||
case lst of
|
||||
hd :: tl => let val acc = add (hd, acc) in helpFromList (tl, acc) end
|
||||
| [] => acc
|
||||
|
||||
fun fromList lst = helpFromList (lst, empty)
|
||||
|
||||
fun helpToVector (hd :: tl, acc) =
|
||||
helpToVector (tl, hd :: acc)
|
||||
| helpToVector ([], acc) = Vector.concat acc
|
||||
|
||||
fun toVector {left, right} = helpToVector (left, right)
|
||||
end
|
||||
510
brolib-sml/src/gap_vector.sml
Normal file
510
brolib-sml/src/gap_vector.sml
Normal file
@@ -0,0 +1,510 @@
|
||||
signature GAP_VECTOR_INPUT =
|
||||
sig
|
||||
type elem
|
||||
|
||||
val maxNodeSide: int
|
||||
end
|
||||
|
||||
signature GAP_VECTOR =
|
||||
sig
|
||||
structure Fn: GAP_VECTOR_INPUT
|
||||
|
||||
type t = {idx: int, left: Fn.elem vector list, right: Fn.elem vector list}
|
||||
|
||||
val empty: t
|
||||
val fromVector: Fn.elem vector -> t
|
||||
val toVector: t -> Fn.elem vector
|
||||
|
||||
val insert: int * Fn.elem * t -> t
|
||||
val insertMany: int * Fn.elem vector * t -> t
|
||||
|
||||
val deleteMany: int * int * t -> t
|
||||
end
|
||||
|
||||
functor MakeGapVector(Fn: GAP_VECTOR_INPUT): GAP_VECTOR =
|
||||
struct
|
||||
structure Fn = Fn
|
||||
|
||||
type t = {idx: int, left: Fn.elem vector list, right: Fn.elem vector list}
|
||||
|
||||
val empty = {idx = 0, left = [], right = []}
|
||||
|
||||
fun fromVector vec = {idx = Vector.length vec, left = [vec], right = []}
|
||||
|
||||
local
|
||||
fun toList (acc, input) =
|
||||
case input of
|
||||
hd :: tl => toList (hd :: acc, tl)
|
||||
| [] => acc
|
||||
in
|
||||
fun toVector ({left, right, ...}: t) =
|
||||
let val lst = toList (right, left)
|
||||
in Vector.concat lst
|
||||
end
|
||||
end
|
||||
|
||||
fun isLessThanTarget (v1, v2) =
|
||||
Vector.length v1 + Vector.length v2 <= Fn.maxNodeSide
|
||||
|
||||
fun isThreeLessThanTarget (v1, v2, v3) =
|
||||
Vector.length v1 + Vector.length v2 + Vector.length v3 <= Fn.maxNodeSide
|
||||
|
||||
fun consLeft (curIdx, newVector, left, right) =
|
||||
{ idx = curIdx + Vector.length newVector
|
||||
, left = newVector :: left
|
||||
, right = right
|
||||
}
|
||||
|
||||
fun joinEndOfLeft (newVector, left) =
|
||||
case left of
|
||||
hd :: tail =>
|
||||
if isLessThanTarget (newVector, hd) then
|
||||
Vector.concat [hd, newVector] :: tail
|
||||
else
|
||||
newVector :: left
|
||||
| [] => newVector :: left
|
||||
|
||||
fun joinStartOfRight (newVector, right) =
|
||||
case right of
|
||||
hd :: tail =>
|
||||
if isLessThanTarget (newVector, hd) then
|
||||
Vector.concat [newVector, hd] :: tail
|
||||
else
|
||||
newVector :: right
|
||||
| [] => newVector :: right
|
||||
|
||||
fun preferInsertLeft (curIdx, newVector, left, right) =
|
||||
case left of
|
||||
hd :: tail =>
|
||||
if isLessThanTarget (hd, newVector) then
|
||||
{ idx = curIdx + Vector.length newVector
|
||||
, left = Vector.concat [hd, newVector] :: tail
|
||||
, right = right
|
||||
}
|
||||
else
|
||||
(case right of
|
||||
hd :: tail =>
|
||||
if isLessThanTarget (hd, newVector) then
|
||||
{ idx = curIdx
|
||||
, left = left
|
||||
, right = Vector.concat [newVector, hd] :: tail
|
||||
}
|
||||
else
|
||||
consLeft (curIdx, newVector, left, right)
|
||||
| [] => consLeft (curIdx, newVector, left, right))
|
||||
| [] => consLeft (curIdx, newVector, left, right)
|
||||
|
||||
fun isSliceLessThanTarget (slice, vec) =
|
||||
VectorSlice.length slice + Vector.length vec <= Fn.maxNodeSide
|
||||
|
||||
fun isThreeSliceLessThanTarget (slice1, slice2, vec) =
|
||||
VectorSlice.length slice1 + VectorSlice.length slice2 + Vector.length vec
|
||||
<= Fn.maxNodeSide
|
||||
|
||||
fun insLeft (prevIdx, idx, newVector, curIdx, hd, tail, right) =
|
||||
(* The requested index is either:
|
||||
* - At the start of the left vector
|
||||
* - In the middle of the left vector
|
||||
* Find out which and split the middle of the vector if necessary. *)
|
||||
if idx = prevIdx then
|
||||
(* At start of vector. *)
|
||||
{ idx = curIdx + Vector.length newVector
|
||||
, right = right
|
||||
, left =
|
||||
(* These two meant to look reversed,
|
||||
* with respect to newVector and hd.
|
||||
*
|
||||
* The line
|
||||
* `newVector ^ hd`
|
||||
* places the contents of newVector before hd,
|
||||
* and the line
|
||||
* `hd :: newVector`
|
||||
* in a zipper also places newVector before hd.
|
||||
*
|
||||
* Using `newVector ^ hd` with `newVector :: hd` gives
|
||||
* different contents in the case of a zipper.
|
||||
* *)
|
||||
if isLessThanTarget (newVector, hd) then
|
||||
Vector.concat [newVector, hd] :: tail
|
||||
else
|
||||
hd :: newVector :: tail
|
||||
}
|
||||
else
|
||||
(* In middle of vector. *)
|
||||
let
|
||||
val length = idx - prevIdx
|
||||
val slice1 = VectorSlice.slice (hd, 0, SOME length)
|
||||
val slice2 = VectorSlice.slice (hd, length, SOME
|
||||
(Vector.length hd - length))
|
||||
in
|
||||
if isThreeSliceLessThanTarget (slice1, slice2, newVector) then
|
||||
let
|
||||
val newVector = VectorSlice.full newVector
|
||||
val hd = VectorSlice.concat [slice1, newVector, slice2]
|
||||
in
|
||||
{ idx = curIdx + VectorSlice.length newVector
|
||||
, left = hd :: tail
|
||||
, right = right
|
||||
}
|
||||
end
|
||||
else if isSliceLessThanTarget (slice1, newVector) then
|
||||
let
|
||||
val idx =
|
||||
prevIdx + VectorSlice.length slice1 + Vector.length newVector
|
||||
val newVector = VectorSlice.full newVector
|
||||
val lhd = VectorSlice.concat [slice1, newVector]
|
||||
in
|
||||
{ idx = idx
|
||||
, left = joinEndOfLeft (lhd, tail)
|
||||
, right = joinStartOfRight (VectorSlice.vector slice2, right)
|
||||
}
|
||||
end
|
||||
else if isSliceLessThanTarget (slice2, newVector) then
|
||||
let
|
||||
val idx = prevIdx + VectorSlice.length slice1
|
||||
val newVector = VectorSlice.full newVector
|
||||
val rhd = VectorSlice.concat [newVector, slice2]
|
||||
in
|
||||
{ idx = idx
|
||||
, left = joinEndOfLeft (VectorSlice.vector slice1, tail)
|
||||
, right = joinStartOfRight (rhd, right)
|
||||
}
|
||||
end
|
||||
else
|
||||
let
|
||||
val slice1 = VectorSlice.vector slice1
|
||||
val slice2 = VectorSlice.vector slice2
|
||||
in
|
||||
{ idx = prevIdx
|
||||
, left = tail
|
||||
, right = slice1 :: newVector :: slice2 :: right
|
||||
}
|
||||
end
|
||||
end
|
||||
|
||||
fun insRight (nextIdx, idx, newVector, curIdx, left, hd, tail) =
|
||||
if idx = nextIdx then
|
||||
(* At end of next Vector. *)
|
||||
{ idx = curIdx
|
||||
, left = left
|
||||
, right =
|
||||
if isLessThanTarget (newVector, hd) then
|
||||
Vector.concat [hd, newVector] :: tail
|
||||
else
|
||||
hd :: (joinStartOfRight (newVector, tail))
|
||||
}
|
||||
else
|
||||
let
|
||||
val length = idx - curIdx
|
||||
val slice1 = VectorSlice.slice (hd, 0, SOME length)
|
||||
val slice2 = VectorSlice.slice (hd, length, SOME
|
||||
(Vector.length hd - length))
|
||||
in
|
||||
if isThreeSliceLessThanTarget (slice1, slice2, newVector) then
|
||||
let
|
||||
val idx =
|
||||
curIdx + VectorSlice.length slice1 + Vector.length newVector
|
||||
+ VectorSlice.length slice2
|
||||
|
||||
val newVector = VectorSlice.full newVector
|
||||
val lhd = VectorSlice.concat [slice1, newVector, slice2]
|
||||
in
|
||||
{idx = idx, left = joinEndOfLeft (lhd, left), right = tail}
|
||||
end
|
||||
else if isSliceLessThanTarget (slice1, newVector) then
|
||||
let
|
||||
val idx =
|
||||
curIdx + VectorSlice.length slice1 + Vector.length newVector
|
||||
val lhd = VectorSlice.concat [slice1, VectorSlice.full newVector]
|
||||
in
|
||||
{ idx = idx
|
||||
, left = joinEndOfLeft (lhd, left)
|
||||
, right = joinStartOfRight (VectorSlice.vector slice2, tail)
|
||||
}
|
||||
end
|
||||
else if isSliceLessThanTarget (slice2, newVector) then
|
||||
let
|
||||
val idx = curIdx + VectorSlice.length slice1
|
||||
val lhd = VectorSlice.vector slice1
|
||||
val newVector = VectorSlice.full newVector
|
||||
val rhd = VectorSlice.concat [newVector, slice2]
|
||||
in
|
||||
{ idx = idx
|
||||
, left = joinEndOfLeft (lhd, left)
|
||||
, right = joinStartOfRight (rhd, tail)
|
||||
}
|
||||
end
|
||||
else
|
||||
let
|
||||
val idx =
|
||||
curIdx + VectorSlice.length slice1 + Vector.length newVector
|
||||
val slice1 = VectorSlice.vector slice1
|
||||
val slice2 = VectorSlice.vector slice2
|
||||
in
|
||||
{ idx = idx
|
||||
, left = newVector :: joinEndOfLeft (slice1, left)
|
||||
, right = joinStartOfRight (slice2, tail)
|
||||
}
|
||||
end
|
||||
end
|
||||
|
||||
fun ins (idx, newVector, curIdx, left, right) : t =
|
||||
if curIdx = idx then
|
||||
preferInsertLeft (curIdx, newVector, left, right)
|
||||
else if idx < curIdx then
|
||||
(* Need to insert on the left. *)
|
||||
case left of
|
||||
[] =>
|
||||
(* If there is no vector on the left, then add the new vector there. *)
|
||||
{idx = Vector.length newVector, left = [newVector], right = right}
|
||||
| hd :: tail =>
|
||||
let
|
||||
val prevIdx = curIdx - Vector.length hd
|
||||
in
|
||||
if idx < prevIdx then
|
||||
(* The requested index is prior to the vector on the left,
|
||||
* so move leftward one vector. *)
|
||||
ins (idx, newVector, prevIdx, tail, joinStartOfRight (hd, right))
|
||||
else
|
||||
insLeft (prevIdx, idx, newVector, curIdx, hd, tail, right)
|
||||
end
|
||||
else
|
||||
(* Need to insert to the right. *)
|
||||
case right of
|
||||
[] => {idx = curIdx, left = left, right = [newVector]}
|
||||
| hd :: tail =>
|
||||
let
|
||||
val nextIdx = Vector.length hd + curIdx
|
||||
in
|
||||
if idx > nextIdx then
|
||||
ins (idx, newVector, nextIdx, joinEndOfLeft (hd, left), tail)
|
||||
else
|
||||
insRight (nextIdx, idx, newVector, curIdx, left, hd, tail)
|
||||
end
|
||||
|
||||
fun insertMany (idx, newVector, buffer: t) =
|
||||
ins (idx, newVector, #idx buffer, #left buffer, #right buffer)
|
||||
|
||||
fun insert (idx, elem, buffer) =
|
||||
insertMany (idx, Vector.fromList [elem], buffer)
|
||||
|
||||
fun deleteRightFromHere (curIdx, finish, right) =
|
||||
case right of
|
||||
hd :: tail =>
|
||||
let
|
||||
val nextIdx = curIdx + Vector.length hd
|
||||
in
|
||||
if nextIdx < finish then
|
||||
deleteRightFromHere (nextIdx, finish, tail)
|
||||
else if nextIdx > finish then
|
||||
let
|
||||
val newVecStart = finish - curIdx
|
||||
val slice = VectorSlice.slice (hd, newVecStart, SOME
|
||||
(Vector.length hd - newVecStart))
|
||||
val newVec = VectorSlice.vector slice
|
||||
in
|
||||
newVec :: 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 + Vector.length 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 vector,
|
||||
* and then continue deleting right. *)
|
||||
let
|
||||
val length = start - curIdx
|
||||
val newVector = VectorSlice.slice (hd, 0, SOME length)
|
||||
val newVector = VectorSlice.vector newVector
|
||||
in
|
||||
{ idx = curIdx + Vector.length newVector
|
||||
, left = joinEndOfLeft (newVector, left)
|
||||
, right = deleteRightFromHere (nextIdx, finish, tail)
|
||||
}
|
||||
end
|
||||
else if nextIdx > finish then
|
||||
(* Have to delete from middle of vector. *)
|
||||
let
|
||||
val sub1Length = start - curIdx
|
||||
val sub2Start = finish - curIdx
|
||||
val sub2Len = Vector.length hd - sub2Start
|
||||
|
||||
val slice1 = VectorSlice.slice (hd, 0, SOME sub1Length)
|
||||
val slice2 = VectorSlice.slice (hd, sub2Start, SOME sub2Len)
|
||||
val slice1 = VectorSlice.vector slice1
|
||||
val slice2 = VectorSlice.vector slice2
|
||||
in
|
||||
{ idx = curIdx + sub1Length
|
||||
, left = joinEndOfLeft (slice1, left)
|
||||
, right = joinStartOfRight (slice2, tail)
|
||||
}
|
||||
end
|
||||
else
|
||||
(* nextIdx = finish
|
||||
* Have to delete from end of this vector. *)
|
||||
let
|
||||
val vecLength = start - curIdx
|
||||
val vec = VectorSlice.slice (hd, 0, SOME vecLength)
|
||||
val vec = VectorSlice.vector vec
|
||||
in
|
||||
{ idx = curIdx + vecLength
|
||||
, left = joinEndOfLeft (vec, left)
|
||||
, right = tail
|
||||
}
|
||||
end
|
||||
else
|
||||
(* nextIdx = start
|
||||
* The start range is contained fully at the next node,
|
||||
* without having to remove part of a vector 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 - Vector.length hd
|
||||
in
|
||||
if start < prevIdx then
|
||||
deleteLeftFromHere (start, prevIdx, tail, right)
|
||||
else if start > prevIdx then
|
||||
(* Need to delete from some part of this vector. *)
|
||||
let
|
||||
val length = start - prevIdx
|
||||
val newVec = VectorSlice.slice (hd, 0, SOME length)
|
||||
val newVec = VectorSlice.vector newVec
|
||||
in
|
||||
{ idx = prevIdx
|
||||
, left = tail
|
||||
, right = joinStartOfRight (newVec, 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 - Vector.length 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 vector,
|
||||
* and then call function to continue deleting leftward. *)
|
||||
let
|
||||
val hdStart = finish - prevIdx
|
||||
val newLen = Vector.length hd - hdStart
|
||||
val newHd = VectorSlice.slice (hd, hdStart, SOME newLen)
|
||||
val newHd = VectorSlice.vector newHd
|
||||
|
||||
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 vector. *)
|
||||
let
|
||||
val sub1Length = start - prevIdx
|
||||
val sub2Start = finish - prevIdx
|
||||
val sub2Len = Vector.length hd - sub2Start
|
||||
|
||||
val slice1 = VectorSlice.slice (hd, 0, SOME sub1Length)
|
||||
val slice2 = VectorSlice.slice (hd, sub2Start, SOME sub2Len)
|
||||
val slice1 = VectorSlice.vector slice1
|
||||
val slice2 = VectorSlice.vector slice2
|
||||
in
|
||||
{ idx = prevIdx + sub1Length
|
||||
, left = joinEndOfLeft (slice1, tail)
|
||||
, right = joinStartOfRight (slice2, right)
|
||||
}
|
||||
end
|
||||
else
|
||||
(* prevIdx = start
|
||||
* We want to delete from the start of this vector and stop. *)
|
||||
let
|
||||
val vecStart = finish - prevIdx
|
||||
val vecLen = Vector.length hd - vecStart
|
||||
val vec = VectorSlice.slice (hd, vecStart, SOME vecLen)
|
||||
val vec = VectorSlice.vector vec
|
||||
in
|
||||
{ idx = prevIdx
|
||||
, left = tail
|
||||
, right = joinStartOfRight (vec, 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 deleteMany (start, length, buffer: t) =
|
||||
if length > 0 then
|
||||
del (start, start + length, #idx buffer, #left buffer, #right buffer)
|
||||
else
|
||||
buffer
|
||||
end
|
||||
3586
brolib-sml/src/line_gap.sml
Normal file
3586
brolib-sml/src/line_gap.sml
Normal file
File diff suppressed because it is too large
Load Diff
795
brolib-sml/src/rope.sml
Normal file
795
brolib-sml/src/rope.sml
Normal 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 - 1, 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
|
||||
176
brolib-sml/src/rrb_rope.sml
Normal file
176
brolib-sml/src/rrb_rope.sml
Normal file
@@ -0,0 +1,176 @@
|
||||
structure RrbRope =
|
||||
struct
|
||||
val bits: Word.word = 0w5
|
||||
val width: Word.word = 0w32
|
||||
val mask: Word.word = 0w31
|
||||
|
||||
datatype tree = BRANCH of tree vector | LEAF of int vector
|
||||
|
||||
type t = {root: tree, shift: word, count: int}
|
||||
|
||||
val empty: t = {root = LEAF (Vector.fromList []), shift = 0w0, count = 0}
|
||||
|
||||
fun tailoff count =
|
||||
if count < 32 then
|
||||
0w0
|
||||
else
|
||||
let
|
||||
val w = Word.fromInt (count - 1)
|
||||
val w = Word.>> (w, bits)
|
||||
in
|
||||
Word.<< (w, bits)
|
||||
end
|
||||
|
||||
datatype append_result = UPDATE | APPEND
|
||||
|
||||
fun helpAppend (item, tree) =
|
||||
case tree of
|
||||
BRANCH n =>
|
||||
let
|
||||
val lastNode = Vector.sub (n, Vector.length n - 1)
|
||||
in
|
||||
case helpAppend (item, lastNode) of
|
||||
(UPDATE, newLast, newDepth) =>
|
||||
let val n = Vector.update (n, Vector.length n - 1, newLast)
|
||||
in (UPDATE, BRANCH n, newDepth + 1)
|
||||
end
|
||||
| (APPEND, newNode, newDepth) =>
|
||||
if Vector.length n = 32 then
|
||||
let val hewNode = BRANCH (Vector.fromList [newNode])
|
||||
in (APPEND, newNode, newDepth + 1)
|
||||
end
|
||||
else
|
||||
let val n = Vector.concat [n, Vector.fromList [newNode]]
|
||||
in (UPDATE, BRANCH n, newDepth + 1)
|
||||
end
|
||||
end
|
||||
| LEAF items =>
|
||||
if Vector.length items = 32 then
|
||||
let val appendLeaf = LEAF (Vector.fromList [item])
|
||||
in (APPEND, appendLeaf, 0)
|
||||
end
|
||||
else
|
||||
let val newLeaf = Vector.concat [items, Vector.fromList [item]]
|
||||
in (UPDATE, LEAF newLeaf, 0)
|
||||
end
|
||||
|
||||
fun append (item, {shift, root, count}: t) =
|
||||
case helpAppend (item, root) of
|
||||
(UPDATE, updatedTree, newDepth) =>
|
||||
{ count = count + 1
|
||||
, root = updatedTree
|
||||
, shift = let val w = Word.fromInt newDepth in w * bits end
|
||||
}
|
||||
| (APPEND, newLast, newDepth) =>
|
||||
let
|
||||
val root = BRANCH (Vector.fromList [root, newLast])
|
||||
val w = Word.fromInt newDepth
|
||||
val shift = w * bits
|
||||
in
|
||||
{count = count + 1, root = root, shift = shift}
|
||||
end
|
||||
|
||||
fun getLast tree =
|
||||
case tree of
|
||||
BRANCH n => getLast (Vector.sub (n, Vector.length n - 1))
|
||||
| LEAF i => Vector.sub (i, Vector.length i - 1)
|
||||
|
||||
fun helpGet (key: Word.word, level, tree) =
|
||||
case tree of
|
||||
BRANCH nodes =>
|
||||
let
|
||||
val w = Word.>> (key, level)
|
||||
val w = Word.andb (w, mask)
|
||||
val node = Vector.sub (nodes, Word.toInt w)
|
||||
in
|
||||
helpGet (key, level - bits, node)
|
||||
end
|
||||
| LEAF items =>
|
||||
let val idx = Word.andb (key, mask)
|
||||
in Vector.sub (items, Word.toInt idx)
|
||||
end
|
||||
|
||||
fun get (key, {shift, root, count}: t) =
|
||||
let val key = Word.fromInt key
|
||||
in if key >= tailoff count then getLast root else helpGet (key, shift, root)
|
||||
end
|
||||
|
||||
fun splitKeepingLeft (idx, level, tree) =
|
||||
case tree of
|
||||
BRANCH nodes =>
|
||||
let
|
||||
val w = Word.>> (idx, level)
|
||||
val w = Word.andb (w, mask)
|
||||
val nodeIdx = Word.toInt w
|
||||
|
||||
val node = Vector.sub (nodes, nodeIdx)
|
||||
val newNode = splitKeepingLeft (idx, level - bits, node)
|
||||
val newNode = Vector.fromList [newNode]
|
||||
val newNode = VectorSlice.full newNode
|
||||
|
||||
val newNodes = VectorSlice.slice (nodes, 0, SOME nodeIdx)
|
||||
val newNodes = VectorSlice.concat [newNodes, newNode]
|
||||
in
|
||||
BRANCH newNodes
|
||||
end
|
||||
| LEAF items =>
|
||||
let
|
||||
val w = Word.andb (idx, mask)
|
||||
val idx = Word.toInt w
|
||||
val items = VectorSlice.slice (items, 0, SOME idx)
|
||||
val items = VectorSlice.vector items
|
||||
in
|
||||
LEAF items
|
||||
end
|
||||
|
||||
fun splitKeepingRight (idx, level, tree) =
|
||||
case tree of
|
||||
BRANCH nodes =>
|
||||
let
|
||||
val w = Word.>> (idx, level)
|
||||
val w = Word.andb (w, mask)
|
||||
val nodeIdx = Word.toInt w
|
||||
|
||||
val node = Vector.sub (nodes, nodeIdx)
|
||||
val newNode = splitKeepingRight (idx, level - bits, node)
|
||||
val newNode = Vector.fromList [newNode]
|
||||
val newNode = VectorSlice.full newNode
|
||||
|
||||
val newNodes = VectorSlice.slice (nodes, nodeIdx, NONE)
|
||||
val newNodes = VectorSlice.concat [newNode, newNodes]
|
||||
in
|
||||
BRANCH newNodes
|
||||
end
|
||||
| LEAF items =>
|
||||
let
|
||||
val w = Word.andb (idx, mask)
|
||||
val idx = Word.toInt w
|
||||
val items = VectorSlice.slice (items, idx, NONE)
|
||||
val items = VectorSlice.vector items
|
||||
in
|
||||
LEAF items
|
||||
end
|
||||
|
||||
fun replaceStartLeaf (newStart, tree) =
|
||||
case tree of
|
||||
BRANCH nodes =>
|
||||
let
|
||||
val startNode = replaceStartLeaf (newStart, Vector.sub (nodes, 0))
|
||||
val nodes = Vector.update (nodes, 0, startNode)
|
||||
in
|
||||
BRANCH nodes
|
||||
end
|
||||
| LEAF _ => LEAF newStart
|
||||
|
||||
fun replaceEndLeaf (newEnd, tree) =
|
||||
case tree of
|
||||
BRANCH nodes =>
|
||||
let
|
||||
val endNode = Vector.sub (nodes, Vector.length nodes - 1)
|
||||
val endNode = replaceEndLeaf (newEnd, endNode)
|
||||
val nodes = Vector.update (nodes, Vector.length nodes - 1, endNode)
|
||||
in
|
||||
BRANCH endNode
|
||||
end
|
||||
| LEAF _ => LEAF newEnd
|
||||
end
|
||||
393
brolib-sml/src/tiny_rope.sml
Normal file
393
brolib-sml/src/tiny_rope.sml
Normal 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
brolib-sml/src/tiny_rope23.sml
Normal file
283
brolib-sml/src/tiny_rope23.sml
Normal 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
|
||||
Reference in New Issue
Block a user