Files
sml-projects/src/line_gap.sml

3587 lines
121 KiB
Standard ML
Raw Normal View History

2024-10-04 15:00:14 +01:00
signature LINE_GAP =
sig
type t =
{ idx: int
, textLength: int
2024-10-04 15:00:14 +01:00
, leftStrings: string list
, rightStrings: string list
, line: int
, lineLength: int
2024-10-04 15:00:14 +01:00
, leftLines: int vector list
, rightLines: int vector list
}
val empty: t
val fromString: string -> t
2024-10-04 15:00:14 +01:00
val toString: t -> string
val sub: int * t -> char
val substring: int * int * t -> string
val nullSubstring: int * int * t -> string
val substringWithEnd: int * int * t * string -> string
2024-10-04 15:00:14 +01:00
val delete: int * int * t -> t
val insert: int * string * t -> t
2024-10-05 12:39:45 +01:00
val append: string * t -> t
val goToStart: t -> t
2024-10-30 10:23:55 +00:00
val goToEnd: t -> t
val goToIdx: int * t -> t
val goToLine: int * t -> t
val idxToLineNumber: int * t -> int
val lineNumberToIdx: int * t -> int
type string_iterator =
{ idx: int
, leftStrings: string list
, rightStrings: string list
, textLength: int
}
val makeStringIterator: t -> string_iterator
val moveIteratorToIdx: int * string_iterator -> string_iterator
val subIterator: int * string_iterator -> char
2024-10-04 15:00:14 +01:00
(* for testing *)
val verifyIndex: t -> unit
val verifyLines: t -> unit
end
structure LineGap :> LINE_GAP =
struct
local
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
in
fun countLineBreaks str =
helpCountLineBreaks (String.size str - 1, [], str)
end
type t =
{ idx: int
, textLength: int
, leftStrings: string list
, rightStrings: string list
, line: int
, lineLength: int
, leftLines: int vector list
, rightLines: int vector list
}
val stringLimit = 1024
val vecLimit = 32
val empty =
{ idx = 0
, textLength = 0
, leftStrings = []
, rightStrings = []
, line = 0
, lineLength = 0
, leftLines = []
, rightLines = []
}
fun fromString str =
let
val linebreaks = countLineBreaks str
in
{ idx = 0
, textLength = String.size str
, leftStrings = []
, rightStrings = [str]
, line = 0
, lineLength = Vector.length linebreaks
, leftLines = []
, rightLines = [linebreaks]
}
end
local
fun helpToString (acc, input) =
case input of
hd :: tl => helpToString (hd :: acc, tl)
| [] => String.concat acc
in
fun toString ({leftStrings, rightStrings, ...}: t) =
helpToString (rightStrings, leftStrings)
end
fun isInLimit (s1, s2, v1, v2) =
String.size s1 + String.size s2 <= stringLimit
andalso Vector.length v1 + Vector.length v2 <= vecLimit
fun isThreeInLimit (s1, s2, s3, v1, v2) =
String.size s1 + String.size s2 + String.size s3 <= stringLimit
andalso Vector.length v1 + Vector.length v2 <= vecLimit
2024-07-04 09:47:35 +01:00
(* Binary search. If value isn't found, returns the value before it. *)
2024-06-29 17:46:43 +01:00
local
fun reverseLinearSearch (findNum, idx, lines) =
if idx < 0 then
idx
else
let
val curVal = Vector.sub (lines, idx)
in
if curVal < findNum then idx
else reverseLinearSearch (findNum, idx, lines)
end
fun helpBinSearch (findNum, lines, low, high) =
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
helpBinSearch (findNum, lines, mid + 1, high)
else
helpBinSearch (findNum, lines, low, mid - 1)
end
else
reverseLinearSearch (findNum, mid, lines)
end
2024-06-29 17:46:43 +01:00
in
fun binSearch (findNum, lines) =
if Vector.length lines = 0 then 0
else helpBinSearch (findNum, lines, 0, Vector.length lines - 1)
2024-06-29 17:46:43 +01:00
end
2024-07-04 09:47:35 +01:00
(* Binary search. If value isn't found, returns the value after it. *)
local
fun forwardLinearSearch (findNum, idx, lines) =
if idx = Vector.length lines then
idx
2024-07-04 09:47:35 +01:00
else
let
val curVal = Vector.sub (lines, idx)
in
if curVal > findNum then idx
else forwardLinearSearch (findNum, idx + 1, lines)
2024-07-04 09:47:35 +01:00
end
fun helpBinSearch (findNum, lines, low, high) =
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
helpBinSearch (findNum, lines, mid + 1, high)
else
helpBinSearch (findNum, lines, low, mid - 1)
end
else if mid >= 0 then
forwardLinearSearch (findNum, mid, lines)
2024-07-04 09:47:35 +01:00
else
0
2024-07-04 09:47:35 +01:00
end
in
fun forwardBinSearch (findNum, lines) =
if Vector.length lines = 0 then 0
else helpBinSearch (findNum, lines, 0, Vector.length lines - 1)
end
2024-07-04 05:57:31 +01:00
(* Insert function and helper functions for it. *)
local
fun insWhenIdxAndCurIdxAreEqual
( newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) : t =
case (leftStrings, leftLines) of
(strHd :: strTl, lineHd :: lineTl) =>
if isInLimit (strHd, newString, lineHd, newLines) then
(* Fits in limit, so we can add to existing string/line vector.*)
let
val newIdx = curIdx + String.size newString
val newStrHd = strHd ^ newString
val newLeftString = newStrHd :: strTl
val newLine = curLine + Vector.length newLines
val newLinesHd =
Vector.tabulate
( Vector.length lineHd + Vector.length newLines
, fn idx =>
if idx < Vector.length lineHd then
Vector.sub (lineHd, idx)
else
Vector.sub (newLines, idx - Vector.length lineHd)
+ String.size strHd
)
val newLeftLines = newLinesHd :: lineTl
in
{ idx = newIdx
, textLength = textLength
, line = newLine
, lineLength = lineLength
, leftStrings = newLeftString
, leftLines = newLeftLines
, rightStrings = rightStrings
, rightLines = rightLines
}
end
else
(* Does not fit in limit, so cons instead.*)
{ idx = curIdx + String.size newString
, textLength = textLength
, line = curLine + Vector.length newLines
, lineLength = lineLength
, leftStrings = newString :: leftStrings
, leftLines = newLines :: leftLines
, rightStrings = rightStrings
, rightLines = rightLines
}
| (_, _) =>
(*
* Because movements between string/line lists in the gap buffer
* always move together, we know that either list being empty
* also means that the other one is empty.
* So we don't need to perform addition or consing.
*)
{ idx = String.size newString
, textLength = textLength
, line = Vector.length newLines
, lineLength = lineLength
, leftStrings = [newString]
, leftLines = [newLines]
, rightStrings = rightStrings
, rightLines = rightLines
}
fun insInLeftList
( idx
, newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, prevIdx
, leftStringsHd
, leftStringsTl
, leftLinesHd
, leftLinesTl
, textLength
, lineLength
) : t =
if idx = prevIdx then
(* Need to insert at the start of the left list. *)
if isInLimit (newString, leftStringsHd, newLines, leftLinesHd) then
let
(* Create new vector, adjusting indices as needed. *)
val joinedLines =
Vector.tabulate
( Vector.length newLines + Vector.length leftLinesHd
, fn idx =>
if idx < Vector.length newLines then
Vector.sub (newLines, idx)
else
Vector.sub (leftLinesHd, idx - Vector.length newLines)
+ String.size newString
)
in
{ idx = curIdx + String.size newString
, textLength = textLength
, line = curLine + Vector.length newLines
, lineLength = lineLength
, leftStrings = (newString ^ leftStringsHd) :: leftStringsTl
, leftLines = joinedLines :: leftLinesTl
, rightStrings = rightStrings
, rightLines = rightLines
}
end
else
(* Just cons everything; no way we can join while staying in limit. *)
{ idx = curIdx + String.size newString
, textLength = textLength
, line = curLine + Vector.length newLines
, lineLength = lineLength
, leftStrings = leftStringsHd :: newString :: leftStringsTl
, leftLines = leftLinesHd :: newLines :: leftLinesTl
, rightStrings = rightStrings
, rightLines = rightLines
}
else
(* Need to insert in the middle of the left list. *)
let
(* Get string slices on both sides. *)
val strLength = idx - prevIdx
val strSub1 = String.substring (leftStringsHd, 0, strLength)
val strSub2 = String.substring
(leftStringsHd, strLength, String.size leftStringsHd - strLength)
val midpoint = binSearch (String.size strSub1 - 1, leftLinesHd)
in
if
isThreeInLimit (strSub1, newString, strSub2, leftLinesHd, newLines)
then
(* Join three strings together. *)
let
val joinedString = String.concat [strSub1, newString, strSub2]
val joinedLines =
if Vector.length leftLinesHd > 0 then
Vector.tabulate
( Vector.length leftLinesHd + Vector.length newLines
, fn idx =>
if idx <= midpoint then
Vector.sub (leftLinesHd, idx)
else if idx <= midpoint + Vector.length newLines then
Vector.sub (newLines, (idx - midpoint) - 1)
+ String.size strSub1
else
Vector.sub
(leftLinesHd, (idx - Vector.length newLines))
+ String.size newString
)
else
Vector.map (fn el => el + String.size strSub1) newLines
in
{ idx = curIdx + String.size newString
, textLength = textLength
, line = curLine + Vector.length newLines
, lineLength = lineLength
, leftStrings = joinedString :: leftStringsTl
, leftLines = joinedLines :: leftLinesTl
, rightStrings = rightStrings
, rightLines = rightLines
}
end
else if
String.size strSub1 + String.size newString <= stringLimit
andalso midpoint + Vector.length newLines <= vecLimit
then
(* If we can join newString/lines with sub1 while
* staying in limit. *)
if midpoint >= 0 then
(* Implicit: a binSearch match was found. *)
let
val newLeftLinesLength = midpoint + 1 + Vector.length newLines
val newLeftLines =
Vector.tabulate (newLeftLinesLength, fn idx =>
if idx <= midpoint then
Vector.sub (leftLinesHd, idx)
else
Vector.sub (newLines, idx - (midpoint + 1))
+ String.size strSub1)
val newRightLines =
Vector.tabulate
( (Vector.length leftLinesHd - midpoint) - 1
, fn idx =>
Vector.sub (leftLinesHd, idx + midpoint + 1)
- String.size strSub1
)
in
{ idx = prevIdx + String.size strSub1 + String.size newString
, textLength = textLength
, line =
(curLine - Vector.length leftLinesHd)
+ Vector.length newLeftLines
, lineLength = lineLength
, leftStrings = (strSub1 ^ newString) :: leftStringsTl
, leftLines = newLeftLines :: leftLinesTl
, rightStrings = strSub2 :: rightStrings
, rightLines = newRightLines :: rightLines
}
end
else
let
(* No binSearch result found. *)
val newLeftLines =
Vector.map (fn el => el + String.size strSub1) newLines
val newRightLines =
Vector.map (fn idx => idx - String.size strSub1) leftLinesHd
in
{ idx = prevIdx + String.size strSub1 + String.size newString
, textLength = textLength
, line =
(curLine - Vector.length leftLinesHd)
+ Vector.length newLeftLines
, lineLength = lineLength
, leftStrings = (strSub1 ^ newString) :: leftStringsTl
, leftLines = newLeftLines :: leftLinesTl
, rightStrings = strSub2 :: rightStrings
, rightLines = newRightLines :: rightLines
}
end
else if
String.size newString + String.size strSub2 <= stringLimit
andalso
(Vector.length leftLinesHd - midpoint) + Vector.length newLines
<= vecLimit
then
(* If we can join newString/line with sub2 while staying
* in limit. *)
let
val newLeftLines =
if midpoint >= 0 andalso Vector.length leftLinesHd > 0 then
let
val newLeftLines = VectorSlice.slice
(leftLinesHd, 0, SOME (midpoint + 1))
in
VectorSlice.vector newLeftLines
end
else
Vector.fromList []
2024-06-30 16:30:12 +01:00
val newRightLines =
Vector.tabulate
( (Vector.length leftLinesHd - Vector.length newLeftLines)
+ Vector.length newLines
, fn idx =>
if idx < Vector.length newLines then
Vector.sub (newLines, idx)
else
Vector.sub
( leftLinesHd
, (idx - Vector.length newLines)
+ Vector.length newLeftLines
) - String.size strSub1 + String.size newString
)
in
{ idx = prevIdx + String.size strSub1
, textLength = textLength
, line = (curLine - Vector.length leftLinesHd) + midpoint
, lineLength = lineLength
, leftStrings = strSub1 :: leftStringsTl
, leftLines = newLeftLines :: leftLinesTl
, rightStrings = (newString ^ strSub2) :: rightStrings
, rightLines = newRightLines :: rightLines
}
end
else
(* Can't join on either side while staying in limit. *)
let
val lineSub1 =
if midpoint >= 0 andalso Vector.length leftLinesHd > 0 then
let
val lineSub1 = VectorSlice.slice
(leftLinesHd, 0, SOME (midpoint + 1))
in
VectorSlice.vector lineSub1
end
else
Vector.fromList []
val lineSub2Length =
Vector.length leftLinesHd - Vector.length lineSub1
val lineSub2 = Vector.tabulate (lineSub2Length, fn idx =>
Vector.sub (leftLinesHd, idx + Vector.length lineSub1)
- String.size strSub1)
in
{ idx = prevIdx + String.size strSub1 + String.size newString
, textLength = textLength
, line =
(curLine - String.size leftStringsHd) + midpoint
+ Vector.length newLines
, lineLength = lineLength
, leftStrings = newString :: strSub1 :: leftStringsTl
, leftLines = newLines :: lineSub1 :: leftLinesTl
, rightStrings = strSub2 :: rightStrings
, rightLines = lineSub2 :: rightLines
}
end
end
fun moveLeftAndIns
( idx
, newString
, newLines: int vector
, curIdx
, curLine
, leftStrings: string list
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) =
case (leftStrings, leftLines) of
(leftStringsHd :: leftStringsTl, leftLinesHd :: leftLinesTl) =>
let
val prevIdx = curIdx - String.size leftStringsHd
in
if idx < prevIdx then
(*
* Need to move leftward.
* The rather complicated code below is an optimisation checking
* if we can minimise the number of lists in the gap buffer
* by concatenating lines/strings together while staying
* under the limit.
* *)
(case (rightStrings, rightLines) of
( rightStringsHd :: rightStringsTl
, rightLinesHd :: rightLinesTl
) =>
if
isInLimit
( leftStringsHd
, rightStringsHd
, leftLinesHd
, rightLinesHd
)
then
let
val prevLine = curLine - Vector.length leftLinesHd
val newRightStringsHd = leftStringsHd ^ rightStringsHd
val newRightLinesHd =
Vector.tabulate
( Vector.length leftLinesHd
+ Vector.length rightLinesHd
, fn idx =>
if idx < Vector.length leftLinesHd then
Vector.sub (leftLinesHd, idx)
else
Vector.sub
( rightLinesHd
, idx - Vector.length leftLinesHd
) + String.size leftStringsHd
)
in
moveLeftAndIns
( idx
, newString
, newLines
, prevIdx
, prevLine
, leftStringsTl
, leftLinesTl
, newRightStringsHd :: rightStringsTl
, newRightLinesHd :: rightLinesTl
, textLength
, lineLength
)
end
else
moveLeftAndIns
( idx
, newString
, newLines
, prevIdx
, curLine - Vector.length leftLinesHd
, leftStringsTl
, leftLinesTl
, leftStringsHd :: rightStrings
, leftLinesHd :: rightLines
, textLength
, lineLength
)
| (_, _) =>
moveLeftAndIns
( idx
, newString
, newLines
, prevIdx
, curLine - Vector.length newLines
, leftStringsTl
, leftLinesTl
, leftStringsHd :: rightStrings
, leftLinesHd :: rightLines
, textLength
, lineLength
))
else
(* Insertion is somewhere between the head of the left list,
* and the tail of the left list. *)
insInLeftList
( idx
, newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, prevIdx
, leftStringsHd
, leftStringsTl
, leftLinesHd
, leftLinesTl
, textLength
, lineLength
)
end
| (_, _) =>
(* Left list is empty, so need to cons or join.
* Just set left string/list as newString/newLines. *)
{ idx = String.size newString
, textLength = textLength
, line = Vector.length newLines
, lineLength = lineLength
, leftStrings = [newString]
, leftLines = [newLines]
, rightStrings = rightStrings
, rightLines = rightLines
}
fun insInRightList
( idx
, newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, nextIdx
, rightStringsHd
, rightStringsTl
, rightLinesHd: int vector
, rightLinesTl
, textLength
, lineLength
) : t =
if idx = nextIdx then
(* Need to put newString/newLines at the end of the right list's hd. *)
if isInLimit (newString, rightStringsHd, newLines, rightLinesHd) then
(* Allocate new string because we can do so while staying in limit. *)
2024-06-29 17:46:43 +01:00
let
val newRightStringsHd = rightStringsHd ^ newString
2024-07-03 14:49:32 +01:00
val newRightLinesHd =
Vector.tabulate
( Vector.length rightLinesHd + Vector.length newLines
, fn idx =>
if idx < Vector.length rightLinesHd then
Vector.sub (rightLinesHd, idx)
else
Vector.sub (newLines, idx - Vector.length rightLinesHd)
+ String.size rightStringsHd
)
2024-06-29 17:46:43 +01:00
in
{ idx = curIdx
, textLength = textLength
, line = curLine
, lineLength = lineLength
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = newRightStringsHd :: rightStringsTl
, rightLines = newRightLinesHd :: rightLinesTl
}
2024-06-29 17:46:43 +01:00
end
else
(* Cons newString and newLines to after-the-head,
* because we can't join while staying in the limit.*)
{ idx = curIdx
, textLength = textLength
, line = curLine
, lineLength = lineLength
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = rightStringsHd :: newString :: rightStringsTl
, rightLines = rightLinesHd :: newLines :: rightLinesTl
}
else
(* Have to split rightStringsHd and rightLinesHd in the middle. *)
let
val strLength = idx - curIdx
val strSub1 = String.substring (rightStringsHd, 0, strLength)
val strSub2 = String.substring
(rightStringsHd, strLength, String.size rightStringsHd - strLength)
val midpoint = binSearch (String.size strSub1 - 1, rightLinesHd)
in
if
isThreeInLimit (strSub1, newString, strSub2, rightLinesHd, newLines)
then
(* Join three strings together. *)
let
val newRightStringsHd =
String.concat [strSub1, newString, strSub2]
val newRightLinesHd =
if Vector.length rightLinesHd > 0 then
Vector.tabulate
( Vector.length rightLinesHd + Vector.length newLines
, fn idx =>
if idx <= midpoint then
Vector.sub (rightLinesHd, idx)
else if idx <= midpoint + Vector.length newLines then
Vector.sub (newLines, (idx - midpoint) - 1)
+ String.size strSub1
else
Vector.sub
(rightLinesHd, (idx - Vector.length newLines))
+ String.size newString
)
else
Vector.map (fn el => el + String.size strSub1) newLines
in
{ idx = curIdx
, textLength = textLength
, line = curLine
, lineLength = lineLength
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = newRightStringsHd :: rightStringsTl
, rightLines = newRightLinesHd :: rightLinesTl
}
end
else if
String.size strSub1 + String.size newString <= stringLimit
andalso midpoint + Vector.length newLines <= vecLimit
then
(* If we can join newString/lines with sub1 while
* staying in limit. *)
if midpoint >= 0 then
let
(* Implicit: a binSearch match was found. *)
val newLeftStringsHd = strSub1 ^ newString
val newLeftLinesLength = midpoint + 1 + Vector.length newLines
val newLeftLinesHd =
Vector.tabulate (newLeftLinesLength, fn idx =>
if idx <= midpoint then
Vector.sub (rightLinesHd, idx)
else
Vector.sub (newLines, idx - (midpoint + 1))
+ String.size strSub1)
val newRightLinesHd =
Vector.tabulate
( (Vector.length rightLinesHd - midpoint) - 1
, fn idx =>
Vector.sub (rightLinesHd, idx + midpoint + 1)
- String.size strSub1
)
in
{ idx = curIdx + String.size newLeftStringsHd
, textLength = textLength
, line = curLine + Vector.length newLeftLinesHd
, lineLength = lineLength
, leftStrings = newLeftStringsHd :: leftStrings
, leftLines = newLeftLinesHd :: leftLines
, rightStrings = strSub2 :: rightStringsTl
, rightLines = newRightLinesHd :: rightLinesTl
}
end
else
let
(* No binSearch match found. *)
val newLeftStringsHd = strSub1 ^ newString
val newLeftLinesHd =
Vector.map (fn el => el + String.size strSub1) newLines
val newRightLinesHd =
Vector.map (fn idx => idx - String.size strSub1) rightLinesHd
in
{ idx = curIdx + String.size newLeftStringsHd
, textLength = textLength
, line = curLine + Vector.length newLeftLinesHd
, lineLength = lineLength
, leftStrings = newLeftStringsHd :: leftStrings
, leftLines = newLeftLinesHd :: leftLines
, rightStrings = strSub2 :: rightStringsTl
, rightLines = newRightLinesHd :: rightLinesTl
}
end
else if
String.size newString + String.size strSub2 <= stringLimit
andalso
(Vector.length rightLinesHd - midpoint) + Vector.length newLines
<= vecLimit
then
(* If we can join newString/line with sub2 while staying
* in limit. *)
let
val newLeftLinesHd =
if midpoint >= 0 then
let
val newLeftLinesHd = VectorSlice.slice
(rightLinesHd, 0, SOME (midpoint + 1))
in
VectorSlice.vector newLeftLinesHd
end
else
Vector.fromList []
val newRightStringsHd = newString ^ strSub2
val newRightLinesHd =
2024-07-03 14:35:38 +01:00
Vector.tabulate
( (Vector.length newLines + Vector.length rightLinesHd)
- Vector.length newLeftLinesHd
2024-07-03 14:35:38 +01:00
, fn idx =>
if idx < Vector.length newLines then
Vector.sub (newLines, idx)
else
(Vector.sub
( rightLinesHd
, (idx - Vector.length newLines)
+ Vector.length newLeftLinesHd
) - String.size strSub1) + String.size newString
2024-07-03 14:35:38 +01:00
)
in
{ idx = curIdx + String.size strSub1
, textLength = textLength
, line = curLine + Vector.length newLeftLinesHd
, lineLength = lineLength
, leftStrings = strSub1 :: leftStrings
, leftLines = newLeftLinesHd :: leftLines
, rightStrings = newRightStringsHd :: rightStringsTl
, rightLines = newRightLinesHd :: rightLinesTl
}
end
else
(* Can't join on either side while staying in limit. *)
let
val lineSub1 =
if midpoint >= 0 andalso Vector.length rightLinesHd > 0 then
let
val lineSub1 = VectorSlice.slice
(rightLinesHd, 0, SOME (midpoint + 1))
in
VectorSlice.vector lineSub1
end
else
Vector.fromList []
val lineSub2Length =
Vector.length rightLinesHd - Vector.length lineSub1
val lineSub2 = Vector.tabulate (lineSub2Length, fn idx =>
Vector.sub (rightLinesHd, idx + Vector.length lineSub1)
- String.size strSub1)
in
{ idx = curIdx + String.size strSub1 + String.size newString
, textLength = textLength
, line = curLine + Vector.length newLines + Vector.length lineSub1
, lineLength = lineLength
, leftStrings = newString :: strSub1 :: leftStrings
, leftLines = newLines :: lineSub1 :: leftLines
, rightStrings = strSub2 :: rightStringsTl
, rightLines = lineSub2 :: rightLinesTl
}
end
end
2024-07-03 14:05:27 +01:00
fun moveRightAndIns
( idx
, newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) =
case (rightStrings, rightLines) of
(rightStringsHd :: rightStringsTl, rightLinesHd :: rightLinesTl) =>
let
val nextIdx = curIdx + String.size rightStringsHd
in
if idx > nextIdx then
(* Need to move rightward. *)
(case (leftStrings, leftLines) of
(leftStringsHd :: leftStringsTl, leftLinesHd :: leftLinesTl) =>
if
isInLimit
( leftStringsHd
, rightStringsHd
, leftLinesHd
, rightLinesHd
)
then
let
val nextLine = curLine + Vector.length rightLinesHd
val newLeftStringsHd = leftStringsHd ^ rightStringsHd
val newLeftLinesHd =
Vector.tabulate
( Vector.length leftLinesHd
+ Vector.length rightLinesHd
, fn idx =>
if idx < Vector.length leftLinesHd then
Vector.sub (leftLinesHd, idx)
else
Vector.sub
( rightLinesHd
, idx - Vector.length leftLinesHd
) + String.size leftStringsHd
)
in
moveRightAndIns
( idx
, newString
, newLines
, nextIdx
, nextLine
, newLeftStringsHd :: leftStringsTl
, newLeftLinesHd :: leftLinesTl
, rightStringsTl
, rightLinesTl
, textLength
, lineLength
2024-07-03 14:05:27 +01:00
)
end
else
moveRightAndIns
( idx
, newString
, newLines
, nextIdx
, curLine + Vector.length rightLinesHd
, rightStringsHd :: leftStrings
, rightLinesHd :: leftLines
, rightStringsTl
, rightLinesTl
, textLength
, lineLength
)
| (_, _) =>
moveRightAndIns
( idx
, newString
, newLines
, nextIdx
, curLine + Vector.length rightLinesHd
, rightStringsHd :: leftStrings
2024-06-29 23:40:39 +01:00
, rightLinesHd :: leftLines
, rightStringsTl
, rightLinesTl
, textLength
, lineLength
))
else
(* Need to insert in the middle of the right string's hd. *)
insInRightList
( idx
, newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, nextIdx
, rightStringsHd
, rightStringsTl
, rightLinesHd
, rightLinesTl
, textLength
, lineLength
)
end
| (_, _) =>
(* Right string/line is empty. *)
{ idx = curIdx
, textLength = textLength
, line = curLine
, lineLength = lineLength
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = [newString]
, rightLines = [newLines]
}
fun ins
( idx
, newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) : t =
if curIdx = idx then
insWhenIdxAndCurIdxAreEqual
( newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
else if idx < curIdx then
moveLeftAndIns
( idx
, newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
else
(* idx > curIdx. *)
moveRightAndIns
( idx
, newString
, newLines
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
in
fun insert (idx, newString, buffer: t) =
let
val newLines = countLineBreaks newString
val newTextLength = #textLength buffer + String.size newString
val newLineLength = #lineLength buffer + Vector.length newLines
in
ins
( idx
, newString
, newLines
, #idx buffer
, #line buffer
, #leftStrings buffer
, #leftLines buffer
, #rightStrings buffer
, #rightLines buffer
, newTextLength
, newLineLength
)
end
end
2024-10-05 12:39:45 +01:00
fun helpGoToEndAndAppend
( newString
, newLines
, idx
, leftStrings
, rightStrings
, line
, leftLines
, rightLines
, textLength
, lineLength
2024-10-05 12:39:45 +01:00
) =
case (rightStrings, rightLines) of
(rStrHd :: rStrTl, rLnHd :: rLnTl) =>
(* move gap rightwards one node,
* and join with right head with left if possible *)
(case (leftStrings, leftLines) of
(lStrHd :: lStrTl, lLnHd :: lLnTl) =>
if isInLimit (lStrHd, rStrHd, lLnHd, rLnHd) then
let
val newLstrHd = lStrHd ^ rStrHd
val newLlnHd =
Vector.tabulate
( Vector.length lLnHd + Vector.length rLnHd
, fn lnIdx =>
if lnIdx < Vector.length lLnHd then
Vector.sub (lLnHd, lnIdx)
else
Vector.sub (rLnHd, lnIdx - Vector.length lLnHd)
+ String.size lStrHd
)
in
helpGoToEndAndAppend
( newString
, newLines
, idx + String.size rStrHd
, newLstrHd :: lStrTl
, rStrTl
, line + Vector.length rLnHd
, newLlnHd :: lLnTl
, rLnTl
, textLength
, lineLength
2024-10-05 12:39:45 +01:00
)
end
else
helpGoToEndAndAppend
( newString
, newLines
, idx + String.size rStrHd
, rStrHd :: leftStrings
, rStrTl
, line + Vector.length rLnHd
, rLnHd :: leftLines
, rLnTl
, textLength
, lineLength
2024-10-05 12:39:45 +01:00
)
| (_, _) =>
(* left side is empty; we are at start *)
helpGoToEndAndAppend
( newString
, newLines
, String.size rStrHd
, [rStrHd]
, rStrTl
, Vector.length rLnHd
, [rLnHd]
, rLnTl
, textLength
, lineLength
2024-10-05 12:39:45 +01:00
))
| (_, _) =>
(* we have reached the end, and right side is empty *)
(case (leftStrings, leftLines) of
(lStrHd :: lStrTl, lLnHd :: lLnTl) =>
if isInLimit (lStrHd, newString, lLnHd, newLines) then
(* join new string and line with left *)
let
val newLstrHd = lStrHd ^ newString
val newLlnHd =
Vector.tabulate
( Vector.length lLnHd + Vector.length newLines
, fn lnIdx =>
if lnIdx < Vector.length lLnHd then
Vector.sub (lLnHd, lnIdx)
else
Vector.sub (newLines, lnIdx - Vector.length lLnHd)
+ String.size lStrHd
)
in
{ idx = idx + String.size newString
, textLength = textLength
2024-10-05 12:39:45 +01:00
, line = line + Vector.length newLines
, lineLength = lineLength
2024-10-05 12:39:45 +01:00
, leftStrings = newLstrHd :: lStrTl
, leftLines = newLlnHd :: lLnTl
, rightStrings = []
, rightLines = []
}
end
else
{ idx = idx + String.size newString
, textLength = textLength
2024-10-05 12:39:45 +01:00
, line = line + Vector.length newLines
, lineLength = lineLength
2024-10-05 12:39:45 +01:00
, leftStrings = newString :: leftStrings
, leftLines = newLines :: leftLines
, rightStrings = []
, rightLines = []
}
| (_, _) =>
{ idx = idx + String.size newString
, textLength = textLength
2024-10-05 12:39:45 +01:00
, line = line + Vector.length newLines
, lineLength = lineLength
2024-10-05 12:39:45 +01:00
, leftStrings = newString :: leftStrings
, leftLines = newLines :: leftLines
, rightStrings = []
, rightLines = []
})
fun append (newString, buffer) =
2024-10-05 12:39:45 +01:00
let
val
{ idx
, line
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
} = buffer
val newTextLength = textLength + String.size newString
2024-10-05 12:39:45 +01:00
val newLines = countLineBreaks newString
val newLineLength = lineLength + Vector.length newLines
2024-10-05 12:39:45 +01:00
in
helpGoToEndAndAppend
( newString
, newLines
, idx
, leftStrings
, rightStrings
, line
, leftLines
, rightLines
, newTextLength
, newLineLength
2024-10-05 12:39:45 +01:00
)
end
2024-07-04 05:57:31 +01:00
(* Delete function and helper functions for it. *)
local
fun deleteRightFromHere
( origIdx
, origLine
, moveIdx
, finish
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) =
case (rightStrings, rightLines) of
(rightStringsHd :: rightStringsTl, rightLinesHd :: rightLinesTl) =>
let
val nextIdx = moveIdx + String.size rightStringsHd
in
if nextIdx < finish then
(* Remove string/line head and keep moving right. *)
deleteRightFromHere
( origIdx
, origLine
, nextIdx
, finish
, leftStrings
, leftLines
, rightStringsTl
, rightLinesTl
, textLength - String.size rightStringsHd
, lineLength - Vector.length rightLinesHd
)
else if nextIdx > finish then
(* Base case: delete from the start of this string and stop moving. *)
let
val oldNodeTextLength = String.size rightStringsHd
val oldNodeLineLength = Vector.length rightLinesHd
(* Delete part of string. *)
val newStrStart = finish - moveIdx
val newStr = String.substring
( rightStringsHd
, newStrStart
, String.size rightStringsHd - newStrStart
)
2024-07-04 05:57:31 +01:00
(* Delete from line vector if we need to. *)
val newLines =
if Vector.length rightLinesHd > 0 then
let
2024-07-18 22:41:54 +01:00
val lineDeleteStart =
2024-07-18 23:16:24 +01:00
forwardBinSearch (newStrStart, rightLinesHd)
in
2024-07-18 23:16:24 +01:00
if lineDeleteStart < Vector.length rightLinesHd then
let
val lineDeleteLength =
Vector.length rightLinesHd - lineDeleteStart
in
Vector.tabulate (lineDeleteLength, fn idx =>
Vector.sub (rightLinesHd, idx + lineDeleteStart)
- newStrStart)
end
else
2024-07-18 23:16:24 +01:00
Vector.fromList []
end
else
rightLinesHd (* empty vector *)
val newNodeTextLength = String.size newStr
val textLengthDifference = oldNodeTextLength - newNodeTextLength
val textLength = textLength - textLengthDifference
val newNodeLineLength = Vector.length newLines
val lineLengthDifference = oldNodeLineLength - newNodeLineLength
val lineLength = lineLength - lineLengthDifference
in
{ idx = origIdx
, textLength = textLength
, line = origLine
, lineLength = lineLength
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = newStr :: rightStringsTl
, rightLines = newLines :: rightLinesTl
}
end
else
(* Delete this node fully, but delete no further. *)
{ idx = origIdx
, textLength = textLength - String.size rightStringsHd
, line = origLine
, lineLength = lineLength - Vector.length rightLinesHd
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = rightStringsTl
, rightLines = rightLinesTl
}
end
| (_, _) =>
{ idx = origIdx
, textLength = textLength
, line = origLine
, lineLength = lineLength
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = []
, rightLines = []
}
2024-07-04 05:57:31 +01:00
fun moveRightAndDelete
( start
, finish
, curIdx
, curLine
, leftStrings: string list
, leftLines: int vector list
, rightStrings: string list
, rightLines: int vector list
, textLength
, lineLength
) =
case (rightStrings, rightLines) of
(rightStringsHd :: rightStringsTl, rightLinesHd :: rightLinesTl) =>
let
val nextIdx = curIdx + String.size rightStringsHd
in
if nextIdx < start then
(* Keep moving right.
* Complicated code below is an optimsation to reduce number of
* elements in the gap buffer.
* If we can join left head with right head while staying in limit, then
* do so; else, just cons as we move. *)
(case (leftStrings, leftLines) of
(leftStringsHd :: leftStringsTl, leftLinesHd :: leftLinesTl) =>
if
isInLimit
( leftStringsHd
, rightStringsHd
, leftLinesHd
, rightLinesHd
)
then
(* We can join the heads while staying in limit, so do so. *)
let
val newLeftStringsHd = leftStringsHd ^ rightStringsHd
val newLeftLinesHd: int vector =
Vector.tabulate
( Vector.length leftLinesHd
+ Vector.length rightLinesHd
, fn idx =>
if idx < Vector.length leftLinesHd then
Vector.sub (leftLinesHd, idx)
else
Vector.sub
( rightLinesHd
, idx - Vector.length leftLinesHd
) + String.size leftStringsHd
)
val newLeftStrings = newLeftStringsHd :: leftStringsTl
val newLeftLines = newLeftLinesHd :: leftLinesTl
in
moveRightAndDelete
( start
, finish
, nextIdx
, curLine + Vector.length rightLinesHd
, newLeftStrings
, newLeftLines
, rightStringsTl
, rightLinesTl
, textLength
, lineLength
)
end
else
(* Can't join heads while staying in limit, so just cons. *)
moveRightAndDelete
( start
, finish
, nextIdx
, curLine + Vector.length rightLinesHd
, rightStringsHd :: leftStrings
, rightLinesHd :: leftLines
, rightStringsTl
, rightLinesTl
, textLength
, lineLength
)
| (_, _) =>
(* Can't join heads while staying in limit, so just cons. *)
moveRightAndDelete
( start
, finish
, nextIdx
, curLine + Vector.length rightLinesHd
, rightStringsHd :: leftStrings
, rightLinesHd :: leftLines
, rightStringsTl
, rightLinesTl
, textLength
, lineLength
))
else if nextIdx > start then
if nextIdx < finish then
(* Start deleting from the end of this string,
* and then continue deleting rightwards. *)
let
val oldNodeTextLength = String.size rightStringsHd
val oldNodeLineLength = Vector.length rightLinesHd
val length = start - curIdx
val newString = String.substring (rightStringsHd, 0, length)
2024-07-04 09:47:35 +01:00
val lineDeleteEnd = binSearch
(String.size newString - 1, rightLinesHd)
val newLines =
if Vector.length rightLinesHd = 0 orelse lineDeleteEnd < 0 then
Vector.fromList []
else
let
val slice = VectorSlice.slice
(rightLinesHd, 0, SOME (lineDeleteEnd + 1))
in
VectorSlice.vector slice
end
val newNodeTextLength = String.size newString
val textLengthDifference =
oldNodeTextLength - newNodeTextLength
val textLength = textLength - textLengthDifference
val newNodeLineLength = Vector.length newLines
val lineLengthDifference =
oldNodeLineLength - newNodeLineLength
val lineLength = lineLength - lineLengthDifference
in
(* Try joining new string with left head if possible. *)
(case (leftStrings, leftLines) of
( leftStringsHd :: leftStringsTl
, leftLinesHd :: leftLinesTl
) =>
if
isInLimit
(newString, leftStringsHd, newLines, leftLinesHd)
then
(* Join new string with left head. *)
let
val newLeftStringsHd = leftStringsHd ^ newString
val newLeftLinesHd =
Vector.tabulate
( Vector.length leftLinesHd
+ Vector.length newLines
, fn idx =>
if idx < Vector.length leftLinesHd then
Vector.sub (leftLinesHd, idx)
else
Vector.sub
( newLines
, idx - Vector.length leftLinesHd
) + String.size leftStringsHd
)
in
(* moveIdx passed as arameter should be
* different from origIdx,
* because moveIdx considers range to delete from
* while origIdx considers index to return
* once buffer is done deleting. *)
deleteRightFromHere
( curIdx + String.size newString
, curLine + Vector.length newLines
, nextIdx
, finish
, newLeftStringsHd :: leftStringsTl
, newLeftLinesHd :: leftLinesTl
, rightStringsTl
, rightLinesTl
, textLength
, lineLength
2024-07-04 09:47:35 +01:00
)
end
else
(* Can't join new string with left head
* while staying in limit, so just cons. *)
2024-07-04 09:47:35 +01:00
deleteRightFromHere
( curIdx + String.size newString
, curLine + Vector.length newLines
, nextIdx
2024-07-04 09:47:35 +01:00
, finish
, newString :: leftStrings
, newLines :: leftLines
2024-07-04 09:47:35 +01:00
, rightStringsTl
, rightLinesTl
, textLength
, lineLength
)
| (_, _) =>
deleteRightFromHere
( curIdx + String.size newString
, curLine + Vector.length newLines
, nextIdx
, finish
, newString :: leftStrings
, newLines :: leftLines
, rightStringsTl
, rightLinesTl
, textLength
, lineLength
))
end
else if nextIdx > finish then
(* Base case: delete from the middle part of this string. *)
let
val oldNodeTextLength = String.size rightStringsHd
val oldNodeLineLength = Vector.length rightLinesHd
val sub1Length = start - curIdx
val sub1 = String.substring (rightStringsHd, 0, sub1Length)
val sub1LineEnd = binSearch
(String.size sub1 - 1, rightLinesHd)
val sub1Lines =
2024-07-18 22:41:54 +01:00
if sub1LineEnd < 0 orelse Vector.length rightLinesHd = 0 then
Vector.fromList []
2024-07-18 22:19:29 +01:00
else
let
2024-07-18 22:41:54 +01:00
val slice = VectorSlice.slice
(rightLinesHd, 0, SOME (sub1LineEnd + 1))
in
VectorSlice.vector slice
end
2024-07-04 09:47:35 +01:00
val sub2Start = finish - curIdx
val sub2 = String.substring
( rightStringsHd
, sub2Start
, String.size rightStringsHd - sub2Start
)
val sub2LineStart = forwardBinSearch (sub2Start, rightLinesHd)
val sub2Lines =
if sub2LineStart < Vector.length rightLinesHd then
Vector.tabulate
( Vector.length rightLinesHd - sub2LineStart
, fn idx =>
Vector.sub (rightLinesHd, idx + sub2LineStart)
- (String.size rightStringsHd - String.size sub2)
)
else
Vector.fromList []
val newNodeTextLength = String.size sub1 + String.size sub2
val textLengthDifference =
oldNodeTextLength - newNodeTextLength
val newTextLength = textLength - textLengthDifference
val newNodeLineLength =
Vector.length sub1Lines + Vector.length sub2Lines
val lineLengthDifference =
oldNodeLineLength - newNodeLineLength
val newLineLength = lineLength - lineLengthDifference
in
{ idx = curIdx + String.size sub1
, textLength = newTextLength
, line = curLine + Vector.length sub1Lines
, lineLength = newLineLength
, leftStrings = sub1 :: leftStrings
, leftLines = sub1Lines :: leftLines
, rightStrings = sub2 :: rightStringsTl
, rightLines = sub2Lines :: rightLinesTl
}
end
else
(* nextIdx = finish
* Base case: delete from middle to end of this string, keeping start. *)
let
val oldNodeTextLength = String.size rightStringsHd
val oldNodeLineLength = Vector.length rightLinesHd
val strLength = start - curIdx
val str = String.substring (rightStringsHd, 0, strLength)
val midpoint = binSearch (String.size str - 1, rightLinesHd)
val newLeftLines =
2024-07-18 22:41:54 +01:00
if midpoint < 0 orelse Vector.length rightLinesHd = 0 then
Vector.fromList []
2024-07-18 22:27:41 +01:00
else
let
val slice = VectorSlice.slice
(rightLinesHd, 0, SOME (midpoint + 1))
in
VectorSlice.vector slice
end
val newNodeTextLength = String.size str
val textLengthDifference =
oldNodeTextLength - newNodeTextLength
val newTextLength = textLength - textLengthDifference
val newNodeLineLength = Vector.length newLeftLines
val lineLengthDifference =
oldNodeLineLength - newNodeLineLength
val newLineLength = lineLength - lineLengthDifference
in
{ idx = curIdx + String.size str
, textLength = newTextLength
, line = curLine + Vector.length newLeftLines
, lineLength = newLineLength
, leftStrings = str :: leftStrings
, leftLines = newLeftLines :: leftLines
, rightStrings = rightStringsTl
, rightLines = rightLinesTl
}
end
else
(* nextIdx = start
* Another base case of this function.
* The start of the deletion range contains the rightStrings/LinesHd,
* and it may extend beyond the current head.
* So pass the rightStringsTl and rightLinesTl to a function that
* will delete rightwards if it needs to, or else terminates. *)
deleteRightFromHere
( curIdx + String.size rightStringsHd
, curLine + Vector.length rightLinesHd
, nextIdx
, finish
, rightStringsHd :: leftStrings
, rightLinesHd :: leftLines
, rightStringsTl
, rightLinesTl
, textLength
, lineLength
)
end
| (_, _) =>
{ idx = curIdx
, textLength = textLength
, line = curLine
, lineLength = lineLength
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = rightStrings
, rightLines = rightLines
}
fun deleteLeftFromHere
( start
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) =
case (leftStrings, leftLines) of
(leftStringsHd :: leftStringsTl, leftLinesHd :: leftLinesTl) =>
let
val prevIdx = curIdx - String.size leftStringsHd
val prevLine = curLine - Vector.length leftLinesHd
in
if start < prevIdx then
(* Continue deleting leftward. *)
deleteLeftFromHere
( start
, prevIdx
, prevLine
, leftStringsTl
, leftLinesTl
, rightStrings
, rightLines
, textLength - String.size leftStringsHd
, lineLength - Vector.length leftLinesHd
)
else if start > prevIdx then
(* Base case: delete end part of this string and return. *)
let
val oldNodeTextLength = String.size leftStringsHd
val oldNodeLineLength = Vector.length leftLinesHd
val length = start - prevIdx
val newStr = String.substring (leftStringsHd, 0, length)
val newLines =
if Vector.length leftLinesHd > 0 then
let
val midpoint = binSearch
(String.size newStr - 1, leftLinesHd)
val slice = VectorSlice.slice
(leftLinesHd, 0, SOME (midpoint + 1))
in
VectorSlice.vector slice
end
else
Vector.fromList []
val newNodeTextLength = String.size newStr
val textLengthDifference = oldNodeTextLength - newNodeTextLength
val newTextLength = textLength - textLengthDifference
val newNodeLineLength = Vector.length newLines
val lineLengthDifference = oldNodeLineLength - newNodeLineLength
val newLineLength = lineLength - lineLengthDifference
in
{ idx = prevIdx + String.size newStr
, textLength = newTextLength
, line = prevLine + Vector.length newLines
, lineLength = newLineLength
, leftStrings = newStr :: leftStringsTl
, leftLines = newLines :: leftLinesTl
, rightStrings = rightStrings
, rightLines = rightLines
}
end
else
(* start = prevIdx
* Base case: Remove leftStrings/LinesHd without removing any further. *)
{ idx = prevIdx
, line = prevLine
, leftStrings = leftStringsTl
, leftLines = leftLinesTl
, rightStrings = rightStrings
, rightLines = rightLines
, textLength = textLength - String.size leftStringsHd
, lineLength = lineLength - Vector.length leftLinesHd
}
end
| (_, _) =>
{ idx = curIdx
, line = curLine
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = rightStrings
, rightLines = rightLines
, textLength = textLength
, lineLength = lineLength
}
fun deleteFromLetAndRight
( start
, finish
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) =
let
val
{ idx = curIdx
, line = curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
} = deleteRightFromHere
( curIdx
, curLine
, curIdx
, finish
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
in
deleteLeftFromHere
( start
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
end
fun moveLeftAndDelete
( start
, finish
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) =
case (leftStrings, leftLines) of
(leftStringsHd :: leftStringsTl, leftLinesHd :: leftLinesTl) =>
let
val prevIdx = curIdx - String.size leftStringsHd
in
if prevIdx > finish then
(* Have to continue moving leftwards.
* Case statement below is an optimisation attempt:
* We are trying to join strings and line-vectors while staying in
* limit if this is possible while staying in limit.
* If this is not possible, we just cons instead. *)
(case (rightStrings, rightLines) of
( rightStringsHd :: rightStringsTl
, rightLinesHd :: rightLinesTl
) =>
if
isInLimit
( leftStringsHd
, rightStringsHd
, leftLinesHd
, rightLinesHd
)
then
(* Can join while staying in limit, so do join. *)
let
val newRightStringsHd = leftStringsHd ^ rightStringsHd
val newRightLinesHd =
Vector.tabulate
( Vector.length leftLinesHd
+ Vector.length rightLinesHd
, fn idx =>
if idx < Vector.length leftLinesHd then
Vector.sub (leftLinesHd, idx)
else
Vector.sub
( rightLinesHd
, idx - Vector.length leftLinesHd
) + String.size leftStringsHd
)
val newRightStrings = newRightStringsHd :: rightStringsTl
val newRightLines = newRightLinesHd :: rightLinesTl
in
moveLeftAndDelete
( start
, finish
, prevIdx
, curLine - Vector.length leftLinesHd
, leftStringsTl
, leftLinesTl
, newRightStrings
, newRightLines
, textLength
, lineLength
2024-07-14 16:23:42 +01:00
)
end
else
(* Cannot join while staying in limit, so don't. *)
moveLeftAndDelete
( start
, finish
, prevIdx
, curLine - Vector.length leftLinesHd
, leftStringsTl
, leftLinesTl
, leftStringsHd :: rightStrings
, leftLinesHd :: rightLines
, textLength
, lineLength
)
| (_, _) =>
(* Base case: reached empty list while trying to move leftwards.
* Cannot do anything so just return. *)
moveLeftAndDelete
( start
, finish
, prevIdx
, curLine - Vector.length leftLinesHd
, leftStringsTl
, leftLinesTl
, [leftStringsHd]
, [leftLinesHd]
, textLength
, lineLength
))
else if prevIdx < finish then
if prevIdx > start then
(* Delete from start point of this string,
* and then call function to continue deleting leftwards. *)
let
val oldNodeTextLength = String.size leftStringsHd
val oldNodeLineLength = Vector.length leftLinesHd
val stringStart = finish - prevIdx
val newString = String.substring
( leftStringsHd
, stringStart
, String.size leftStringsHd - stringStart
)
val newLines =
let
val midpoint = forwardBinSearch (stringStart, leftLinesHd)
in
if midpoint >= 0 then
Vector.tabulate
( Vector.length leftLinesHd - midpoint
, fn idx =>
Vector.sub (leftLinesHd, idx + midpoint)
- stringStart
)
else
Vector.fromList []
end
val newRightStrings = newString :: rightStrings
val newRightLines = newLines :: rightLines
val prevLine = curLine - Vector.length leftLinesHd
val newNodeTextLength = String.size newString
val textLengthDifference =
oldNodeTextLength - newNodeTextLength
val textLength = textLength - textLengthDifference
val newNodeLineLength = Vector.length newLines
val lineLengthDifference =
oldNodeLineLength - newNodeLineLength
val lineLength = lineLength - lineLengthDifference
in
deleteLeftFromHere
( start
, prevIdx
, prevLine
, leftStringsTl
, leftLinesTl
, newRightStrings
, newRightLines
, textLength
, lineLength
)
end
else if prevIdx < start then
if finish >= curIdx then
(* delete from end of string *)
let
val oldNodeTextLength = String.size leftStringsHd
val oldNodeLineLength = Vector.length leftLinesHd
val sub1Length = start - prevIdx
val sub1 = String.substring (leftStringsHd, 0, sub1Length)
val sub1Lines =
if Vector.length leftLinesHd > 0 then
let
val midpoint = binSearch
(String.size sub1 - 1, leftLinesHd)
in
if midpoint >= 0 then
let
val slice = VectorSlice.slice
(leftLinesHd, 0, SOME (midpoint + 1))
in
VectorSlice.vector slice
end
else
Vector.fromList []
end
else
leftLinesHd
val newNodeTextLength = String.size sub1
val textLengthDifference =
oldNodeTextLength - newNodeTextLength
val textLength = textLength - textLengthDifference
val newNodeLineLength = Vector.length sub1Lines
val lineLengthDifference =
oldNodeLineLength - newNodeLineLength
val lineLength = lineLength - lineLengthDifference
in
{ idx = prevIdx + String.size sub1
, line =
(curLine - Vector.length leftLinesHd)
+ Vector.length sub1Lines
, leftStrings = sub1 :: leftStringsTl
, leftLines = sub1Lines :: leftLinesTl
, rightStrings = rightStrings
, rightLines = rightLines
, textLength = textLength
, lineLength = lineLength
}
end
else
(* We want to delete in the middle of leftStringsHd.
* We also have to delete in the middle of leftLinesHd in order to
* do this. *)
let
val oldNodeTextLength = String.size leftStringsHd
val oldNodeLineLength = Vector.length leftLinesHd
val sub1Length = start - prevIdx
val sub1 = String.substring (leftStringsHd, 0, sub1Length)
val sub2Start = finish - prevIdx
val sub2 = String.substring
( leftStringsHd
, sub2Start
, String.size leftStringsHd - sub2Start
)
val sub1Lines =
if Vector.length leftLinesHd > 0 then
let
val midpoint = binSearch
(String.size sub1 - 1, leftLinesHd)
in
if midpoint >= 0 then
let
val slice = VectorSlice.slice
(leftLinesHd, 0, SOME (midpoint + 1))
in
VectorSlice.vector slice
end
else
Vector.fromList []
end
else
leftLinesHd
2024-07-14 16:39:44 +01:00
val sub2Lines =
let
val midpoint = forwardBinSearch (sub2Start, leftLinesHd)
in
if midpoint < Vector.length leftLinesHd then
Vector.tabulate
( Vector.length leftLinesHd - midpoint
, fn idx =>
Vector.sub (leftLinesHd, idx + midpoint)
- sub2Start
)
else
Vector.fromList []
end
val newNodeTextLength = String.size sub1 + String.size sub2
val textLengthDifference =
oldNodeTextLength - newNodeTextLength
val textLength = textLength - textLengthDifference
val newNodeLineLength =
Vector.length sub1Lines + Vector.length sub2Lines
val lineLengthDifference =
oldNodeLineLength - newNodeLineLength
val lineLength = lineLength - lineLengthDifference
in
{ idx = prevIdx + String.size sub1
, line =
(curLine - Vector.length leftLinesHd)
+ Vector.length sub1Lines
, leftStrings = sub1 :: leftStringsTl
, leftLines = sub1Lines :: leftLinesTl
, rightStrings = sub2 :: rightStrings
, rightLines = sub2Lines :: rightLines
, textLength = textLength
, lineLength = lineLength
}
end
else
(* prevIdx = start
* We want to delete from the start of this string and stop. *)
let
val oldNodeTextLength = String.size leftStringsHd
val oldNodeLineLength = Vector.length leftLinesHd
val strStart = finish - prevIdx
val str = String.substring
( leftStringsHd
, strStart
, String.size leftStringsHd - strStart
)
val lines =
let
val lineStart = forwardBinSearch (strStart, leftLinesHd)
in
if lineStart < Vector.length leftLinesHd then
Vector.tabulate
( Vector.length leftLinesHd - lineStart
, fn idx =>
Vector.sub (leftLinesHd, idx + lineStart)
- strStart
)
else
Vector.fromList []
end
val newNodeTextLength = String.size str
val textLengthDifference =
oldNodeTextLength - newNodeTextLength
val textLength = textLength - textLengthDifference
val newNodeLineLength = Vector.length lines
val lineLengthDifference =
oldNodeLineLength - newNodeLineLength
val lineLength = lineLength - lineLengthDifference
in
{ idx = prevIdx + String.size str
, textLength = textLength
, line =
(curLine - Vector.length leftLinesHd) + String.size str
, lineLength = lineLength
, leftStrings = str :: leftStringsTl
, leftLines = lines :: leftLinesTl
, rightStrings = rightStrings
, rightLines = rightLines
}
end
2024-07-14 16:39:44 +01:00
else
(* prevIdx = finish
* We need to call a function that will start deleting from prevIdx.
* Optimsation: Try joining leftStrings/LinesHd with
* rightStrings/LinesHd if possible while staying in limit. *)
(case (rightStrings, rightLines) of
( rightStringsHd :: rightStringsTl
, rightLinesHd :: rightLinesTl
) =>
if
isInLimit
( leftStringsHd
, rightStringsHd
, leftLinesHd
, rightLinesHd
)
then
(* Can join while staying in limit. *)
let
val newRightStringsHd = leftStringsHd ^ rightStringsHd
val newRightLinesHd =
Vector.tabulate
( Vector.length leftLinesHd
+ Vector.length rightLinesHd
, fn idx =>
if idx < Vector.length leftLinesHd then
Vector.sub (leftLinesHd, idx)
else
Vector.sub
( rightLinesHd
, idx - Vector.length leftLinesHd
) + String.size leftStringsHd
)
in
deleteLeftFromHere
( start
, prevIdx
, curLine - Vector.length leftLinesHd
, leftStringsTl
, leftLinesTl
, newRightStringsHd :: rightStringsTl
, newRightLinesHd :: rightLinesTl
, textLength
, lineLength
)
end
else
(* Cannot join while staying in limit. *)
deleteLeftFromHere
( start
, prevIdx
, curLine - Vector.length leftLinesHd
, leftStringsTl
, leftLinesTl
, leftStringsHd :: rightStrings
, leftLinesHd :: rightLines
, textLength
, lineLength
)
| (_, _) =>
(* Right strings and lines are empty, so can't join. *)
deleteLeftFromHere
( start
, prevIdx
, curLine - Vector.length leftLinesHd
, leftStringsTl
, leftLinesTl
, [leftStringsHd]
, [leftLinesHd]
, textLength
, lineLength
))
end
| (_, _) =>
(* Can't move further leftward so just return. *)
{ idx = 0
, textLength = textLength
, line = 0
, lineLength = lineLength
, leftStrings = []
, leftLines = []
, rightStrings = rightStrings
, rightLines = rightLines
}
fun del
( start
, finish
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) =
if start > curIdx then
moveRightAndDelete
( start
, finish
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
else if start < curIdx then
if finish <= curIdx then
moveLeftAndDelete
( start
, finish
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
else
deleteFromLetAndRight
( start
, finish
, curIdx
, curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
else
deleteRightFromHere
( curIdx
, curLine
, curIdx
, finish
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
in
fun delete (start, length, buffer: t) =
if length > 0 then
del
( start
, start + length
, #idx buffer
, #line buffer
, #leftStrings buffer
, #leftLines buffer
, #rightStrings buffer
, #rightLines buffer
, #textLength buffer
, #lineLength buffer
)
else
buffer
end
fun subRight (findIdx, curIdx, hd, tl) =
let
val nextIdx = curIdx + String.size hd
in
if findIdx > nextIdx - 1 then
case tl of
hd :: tl => subRight (findIdx, nextIdx, hd, tl)
| [] => raise Fail "not found"
else
let val strIdx = findIdx - curIdx
in String.sub (hd, strIdx)
end
end
fun subLeft (findIdx, curIdx, hd, tl) =
let
val prevIdx = curIdx - String.size hd
in
if findIdx < prevIdx then
case tl of
hd :: tl => subLeft (findIdx, prevIdx, hd, tl)
| [] => raise Fail "not found"
else
let val strIdx = findIdx - prevIdx
in String.sub (hd, strIdx)
end
end
fun sub (findIdx, buffer: t) =
if findIdx >= #idx buffer then
case #rightStrings buffer of
hd :: tl => subRight (findIdx, #idx buffer, hd, tl)
| [] => raise Fail "not found"
else
case #leftStrings buffer of
hd :: tl => subLeft (findIdx, #idx buffer, hd, tl)
| [] => raise Fail "not found"
local
fun consIfNotEmpty (s, acc) =
if String.size s > 0 then s :: acc else acc
(* We build up the string list and, at the end,
* we always make sure to reverse the list too
* because the order of the list matters for String.concat *)
fun subRightFromHere (curIdx, finish, right, acc, endWith) =
case right of
hd :: tl =>
let
val nextIdx = curIdx + String.size hd
in
if nextIdx < finish then
subRightFromHere (curIdx, finish, tl, hd :: acc, endWith)
else if nextIdx > finish then
let
val length = finish - curIdx
val accHd = String.substring (hd, 0, length)
val acc = consIfNotEmpty (endWith, accHd :: acc)
in
List.rev acc
end
else
(* nextIdx = finish
* so add current hd to vec and then concat *)
let
val acc = hd :: acc
val acc = consIfNotEmpty (endWith, acc)
in
List.rev acc
end
end
| [] => let val acc = consIfNotEmpty (endWith, acc) in List.rev acc end
fun moveRightAndSub (start, finish, curIdx, right, endWith) =
case right of
hd :: tl =>
let
val nextIdx = curIdx + String.size hd
in
if nextIdx < start then
(* continue moving rightwards *)
moveRightAndSub (start, finish, nextIdx, tl, endWith)
else if nextIdx > start then
if nextIdx < finish then
(* get starting acc,
* and then call subRightFromHere *)
let
val substart = start - curIdx
val length = String.size hd - substart
val acc = [String.substring (hd, substart, length)]
val acc = subRightFromHere (nextIdx, finish, tl, acc, endWith)
in
String.concat acc
end
else if nextIdx > finish then
(* have to get susbstring from middle of this string *)
let
val substart = start - curIdx
val subfinish = finish - curIdx
val length = subfinish - substart
val str = String.substring (hd, substart, length)
in
if String.size endWith > 0 then str ^ endWith else str
end
else
(* have to get substring from middle to end *)
let
val substart = start - curIdx
val length = String.size hd - substart
val str = String.substring (hd, substart, length)
in
if String.size endWith > 0 then str ^ endWith else str
end
else
(* nextIdx = start
* so we have to ignore this string
* and start building acc from tl *)
let val acc = subRightFromHere (nextIdx, finish, tl, [], endWith)
in String.concat acc
end
end
| [] =>
(* if there are no strings to the right,
* return empty string,
* as we cannot do much else. *)
endWith
fun subLeftFromHere (start, curIdx, left, acc) =
case left of
hd :: tl =>
let
val prevIdx = curIdx - String.size hd
in
if start < prevIdx then
(* continue *)
subLeftFromHere (start, prevIdx, tl, hd :: acc)
else if start > prevIdx then
(* need to add some part of this string to acc
* and return *)
let
val substart = start - prevIdx
val length = String.size hd - substart
val accHd = String.substring (hd, substart, length)
val acc = accHd :: acc
in
String.concat acc
end
else
(* start = prevIdx
* add hd to acc and return *)
let val acc = hd :: acc
in String.concat acc
end
end
| [] => String.concat acc
fun subFromLeftAndRight (start, finish, curIdx, left, right, endWith) =
let val acc = subRightFromHere (curIdx, finish, right, [], endWith)
in subLeftFromHere (start, curIdx, left, acc)
end
fun moveLeftAndSub (start, finish, curIdx, left, endWith) =
case left of
hd :: tl =>
let
val prevIdx = curIdx - String.size hd
in
if prevIdx > finish then
(* continue *)
moveLeftAndSub (start, finish, prevIdx, tl, endWith)
else if prevIdx < finish then
if prevIdx > start then
(* get initial acc
* and continue substring leftwards *)
let
val length = finish - prevIdx
val str = String.substring (hd, 0, length)
val acc = [str, endWith]
in
subLeftFromHere (start, prevIdx, tl, acc)
end
else if prevIdx < start then
(* we want to return a substring
* extracted from the middle of hd *)
let
val substart = start - prevIdx
val subfinish = finish - prevIdx
val length = subfinish - substart
val str = String.substring (hd, substart, length)
in
if String.size endWith > 0 then str ^ endWith else str
end
else
(* prevIdx = start
* we want to return a substring starting from 0 *)
let
val subfinish = finish - prevIdx
val length = String.size hd - subfinish
val str = String.substring (hd, 0, length)
in
if String.size endWith > 0 then str ^ endWith else str
end
else
(* prevIdx = finish
* so we want to ignore hd and start
* subLeftFromHere with an empty list *)
subLeftFromHere (start, prevIdx, tl, [endWith])
end
| [] => endWith
fun sub (start, finish, curIdx, left, right, endWith) =
if start > curIdx then
(* move rightwards to begin getting substring *)
moveRightAndSub (start, finish, curIdx, right, endWith)
else if start < curIdx then
if finish <= curIdx then
moveLeftAndSub (start, finish, curIdx, left, endWith)
else
(* in middle of buffer we want to get substring from *)
subFromLeftAndRight (start, finish, curIdx, left, right, endWith)
else
let
(* start = curIdx so only need to traverse right *)
val acc = subRightFromHere (curIdx, finish, right, [], endWith)
in
String.concat acc
end
in
fun substringWithEnd (start, length, buffer: t, endWith) =
let
val finish = start + length
val {idx, leftStrings, rightStrings, ...} = buffer
in
sub (start, finish, idx, leftStrings, rightStrings, endWith)
end
fun nullSubstring (start, length, buffer: t) =
let
val finish = start + length
val {idx, leftStrings, rightStrings, ...} = buffer
in
sub (start, finish, idx, leftStrings, rightStrings, "\u0000")
end
fun substring (start, length, buffer: t) =
let
val finish = start + length
val {idx, leftStrings, rightStrings, ...} = buffer
in
sub (start, finish, idx, leftStrings, rightStrings, "")
end
end
fun helpGoToStart
( idx
, line
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) =
case (leftStrings, leftLines) of
(lStrHd :: lStrTl, lLnHd :: lLnTl) =>
(case (rightStrings, rightLines) of
(rStrHd :: rStrTl, rLnHd :: rLnTl) =>
if isInLimit (lStrHd, rStrHd, lLnHd, rLnHd) then
(* join if possible *)
let
val newRstrHd = lStrHd ^ rStrHd
val newRlnHd =
Vector.tabulate
( Vector.length lLnHd + Vector.length rLnHd
, fn lnIdx =>
if lnIdx < Vector.length lLnHd then
Vector.sub (lLnHd, lnIdx)
else
Vector.sub (rLnHd, lnIdx - Vector.length lLnHd)
+ String.size lStrHd
)
in
helpGoToStart
( idx - String.size lStrHd
, line - Vector.length lLnHd
, lStrTl
, lLnTl
, newRstrHd :: rStrTl
, newRlnHd :: rLnTl
, textLength
, lineLength
)
end
else
helpGoToStart
( idx - String.size lStrHd
, line - Vector.length lLnHd
, lStrTl
, lLnTl
, lStrHd :: rightStrings
, lLnHd :: rightLines
, textLength
, lineLength
)
| (_, _) =>
(* rightStrings and rightLines are both empty *)
helpGoToStart
( idx - String.size lStrHd
, line - Vector.length lLnHd
, lStrTl
, lLnTl
, [lStrHd]
, [lLnHd]
, textLength
, lineLength
))
| (_, _) =>
(* left strings are empty, meaning we are at start and can return *)
{ idx = idx
, textLength = textLength
, line = line
, lineLength = lineLength
, leftStrings = []
, leftLines = []
, rightStrings = rightStrings
, rightLines = rightLines
}
fun goToStart (buffer: t) =
let
val
{ idx
, line
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
} = buffer
in
helpGoToStart
( idx
, line
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
end
fun helpGoToEnd
( idx
, line
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) =
2024-10-30 10:23:55 +00:00
case (rightStrings, rightLines) of
(rStrHd :: rStrTl, rLnHd :: rLnTl) =>
(case (leftStrings, leftLines) of
(lStrHd :: lStrTl, lLnHd :: lLnTl) =>
if isInLimit (lStrHd, rStrHd, lLnHd, rLnHd) then
(* join if possible *)
let
val newLstrHd = lStrHd ^ rStrHd
val newLlnHd =
Vector.tabulate
( Vector.length lLnHd + Vector.length rLnHd
, fn lnIdx =>
if lnIdx < Vector.length lLnHd then
Vector.sub (lLnHd, lnIdx)
else
Vector.sub (rLnHd, lnIdx - Vector.length lLnHd)
+ String.size lStrHd
)
in
helpGoToEnd
( idx + String.size rStrHd
, line + Vector.length rLnHd
, newLstrHd :: lStrTl
, newLlnHd :: lLnTl
, rStrTl
, rLnTl
, textLength
, lineLength
2024-10-30 10:23:55 +00:00
)
end
else
helpGoToEnd
( idx + String.size rStrHd
, line + Vector.length rLnHd
, rStrHd :: leftStrings
, rLnHd :: leftLines
, rStrTl
, rLnTl
, textLength
, lineLength
2024-10-30 10:23:55 +00:00
)
| (_, _) =>
(* rightStrings and rightLines are both empty *)
helpGoToEnd
( idx + String.size rStrHd
, line + Vector.length rLnHd
, rStrHd :: leftStrings
, rLnHd :: leftLines
, rStrTl
, rLnTl
, textLength
, lineLength
2024-10-30 10:23:55 +00:00
))
| (_, _) =>
(* rightStrings strings are empty, meaning we are at end and can return *)
{ idx = idx
, textLength = textLength
2024-10-30 10:23:55 +00:00
, line = line
, lineLength = lineLength
2024-10-30 10:23:55 +00:00
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = []
, rightLines = []
}
fun goToEnd (buffer: t) =
let
val
{ idx
, line
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
} = buffer
in
helpGoToEnd
( idx
, line
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
end
2024-10-30 10:23:55 +00:00
(* function to abstract leftwards movement.
* if the left hd and the right hd can be joined in one node
* during movement, while staying in limit, then join and move.
* Else, move without joining.
* The code to do this is a bit boiler-plate heavy
* so it has been abstracted to a reusable function.
*
* The last parameter, fGoLeft, is the function to return to
* after the leftwards movement.
*
* The third paremeter, searchTo, is the line number or UTF-8
* index to search. Since moveLeft is meant to abstract over
* the search number, this parameter is just passed to fGoLeft.
* *)
fun moveLeft
( idx
, line
, searchTo
, rightStrings
, rightLines
, lStrHd
, lStrTl
, lLnHd
, lLnTl
, textLength
, lineLength
, fGoLeft
) =
case (rightStrings, rightLines) of
(rStrHd :: rStrTl, rLnHd :: rLnTl) =>
if isInLimit (lStrHd, rStrHd, lLnHd, rLnHd) then
(* join into a single node before moving *)
let
val newRstrHd = lStrHd ^ rStrHd
val newRlnHd =
Vector.tabulate
( Vector.length lLnHd + Vector.length rLnHd
, fn lnIdx =>
if lnIdx < Vector.length lLnHd then
Vector.sub (lLnHd, lnIdx)
else
Vector.sub (rLnHd, lnIdx - Vector.length lLnHd)
+ String.size lStrHd
)
in
fGoLeft
( idx - String.size lStrHd
, line - Vector.length lLnHd
, searchTo
, lStrTl
, lLnTl
, newRstrHd :: rStrTl
, newRlnHd :: rLnTl
, textLength
, lineLength
)
end
else
(* move without joining *)
fGoLeft
( idx - String.size lStrHd
, line - Vector.length lLnHd
, searchTo
, lStrTl
, lLnTl
, lStrHd :: rightStrings
, lLnHd :: rightLines
, textLength
, lineLength
)
| (_, _) =>
(* right side is empty, so just move left without joining *)
fGoLeft
( idx - String.size lStrHd
, line - Vector.length lLnHd
, searchTo
, lStrTl
, lLnTl
, [lStrHd]
, [lLnHd]
, textLength
, lineLength
)
(* same as moveLeft function, except it move rightwards instead *)
fun moveRight
( idx
, line
, searchTo
, leftStrings
, leftLines
, rStrHd
, rStrTl
, rLnHd
, rLnTl
, textLength
, lineLength
, fGoRight
) =
case (leftStrings, leftLines) of
(lStrHd :: lStrTl, lLnHd :: lLnTl) =>
if isInLimit (lStrHd, rStrHd, lLnHd, rLnHd) then
(* can join while staying in limit, so join and move right *)
let
val newLstrHd = lStrHd ^ rStrHd
val newLlnHd =
Vector.tabulate
( Vector.length lLnHd + Vector.length rLnHd
, fn lnIdx =>
if lnIdx < Vector.length lLnHd then
Vector.sub (lLnHd, lnIdx)
else
Vector.sub (rLnHd, lnIdx - Vector.length lLnHd)
+ String.size lStrHd
)
in
fGoRight
( idx + String.size rStrHd
, line + Vector.length rLnHd
, searchTo
, newLstrHd :: lStrTl
, newLlnHd :: lLnTl
, rStrTl
, rLnTl
, textLength
, lineLength
)
end
else
(* cannot join while staying in limit, so just move right *)
fGoRight
( idx + String.size rStrHd
, line + Vector.length rLnHd
, searchTo
, rStrHd :: leftStrings
, rLnHd :: leftLines
, rStrTl
, rLnTl
, textLength
, lineLength
)
| (_, _) =>
(* left side is empty, so just move rightwards without joining *)
fGoRight
( String.size rStrHd
, Vector.length rLnHd
, searchTo
, [rStrHd]
, [rLnHd]
, rStrTl
, rLnTl
, textLength
, lineLength
)
fun helpGoToLineLeft
( idx
, line
, searchLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) =
case (leftStrings, leftLines) of
(lStrHd :: lStrTl, lLnHd :: lLnTl) =>
if searchLine >= line - Vector.length lLnHd then
(* line is at left head, so place it to the right and return *)
{ idx = idx - String.size lStrHd
, textLength = textLength
, line = line - Vector.length lLnHd
, lineLength = lineLength
, leftStrings = lStrTl
, leftLines = lLnTl
, rightStrings = lStrHd :: rightStrings
, rightLines = lLnHd :: rightLines
}
else
(* move leftwards, joining if possible *)
moveLeft
( idx
, line
, searchLine
, rightStrings
, rightLines
, lStrHd
, lStrTl
, lLnHd
, lLnTl
, textLength
, lineLength
, helpGoToLineLeft
)
| (_, _) =>
(* left side is empty, so just return *)
{ idx = idx
, textLength = textLength
, line = line
, lineLength = lineLength
, leftStrings = []
, leftLines = []
, rightStrings = rightStrings
, rightLines = rightLines
}
fun helpGoToLineRight
( idx
, line
, searchLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) =
case (rightStrings, rightLines) of
(rStrHd :: rStrTl, rLnHd :: rLnTl) =>
if line + Vector.length rLnHd >= searchLine then
(* searchLine is in rStrHd/rLnHd, so return *)
{ idx = idx
, textLength = textLength
, line = line
, lineLength = lineLength
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = rightStrings
, rightLines = rightLines
}
else
(* have to move rightwards *)
moveRight
( idx
, line
, searchLine
, leftStrings
, leftLines
, rStrHd
, rStrTl
, rLnHd
, rLnTl
, textLength
, lineLength
, helpGoToLineRight
)
| (_, _) =>
(* right side is empty, so just return *)
{ idx = idx
, textLength = textLength
, line = line
, lineLength = lineLength
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = []
, rightLines = []
}
fun goToLine (searchLine, buffer: t) =
let
val
{ idx
, line
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
} = buffer
in
if searchLine <= 0 then
goToStart buffer
else
(* we compare current line with searchLine - 1
* because if searchLine - 1 is here,
* that means we can access the linebreak
* that starts searchLine *)
(if searchLine - 1 < line then
helpGoToLineLeft
( idx
, line
, searchLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
else if searchLine - 1 > line then
helpGoToLineRight
( idx
, line
, searchLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
else
buffer)
end
fun helpGoToIdxLeft
( idx
, line
, searchIdx
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) =
case (leftStrings, leftLines) of
(lStrHd :: lStrTl, lLnHd :: lLnTl) =>
if searchIdx < idx - String.size lStrHd then
(* move leftwards, joining if possible *)
moveLeft
( idx
, line
, searchIdx
, rightStrings
, rightLines
, lStrHd
, lStrTl
, lLnHd
, lLnTl
, textLength
, lineLength
, helpGoToIdxLeft
)
else
(* line is at left head, so place it to the right and return *)
{ idx = idx - String.size lStrHd
, textLength = textLength
, line = line - Vector.length lLnHd
, lineLength = lineLength
, leftStrings = lStrTl
, leftLines = lLnTl
, rightStrings = lStrHd :: rightStrings
, rightLines = lLnHd :: rightLines
}
| (_, _) =>
(* left side is empty, so just return *)
{ idx = idx
, textLength = textLength
, line = line
, lineLength = lineLength
, leftStrings = []
, leftLines = []
, rightStrings = rightStrings
, rightLines = rightLines
}
fun helpGoToIdxRight
( idx
, line
, searchIdx
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
) =
case (rightStrings, rightLines) of
(rStrHd :: rStrTl, rLnHd :: rLnTl) =>
if searchIdx > idx + String.size rStrHd then
(* have to move rightwards *)
moveRight
( idx
, line
, searchIdx
, leftStrings
, leftLines
, rStrHd
, rStrTl
, rLnHd
, rLnTl
, textLength
, lineLength
, helpGoToIdxRight
)
else
(* searchLine is in rStrHd/rLnHd, so return *)
{ idx = idx
, textLength = textLength
, line = line
, lineLength = lineLength
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = rightStrings
, rightLines = rightLines
}
| (_, _) =>
(* right side is empty, so just return *)
{ idx = idx
, textLength = textLength
, line = line
, lineLength = lineLength
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = []
, rightLines = []
}
fun goToIdx (searchIdx, buffer: t) =
let
val
{ idx
, line
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
} = buffer
in
if searchIdx < idx then
helpGoToIdxLeft
( idx
, line
, searchIdx
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
else if searchIdx > idx then
helpGoToIdxRight
( idx
, line
, searchIdx
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
)
else
buffer
end
fun idxToLineNumberLeft (findIdx, curIdx, curLine, leftStrings, leftLines) =
case (leftStrings, leftLines) of
(shd :: stl, lhd :: ltl) =>
let
val prevIdx = curIdx - String.size shd
in
if findIdx = prevIdx then
curLine - Vector.length lhd
else if findIdx > prevIdx then
(* bin search vector *)
if Vector.length lhd = 0 then
curLine
else
let
val prevLine = curLine - Vector.length lhd
val relativeIdx = findIdx - prevIdx - 1
val relativeLine = binSearch (relativeIdx, lhd) + 1
in
prevLine + relativeLine
end
else
let val prevLine = curLine - Vector.length lhd
in idxToLineNumberLeft (findIdx, prevIdx, prevLine, stl, ltl)
end
end
| (_, _) => 0
fun idxToLineNumberRight (findIdx, curIdx, curLine, rightStrings, rightLines) =
case (rightStrings, rightLines) of
(shd :: stl, lhd :: ltl) =>
let
val nextIdx = curIdx + String.size shd
in
if findIdx = nextIdx then
curLine + Vector.length lhd
else if findIdx < nextIdx then
if Vector.length lhd = 0 then
curLine
else
let
val relativeIdx = findIdx - curIdx - 1
val relativeLine = binSearch (relativeIdx, lhd) + 1
in
curLine + relativeLine
end
else
let val nextLine = curLine + Vector.length lhd
in idxToLineNumberRight (findIdx, nextIdx, nextLine, stl, ltl)
end
end
| (_, _) => curLine
fun idxToLineNumber (findIdx, buffer: t) =
let
val
{ idx = curIdx
, leftStrings
, leftLines
, rightStrings
, rightLines
, line = curLine
, ...
} = buffer
in
if findIdx < curIdx then
idxToLineNumberLeft (findIdx, curIdx, curLine, leftStrings, leftLines)
else if findIdx > curIdx then
idxToLineNumberRight
(findIdx, curIdx, curLine, rightStrings, rightLines)
else
curLine
end
fun lineNumberToIdxLeft (findLine, curIdx, curLine, leftStrings, leftLines) =
case (leftStrings, leftLines) of
(shd :: stl, lhd :: ltl) =>
let
val prevLine = curLine - Vector.length lhd
val prevIdx = curIdx - String.size shd
in
if findLine >= prevLine then
let
val relativeLine = findLine - prevLine - 1
in
if relativeLine < 0 then
(* the line start is not at this node,
* so we need to continue going left
* to find what index the line start corresponds to *)
lineNumberToIdxLeft (findLine, prevIdx, prevLine, stl, ltl)
else
Vector.sub (lhd, relativeLine) + prevIdx
end
else
lineNumberToIdxLeft (findLine, prevIdx, prevLine, stl, ltl)
end
| (_, _) => 0
fun lineNumberToIdxRight (findLine, curIdx, curLine, rightStrings, rightLines) =
case (rightStrings, rightLines) of
(shd :: stl, lhd :: ltl) =>
let
val nextLine = curLine + Vector.length lhd
in
if findLine <= nextLine then
let val relativeLine = findLine - curLine - 1
in Vector.sub (lhd, relativeLine) + curIdx
end
else
lineNumberToIdxRight
(findLine, curIdx + String.size shd, nextLine, stl, ltl)
end
| (_, _) => curIdx
fun lineNumberToIdx (findLine, buffer: t) =
let
val
{ idx = curIdx
, line = curLine
, leftStrings
, leftLines
, rightStrings
, rightLines
, ...
} = buffer
in
if findLine = 0 then
0
else if findLine - 1 < curLine then
lineNumberToIdxLeft (findLine, curIdx, curLine, leftStrings, leftLines)
else
lineNumberToIdxRight
(findLine, curIdx, curLine, rightStrings, rightLines)
end
type string_iterator =
{ idx: int
, leftStrings: string list
, rightStrings: string list
, textLength: int
}
fun makeStringIterator ({idx, leftStrings, rightStrings, textLength, ...}: t) =
{ idx = idx
, leftStrings = leftStrings
, rightStrings = rightStrings
, textLength = textLength
}
fun moveIteratorLeft (findIdx, idx, leftStrings, rightStrings, textLength) =
case leftStrings of
hd :: tl =>
let
val prevIdx = idx - String.size hd
in
if findIdx < prevIdx then
moveIteratorLeft
(findIdx, prevIdx, tl, hd :: rightStrings, textLength)
else
{ idx = idx
, leftStrings = leftStrings
, rightStrings = rightStrings
, textLength = textLength
}
end
| [] =>
{ idx = idx
, leftStrings = leftStrings
, rightStrings = rightStrings
, textLength = textLength
}
fun moveIteratorRight (findIdx, idx, leftStrings, rightStrings, textLength) =
case rightStrings of
hd :: tl =>
let
val nextIdx = idx + String.size hd
in
if findIdx > nextIdx then
moveIteratorRight
(findIdx, nextIdx, hd :: leftStrings, tl, textLength)
else
{ idx = idx
, leftStrings = leftStrings
, rightStrings = rightStrings
, textLength = textLength
}
end
| [] =>
{ idx = idx
, leftStrings = leftStrings
, rightStrings = rightStrings
, textLength = textLength
}
fun moveIteratorToIdx (findIdx, {idx, leftStrings, rightStrings, textLength}) =
if findIdx < idx then
moveIteratorLeft (findIdx, idx, leftStrings, rightStrings, textLength)
else
moveIteratorRight (findIdx, idx, leftStrings, rightStrings, textLength)
fun subIterator (findIdx, {idx, leftStrings, rightStrings, textLength = _}) =
if findIdx >= idx then
case rightStrings of
hd :: tl => subRight (findIdx, idx, hd, tl)
| [] => raise Fail "not found"
else
case leftStrings of
hd :: tl => subLeft (findIdx, idx, hd, tl)
| [] => raise Fail "not found"
(* TEST CODE *)
local
fun lineBreaksToString vec =
(Vector.foldr (fn (el, acc) => Int.toString el ^ ", " ^ acc) "" vec)
^ "\n"
fun checkLineBreaks (v1, v2) =
if v1 = v2 then
()
else
let
val _ = print ("broken: " ^ (lineBreaksToString v1))
val _ = print ("fixed: " ^ (lineBreaksToString v2))
in
()
end
fun goToStart (leftStrings, leftLines, accStrings, accLines) =
case (leftStrings, leftLines) of
(lsHd :: lsTl, llHd :: llTl) =>
goToStart (lsTl, llTl, lsHd :: accStrings, llHd :: accLines)
| (_, _) => (accStrings, accLines)
fun isLineListCorrect (strings, lines) =
case (strings, lines) of
(strHd :: strTl, lHd :: lTl) =>
let
val checkLines = countLineBreaks strHd
in
if checkLines = lHd then
isLineListCorrect (strTl, lTl)
else
let
val _ = print "line metadata is incorrect\n"
val _ = checkLineBreaks (lHd, checkLines)
in
false
end
end
| (_, _) => (print "verified lines; no problems\n"; true)
in
fun verifyLines (buffer: t) =
let
val (strings, lines) =
goToStart
( #leftStrings buffer
, #leftLines buffer
, #rightStrings buffer
, #rightLines buffer
)
val lineListIsCorrect = isLineListCorrect (strings, lines)
val lineLengthIsCorrect = let val lines = Vector.concat lines
in Vector.length lines = #lineLength buffer
end
val () =
if lineLengthIsCorrect then () else print "line length is incorrect\n"
in
if lineLengthIsCorrect andalso lineListIsCorrect then ()
else raise Fail ""
end
end
local
fun calcIndexList (accIdx, lst) =
case lst of
[] => accIdx
| hd :: tl => calcIndexList (String.size hd + accIdx, tl)
fun calcIndexStart lst = calcIndexList (0, lst)
in
fun verifyIndex (buffer: t) =
let
val bufferIdx = #idx buffer
val correctIdx = calcIndexStart (#leftStrings buffer)
val idxIsCorrect = bufferIdx = correctIdx
val {rightLines, rightStrings, ...} = goToStart buffer
val textLength = #textLength buffer
val correctTextLength = String.size (String.concat rightStrings)
val textLengthIsCorrect = textLength = correctTextLength
val lineLength = #lineLength buffer
val correctLineLength = Vector.length (Vector.concat rightLines)
val lineLengthIsCorrect = lineLength = correctLineLength
val _ =
if idxIsCorrect then
print "idx is correct\n"
else
let
val msg = String.concat
[ "idx is incorrect;"
, "bufferIdx: "
, Int.toString bufferIdx
, "; correctIdx: "
, Int.toString correctIdx
, "\n"
]
in
print msg
end
val _ =
if textLengthIsCorrect then
print "textLength is correct\n"
else
let
val msg = String.concat
[ "text length is incorrect;"
, "text length: "
, Int.toString textLength
, "; correct length: "
, Int.toString correctTextLength
, "\n"
]
in
print msg
end
val _ =
if lineLengthIsCorrect then
print "lineLength is correct\n"
else
let
val msg = String.concat
[ "line length is incorrect;"
, "line length: "
, Int.toString lineLength
, "; correct length: "
, Int.toString correctLineLength
, "\n"
]
in
print msg
end
val () = print "\n"
in
if textLengthIsCorrect andalso idxIsCorrect andalso lineLengthIsCorrect then
()
else
raise Fail "either index or idx metadata or text length is incorrect"
end
end
end