From 96f0afc2b29e68f0cd04c9e0ce683d1cf002a7aa Mon Sep 17 00:00:00 2001 From: Humza Shahid Date: Sat, 11 Oct 2025 11:32:30 +0100 Subject: [PATCH] attempt at fixing dfa-gen to convert properly --- fcore/search-list/dfa-gen.sml | 414 ++-- temp.txt | 3573 +++++++++++++++++++++++++++++++++ 2 files changed, 3721 insertions(+), 266 deletions(-) diff --git a/fcore/search-list/dfa-gen.sml b/fcore/search-list/dfa-gen.sml index 39082c3..d0aa86f 100644 --- a/fcore/search-list/dfa-gen.sml +++ b/fcore/search-list/dfa-gen.sml @@ -22,26 +22,14 @@ end functor MakeDfaGen(Fn: DFA_GEN_PARAMS): DFA_GEN = struct datatype parse_tree = - CHAR_LITERAL of {char: char, position: int, follows: int list} - | WILDCARD of {position: int, follows: int list} - | IS_ANY_CHARACTER of {chars: char vector, position: int, follows: int list} - | NOT_ANY_CHARACTER of {chars: char vector, position: int, follows: int list} + CHAR_LITERAL of {char: char, position: int} + | WILDCARD of int + | IS_ANY_CHARACTER of {chars: char vector, position: int} + | NOT_ANY_CHARACTER of {chars: char vector, position: int} | CONCAT of - { l: parse_tree - , r: parse_tree - , leftMaxState: int - , rightMaxState: int - , firstpos: int list - , lastpos: int list - } + {l: parse_tree, r: parse_tree, leftMaxState: int, rightMaxState: int} | ALTERNATION of - { l: parse_tree - , r: parse_tree - , leftMaxState: int - , rightMaxState: int - , firstpos: int list - , lastpos: int list - } + {l: parse_tree, r: parse_tree, leftMaxState: int, rightMaxState: int} | ZERO_OR_ONE of parse_tree | ZERO_OR_MORE of parse_tree | ONE_OR_MORE of parse_tree @@ -66,29 +54,50 @@ struct fun firstpos (tree, acc) = case tree of CHAR_LITERAL {position, ...} => position :: acc - | WILDCARD {position, ...} => position :: acc | IS_ANY_CHARACTER {position, ...} => position :: acc | NOT_ANY_CHARACTER {position, ...} => position :: acc - | CONCAT {firstpos = fp, ...} => fp @ acc - | ALTERNATION {firstpos = fp, ...} => fp @ acc - | ZERO_OR_ONE tree => firstpos (tree, acc) - | ZERO_OR_MORE tree => firstpos (tree, acc) - | ONE_OR_MORE tree => firstpos (tree, acc) - | GROUP tree => firstpos (tree, acc) + | WILDCARD i => i :: acc + + | CONCAT {l, r, ...} => + if isNullable l then + let val acc = firstpos (l, acc) + in firstpos (r, acc) + end + else + firstpos (l, acc) + | ALTERNATION {l, r, ...} => + let val acc = firstpos (l, acc) + in firstpos (r, acc) + end + + | ZERO_OR_ONE regex => firstpos (regex, acc) + | ZERO_OR_MORE regex => firstpos (regex, acc) + | ONE_OR_MORE regex => firstpos (regex, acc) + | GROUP regex => firstpos (regex, acc) fun lastpos (tree, acc) = case tree of CHAR_LITERAL {position, ...} => position :: acc - | WILDCARD {position, ...} => position :: acc | IS_ANY_CHARACTER {position, ...} => position :: acc | NOT_ANY_CHARACTER {position, ...} => position :: acc - | CONCAT {lastpos = lp, ...} => lp @ acc - | ALTERNATION {lastpos = lp, ...} => lp @ acc - | ZERO_OR_ONE tree => lastpos (tree, acc) - | ZERO_OR_MORE tree => lastpos (tree, acc) - | ONE_OR_MORE tree => lastpos (tree, acc) - | GROUP tree => lastpos (tree, acc) + | WILDCARD i => i :: acc + | CONCAT {l, r, ...} => + if isNullable r then + let val acc = lastpos (l, acc) + in lastpos (r, acc) + end + else + lastpos (r, acc) + | ALTERNATION {l, r, ...} => + let val acc = lastpos (l, acc) + in lastpos (r, acc) + end + + | ZERO_OR_ONE regex => lastpos (regex, acc) + | ZERO_OR_MORE regex => lastpos (regex, acc) + | ONE_OR_MORE regex => lastpos (regex, acc) + | GROUP regex => lastpos (regex, acc) structure Set = struct @@ -156,6 +165,19 @@ struct fun keysToList tree = helpKeysToList (tree, []) + fun helpValuesToList (tree, acc) = + case tree of + BRANCH (l, _, v, r) => + let + val acc = helpValuesToList (r, acc) + val acc = v :: acc + in + helpValuesToList (l, acc) + end + | LEAF => acc + + fun valuesToList tree = helpValuesToList (tree, []) + fun map (f, tree) = case tree of BRANCH (l, key, value, r) => @@ -178,6 +200,17 @@ struct foldl (f, r, acc) end | LEAF => acc + + fun foldr (f, tree, acc) = + case tree of + BRANCH (l, k, v, r) => + let + val acc = foldr (f, r, acc) + val acc = f (v, acc) + in + foldr (f, l, acc) + end + | LEAF => acc end structure ParseDfa = @@ -363,9 +396,7 @@ struct case getCharsInBrackets (pos, str, []) of SOME (pos, chars) => let - val node = - IS_ANY_CHARACTER - {chars = chars, position = stateNum + 1, follows = []} + val node = IS_ANY_CHARACTER {chars = chars, position = stateNum + 1} in SOME (pos, node, stateNum + 1) end @@ -376,8 +407,7 @@ struct SOME (pos, chars) => let val node = - NOT_ANY_CHARACTER - {chars = chars, position = stateNum + 1, follows = []} + NOT_ANY_CHARACTER {chars = chars, position = stateNum + 1} in SOME (pos, node, stateNum + 1) end @@ -414,9 +444,7 @@ struct NONE else if isValid then let - val chr = - CHAR_LITERAL - {char = chr, position = stateNum + 1, follows = []} + val chr = CHAR_LITERAL {char = chr, position = stateNum + 1} in SOME (pos + 2, chr, stateNum + 1) end @@ -424,7 +452,7 @@ struct NONE end | #"." => - let val w = WILDCARD {position = stateNum + 1, follows = []} + let val w = WILDCARD (stateNum + 1) in SOME (pos + 1, w, stateNum + 1) end | #"[" => @@ -445,12 +473,8 @@ struct if Fn.charIsEqual (chr, Fn.endMarker) then NONE else - let - val chr = - CHAR_LITERAL - {char = chr, position = stateNum + 1, follows = []} - in - SOME (pos + 1, chr, stateNum + 1) + let val chr = CHAR_LITERAL {char = chr, position = stateNum + 1} + in SOME (pos + 1, chr, stateNum + 1) end and climb (pos, str, lhs, level, stateNum) : (int * parse_tree * int) option = @@ -464,26 +488,16 @@ struct else if pos + 1 < String.size str then let val chr = String.sub (str, pos + 1) - val chr = - CHAR_LITERAL - {char = chr, position = stateNum + 1, follows = []} + val chr = CHAR_LITERAL {char = chr, position = stateNum + 1} in case climb (pos + 2, str, chr, altLevel, stateNum + 1) of SOME (pos, rhs, rightStateNum) => let - val fp = let val acc = firstpos (lhs, []) - in firstpos (rhs, acc) - end - val lp = let val acc = lastpos (lhs, []) - in lastpos (rhs, acc) - end val result = ALTERNATION { l = lhs , r = rhs , leftMaxState = stateNum , rightMaxState = rightStateNum - , firstpos = fp - , lastpos = lp } in SOME (pos, result, rightStateNum) @@ -522,29 +536,11 @@ struct (case climb (nextPos, str, curAtom, concatLevel, atomStateNum) of SOME (pos, rhs, rightStateNum) => let - val fp = - if isNullable lhs then - let val acc = firstpos (lhs, []) - in firstpos (rhs, acc) - end - else - firstpos (lhs, []) - - val lp = - if isNullable rhs then - let val acc = lastpos (lhs, []) - in lastpos (rhs, acc) - end - else - lastpos (rhs, []) - val result = CONCAT { l = lhs , r = rhs , leftMaxState = stateNum , rightMaxState = rightStateNum - , firstpos = fp - , lastpos = lp } in SOME (pos, result, rightStateNum) @@ -571,12 +567,8 @@ struct structure ToDfa = struct - fun followpos (char, regex, acc) = - case regex of - CONCAT {r, ...} => firstpos (r, acc) - | ZERO_OR_MORE r => firstpos (r, acc) - | ONE_OR_MORE r => firstpos (r, acc) - | _ => acc + type dstate_element = {marked: bool, transitions: int list} + type dstate_vec = dstate_element vector fun chrExistsInVec (idx, vec, curChr) = if idx = Vector.length vec then @@ -589,112 +581,6 @@ struct orelse chrExistsInVec (idx + 1, vec, curChr) end - (* Does two things: - * 1. Descends to the leaf matching 'pos'. - * 2. If the character at 'pos' matches the current character, - * calls followpos at the appropriate nodes. - * In the end, we get a list of positions to follow. - * Note: The character #"\^@" is an endmarker - * indicating that this is the final state. - * We say that there is no match, - * even if the curChr is the endmarker. *) - fun getFollowsForPositionAndChar (regex: parse_tree, pos, curChr) = - case regex of - CHAR_LITERAL {char, ...} => - let val charIsMatch = Fn.charIsEqual (char, curChr) - in {sawConcat = false, follows = [], charIsMatch = charIsMatch} - end - | WILDCARD _ => - let val isNotEndmarker = Fn.charIsNotEqual (curChr, Fn.endMarker) - in {sawConcat = false, follows = [], charIsMatch = isNotEndmarker} - end - | IS_ANY_CHARACTER {chars, ...} => - let val chrExists = chrExistsInVec (0, chars, curChr) - in {sawConcat = false, follows = [], charIsMatch = chrExists} - end - | NOT_ANY_CHARACTER {chars, ...} => - let - val charIsValid = chrExistsInVec (0, chars, curChr) - val charIsValid = - not charIsValid andalso Fn.charIsNotEqual (curChr, Fn.endMarker) - in - {sawConcat = false, follows = [], charIsMatch = charIsValid} - end - | ALTERNATION {l, r, leftMaxState, rightMaxState, ...} => - let val nodeToFollow = if pos <= leftMaxState then l else r - in getFollowsForPositionAndChar (nodeToFollow, pos, curChr) - end - | GROUP regex => getFollowsForPositionAndChar (regex, pos, curChr) - - | CONCAT {l, r, leftMaxState, ...} => - if pos <= leftMaxState then - let - val result = getFollowsForPositionAndChar (l, pos, curChr) - val {sawConcat, follows, charIsMatch} = result - in - if charIsMatch then - if sawConcat then - (* we already saw a concat and got followpos *) - result - else - let val fp = followpos (curChr, regex, follows) - in {sawConcat = true, follows = fp, charIsMatch = true} - end - else - (* char is not match, so don't get follow pos *) - result - end - else - getFollowsForPositionAndChar (r, pos, 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 => getFollowsForPositionAndChar (child, pos, curChr) - | ONE_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 - - fun getFollowPositionsFromList (lst: int list, regex, char, followSet) = - case lst of - hd :: tl => - let - val fpList = getFollowsForPositionAndChar (regex, hd, char) - val {sawConcat, follows, charIsMatch} = fpList - val follows = - if charIsMatch andalso not sawConcat then - (Char.ord Fn.endMarker) :: follows - else - follows - - val followSet = - List.foldl - (fn (fp, followSet) => Set.insertOrReplace (fp, (), followSet)) - followSet follows - in - getFollowPositionsFromList (tl, regex, char, followSet) - end - | [] => Set.keysToList followSet - fun addKeysToFollowSet (lst, addSet, followSet) = case lst of hd :: tl => @@ -748,12 +634,13 @@ struct | ZERO_OR_ONE child => addToFollowSet (child, followSet) | GROUP child => addToFollowSet (child, followSet) - fun appendIfNew (pos, dstates, newStates) = if pos = Vector.length dstates then let val record = {transitions = newStates, marked = false} val dstates = Vector.concat [dstates, Vector.fromList [record]] + val () = print + ("658 new append = " ^ PolyML.makestring newStates ^ "\n") in (pos, dstates) end @@ -770,7 +657,7 @@ struct NONE else let - val record = Vector.sub (dstates, pos) + val record: dstate_element = Vector.sub (dstates, pos) in if #marked record then getUnmarkedTransitionsIfExists (pos + 1, dstates) @@ -778,11 +665,6 @@ struct SOME (pos, #transitions record) end - (* the int key in dtran refers to the char code - * while the int value refers to the idx from dstates - * that this char transitions to *) - type dtran = int Set.set - fun isCharMatch (regex, pos, curChr) = case regex of CHAR_LITERAL {char, ...} => Fn.charIsEqual (char, curChr) @@ -803,99 +685,99 @@ struct | ONE_OR_MORE child => isCharMatch (child, pos, curChr) | GROUP child => isCharMatch (child, pos, curChr) - fun positionsThatCorrespondToChar (char, curStates, followsForChar, regex) = + fun positionsThatCorrespondToChar (char, curStates, regex, acc, followSet) = case curStates of - [] => Set.keysToList followsForChar + [] => List.concat (Set.valuesToList acc) | pos :: tl => + if isCharMatch (regex, pos, Char.chr char) then + let + (* get union of new and previous follows *) + val prevFollows = Set.getOrDefault (char, acc, []) + val newFollows = Set.getOrDefault (pos, followSet, []) + + val tempSet = Set.addFromList (prevFollows, Set.LEAF) + val tempSet = Set.addFromList (newFollows, tempSet) + val allFollowList = Set.keysToList tempSet + + (* store union of new and previous follows so far *) + val acc = Set.insertOrReplace (char, allFollowList, acc) + in + positionsThatCorrespondToChar (char, tl, regex, acc, followSet) + end + else + positionsThatCorrespondToChar (char, tl, regex, acc, followSet) + + structure Dtran = + struct + (* vector, with idx corresponding to state in dstate, + * an int key which corresponds to char's ascii code, + * and an int value corresponding to state we will transition to *) + type t = int Set.set vector + + fun insert (dStateIdx, char, toStateIdx, dtran: t) = + if dStateIdx = Vector.length dtran then let - val followsForChar = - if isCharMatch (regex, pos, Char.chr char) then - Set.insertOrReplace (pos, (), followsForChar) - else - followsForChar + val el = Set.insertOrReplace (char, toStateIdx, Set.LEAF) + val el = Vector.fromList [el] in - positionsThatCorrespondToChar (char, tl, followsForChar, regex) + Vector.concat [dtran, el] end + else + let + val el = Vector.sub (dtran, dStateIdx) + val el = Set.insertOrReplace (char, toStateIdx, el) + in + Vector.update (dtran, dStateIdx, el) + end + end fun convertChar ( char , regex , dstates - , dtran: dtran vector - , curStates - , curStatesIdx - , setForCurStates + , dtran: Dtran.t + , unmarkedState + , unmarkedIdx , followSet - , followPositionsForAllChars ) = if char < 0 then - let - (* append setForCurStates which was accumulated in this function - * to the end of dtran. *) - val dtran = Vector.concat [dtran, Vector.fromList [setForCurStates]] - in - (dstates, dtran) - end + (dstates, dtran) else let - (* get union of all follow positions that match char *) - val followsForCurrentChr = - positionsThatCorrespondToChar - (char, followPositionsForAllChars, Set.LEAF, regex) + val u = positionsThatCorrespondToChar + (char, unmarkedState, regex, Set.LEAF, followSet) in - case followsForCurrentChr of + case u of [] => - (* no follow positions from here, so don't add to dstates *) convertChar ( char - 1 , regex , dstates , dtran - , curStates - , curStatesIdx - , setForCurStates + , unmarkedState + , unmarkedIdx , followSet - , followPositionsForAllChars ) | _ => let - (* add follow positions to dstates if they are not already inside - * and if follow is not empty *) - val (newStateIdx, dstates) = - appendIfNew (0, dstates, followsForCurrentChr) - - (* update dtran to include transitions for char. *) - val setForCurStates = - Set.insertOrReplace (char, newStateIdx, setForCurStates) + (* dtran is idx -> char -> state_list map *) + val (uIdx, dstates) = appendIfNew (0, dstates, u) + val dtran = Dtran.insert (unmarkedIdx, char, uIdx, dtran) in convertChar ( char - 1 , regex , dstates , dtran - , curStates - , curStatesIdx - , setForCurStates + , unmarkedState + , unmarkedIdx , followSet - , followPositionsForAllChars ) end end - fun getFollowsForUnmarked (unmarked, followsForUnmarked, followSet) = - case unmarked of - [] => List.concat followsForUnmarked - | hd :: tl => - let - val followForHd = Set.getOrDefault (hd, followSet, []) - in - case followForHd of - [] => getFollowsForUnmarked (tl, followsForUnmarked, followSet) - | _ => - let val followsForUnmarked = followForHd :: followsForUnmarked - in getFollowsForUnmarked (tl, followsForUnmarked, followSet) - end - end + fun makeEndmarkerVec i = + if i = Char.ord Fn.endMarker then Char.ord Fn.endMarker else ~1 fun convertLoop (regex, dstates, dtran, followSet) = case getUnmarkedTransitionsIfExists (0, dstates) of @@ -909,10 +791,6 @@ struct Vector.update (dstates, unmarkedIdx, newMark) end - (* get follow positions for all chars *) - val followPositionsForAllChars = - getFollowsForUnmarked (unamarkedTransition, [], followSet) - val (dstates, dtran) = convertChar ( 255 , regex @@ -920,18 +798,23 @@ struct , dtran , unamarkedTransition , unmarkedIdx - , Set.LEAF , followSet - , followPositionsForAllChars ) in convertLoop (regex, dstates, dtran, followSet) end | NONE => - Vector.map - (fn set => - Vector.tabulate (256, fn i => Set.getOrDefault (i, set, ~1))) - dtran + let + val result = + Vector.map + (fn set => + Vector.tabulate (256, fn i => Set.getOrDefault (i, set, ~1))) + dtran + val endMarker = Vector.tabulate (256, makeEndmarkerVec) + val endMarker = Vector.fromList [endMarker] + in + Vector.concat [result, endMarker] + end fun convert regex = let @@ -952,17 +835,13 @@ struct case ParseDfa.parse (str, 0) of SOME (ast, numStates) => let - val fp = firstpos (ast, []) val endMarker = - CHAR_LITERAL - {char = Fn.endMarker, position = numStates + 1, follows = []} + CHAR_LITERAL {char = Fn.endMarker, position = numStates + 1} val ast = CONCAT { l = ast , leftMaxState = numStates , r = endMarker , rightMaxState = numStates + 1 - , firstpos = fp - , lastpos = [] } in ToDfa.convert ast @@ -1040,3 +919,6 @@ structure CaseSensitiveDfa = fun charIsEqual (a: char, b: char) = a = b fun charIsNotEqual (a: char, b: char) = a <> b end) + +val fs = CaseSensitiveDfa.fromString +val s = "(a|b)*abb#" diff --git a/temp.txt b/temp.txt index 8e6ffd9..56d9290 100644 --- a/temp.txt +++ b/temp.txt @@ -1 +1,3574 @@ +signature LINE_GAP = +sig + type t = + { idx: int + , textLength: int + , leftStrings: string list + , rightStrings: string list + + , line: int + , lineLength: int + , leftLines: int vector list + , rightLines: int vector list + } + + val empty: t + + val fromString: string -> t + val toString: t -> string + + val sub: int * t -> char + val substring: int * int * t -> string + val nullSubstring: int * int * t -> string + val substringWithEnd: int * int * t * string -> string + + val delete: int * int * t -> t + val insert: int * string * t -> t + val append: string * t -> t + + val goToStart: t -> t + val goToEnd: t -> t + val goToIdx: int * t -> t + val goToLine: int * t -> t + + val idxToLineNumber: int * t -> int + val lineNumberToIdx: int * t -> int + + type string_iterator = + { idx: int + , leftStrings: string list + , rightStrings: string list + , textLength: int + } + + val makeStringIterator: t -> string_iterator + val moveIteratorToIdx: int * string_iterator -> string_iterator + val subIterator: int * string_iterator -> char + + (* for testing *) + val verifyIndex: t -> unit + val verifyLines: t -> unit +end + +structure LineGap :> LINE_GAP = +struct + local + fun helpCountLineBreaks (pos, acc, str) = + if pos < 0 then + Vector.fromList acc + else + let + val chr = String.sub (str, pos) + in + if chr = #"\n" then + (* Is this a \r\n pair? Then the position of \r should be consed. *) + if pos = 0 then + Vector.fromList (0 :: acc) + else + let + val prevChar = String.sub (str, pos - 1) + in + if prevChar = #"\r" then + helpCountLineBreaks (pos - 2, (pos - 1) :: acc, str) + else + helpCountLineBreaks (pos - 1, pos :: acc, str) + end + else if chr = #"\r" then + helpCountLineBreaks (pos - 1, pos :: acc, str) + else + helpCountLineBreaks (pos - 1, acc, str) + end + in + fun countLineBreaks str = + helpCountLineBreaks (String.size str - 1, [], str) + end + + type t = + { idx: int + , textLength: int + , leftStrings: string list + , rightStrings: string list + + , line: int + , lineLength: int + , leftLines: int vector list + , rightLines: int vector list + } + + val stringLimit = 1024 + val vecLimit = 32 + + val empty = + { idx = 0 + , textLength = 0 + , leftStrings = [] + , rightStrings = [] + , line = 0 + , lineLength = 0 + , leftLines = [] + , rightLines = [] + } + + fun fromString str = + let + val linebreaks = countLineBreaks str + in + { idx = 0 + , textLength = String.size str + , leftStrings = [] + , rightStrings = [str] + , line = 0 + , lineLength = Vector.length linebreaks + , leftLines = [] + , rightLines = [linebreaks] + } + end + + local + fun helpToString (acc, input) = + case input of + hd :: tl => helpToString (hd :: acc, tl) + | [] => String.concat acc + in + fun toString ({leftStrings, rightStrings, ...}: t) = + helpToString (rightStrings, leftStrings) + end + + fun isInLimit (s1, s2, v1, v2) = + String.size s1 + String.size s2 <= stringLimit + andalso Vector.length v1 + Vector.length v2 <= vecLimit + + fun isThreeInLimit (s1, s2, s3, v1, v2) = + String.size s1 + String.size s2 + String.size s3 <= stringLimit + andalso Vector.length v1 + Vector.length v2 <= vecLimit + + (* Binary search. If value isn't found, returns the value before it. *) + local + fun reverseLinearSearch (findNum, idx, lines) = + if idx < 0 then + idx + else + let + val curVal = Vector.sub (lines, idx) + in + if curVal < findNum then idx + else reverseLinearSearch (findNum, idx, lines) + end + + fun helpBinSearch (findNum, lines, low, high) = + let + val mid = low + ((high - low) div 2) + in + if high >= low then + let + val midVal = Vector.sub (lines, mid) + in + if midVal = findNum then + mid + else if midVal < findNum then + helpBinSearch (findNum, lines, mid + 1, high) + else + helpBinSearch (findNum, lines, low, mid - 1) + end + else + reverseLinearSearch (findNum, mid, lines) + end + in + fun binSearch (findNum, lines) = + if Vector.length lines = 0 then 0 + else helpBinSearch (findNum, lines, 0, Vector.length lines - 1) + end + + (* Binary search. If value isn't found, returns the value after it. *) + local + fun forwardLinearSearch (findNum, idx, lines) = + if idx = Vector.length lines then + idx + else + let + val curVal = Vector.sub (lines, idx) + in + if curVal > findNum then idx + else forwardLinearSearch (findNum, idx + 1, lines) + end + + fun helpBinSearch (findNum, lines, low, high) = + let + val mid = low + ((high - low) div 2) + in + if high >= low then + let + val midVal = Vector.sub (lines, mid) + in + if midVal = findNum then + mid + else if midVal < findNum then + helpBinSearch (findNum, lines, mid + 1, high) + else + helpBinSearch (findNum, lines, low, mid - 1) + end + else if mid >= 0 then + forwardLinearSearch (findNum, mid, lines) + else + 0 + end + in + fun forwardBinSearch (findNum, lines) = + if Vector.length lines = 0 then 0 + else helpBinSearch (findNum, lines, 0, Vector.length lines - 1) + end + + (* Insert function and helper functions for it. *) + local + fun insWhenIdxAndCurIdxAreEqual + ( newString + , newLines + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) : t = + case (leftStrings, leftLines) of + (strHd :: strTl, lineHd :: lineTl) => + if isInLimit (strHd, newString, lineHd, newLines) then + (* Fits in limit, so we can add to existing string/line vector.*) + let + val newIdx = curIdx + String.size newString + val newStrHd = strHd ^ newString + val newLeftString = newStrHd :: strTl + val newLine = curLine + Vector.length newLines + + val newLinesHd = + Vector.tabulate + ( Vector.length lineHd + Vector.length newLines + , fn idx => + if idx < Vector.length lineHd then + Vector.sub (lineHd, idx) + else + Vector.sub (newLines, idx - Vector.length lineHd) + + String.size strHd + ) + val newLeftLines = newLinesHd :: lineTl + in + { idx = newIdx + , textLength = textLength + , line = newLine + , lineLength = lineLength + , leftStrings = newLeftString + , leftLines = newLeftLines + , rightStrings = rightStrings + , rightLines = rightLines + } + end + else + (* Does not fit in limit, so cons instead.*) + { idx = curIdx + String.size newString + , textLength = textLength + , line = curLine + Vector.length newLines + , lineLength = lineLength + , leftStrings = newString :: leftStrings + , leftLines = newLines :: leftLines + , rightStrings = rightStrings + , rightLines = rightLines + } + | (_, _) => + (* + * Because movements between string/line lists in the gap buffer + * always move together, we know that either list being empty + * also means that the other one is empty. + * So we don't need to perform addition or consing. + *) + { idx = String.size newString + , textLength = textLength + , line = Vector.length newLines + , lineLength = lineLength + , leftStrings = [newString] + , leftLines = [newLines] + , rightStrings = rightStrings + , rightLines = rightLines + } + + fun insInLeftList + ( idx + , newString + , newLines + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , prevIdx + , leftStringsHd + , leftStringsTl + , leftLinesHd + , leftLinesTl + , textLength + , lineLength + ) : t = + if idx = prevIdx then + (* Need to insert at the start of the left list. *) + if isInLimit (newString, leftStringsHd, newLines, leftLinesHd) then + let + (* Create new vector, adjusting indices as needed. *) + val joinedLines = + Vector.tabulate + ( Vector.length newLines + Vector.length leftLinesHd + , fn idx => + if idx < Vector.length newLines then + Vector.sub (newLines, idx) + else + Vector.sub (leftLinesHd, idx - Vector.length newLines) + + String.size newString + ) + in + { idx = curIdx + String.size newString + , textLength = textLength + , line = curLine + Vector.length newLines + , lineLength = lineLength + , leftStrings = (newString ^ leftStringsHd) :: leftStringsTl + , leftLines = joinedLines :: leftLinesTl + , rightStrings = rightStrings + , rightLines = rightLines + } + end + else + (* Just cons everything; no way we can join while staying in limit. *) + { idx = curIdx + String.size newString + , textLength = textLength + , line = curLine + Vector.length newLines + , lineLength = lineLength + , leftStrings = leftStringsHd :: newString :: leftStringsTl + , leftLines = leftLinesHd :: newLines :: leftLinesTl + , rightStrings = rightStrings + , rightLines = rightLines + } + else + (* Need to insert in the middle of the left list. *) + let + (* Get string slices on both sides. *) + val strLength = idx - prevIdx + val strSub1 = String.substring (leftStringsHd, 0, strLength) + val strSub2 = String.substring + (leftStringsHd, strLength, String.size leftStringsHd - strLength) + val midpoint = binSearch (String.size strSub1 - 1, leftLinesHd) + in + if + isThreeInLimit (strSub1, newString, strSub2, leftLinesHd, newLines) + then + (* Join three strings together. *) + let + val joinedString = String.concat [strSub1, newString, strSub2] + val joinedLines = + if Vector.length leftLinesHd > 0 then + Vector.tabulate + ( Vector.length leftLinesHd + Vector.length newLines + , fn idx => + if idx <= midpoint then + Vector.sub (leftLinesHd, idx) + else if idx <= midpoint + Vector.length newLines then + Vector.sub (newLines, (idx - midpoint) - 1) + + String.size strSub1 + else + Vector.sub + (leftLinesHd, (idx - Vector.length newLines)) + + String.size newString + ) + else + Vector.map (fn el => el + String.size strSub1) newLines + in + { idx = curIdx + String.size newString + , textLength = textLength + , line = curLine + Vector.length newLines + , lineLength = lineLength + , leftStrings = joinedString :: leftStringsTl + , leftLines = joinedLines :: leftLinesTl + , rightStrings = rightStrings + , rightLines = rightLines + } + end + else if + String.size strSub1 + String.size newString <= stringLimit + andalso midpoint + Vector.length newLines <= vecLimit + then + (* If we can join newString/lines with sub1 while + * staying in limit. *) + if midpoint >= 0 then + (* Implicit: a binSearch match was found. *) + let + val newLeftLinesLength = midpoint + 1 + Vector.length newLines + val newLeftLines = + Vector.tabulate (newLeftLinesLength, fn idx => + if idx <= midpoint then + Vector.sub (leftLinesHd, idx) + else + Vector.sub (newLines, idx - (midpoint + 1)) + + String.size strSub1) + + val newRightLines = + Vector.tabulate + ( (Vector.length leftLinesHd - midpoint) - 1 + , fn idx => + Vector.sub (leftLinesHd, idx + midpoint + 1) + - String.size strSub1 + ) + in + { idx = prevIdx + String.size strSub1 + String.size newString + , textLength = textLength + , line = + (curLine - Vector.length leftLinesHd) + + Vector.length newLeftLines + , lineLength = lineLength + , leftStrings = (strSub1 ^ newString) :: leftStringsTl + , leftLines = newLeftLines :: leftLinesTl + , rightStrings = strSub2 :: rightStrings + , rightLines = newRightLines :: rightLines + } + end + else + let + (* No binSearch result found. *) + val newLeftLines = + Vector.map (fn el => el + String.size strSub1) newLines + val newRightLines = + Vector.map (fn idx => idx - String.size strSub1) leftLinesHd + in + { idx = prevIdx + String.size strSub1 + String.size newString + , textLength = textLength + , line = + (curLine - Vector.length leftLinesHd) + + Vector.length newLeftLines + , lineLength = lineLength + , leftStrings = (strSub1 ^ newString) :: leftStringsTl + , leftLines = newLeftLines :: leftLinesTl + , rightStrings = strSub2 :: rightStrings + , rightLines = newRightLines :: rightLines + } + end + else if + String.size newString + String.size strSub2 <= stringLimit + andalso + (Vector.length leftLinesHd - midpoint) + Vector.length newLines + <= vecLimit + then + (* If we can join newString/line with sub2 while staying + * in limit. *) + let + val newLeftLines = + if midpoint >= 0 andalso Vector.length leftLinesHd > 0 then + let + val newLeftLines = VectorSlice.slice + (leftLinesHd, 0, SOME (midpoint + 1)) + in + VectorSlice.vector newLeftLines + end + else + Vector.fromList [] + + val newRightLines = + Vector.tabulate + ( (Vector.length leftLinesHd - Vector.length newLeftLines) + + Vector.length newLines + , fn idx => + if idx < Vector.length newLines then + Vector.sub (newLines, idx) + else + Vector.sub + ( leftLinesHd + , (idx - Vector.length newLines) + + Vector.length newLeftLines + ) - String.size strSub1 + String.size newString + ) + in + { idx = prevIdx + String.size strSub1 + , textLength = textLength + , line = (curLine - Vector.length leftLinesHd) + midpoint + , lineLength = lineLength + , leftStrings = strSub1 :: leftStringsTl + , leftLines = newLeftLines :: leftLinesTl + , rightStrings = (newString ^ strSub2) :: rightStrings + , rightLines = newRightLines :: rightLines + } + end + else + (* Can't join on either side while staying in limit. *) + let + val lineSub1 = + if midpoint >= 0 andalso Vector.length leftLinesHd > 0 then + let + val lineSub1 = VectorSlice.slice + (leftLinesHd, 0, SOME (midpoint + 1)) + in + VectorSlice.vector lineSub1 + end + else + Vector.fromList [] + + val lineSub2Length = + Vector.length leftLinesHd - Vector.length lineSub1 + val lineSub2 = Vector.tabulate (lineSub2Length, fn idx => + Vector.sub (leftLinesHd, idx + Vector.length lineSub1) + - String.size strSub1) + in + { idx = prevIdx + String.size strSub1 + String.size newString + , textLength = textLength + , line = + (curLine - String.size leftStringsHd) + midpoint + + Vector.length newLines + , lineLength = lineLength + , leftStrings = newString :: strSub1 :: leftStringsTl + , leftLines = newLines :: lineSub1 :: leftLinesTl + , rightStrings = strSub2 :: rightStrings + , rightLines = lineSub2 :: rightLines + } + end + end + + fun moveLeftAndIns + ( idx + , newString + , newLines: int vector + , curIdx + , curLine + , leftStrings: string list + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) = + case (leftStrings, leftLines) of + (leftStringsHd :: leftStringsTl, leftLinesHd :: leftLinesTl) => + let + val prevIdx = curIdx - String.size leftStringsHd + in + if idx < prevIdx then + (* + * Need to move leftward. + * The rather complicated code below is an optimisation checking + * if we can minimise the number of lists in the gap buffer + * by concatenating lines/strings together while staying + * under the limit. + * *) + (case (rightStrings, rightLines) of + ( rightStringsHd :: rightStringsTl + , rightLinesHd :: rightLinesTl + ) => + if + isInLimit + ( leftStringsHd + , rightStringsHd + , leftLinesHd + , rightLinesHd + ) + then + let + val prevLine = curLine - Vector.length leftLinesHd + val newRightStringsHd = leftStringsHd ^ rightStringsHd + + val newRightLinesHd = + Vector.tabulate + ( Vector.length leftLinesHd + + Vector.length rightLinesHd + , fn idx => + if idx < Vector.length leftLinesHd then + Vector.sub (leftLinesHd, idx) + else + Vector.sub + ( rightLinesHd + , idx - Vector.length leftLinesHd + ) + String.size leftStringsHd + ) + in + moveLeftAndIns + ( idx + , newString + , newLines + , prevIdx + , prevLine + , leftStringsTl + , leftLinesTl + , newRightStringsHd :: rightStringsTl + , newRightLinesHd :: rightLinesTl + , textLength + , lineLength + ) + end + else + moveLeftAndIns + ( idx + , newString + , newLines + , prevIdx + , curLine - Vector.length leftLinesHd + , leftStringsTl + , leftLinesTl + , leftStringsHd :: rightStrings + , leftLinesHd :: rightLines + , textLength + , lineLength + ) + | (_, _) => + moveLeftAndIns + ( idx + , newString + , newLines + , prevIdx + , curLine - Vector.length newLines + , leftStringsTl + , leftLinesTl + , leftStringsHd :: rightStrings + , leftLinesHd :: rightLines + , textLength + , lineLength + )) + else + (* Insertion is somewhere between the head of the left list, + * and the tail of the left list. *) + insInLeftList + ( idx + , newString + , newLines + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , prevIdx + , leftStringsHd + , leftStringsTl + , leftLinesHd + , leftLinesTl + , textLength + , lineLength + ) + end + | (_, _) => + (* Left list is empty, so need to cons or join. + * Just set left string/list as newString/newLines. *) + { idx = String.size newString + , textLength = textLength + , line = Vector.length newLines + , lineLength = lineLength + , leftStrings = [newString] + , leftLines = [newLines] + , rightStrings = rightStrings + , rightLines = rightLines + } + + fun insInRightList + ( idx + , newString + , newLines + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , nextIdx + , rightStringsHd + , rightStringsTl + , rightLinesHd: int vector + , rightLinesTl + , textLength + , lineLength + ) : t = + if idx = nextIdx then + (* Need to put newString/newLines at the end of the right list's hd. *) + if isInLimit (newString, rightStringsHd, newLines, rightLinesHd) then + (* Allocate new string because we can do so while staying in limit. *) + let + val newRightStringsHd = rightStringsHd ^ newString + val newRightLinesHd = + Vector.tabulate + ( Vector.length rightLinesHd + Vector.length newLines + , fn idx => + if idx < Vector.length rightLinesHd then + Vector.sub (rightLinesHd, idx) + else + Vector.sub (newLines, idx - Vector.length rightLinesHd) + + String.size rightStringsHd + ) + in + { idx = curIdx + , textLength = textLength + , line = curLine + , lineLength = lineLength + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = newRightStringsHd :: rightStringsTl + , rightLines = newRightLinesHd :: rightLinesTl + } + end + else + (* Cons newString and newLines to after-the-head, + * because we can't join while staying in the limit.*) + { idx = curIdx + , textLength = textLength + , line = curLine + , lineLength = lineLength + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = rightStringsHd :: newString :: rightStringsTl + , rightLines = rightLinesHd :: newLines :: rightLinesTl + } + else + (* Have to split rightStringsHd and rightLinesHd in the middle. *) + let + val strLength = idx - curIdx + val strSub1 = String.substring (rightStringsHd, 0, strLength) + val strSub2 = String.substring + (rightStringsHd, strLength, String.size rightStringsHd - strLength) + val midpoint = binSearch (String.size strSub1 - 1, rightLinesHd) + in + if + isThreeInLimit (strSub1, newString, strSub2, rightLinesHd, newLines) + then + (* Join three strings together. *) + let + val newRightStringsHd = + String.concat [strSub1, newString, strSub2] + val newRightLinesHd = + if Vector.length rightLinesHd > 0 then + Vector.tabulate + ( Vector.length rightLinesHd + Vector.length newLines + , fn idx => + if idx <= midpoint then + Vector.sub (rightLinesHd, idx) + else if idx <= midpoint + Vector.length newLines then + Vector.sub (newLines, (idx - midpoint) - 1) + + String.size strSub1 + else + Vector.sub + (rightLinesHd, (idx - Vector.length newLines)) + + String.size newString + ) + else + Vector.map (fn el => el + String.size strSub1) newLines + in + { idx = curIdx + , textLength = textLength + , line = curLine + , lineLength = lineLength + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = newRightStringsHd :: rightStringsTl + , rightLines = newRightLinesHd :: rightLinesTl + } + end + else if + String.size strSub1 + String.size newString <= stringLimit + andalso midpoint + Vector.length newLines <= vecLimit + then + (* If we can join newString/lines with sub1 while + * staying in limit. *) + if midpoint >= 0 then + let + (* Implicit: a binSearch match was found. *) + val newLeftStringsHd = strSub1 ^ newString + val newLeftLinesLength = midpoint + 1 + Vector.length newLines + val newLeftLinesHd = + Vector.tabulate (newLeftLinesLength, fn idx => + if idx <= midpoint then + Vector.sub (rightLinesHd, idx) + else + Vector.sub (newLines, idx - (midpoint + 1)) + + String.size strSub1) + + val newRightLinesHd = + Vector.tabulate + ( (Vector.length rightLinesHd - midpoint) - 1 + , fn idx => + Vector.sub (rightLinesHd, idx + midpoint + 1) + - String.size strSub1 + ) + in + { idx = curIdx + String.size newLeftStringsHd + , textLength = textLength + , line = curLine + Vector.length newLeftLinesHd + , lineLength = lineLength + , leftStrings = newLeftStringsHd :: leftStrings + , leftLines = newLeftLinesHd :: leftLines + , rightStrings = strSub2 :: rightStringsTl + , rightLines = newRightLinesHd :: rightLinesTl + } + end + else + let + (* No binSearch match found. *) + val newLeftStringsHd = strSub1 ^ newString + val newLeftLinesHd = + Vector.map (fn el => el + String.size strSub1) newLines + val newRightLinesHd = + Vector.map (fn idx => idx - String.size strSub1) rightLinesHd + in + { idx = curIdx + String.size newLeftStringsHd + , textLength = textLength + , line = curLine + Vector.length newLeftLinesHd + , lineLength = lineLength + , leftStrings = newLeftStringsHd :: leftStrings + , leftLines = newLeftLinesHd :: leftLines + , rightStrings = strSub2 :: rightStringsTl + , rightLines = newRightLinesHd :: rightLinesTl + } + end + else if + String.size newString + String.size strSub2 <= stringLimit + andalso + (Vector.length rightLinesHd - midpoint) + Vector.length newLines + <= vecLimit + then + (* If we can join newString/line with sub2 while staying + * in limit. *) + let + val newLeftLinesHd = + if midpoint >= 0 then + let + val newLeftLinesHd = VectorSlice.slice + (rightLinesHd, 0, SOME (midpoint + 1)) + in + VectorSlice.vector newLeftLinesHd + end + else + Vector.fromList [] + + val newRightStringsHd = newString ^ strSub2 + val newRightLinesHd = + Vector.tabulate + ( (Vector.length newLines + Vector.length rightLinesHd) + - Vector.length newLeftLinesHd + , fn idx => + if idx < Vector.length newLines then + Vector.sub (newLines, idx) + else + (Vector.sub + ( rightLinesHd + , (idx - Vector.length newLines) + + Vector.length newLeftLinesHd + ) - String.size strSub1) + String.size newString + ) + in + { idx = curIdx + String.size strSub1 + , textLength = textLength + , line = curLine + Vector.length newLeftLinesHd + , lineLength = lineLength + , leftStrings = strSub1 :: leftStrings + , leftLines = newLeftLinesHd :: leftLines + , rightStrings = newRightStringsHd :: rightStringsTl + , rightLines = newRightLinesHd :: rightLinesTl + } + end + else + (* Can't join on either side while staying in limit. *) + let + val lineSub1 = + if midpoint >= 0 andalso Vector.length rightLinesHd > 0 then + let + val lineSub1 = VectorSlice.slice + (rightLinesHd, 0, SOME (midpoint + 1)) + in + VectorSlice.vector lineSub1 + end + else + Vector.fromList [] + + val lineSub2Length = + Vector.length rightLinesHd - Vector.length lineSub1 + val lineSub2 = Vector.tabulate (lineSub2Length, fn idx => + Vector.sub (rightLinesHd, idx + Vector.length lineSub1) + - String.size strSub1) + in + { idx = curIdx + String.size strSub1 + String.size newString + , textLength = textLength + , line = curLine + Vector.length newLines + Vector.length lineSub1 + , lineLength = lineLength + , leftStrings = newString :: strSub1 :: leftStrings + , leftLines = newLines :: lineSub1 :: leftLines + , rightStrings = strSub2 :: rightStringsTl + , rightLines = lineSub2 :: rightLinesTl + } + end + end + + fun moveRightAndIns + ( idx + , newString + , newLines + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) = + case (rightStrings, rightLines) of + (rightStringsHd :: rightStringsTl, rightLinesHd :: rightLinesTl) => + let + val nextIdx = curIdx + String.size rightStringsHd + in + if idx > nextIdx then + (* Need to move rightward. *) + (case (leftStrings, leftLines) of + (leftStringsHd :: leftStringsTl, leftLinesHd :: leftLinesTl) => + if + isInLimit + ( leftStringsHd + , rightStringsHd + , leftLinesHd + , rightLinesHd + ) + then + let + val nextLine = curLine + Vector.length rightLinesHd + val newLeftStringsHd = leftStringsHd ^ rightStringsHd + val newLeftLinesHd = + Vector.tabulate + ( Vector.length leftLinesHd + + Vector.length rightLinesHd + , fn idx => + if idx < Vector.length leftLinesHd then + Vector.sub (leftLinesHd, idx) + else + Vector.sub + ( rightLinesHd + , idx - Vector.length leftLinesHd + ) + String.size leftStringsHd + ) + in + moveRightAndIns + ( idx + , newString + , newLines + , nextIdx + , nextLine + , newLeftStringsHd :: leftStringsTl + , newLeftLinesHd :: leftLinesTl + , rightStringsTl + , rightLinesTl + , textLength + , lineLength + ) + end + else + moveRightAndIns + ( idx + , newString + , newLines + , nextIdx + , curLine + Vector.length rightLinesHd + , rightStringsHd :: leftStrings + , rightLinesHd :: leftLines + , rightStringsTl + , rightLinesTl + , textLength + , lineLength + ) + | (_, _) => + moveRightAndIns + ( idx + , newString + , newLines + , nextIdx + , curLine + Vector.length rightLinesHd + , rightStringsHd :: leftStrings + , rightLinesHd :: leftLines + , rightStringsTl + , rightLinesTl + , textLength + , lineLength + )) + else + (* Need to insert in the middle of the right string's hd. *) + insInRightList + ( idx + , newString + , newLines + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , nextIdx + , rightStringsHd + , rightStringsTl + , rightLinesHd + , rightLinesTl + , textLength + , lineLength + ) + end + | (_, _) => + (* Right string/line is empty. *) + { idx = curIdx + , textLength = textLength + , line = curLine + , lineLength = lineLength + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = [newString] + , rightLines = [newLines] + } + + fun ins + ( idx + , newString + , newLines + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) : t = + if curIdx = idx then + insWhenIdxAndCurIdxAreEqual + ( newString + , newLines + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + else if idx < curIdx then + moveLeftAndIns + ( idx + , newString + , newLines + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + else + (* idx > curIdx. *) + moveRightAndIns + ( idx + , newString + , newLines + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + in + fun insert (idx, newString, buffer: t) = + let + val newLines = countLineBreaks newString + val newTextLength = #textLength buffer + String.size newString + val newLineLength = #lineLength buffer + Vector.length newLines + in + ins + ( idx + , newString + , newLines + , #idx buffer + , #line buffer + , #leftStrings buffer + , #leftLines buffer + , #rightStrings buffer + , #rightLines buffer + , newTextLength + , newLineLength + ) + end + end + + fun helpGoToEndAndAppend + ( newString + , newLines + , idx + , leftStrings + , rightStrings + , line + , leftLines + , rightLines + , textLength + , lineLength + ) = + case (rightStrings, rightLines) of + (rStrHd :: rStrTl, rLnHd :: rLnTl) => + (* move gap rightwards one node, + * and join with right head with left if possible *) + (case (leftStrings, leftLines) of + (lStrHd :: lStrTl, lLnHd :: lLnTl) => + if isInLimit (lStrHd, rStrHd, lLnHd, rLnHd) then + let + val newLstrHd = lStrHd ^ rStrHd + val newLlnHd = + Vector.tabulate + ( Vector.length lLnHd + Vector.length rLnHd + , fn lnIdx => + if lnIdx < Vector.length lLnHd then + Vector.sub (lLnHd, lnIdx) + else + Vector.sub (rLnHd, lnIdx - Vector.length lLnHd) + + String.size lStrHd + ) + in + helpGoToEndAndAppend + ( newString + , newLines + , idx + String.size rStrHd + , newLstrHd :: lStrTl + , rStrTl + , line + Vector.length rLnHd + , newLlnHd :: lLnTl + , rLnTl + , textLength + , lineLength + ) + end + else + helpGoToEndAndAppend + ( newString + , newLines + , idx + String.size rStrHd + , rStrHd :: leftStrings + , rStrTl + , line + Vector.length rLnHd + , rLnHd :: leftLines + , rLnTl + , textLength + , lineLength + ) + | (_, _) => + (* left side is empty; we are at start *) + helpGoToEndAndAppend + ( newString + , newLines + , String.size rStrHd + , [rStrHd] + , rStrTl + , Vector.length rLnHd + , [rLnHd] + , rLnTl + , textLength + , lineLength + )) + | (_, _) => + (* we have reached the end, and right side is empty *) + (case (leftStrings, leftLines) of + (lStrHd :: lStrTl, lLnHd :: lLnTl) => + if isInLimit (lStrHd, newString, lLnHd, newLines) then + (* join new string and line with left *) + let + val newLstrHd = lStrHd ^ newString + val newLlnHd = + Vector.tabulate + ( Vector.length lLnHd + Vector.length newLines + , fn lnIdx => + if lnIdx < Vector.length lLnHd then + Vector.sub (lLnHd, lnIdx) + else + Vector.sub (newLines, lnIdx - Vector.length lLnHd) + + String.size lStrHd + ) + in + { idx = idx + String.size newString + , textLength = textLength + , line = line + Vector.length newLines + , lineLength = lineLength + , leftStrings = newLstrHd :: lStrTl + , leftLines = newLlnHd :: lLnTl + , rightStrings = [] + , rightLines = [] + } + end + else + { idx = idx + String.size newString + , textLength = textLength + , line = line + Vector.length newLines + , lineLength = lineLength + , leftStrings = newString :: leftStrings + , leftLines = newLines :: leftLines + , rightStrings = [] + , rightLines = [] + } + | (_, _) => + { idx = idx + String.size newString + , textLength = textLength + , line = line + Vector.length newLines + , lineLength = lineLength + , leftStrings = newString :: leftStrings + , leftLines = newLines :: leftLines + , rightStrings = [] + , rightLines = [] + }) + + fun append (newString, buffer) = + let + val + { idx + , line + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + } = buffer + val newTextLength = textLength + String.size newString + val newLines = countLineBreaks newString + val newLineLength = lineLength + Vector.length newLines + in + helpGoToEndAndAppend + ( newString + , newLines + , idx + , leftStrings + , rightStrings + , line + , leftLines + , rightLines + , newTextLength + , newLineLength + ) + end + + (* Delete function and helper functions for it. *) + local + fun deleteRightFromHere + ( origIdx + , origLine + , moveIdx + , finish + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) = + case (rightStrings, rightLines) of + (rightStringsHd :: rightStringsTl, rightLinesHd :: rightLinesTl) => + let + val nextIdx = moveIdx + String.size rightStringsHd + in + if nextIdx < finish then + (* Remove string/line head and keep moving right. *) + deleteRightFromHere + ( origIdx + , origLine + , nextIdx + , finish + , leftStrings + , leftLines + , rightStringsTl + , rightLinesTl + , textLength - String.size rightStringsHd + , lineLength - Vector.length rightLinesHd + ) + else if nextIdx > finish then + (* Base case: delete from the start of this string and stop moving. *) + let + val oldNodeTextLength = String.size rightStringsHd + val oldNodeLineLength = Vector.length rightLinesHd + + (* Delete part of string. *) + val newStrStart = finish - moveIdx + val newStr = String.substring + ( rightStringsHd + , newStrStart + , String.size rightStringsHd - newStrStart + ) + + (* Delete from line vector if we need to. *) + val newLines = + if Vector.length rightLinesHd > 0 then + let + val lineDeleteStart = + forwardBinSearch (newStrStart, rightLinesHd) + in + if lineDeleteStart < Vector.length rightLinesHd then + let + val lineDeleteLength = + Vector.length rightLinesHd - lineDeleteStart + in + Vector.tabulate (lineDeleteLength, fn idx => + Vector.sub (rightLinesHd, idx + lineDeleteStart) + - newStrStart) + end + else + Vector.fromList [] + end + else + rightLinesHd (* empty vector *) + + val newNodeTextLength = String.size newStr + val textLengthDifference = oldNodeTextLength - newNodeTextLength + val textLength = textLength - textLengthDifference + + val newNodeLineLength = Vector.length newLines + val lineLengthDifference = oldNodeLineLength - newNodeLineLength + val lineLength = lineLength - lineLengthDifference + in + { idx = origIdx + , textLength = textLength + , line = origLine + , lineLength = lineLength + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = newStr :: rightStringsTl + , rightLines = newLines :: rightLinesTl + } + end + else + (* Delete this node fully, but delete no further. *) + { idx = origIdx + , textLength = textLength - String.size rightStringsHd + , line = origLine + , lineLength = lineLength - Vector.length rightLinesHd + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = rightStringsTl + , rightLines = rightLinesTl + } + end + | (_, _) => + { idx = origIdx + , textLength = textLength + , line = origLine + , lineLength = lineLength + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = [] + , rightLines = [] + } + + fun moveRightAndDelete + ( start + , finish + , curIdx + , curLine + , leftStrings: string list + , leftLines: int vector list + , rightStrings: string list + , rightLines: int vector list + , textLength + , lineLength + ) = + case (rightStrings, rightLines) of + (rightStringsHd :: rightStringsTl, rightLinesHd :: rightLinesTl) => + let + val nextIdx = curIdx + String.size rightStringsHd + in + if nextIdx < start then + (* Keep moving right. + * Complicated code below is an optimsation to reduce number of + * elements in the gap buffer. + * If we can join left head with right head while staying in limit, then + * do so; else, just cons as we move. *) + (case (leftStrings, leftLines) of + (leftStringsHd :: leftStringsTl, leftLinesHd :: leftLinesTl) => + if + isInLimit + ( leftStringsHd + , rightStringsHd + , leftLinesHd + , rightLinesHd + ) + then + (* We can join the heads while staying in limit, so do so. *) + let + val newLeftStringsHd = leftStringsHd ^ rightStringsHd + val newLeftLinesHd: int vector = + Vector.tabulate + ( Vector.length leftLinesHd + + Vector.length rightLinesHd + , fn idx => + if idx < Vector.length leftLinesHd then + Vector.sub (leftLinesHd, idx) + else + Vector.sub + ( rightLinesHd + , idx - Vector.length leftLinesHd + ) + String.size leftStringsHd + ) + val newLeftStrings = newLeftStringsHd :: leftStringsTl + val newLeftLines = newLeftLinesHd :: leftLinesTl + in + moveRightAndDelete + ( start + , finish + , nextIdx + , curLine + Vector.length rightLinesHd + , newLeftStrings + , newLeftLines + , rightStringsTl + , rightLinesTl + , textLength + , lineLength + ) + end + else + (* Can't join heads while staying in limit, so just cons. *) + moveRightAndDelete + ( start + , finish + , nextIdx + , curLine + Vector.length rightLinesHd + , rightStringsHd :: leftStrings + , rightLinesHd :: leftLines + , rightStringsTl + , rightLinesTl + , textLength + , lineLength + ) + | (_, _) => + (* Can't join heads while staying in limit, so just cons. *) + moveRightAndDelete + ( start + , finish + , nextIdx + , curLine + Vector.length rightLinesHd + , rightStringsHd :: leftStrings + , rightLinesHd :: leftLines + , rightStringsTl + , rightLinesTl + , textLength + , lineLength + )) + else if nextIdx > start then + if nextIdx < finish then + (* Start deleting from the end of this string, + * and then continue deleting rightwards. *) + let + val oldNodeTextLength = String.size rightStringsHd + val oldNodeLineLength = Vector.length rightLinesHd + + val length = start - curIdx + val newString = String.substring (rightStringsHd, 0, length) + + val lineDeleteEnd = binSearch + (String.size newString - 1, rightLinesHd) + val newLines = + if Vector.length rightLinesHd = 0 orelse lineDeleteEnd < 0 then + Vector.fromList [] + else + let + val slice = VectorSlice.slice + (rightLinesHd, 0, SOME (lineDeleteEnd + 1)) + in + VectorSlice.vector slice + end + + val newNodeTextLength = String.size newString + val textLengthDifference = + oldNodeTextLength - newNodeTextLength + val textLength = textLength - textLengthDifference + + val newNodeLineLength = Vector.length newLines + val lineLengthDifference = + oldNodeLineLength - newNodeLineLength + val lineLength = lineLength - lineLengthDifference + in + (* Try joining new string with left head if possible. *) + (case (leftStrings, leftLines) of + ( leftStringsHd :: leftStringsTl + , leftLinesHd :: leftLinesTl + ) => + if + isInLimit + (newString, leftStringsHd, newLines, leftLinesHd) + then + (* Join new string with left head. *) + let + val newLeftStringsHd = leftStringsHd ^ newString + val newLeftLinesHd = + Vector.tabulate + ( Vector.length leftLinesHd + + Vector.length newLines + , fn idx => + if idx < Vector.length leftLinesHd then + Vector.sub (leftLinesHd, idx) + else + Vector.sub + ( newLines + , idx - Vector.length leftLinesHd + ) + String.size leftStringsHd + ) + in + (* moveIdx passed as arameter should be + * different from origIdx, + * because moveIdx considers range to delete from + * while origIdx considers index to return + * once buffer is done deleting. *) + deleteRightFromHere + ( curIdx + String.size newString + , curLine + Vector.length newLines + , nextIdx + , finish + , newLeftStringsHd :: leftStringsTl + , newLeftLinesHd :: leftLinesTl + , rightStringsTl + , rightLinesTl + , textLength + , lineLength + ) + end + else + (* Can't join new string with left head + * while staying in limit, so just cons. *) + deleteRightFromHere + ( curIdx + String.size newString + , curLine + Vector.length newLines + , nextIdx + , finish + , newString :: leftStrings + , newLines :: leftLines + , rightStringsTl + , rightLinesTl + , textLength + , lineLength + ) + | (_, _) => + deleteRightFromHere + ( curIdx + String.size newString + , curLine + Vector.length newLines + , nextIdx + , finish + , newString :: leftStrings + , newLines :: leftLines + , rightStringsTl + , rightLinesTl + , textLength + , lineLength + )) + end + else if nextIdx > finish then + (* Base case: delete from the middle part of this string. *) + let + val oldNodeTextLength = String.size rightStringsHd + val oldNodeLineLength = Vector.length rightLinesHd + + val sub1Length = start - curIdx + val sub1 = String.substring (rightStringsHd, 0, sub1Length) + val sub1LineEnd = binSearch + (String.size sub1 - 1, rightLinesHd) + val sub1Lines = + if sub1LineEnd < 0 orelse Vector.length rightLinesHd = 0 then + Vector.fromList [] + else + let + val slice = VectorSlice.slice + (rightLinesHd, 0, SOME (sub1LineEnd + 1)) + in + VectorSlice.vector slice + end + + val sub2Start = finish - curIdx + val sub2 = String.substring + ( rightStringsHd + , sub2Start + , String.size rightStringsHd - sub2Start + ) + val sub2LineStart = forwardBinSearch (sub2Start, rightLinesHd) + val sub2Lines = + if sub2LineStart < Vector.length rightLinesHd then + Vector.tabulate + ( Vector.length rightLinesHd - sub2LineStart + , fn idx => + Vector.sub (rightLinesHd, idx + sub2LineStart) + - (String.size rightStringsHd - String.size sub2) + ) + else + Vector.fromList [] + + val newNodeTextLength = String.size sub1 + String.size sub2 + val textLengthDifference = + oldNodeTextLength - newNodeTextLength + val newTextLength = textLength - textLengthDifference + + val newNodeLineLength = + Vector.length sub1Lines + Vector.length sub2Lines + val lineLengthDifference = + oldNodeLineLength - newNodeLineLength + val newLineLength = lineLength - lineLengthDifference + in + { idx = curIdx + String.size sub1 + , textLength = newTextLength + , line = curLine + Vector.length sub1Lines + , lineLength = newLineLength + , leftStrings = sub1 :: leftStrings + , leftLines = sub1Lines :: leftLines + , rightStrings = sub2 :: rightStringsTl + , rightLines = sub2Lines :: rightLinesTl + } + end + else + (* nextIdx = finish + * Base case: delete from middle to end of this string, keeping start. *) + let + val oldNodeTextLength = String.size rightStringsHd + val oldNodeLineLength = Vector.length rightLinesHd + + val strLength = start - curIdx + val str = String.substring (rightStringsHd, 0, strLength) + val midpoint = binSearch (String.size str - 1, rightLinesHd) + val newLeftLines = + if midpoint < 0 orelse Vector.length rightLinesHd = 0 then + Vector.fromList [] + else + let + val slice = VectorSlice.slice + (rightLinesHd, 0, SOME (midpoint + 1)) + in + VectorSlice.vector slice + end + + val newNodeTextLength = String.size str + val textLengthDifference = + oldNodeTextLength - newNodeTextLength + val newTextLength = textLength - textLengthDifference + + val newNodeLineLength = Vector.length newLeftLines + val lineLengthDifference = + oldNodeLineLength - newNodeLineLength + val newLineLength = lineLength - lineLengthDifference + in + { idx = curIdx + String.size str + , textLength = newTextLength + , line = curLine + Vector.length newLeftLines + , lineLength = newLineLength + , leftStrings = str :: leftStrings + , leftLines = newLeftLines :: leftLines + , rightStrings = rightStringsTl + , rightLines = rightLinesTl + } + end + else + (* nextIdx = start + * Another base case of this function. + * The start of the deletion range contains the rightStrings/LinesHd, + * and it may extend beyond the current head. + * So pass the rightStringsTl and rightLinesTl to a function that + * will delete rightwards if it needs to, or else terminates. *) + deleteRightFromHere + ( curIdx + String.size rightStringsHd + , curLine + Vector.length rightLinesHd + , nextIdx + , finish + , rightStringsHd :: leftStrings + , rightLinesHd :: leftLines + , rightStringsTl + , rightLinesTl + , textLength + , lineLength + ) + end + | (_, _) => + { idx = curIdx + , textLength = textLength + , line = curLine + , lineLength = lineLength + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = rightStrings + , rightLines = rightLines + } + + fun deleteLeftFromHere + ( start + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) = + case (leftStrings, leftLines) of + (leftStringsHd :: leftStringsTl, leftLinesHd :: leftLinesTl) => + let + val prevIdx = curIdx - String.size leftStringsHd + val prevLine = curLine - Vector.length leftLinesHd + in + if start < prevIdx then + (* Continue deleting leftward. *) + deleteLeftFromHere + ( start + , prevIdx + , prevLine + , leftStringsTl + , leftLinesTl + , rightStrings + , rightLines + , textLength - String.size leftStringsHd + , lineLength - Vector.length leftLinesHd + ) + else if start > prevIdx then + (* Base case: delete end part of this string and return. *) + let + val oldNodeTextLength = String.size leftStringsHd + val oldNodeLineLength = Vector.length leftLinesHd + + val length = start - prevIdx + val newStr = String.substring (leftStringsHd, 0, length) + val newLines = + if Vector.length leftLinesHd > 0 then + let + val midpoint = binSearch + (String.size newStr - 1, leftLinesHd) + val slice = VectorSlice.slice + (leftLinesHd, 0, SOME (midpoint + 1)) + in + VectorSlice.vector slice + end + else + Vector.fromList [] + + val newNodeTextLength = String.size newStr + val textLengthDifference = oldNodeTextLength - newNodeTextLength + val newTextLength = textLength - textLengthDifference + + val newNodeLineLength = Vector.length newLines + val lineLengthDifference = oldNodeLineLength - newNodeLineLength + val newLineLength = lineLength - lineLengthDifference + in + { idx = prevIdx + String.size newStr + , textLength = newTextLength + , line = prevLine + Vector.length newLines + , lineLength = newLineLength + , leftStrings = newStr :: leftStringsTl + , leftLines = newLines :: leftLinesTl + , rightStrings = rightStrings + , rightLines = rightLines + } + end + else + (* start = prevIdx + * Base case: Remove leftStrings/LinesHd without removing any further. *) + { idx = prevIdx + , line = prevLine + , leftStrings = leftStringsTl + , leftLines = leftLinesTl + , rightStrings = rightStrings + , rightLines = rightLines + , textLength = textLength - String.size leftStringsHd + , lineLength = lineLength - Vector.length leftLinesHd + } + end + | (_, _) => + { idx = curIdx + , line = curLine + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = rightStrings + , rightLines = rightLines + , textLength = textLength + , lineLength = lineLength + } + + fun deleteFromLetAndRight + ( start + , finish + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) = + let + val + { idx = curIdx + , line = curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + } = deleteRightFromHere + ( curIdx + , curLine + , curIdx + , finish + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + in + deleteLeftFromHere + ( start + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + end + + fun moveLeftAndDelete + ( start + , finish + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) = + case (leftStrings, leftLines) of + (leftStringsHd :: leftStringsTl, leftLinesHd :: leftLinesTl) => + let + val prevIdx = curIdx - String.size leftStringsHd + in + if prevIdx > finish then + (* Have to continue moving leftwards. + * Case statement below is an optimisation attempt: + * We are trying to join strings and line-vectors while staying in + * limit if this is possible while staying in limit. + * If this is not possible, we just cons instead. *) + (case (rightStrings, rightLines) of + ( rightStringsHd :: rightStringsTl + , rightLinesHd :: rightLinesTl + ) => + if + isInLimit + ( leftStringsHd + , rightStringsHd + , leftLinesHd + , rightLinesHd + ) + then + (* Can join while staying in limit, so do join. *) + let + val newRightStringsHd = leftStringsHd ^ rightStringsHd + val newRightLinesHd = + Vector.tabulate + ( Vector.length leftLinesHd + + Vector.length rightLinesHd + , fn idx => + if idx < Vector.length leftLinesHd then + Vector.sub (leftLinesHd, idx) + else + Vector.sub + ( rightLinesHd + , idx - Vector.length leftLinesHd + ) + String.size leftStringsHd + ) + val newRightStrings = newRightStringsHd :: rightStringsTl + val newRightLines = newRightLinesHd :: rightLinesTl + in + moveLeftAndDelete + ( start + , finish + , prevIdx + , curLine - Vector.length leftLinesHd + , leftStringsTl + , leftLinesTl + , newRightStrings + , newRightLines + , textLength + , lineLength + ) + end + else + (* Cannot join while staying in limit, so don't. *) + moveLeftAndDelete + ( start + , finish + , prevIdx + , curLine - Vector.length leftLinesHd + , leftStringsTl + , leftLinesTl + , leftStringsHd :: rightStrings + , leftLinesHd :: rightLines + , textLength + , lineLength + ) + | (_, _) => + (* Base case: reached empty list while trying to move leftwards. + * Cannot do anything so just return. *) + moveLeftAndDelete + ( start + , finish + , prevIdx + , curLine - Vector.length leftLinesHd + , leftStringsTl + , leftLinesTl + , [leftStringsHd] + , [leftLinesHd] + , textLength + , lineLength + )) + else if prevIdx < finish then + if prevIdx > start then + (* Delete from start point of this string, + * and then call function to continue deleting leftwards. *) + let + val oldNodeTextLength = String.size leftStringsHd + val oldNodeLineLength = Vector.length leftLinesHd + + val stringStart = finish - prevIdx + val newString = String.substring + ( leftStringsHd + , stringStart + , String.size leftStringsHd - stringStart + ) + val newLines = + let + val midpoint = forwardBinSearch (stringStart, leftLinesHd) + in + if midpoint >= 0 then + Vector.tabulate + ( Vector.length leftLinesHd - midpoint + , fn idx => + Vector.sub (leftLinesHd, idx + midpoint) + - stringStart + ) + else + Vector.fromList [] + end + val newRightStrings = newString :: rightStrings + val newRightLines = newLines :: rightLines + val prevLine = curLine - Vector.length leftLinesHd + + val newNodeTextLength = String.size newString + val textLengthDifference = + oldNodeTextLength - newNodeTextLength + val textLength = textLength - textLengthDifference + + val newNodeLineLength = Vector.length newLines + val lineLengthDifference = + oldNodeLineLength - newNodeLineLength + val lineLength = lineLength - lineLengthDifference + in + deleteLeftFromHere + ( start + , prevIdx + , prevLine + , leftStringsTl + , leftLinesTl + , newRightStrings + , newRightLines + , textLength + , lineLength + ) + end + else if prevIdx < start then + if finish >= curIdx then + (* delete from end of string *) + let + val oldNodeTextLength = String.size leftStringsHd + val oldNodeLineLength = Vector.length leftLinesHd + + val sub1Length = start - prevIdx + val sub1 = String.substring (leftStringsHd, 0, sub1Length) + val sub1Lines = + if Vector.length leftLinesHd > 0 then + let + val midpoint = binSearch + (String.size sub1 - 1, leftLinesHd) + in + if midpoint >= 0 then + let + val slice = VectorSlice.slice + (leftLinesHd, 0, SOME (midpoint + 1)) + in + VectorSlice.vector slice + end + else + Vector.fromList [] + end + else + leftLinesHd + val newNodeTextLength = String.size sub1 + val textLengthDifference = + oldNodeTextLength - newNodeTextLength + val textLength = textLength - textLengthDifference + + val newNodeLineLength = Vector.length sub1Lines + val lineLengthDifference = + oldNodeLineLength - newNodeLineLength + val lineLength = lineLength - lineLengthDifference + in + { idx = prevIdx + String.size sub1 + , line = + (curLine - Vector.length leftLinesHd) + + Vector.length sub1Lines + , leftStrings = sub1 :: leftStringsTl + , leftLines = sub1Lines :: leftLinesTl + , rightStrings = rightStrings + , rightLines = rightLines + , textLength = textLength + , lineLength = lineLength + } + end + else + (* We want to delete in the middle of leftStringsHd. + * We also have to delete in the middle of leftLinesHd in order to + * do this. *) + let + val oldNodeTextLength = String.size leftStringsHd + val oldNodeLineLength = Vector.length leftLinesHd + + val sub1Length = start - prevIdx + val sub1 = String.substring (leftStringsHd, 0, sub1Length) + val sub2Start = finish - prevIdx + val sub2 = String.substring + ( leftStringsHd + , sub2Start + , String.size leftStringsHd - sub2Start + ) + + val sub1Lines = + if Vector.length leftLinesHd > 0 then + let + val midpoint = binSearch + (String.size sub1 - 1, leftLinesHd) + in + if midpoint >= 0 then + let + val slice = VectorSlice.slice + (leftLinesHd, 0, SOME (midpoint + 1)) + in + VectorSlice.vector slice + end + else + Vector.fromList [] + end + else + leftLinesHd + + val sub2Lines = + let + val midpoint = forwardBinSearch (sub2Start, leftLinesHd) + in + if midpoint < Vector.length leftLinesHd then + Vector.tabulate + ( Vector.length leftLinesHd - midpoint + , fn idx => + Vector.sub (leftLinesHd, idx + midpoint) + - sub2Start + ) + else + Vector.fromList [] + end + + val newNodeTextLength = String.size sub1 + String.size sub2 + val textLengthDifference = + oldNodeTextLength - newNodeTextLength + val textLength = textLength - textLengthDifference + + val newNodeLineLength = + Vector.length sub1Lines + Vector.length sub2Lines + val lineLengthDifference = + oldNodeLineLength - newNodeLineLength + val lineLength = lineLength - lineLengthDifference + in + { idx = prevIdx + String.size sub1 + , line = + (curLine - Vector.length leftLinesHd) + + Vector.length sub1Lines + , leftStrings = sub1 :: leftStringsTl + , leftLines = sub1Lines :: leftLinesTl + , rightStrings = sub2 :: rightStrings + , rightLines = sub2Lines :: rightLines + , textLength = textLength + , lineLength = lineLength + } + end + else + (* prevIdx = start + * We want to delete from the start of this string and stop. *) + let + val oldNodeTextLength = String.size leftStringsHd + val oldNodeLineLength = Vector.length leftLinesHd + + val strStart = finish - prevIdx + val str = String.substring + ( leftStringsHd + , strStart + , String.size leftStringsHd - strStart + ) + val lines = + let + val lineStart = forwardBinSearch (strStart, leftLinesHd) + in + if lineStart < Vector.length leftLinesHd then + Vector.tabulate + ( Vector.length leftLinesHd - lineStart + , fn idx => + Vector.sub (leftLinesHd, idx + lineStart) + - strStart + ) + else + Vector.fromList [] + end + + val newNodeTextLength = String.size str + val textLengthDifference = + oldNodeTextLength - newNodeTextLength + val textLength = textLength - textLengthDifference + + val newNodeLineLength = Vector.length lines + val lineLengthDifference = + oldNodeLineLength - newNodeLineLength + val lineLength = lineLength - lineLengthDifference + in + { idx = prevIdx + String.size str + , textLength = textLength + , line = + (curLine - Vector.length leftLinesHd) + String.size str + , lineLength = lineLength + , leftStrings = str :: leftStringsTl + , leftLines = lines :: leftLinesTl + , rightStrings = rightStrings + , rightLines = rightLines + } + end + else + (* prevIdx = finish + * We need to call a function that will start deleting from prevIdx. + * Optimsation: Try joining leftStrings/LinesHd with + * rightStrings/LinesHd if possible while staying in limit. *) + (case (rightStrings, rightLines) of + ( rightStringsHd :: rightStringsTl + , rightLinesHd :: rightLinesTl + ) => + if + isInLimit + ( leftStringsHd + , rightStringsHd + , leftLinesHd + , rightLinesHd + ) + then + (* Can join while staying in limit. *) + let + val newRightStringsHd = leftStringsHd ^ rightStringsHd + val newRightLinesHd = + Vector.tabulate + ( Vector.length leftLinesHd + + Vector.length rightLinesHd + , fn idx => + if idx < Vector.length leftLinesHd then + Vector.sub (leftLinesHd, idx) + else + Vector.sub + ( rightLinesHd + , idx - Vector.length leftLinesHd + ) + String.size leftStringsHd + ) + in + deleteLeftFromHere + ( start + , prevIdx + , curLine - Vector.length leftLinesHd + , leftStringsTl + , leftLinesTl + , newRightStringsHd :: rightStringsTl + , newRightLinesHd :: rightLinesTl + , textLength + , lineLength + ) + end + else + (* Cannot join while staying in limit. *) + deleteLeftFromHere + ( start + , prevIdx + , curLine - Vector.length leftLinesHd + , leftStringsTl + , leftLinesTl + , leftStringsHd :: rightStrings + , leftLinesHd :: rightLines + , textLength + , lineLength + ) + | (_, _) => + (* Right strings and lines are empty, so can't join. *) + deleteLeftFromHere + ( start + , prevIdx + , curLine - Vector.length leftLinesHd + , leftStringsTl + , leftLinesTl + , [leftStringsHd] + , [leftLinesHd] + , textLength + , lineLength + )) + end + | (_, _) => + (* Can't move further leftward so just return. *) + { idx = 0 + , textLength = textLength + , line = 0 + , lineLength = lineLength + , leftStrings = [] + , leftLines = [] + , rightStrings = rightStrings + , rightLines = rightLines + } + + fun del + ( start + , finish + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) = + if start > curIdx then + moveRightAndDelete + ( start + , finish + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + else if start < curIdx then + if finish <= curIdx then + moveLeftAndDelete + ( start + , finish + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + else + deleteFromLetAndRight + ( start + , finish + , curIdx + , curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + else + deleteRightFromHere + ( curIdx + , curLine + , curIdx + , finish + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + in + fun delete (start, length, buffer: t) = + if length > 0 then + del + ( start + , start + length + , #idx buffer + , #line buffer + , #leftStrings buffer + , #leftLines buffer + , #rightStrings buffer + , #rightLines buffer + , #textLength buffer + , #lineLength buffer + ) + else + buffer + end + + fun subRight (findIdx, curIdx, hd, tl) = + let + val nextIdx = curIdx + String.size hd + in + if findIdx > nextIdx - 1 then + case tl of + hd :: tl => subRight (findIdx, nextIdx, hd, tl) + | [] => raise Fail "not found" + else + let val strIdx = findIdx - curIdx + in String.sub (hd, strIdx) + end + end + + fun subLeft (findIdx, curIdx, hd, tl) = + let + val prevIdx = curIdx - String.size hd + in + if findIdx < prevIdx then + case tl of + hd :: tl => subLeft (findIdx, prevIdx, hd, tl) + | [] => raise Fail "not found" + else + let val strIdx = findIdx - prevIdx + in String.sub (hd, strIdx) + end + end + + fun sub (findIdx, buffer: t) = + if findIdx >= #idx buffer then + case #rightStrings buffer of + hd :: tl => subRight (findIdx, #idx buffer, hd, tl) + | [] => raise Fail "not found" + else + case #leftStrings buffer of + hd :: tl => subLeft (findIdx, #idx buffer, hd, tl) + | [] => raise Fail "not found" + + local + fun consIfNotEmpty (s, acc) = + if String.size s > 0 then s :: acc else acc + + (* We build up the string list and, at the end, + * we always make sure to reverse the list too + * because the order of the list matters for String.concat *) + fun subRightFromHere (curIdx, finish, right, acc, endWith) = + case right of + hd :: tl => + let + val nextIdx = curIdx + String.size hd + in + if nextIdx < finish then + subRightFromHere (curIdx, finish, tl, hd :: acc, endWith) + else if nextIdx > finish then + let + val length = finish - curIdx + val accHd = String.substring (hd, 0, length) + val acc = consIfNotEmpty (endWith, accHd :: acc) + in + List.rev acc + end + else + (* nextIdx = finish + * so add current hd to vec and then concat *) + let + val acc = hd :: acc + val acc = consIfNotEmpty (endWith, acc) + in + List.rev acc + end + end + | [] => let val acc = consIfNotEmpty (endWith, acc) in List.rev acc end + + fun moveRightAndSub (start, finish, curIdx, right, endWith) = + case right of + hd :: tl => + let + val nextIdx = curIdx + String.size hd + in + if nextIdx < start then + (* continue moving rightwards *) + moveRightAndSub (start, finish, nextIdx, tl, endWith) + else if nextIdx > start then + if nextIdx < finish then + (* get starting acc, + * and then call subRightFromHere *) + let + val substart = start - curIdx + val length = String.size hd - substart + val acc = [String.substring (hd, substart, length)] + val acc = subRightFromHere (nextIdx, finish, tl, acc, endWith) + in + String.concat acc + end + else if nextIdx > finish then + (* have to get susbstring from middle of this string *) + let + val substart = start - curIdx + val subfinish = finish - curIdx + val length = subfinish - substart + val str = String.substring (hd, substart, length) + in + if String.size endWith > 0 then str ^ endWith else str + end + else + (* have to get substring from middle to end *) + let + val substart = start - curIdx + val length = String.size hd - substart + val str = String.substring (hd, substart, length) + in + if String.size endWith > 0 then str ^ endWith else str + end + else + (* nextIdx = start + * so we have to ignore this string + * and start building acc from tl *) + let val acc = subRightFromHere (nextIdx, finish, tl, [], endWith) + in String.concat acc + end + end + | [] => + (* if there are no strings to the right, + * return empty string, + * as we cannot do much else. *) + endWith + + fun subLeftFromHere (start, curIdx, left, acc) = + case left of + hd :: tl => + let + val prevIdx = curIdx - String.size hd + in + if start < prevIdx then + (* continue *) + subLeftFromHere (start, prevIdx, tl, hd :: acc) + else if start > prevIdx then + (* need to add some part of this string to acc + * and return *) + let + val substart = start - prevIdx + val length = String.size hd - substart + val accHd = String.substring (hd, substart, length) + val acc = accHd :: acc + in + String.concat acc + end + else + (* start = prevIdx + * add hd to acc and return *) + let val acc = hd :: acc + in String.concat acc + end + end + | [] => String.concat acc + + fun subFromLeftAndRight (start, finish, curIdx, left, right, endWith) = + let val acc = subRightFromHere (curIdx, finish, right, [], endWith) + in subLeftFromHere (start, curIdx, left, acc) + end + + fun moveLeftAndSub (start, finish, curIdx, left, endWith) = + case left of + hd :: tl => + let + val prevIdx = curIdx - String.size hd + in + if prevIdx > finish then + (* continue *) + moveLeftAndSub (start, finish, prevIdx, tl, endWith) + else if prevIdx < finish then + if prevIdx > start then + (* get initial acc + * and continue substring leftwards *) + let + val length = finish - prevIdx + val str = String.substring (hd, 0, length) + val acc = [str, endWith] + in + subLeftFromHere (start, prevIdx, tl, acc) + end + else if prevIdx < start then + (* we want to return a substring + * extracted from the middle of hd *) + let + val substart = start - prevIdx + val subfinish = finish - prevIdx + val length = subfinish - substart + val str = String.substring (hd, substart, length) + in + if String.size endWith > 0 then str ^ endWith else str + end + else + (* prevIdx = start + * we want to return a substring starting from 0 *) + let + val subfinish = finish - prevIdx + val length = String.size hd - subfinish + val str = String.substring (hd, 0, length) + in + if String.size endWith > 0 then str ^ endWith else str + end + else + (* prevIdx = finish + * so we want to ignore hd and start + * subLeftFromHere with an empty list *) + subLeftFromHere (start, prevIdx, tl, [endWith]) + end + | [] => endWith + + fun sub (start, finish, curIdx, left, right, endWith) = + if start > curIdx then + (* move rightwards to begin getting substring *) + moveRightAndSub (start, finish, curIdx, right, endWith) + else if start < curIdx then + if finish <= curIdx then + moveLeftAndSub (start, finish, curIdx, left, endWith) + else + (* in middle of buffer we want to get substring from *) + subFromLeftAndRight (start, finish, curIdx, left, right, endWith) + else + let + (* start = curIdx so only need to traverse right *) + val acc = subRightFromHere (curIdx, finish, right, [], endWith) + in + String.concat acc + end + in + fun substringWithEnd (start, length, buffer: t, endWith) = + let + val finish = start + length + val {idx, leftStrings, rightStrings, ...} = buffer + in + sub (start, finish, idx, leftStrings, rightStrings, endWith) + end + + fun nullSubstring (start, length, buffer: t) = + let + val finish = start + length + val {idx, leftStrings, rightStrings, ...} = buffer + in + sub (start, finish, idx, leftStrings, rightStrings, "\u0000") + end + + fun substring (start, length, buffer: t) = + let + val finish = start + length + val {idx, leftStrings, rightStrings, ...} = buffer + in + sub (start, finish, idx, leftStrings, rightStrings, "") + end + end + + fun helpGoToStart + ( idx + , line + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) = + case (leftStrings, leftLines) of + (lStrHd :: lStrTl, lLnHd :: lLnTl) => + (case (rightStrings, rightLines) of + (rStrHd :: rStrTl, rLnHd :: rLnTl) => + if isInLimit (lStrHd, rStrHd, lLnHd, rLnHd) then + (* join if possible *) + let + val newRstrHd = lStrHd ^ rStrHd + val newRlnHd = + Vector.tabulate + ( Vector.length lLnHd + Vector.length rLnHd + , fn lnIdx => + if lnIdx < Vector.length lLnHd then + Vector.sub (lLnHd, lnIdx) + else + Vector.sub (rLnHd, lnIdx - Vector.length lLnHd) + + String.size lStrHd + ) + in + helpGoToStart + ( idx - String.size lStrHd + , line - Vector.length lLnHd + , lStrTl + , lLnTl + , newRstrHd :: rStrTl + , newRlnHd :: rLnTl + , textLength + , lineLength + ) + end + else + helpGoToStart + ( idx - String.size lStrHd + , line - Vector.length lLnHd + , lStrTl + , lLnTl + , lStrHd :: rightStrings + , lLnHd :: rightLines + , textLength + , lineLength + ) + | (_, _) => + (* rightStrings and rightLines are both empty *) + helpGoToStart + ( idx - String.size lStrHd + , line - Vector.length lLnHd + , lStrTl + , lLnTl + , [lStrHd] + , [lLnHd] + , textLength + , lineLength + )) + | (_, _) => + (* left strings are empty, meaning we are at start and can return *) + { idx = idx + , textLength = textLength + , line = line + , lineLength = lineLength + , leftStrings = [] + , leftLines = [] + , rightStrings = rightStrings + , rightLines = rightLines + } + + fun goToStart (buffer: t) = + let + val + { idx + , line + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + } = buffer + in + helpGoToStart + ( idx + , line + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + end + + fun helpGoToEnd + ( idx + , line + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) = + case (rightStrings, rightLines) of + (rStrHd :: rStrTl, rLnHd :: rLnTl) => + (case (leftStrings, leftLines) of + (lStrHd :: lStrTl, lLnHd :: lLnTl) => + if isInLimit (lStrHd, rStrHd, lLnHd, rLnHd) then + (* join if possible *) + let + val newLstrHd = lStrHd ^ rStrHd + val newLlnHd = + Vector.tabulate + ( Vector.length lLnHd + Vector.length rLnHd + , fn lnIdx => + if lnIdx < Vector.length lLnHd then + Vector.sub (lLnHd, lnIdx) + else + Vector.sub (rLnHd, lnIdx - Vector.length lLnHd) + + String.size lStrHd + ) + in + helpGoToEnd + ( idx + String.size rStrHd + , line + Vector.length rLnHd + , newLstrHd :: lStrTl + , newLlnHd :: lLnTl + , rStrTl + , rLnTl + , textLength + , lineLength + ) + end + else + helpGoToEnd + ( idx + String.size rStrHd + , line + Vector.length rLnHd + , rStrHd :: leftStrings + , rLnHd :: leftLines + , rStrTl + , rLnTl + , textLength + , lineLength + ) + | (_, _) => + (* rightStrings and rightLines are both empty *) + helpGoToEnd + ( idx + String.size rStrHd + , line + Vector.length rLnHd + , rStrHd :: leftStrings + , rLnHd :: leftLines + , rStrTl + , rLnTl + , textLength + , lineLength + )) + | (_, _) => + (* rightStrings strings are empty, meaning we are at end and can return *) + { idx = idx + , textLength = textLength + , line = line + , lineLength = lineLength + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = [] + , rightLines = [] + } + + fun goToEnd (buffer: t) = + let + val + { idx + , line + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + } = buffer + in + helpGoToEnd + ( idx + , line + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + end + + (* function to abstract leftwards movement. + * if the left hd and the right hd can be joined in one node + * during movement, while staying in limit, then join and move. + * Else, move without joining. + * The code to do this is a bit boiler-plate heavy + * so it has been abstracted to a reusable function. + * + * The last parameter, fGoLeft, is the function to return to + * after the leftwards movement. + * + * The third paremeter, searchTo, is the line number or UTF-8 + * index to search. Since moveLeft is meant to abstract over + * the search number, this parameter is just passed to fGoLeft. + * *) + fun moveLeft + ( idx + , line + , searchTo + , rightStrings + , rightLines + , lStrHd + , lStrTl + , lLnHd + , lLnTl + , textLength + , lineLength + , fGoLeft + ) = + case (rightStrings, rightLines) of + (rStrHd :: rStrTl, rLnHd :: rLnTl) => + if isInLimit (lStrHd, rStrHd, lLnHd, rLnHd) then + (* join into a single node before moving *) + let + val newRstrHd = lStrHd ^ rStrHd + val newRlnHd = + Vector.tabulate + ( Vector.length lLnHd + Vector.length rLnHd + , fn lnIdx => + if lnIdx < Vector.length lLnHd then + Vector.sub (lLnHd, lnIdx) + else + Vector.sub (rLnHd, lnIdx - Vector.length lLnHd) + + String.size lStrHd + ) + in + fGoLeft + ( idx - String.size lStrHd + , line - Vector.length lLnHd + , searchTo + , lStrTl + , lLnTl + , newRstrHd :: rStrTl + , newRlnHd :: rLnTl + , textLength + , lineLength + ) + end + else + (* move without joining *) + fGoLeft + ( idx - String.size lStrHd + , line - Vector.length lLnHd + , searchTo + , lStrTl + , lLnTl + , lStrHd :: rightStrings + , lLnHd :: rightLines + , textLength + , lineLength + ) + | (_, _) => + (* right side is empty, so just move left without joining *) + fGoLeft + ( idx - String.size lStrHd + , line - Vector.length lLnHd + , searchTo + , lStrTl + , lLnTl + , [lStrHd] + , [lLnHd] + , textLength + , lineLength + ) + + (* same as moveLeft function, except it move rightwards instead *) + fun moveRight + ( idx + , line + , searchTo + , leftStrings + , leftLines + , rStrHd + , rStrTl + , rLnHd + , rLnTl + , textLength + , lineLength + , fGoRight + ) = + case (leftStrings, leftLines) of + (lStrHd :: lStrTl, lLnHd :: lLnTl) => + if isInLimit (lStrHd, rStrHd, lLnHd, rLnHd) then + (* can join while staying in limit, so join and move right *) + let + val newLstrHd = lStrHd ^ rStrHd + val newLlnHd = + Vector.tabulate + ( Vector.length lLnHd + Vector.length rLnHd + , fn lnIdx => + if lnIdx < Vector.length lLnHd then + Vector.sub (lLnHd, lnIdx) + else + Vector.sub (rLnHd, lnIdx - Vector.length lLnHd) + + String.size lStrHd + ) + in + fGoRight + ( idx + String.size rStrHd + , line + Vector.length rLnHd + , searchTo + , newLstrHd :: lStrTl + , newLlnHd :: lLnTl + , rStrTl + , rLnTl + , textLength + , lineLength + ) + end + else + (* cannot join while staying in limit, so just move right *) + fGoRight + ( idx + String.size rStrHd + , line + Vector.length rLnHd + , searchTo + , rStrHd :: leftStrings + , rLnHd :: leftLines + , rStrTl + , rLnTl + , textLength + , lineLength + ) + | (_, _) => + (* left side is empty, so just move rightwards without joining *) + fGoRight + ( String.size rStrHd + , Vector.length rLnHd + , searchTo + , [rStrHd] + , [rLnHd] + , rStrTl + , rLnTl + , textLength + , lineLength + ) + + fun helpGoToLineLeft + ( idx + , line + , searchLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) = + case (leftStrings, leftLines) of + (lStrHd :: lStrTl, lLnHd :: lLnTl) => + if searchLine >= line - Vector.length lLnHd then + (* line is at left head, so place it to the right and return *) + { idx = idx - String.size lStrHd + , textLength = textLength + , line = line - Vector.length lLnHd + , lineLength = lineLength + , leftStrings = lStrTl + , leftLines = lLnTl + , rightStrings = lStrHd :: rightStrings + , rightLines = lLnHd :: rightLines + } + else + (* move leftwards, joining if possible *) + moveLeft + ( idx + , line + , searchLine + , rightStrings + , rightLines + , lStrHd + , lStrTl + , lLnHd + , lLnTl + , textLength + , lineLength + , helpGoToLineLeft + ) + | (_, _) => + (* left side is empty, so just return *) + { idx = idx + , textLength = textLength + , line = line + , lineLength = lineLength + , leftStrings = [] + , leftLines = [] + , rightStrings = rightStrings + , rightLines = rightLines + } + + fun helpGoToLineRight + ( idx + , line + , searchLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) = + case (rightStrings, rightLines) of + (rStrHd :: rStrTl, rLnHd :: rLnTl) => + if line + Vector.length rLnHd >= searchLine then + (* searchLine is in rStrHd/rLnHd, so return *) + { idx = idx + , textLength = textLength + , line = line + , lineLength = lineLength + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = rightStrings + , rightLines = rightLines + } + else + (* have to move rightwards *) + moveRight + ( idx + , line + , searchLine + , leftStrings + , leftLines + , rStrHd + , rStrTl + , rLnHd + , rLnTl + , textLength + , lineLength + , helpGoToLineRight + ) + | (_, _) => + (* right side is empty, so just return *) + { idx = idx + , textLength = textLength + , line = line + , lineLength = lineLength + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = [] + , rightLines = [] + } + + fun goToLine (searchLine, buffer: t) = + let + val + { idx + , line + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + } = buffer + in + (* we compare current line with searchLine - 1 + * because if searchLine - 1 is here, + * that means we can access the linebreak + * that starts searchLine *) + if searchLine - 1 < line then + helpGoToLineLeft + ( idx + , line + , searchLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + else if searchLine - 1 > line then + helpGoToLineRight + ( idx + , line + , searchLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + else + buffer + end + + fun helpGoToIdxLeft + ( idx + , line + , searchIdx + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) = + case (leftStrings, leftLines) of + (lStrHd :: lStrTl, lLnHd :: lLnTl) => + if searchIdx < idx - String.size lStrHd then + (* move leftwards, joining if possible *) + moveLeft + ( idx + , line + , searchIdx + , rightStrings + , rightLines + , lStrHd + , lStrTl + , lLnHd + , lLnTl + , textLength + , lineLength + , helpGoToIdxLeft + ) + else + (* line is at left head, so place it to the right and return *) + { idx = idx - String.size lStrHd + , textLength = textLength + , line = line - Vector.length lLnHd + , lineLength = lineLength + , leftStrings = lStrTl + , leftLines = lLnTl + , rightStrings = lStrHd :: rightStrings + , rightLines = lLnHd :: rightLines + } + | (_, _) => + (* left side is empty, so just return *) + { idx = idx + , textLength = textLength + , line = line + , lineLength = lineLength + , leftStrings = [] + , leftLines = [] + , rightStrings = rightStrings + , rightLines = rightLines + } + + fun helpGoToIdxRight + ( idx + , line + , searchIdx + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) = + case (rightStrings, rightLines) of + (rStrHd :: rStrTl, rLnHd :: rLnTl) => + if searchIdx > idx + String.size rStrHd then + (* have to move rightwards *) + moveRight + ( idx + , line + , searchIdx + , leftStrings + , leftLines + , rStrHd + , rStrTl + , rLnHd + , rLnTl + , textLength + , lineLength + , helpGoToIdxRight + ) + else + (* searchLine is in rStrHd/rLnHd, so return *) + { idx = idx + , textLength = textLength + , line = line + , lineLength = lineLength + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = rightStrings + , rightLines = rightLines + } + | (_, _) => + (* right side is empty, so just return *) + { idx = idx + , textLength = textLength + , line = line + , lineLength = lineLength + , leftStrings = leftStrings + , leftLines = leftLines + , rightStrings = [] + , rightLines = [] + } + + fun goToIdx (searchIdx, buffer: t) = + let + val + { idx + , line + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + } = buffer + in + if searchIdx < idx then + helpGoToIdxLeft + ( idx + , line + , searchIdx + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + else if searchIdx > idx then + helpGoToIdxRight + ( idx + , line + , searchIdx + , leftStrings + , leftLines + , rightStrings + , rightLines + , textLength + , lineLength + ) + else + buffer + end + + fun idxToLineNumberLeft (findIdx, curIdx, curLine, leftStrings, leftLines) = + case (leftStrings, leftLines) of + (shd :: stl, lhd :: ltl) => + let + val prevIdx = curIdx - String.size shd + in + if findIdx = prevIdx then + curLine - Vector.length lhd + else if findIdx > prevIdx then + (* bin search vector *) + if Vector.length lhd = 0 then + curLine + else + let + val prevLine = curLine - Vector.length lhd + val relativeIdx = findIdx - prevIdx - 1 + val relativeLine = binSearch (relativeIdx, lhd) + 1 + in + prevLine + relativeLine + end + else + let val prevLine = curLine - Vector.length lhd + in idxToLineNumberLeft (findIdx, prevIdx, prevLine, stl, ltl) + end + end + | (_, _) => 0 + + fun idxToLineNumberRight (findIdx, curIdx, curLine, rightStrings, rightLines) = + case (rightStrings, rightLines) of + (shd :: stl, lhd :: ltl) => + let + val nextIdx = curIdx + String.size shd + in + if findIdx = nextIdx then + curLine + Vector.length lhd + else if findIdx < nextIdx then + if Vector.length lhd = 0 then + curLine + else + let + val relativeIdx = findIdx - curIdx - 1 + val relativeLine = binSearch (relativeIdx, lhd) + 1 + in + curLine + relativeLine + end + else + let val nextLine = curLine + Vector.length lhd + in idxToLineNumberRight (findIdx, nextIdx, nextLine, stl, ltl) + end + end + | (_, _) => curLine + + fun idxToLineNumber (findIdx, buffer: t) = + let + val + { idx = curIdx + , leftStrings + , leftLines + , rightStrings + , rightLines + , line = curLine + , ... + } = buffer + in + if findIdx < curIdx then + idxToLineNumberLeft (findIdx, curIdx, curLine, leftStrings, leftLines) + else if findIdx > curIdx then + idxToLineNumberRight + (findIdx, curIdx, curLine, rightStrings, rightLines) + else + curLine + end + + fun lineNumberToIdxLeft (findLine, curIdx, curLine, leftStrings, leftLines) = + case (leftStrings, leftLines) of + (shd :: stl, lhd :: ltl) => + let + val prevLine = curLine - Vector.length lhd + val prevIdx = curIdx - String.size shd + in + if findLine >= prevLine then + let val relativeLine = findLine - prevLine - 1 + in Vector.sub (lhd, relativeLine) + prevIdx + end + else + lineNumberToIdxLeft (findLine, prevIdx, prevLine, stl, ltl) + end + | (_, _) => 0 + + fun lineNumberToIdxRight (findLine, curIdx, curLine, rightStrings, rightLines) = + case (rightStrings, rightLines) of + (shd :: stl, lhd :: ltl) => + let + val nextLine = curLine + Vector.length lhd + in + if findLine <= nextLine then + let val relativeLine = findLine - curLine - 1 + in Vector.sub (lhd, relativeLine) + curIdx + end + else + lineNumberToIdxRight + (findLine, curIdx + String.size shd, nextLine, stl, ltl) + end + | (_, _) => curIdx + + fun lineNumberToIdx (findLine, buffer: t) = + let + val + { idx = curIdx + , line = curLine + , leftStrings + , leftLines + , rightStrings + , rightLines + , ... + } = buffer + in + if findLine - 1 < curLine then + lineNumberToIdxLeft (findLine, curIdx, curLine, leftStrings, leftLines) + else + lineNumberToIdxRight + (findLine, curIdx, curLine, rightStrings, rightLines) + end + + type string_iterator = + { idx: int + , leftStrings: string list + , rightStrings: string list + , textLength: int + } + + fun makeStringIterator ({idx, leftStrings, rightStrings, textLength, ...}: t) = + { idx = idx + , leftStrings = leftStrings + , rightStrings = rightStrings + , textLength = textLength + } + + fun moveIteratorLeft (findIdx, idx, leftStrings, rightStrings, textLength) = + case leftStrings of + hd :: tl => + let + val prevIdx = idx - String.size hd + in + if findIdx < prevIdx then + moveIteratorLeft + (findIdx, prevIdx, tl, hd :: rightStrings, textLength) + else + { idx = idx + , leftStrings = leftStrings + , rightStrings = rightStrings + , textLength = textLength + } + end + | [] => + { idx = idx + , leftStrings = leftStrings + , rightStrings = rightStrings + , textLength = textLength + } + + fun moveIteratorRight (findIdx, idx, leftStrings, rightStrings, textLength) = + case rightStrings of + hd :: tl => + let + val nextIdx = idx + String.size hd + in + if findIdx > nextIdx then + moveIteratorRight + (findIdx, nextIdx, hd :: leftStrings, tl, textLength) + else + { idx = idx + , leftStrings = leftStrings + , rightStrings = rightStrings + , textLength = textLength + } + end + | [] => + { idx = idx + , leftStrings = leftStrings + , rightStrings = rightStrings + , textLength = textLength + } + + fun moveIteratorToIdx (findIdx, {idx, leftStrings, rightStrings, textLength}) = + if findIdx < idx then + moveIteratorLeft (findIdx, idx, leftStrings, rightStrings, textLength) + else + moveIteratorRight (findIdx, idx, leftStrings, rightStrings, textLength) + + fun subIterator (findIdx, {idx, leftStrings, rightStrings, textLength = _}) = + if findIdx >= idx then + case rightStrings of + hd :: tl => subRight (findIdx, idx, hd, tl) + | [] => raise Fail "not found" + else + case leftStrings of + hd :: tl => subLeft (findIdx, idx, hd, tl) + | [] => raise Fail "not found" + + (* TEST CODE *) + local + fun lineBreaksToString vec = + (Vector.foldr (fn (el, acc) => Int.toString el ^ ", " ^ acc) "" vec) + ^ "\n" + + fun checkLineBreaks (v1, v2) = + if v1 = v2 then + () + else + let + val _ = print ("broken: " ^ (lineBreaksToString v1)) + val _ = print ("fixed: " ^ (lineBreaksToString v2)) + in + () + end + + fun goToStart (leftStrings, leftLines, accStrings, accLines) = + case (leftStrings, leftLines) of + (lsHd :: lsTl, llHd :: llTl) => + goToStart (lsTl, llTl, lsHd :: accStrings, llHd :: accLines) + | (_, _) => (accStrings, accLines) + + fun isLineListCorrect (strings, lines) = + case (strings, lines) of + (strHd :: strTl, lHd :: lTl) => + let + val checkLines = countLineBreaks strHd + in + if checkLines = lHd then + isLineListCorrect (strTl, lTl) + else + let + val _ = print "line metadata is incorrect\n" + val _ = checkLineBreaks (lHd, checkLines) + in + false + end + end + | (_, _) => (print "verified lines; no problems\n"; true) + in + fun verifyLines (buffer: t) = + let + val (strings, lines) = + goToStart + ( #leftStrings buffer + , #leftLines buffer + , #rightStrings buffer + , #rightLines buffer + ) + + val lineListIsCorrect = isLineListCorrect (strings, lines) + val lineLengthIsCorrect = let val lines = Vector.concat lines + in Vector.length lines = #lineLength buffer + end + val () = + if lineLengthIsCorrect then () else print "line length is incorrect\n" + in + if lineLengthIsCorrect andalso lineListIsCorrect then () + else raise Fail "" + end + end + + local + fun calcIndexList (accIdx, lst) = + case lst of + [] => accIdx + | hd :: tl => calcIndexList (String.size hd + accIdx, tl) + + fun calcIndexStart lst = calcIndexList (0, lst) + in + fun verifyIndex (buffer: t) = + let + val bufferIdx = #idx buffer + val correctIdx = calcIndexStart (#leftStrings buffer) + val idxIsCorrect = bufferIdx = correctIdx + + val {rightLines, rightStrings, ...} = goToStart buffer + + val textLength = #textLength buffer + val correctTextLength = String.size (String.concat rightStrings) + val textLengthIsCorrect = textLength = correctTextLength + + val lineLength = #lineLength buffer + val correctLineLength = Vector.length (Vector.concat rightLines) + val lineLengthIsCorrect = lineLength = correctLineLength + + val _ = + if idxIsCorrect then + print "idx is correct\n" + else + let + val msg = String.concat + [ "idx is incorrect;" + , "bufferIdx: " + , Int.toString bufferIdx + , "; correctIdx: " + , Int.toString correctIdx + , "\n" + ] + in + print msg + end + + val _ = + if textLengthIsCorrect then + print "textLength is correct\n" + else + let + val msg = String.concat + [ "text length is incorrect;" + , "text length: " + , Int.toString textLength + , "; correct length: " + , Int.toString correctTextLength + , "\n" + ] + in + print msg + end + + val _ = + if lineLengthIsCorrect then + print "lineLength is correct\n" + else + let + val msg = String.concat + [ "line length is incorrect;" + , "line length: " + , Int.toString lineLength + , "; correct length: " + , Int.toString correctLineLength + , "\n" + ] + in + print msg + end + + val () = print "\n" + in + if textLengthIsCorrect andalso idxIsCorrect andalso lineLengthIsCorrect then + () + else + raise Fail "either index or idx metadata or text length is incorrect" + end + end +end gut feeling