diff --git a/fcore/search-list/dfa-gen.sml b/fcore/search-list/dfa-gen.sml index d41ed18..e4d7f0a 100644 --- a/fcore/search-list/dfa-gen.sml +++ b/fcore/search-list/dfa-gen.sml @@ -337,9 +337,20 @@ struct end else getFollowsForPositionAndChar (r, pos, curChr) - | ZERO_OR_ONE child => - getFollowsForPositionAndCharLoop (pos, regex, child, curChr) | ZERO_OR_MORE child => + let + val result = getFollowsForPositionAndChar (child, pos, curChr) + val {sawConcat, follows, charIsMatch} = result + in + if charIsMatch then + { sawConcat = false + , follows = firstpos (child, follows) + , charIsMatch = true + } + else + result + end + | ZERO_OR_ONE child => getFollowsForPositionAndCharLoop (pos, regex, child, curChr) | ONE_OR_MORE child => getFollowsForPositionAndCharLoop (pos, regex, child, curChr) diff --git a/temp.txt b/temp.txt index f323960..cba94ed 100644 --- a/temp.txt +++ b/temp.txt @@ -1,3398 +1,3 @@ -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 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 - - (* 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 - (* 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 - - 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 - - (* 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 +hello +fellow +yellow