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 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