humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
96f0afc2b29e68f0cd04c9e0ce683d1cf002a7aa
sml-projects/temp.txt

3575 lines
120 KiB
Plaintext
Raw Blame History

signature LINE_GAP =
sig
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 empty: t
val fromString: string -> t
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
val delete: int * int * t -> t
val insert: int * string * t -> t
val append: string * t -> t
val goToStart: t -> t
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
(* 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
(* Binary search. If value isn't found, returns the value before it. *)
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
in
fun binSearch (findNum, lines) =
if Vector.length lines = 0 then 0
else helpBinSearch (findNum, lines, 0, Vector.length lines - 1)
end
(* 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
else
let
val curVal = Vector.sub (lines, idx)
in
if curVal > findNum then idx
else forwardLinearSearch (findNum, idx + 1, 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 if mid >= 0 then
forwardLinearSearch (findNum, mid, lines)
else
0
end
in
fun forwardBinSearch (findNum, lines) =
if Vector.length lines = 0 then 0
else helpBinSearch (findNum, lines, 0, Vector.length lines - 1)
end
(* 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 []
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. *)
let
val newRightStringsHd = rightStringsHd ^ newString
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
)
in
{ idx = curIdx
, textLength = textLength
, line = curLine
, lineLength = lineLength
, leftStrings = leftStrings
, leftLines = leftLines
, rightStrings = newRightStringsHd :: rightStringsTl
, rightLines = newRightLinesHd :: rightLinesTl
}
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 =
Vector.tabulate
( (Vector.length newLines + Vector.length rightLinesHd)
- Vector.length newLeftLinesHd
, 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
)
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
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
)
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
, 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
fun helpGoToEndAndAppend
( newString
, newLines
, idx
, leftStrings
, rightStrings
, line
, leftLines
, rightLines
, textLength
, lineLength
) =
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
)
end
else
helpGoToEndAndAppend
( newString
, newLines
, idx + String.size rStrHd
, rStrHd :: leftStrings
, rStrTl
, line + Vector.length rLnHd
, rLnHd :: leftLines
, rLnTl
, textLength
, lineLength
)
| (_, _) =>
(* left side is empty; we are at start *)
helpGoToEndAndAppend
( newString
, newLines
, String.size rStrHd
, [rStrHd]
, rStrTl
, Vector.length rLnHd
, [rLnHd]
, rLnTl
, textLength
, lineLength
))
| (_, _) =>
(* 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
, line = line + Vector.length newLines
, lineLength = lineLength
, leftStrings = newLstrHd :: lStrTl
, leftLines = newLlnHd :: lLnTl
, rightStrings = []
, rightLines = []
}
end
else
{ idx = idx + String.size newString
, textLength = textLength
, line = line + Vector.length newLines
, lineLength = lineLength
, leftStrings = newString :: leftStrings
, leftLines = newLines :: leftLines
, rightStrings = []
, rightLines = []
}
| (_, _) =>
{ idx = idx + String.size newString
, textLength = textLength
, line = line + Vector.length newLines
, lineLength = lineLength
, leftStrings = newString :: leftStrings
, leftLines = newLines :: leftLines
, rightStrings = []
, rightLines = []
})
fun append (newString, buffer) =
let
val
{ idx
, line
, leftStrings
, leftLines
, rightStrings
, rightLines
, textLength
, lineLength
} = buffer
val newTextLength = textLength + String.size newString
val newLines = countLineBreaks newString
val newLineLength = lineLength + Vector.length newLines
in
helpGoToEndAndAppend
( newString
, newLines
, idx
, leftStrings
, rightStrings
, line
, leftLines
, rightLines
, newTextLength
, newLineLength
)
end
(* 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
)
(* Delete from line vector if we need to. *)
val newLines =
if Vector.length rightLinesHd > 0 then
let
val lineDeleteStart =
forwardBinSearch (newStrStart, rightLinesHd)
in
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
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 = []
}
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)
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
)
end
else
(* Can't join new string with left head
* while staying in limit, so just cons. *)
deleteRightFromHere
( curIdx + String.size newString
, curLine + Vector.length newLines
, nextIdx
, finish
, newString :: leftStrings
, newLines :: leftLines
, 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 =
if sub1LineEnd < 0 orelse Vector.length rightLinesHd = 0 then
Vector.fromList []
else
let
val slice = VectorSlice.slice
(rightLinesHd, 0, SOME (sub1LineEnd + 1))
in
VectorSlice.vector slice
end
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 =
if midpoint < 0 orelse Vector.length rightLinesHd = 0 then
Vector.fromList []
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
)
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
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
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
) =
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
)
end
else
helpGoToEnd
( idx + String.size rStrHd
, line + Vector.length rLnHd
, rStrHd :: leftStrings
, rLnHd :: leftLines
, rStrTl
, rLnTl
, textLength
, lineLength
)
| (_, _) =>
(* rightStrings and rightLines are both empty *)
helpGoToEnd
( idx + String.size rStrHd
, line + Vector.length rLnHd
, rStrHd :: leftStrings
, rLnHd :: leftLines
, rStrTl
, rLnTl
, textLength
, lineLength
))
| (_, _) =>
(* rightStrings strings are empty, meaning we are at end and can return *)
{ idx = idx
, textLength = textLength
, line = line
, lineLength = lineLength
, 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
(* 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
(* 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 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 - 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
gut feeling
Reference in New Issue View Git Blame Copy Permalink