From 01369627bfe87f2a092a16558fe46355d8a181dc Mon Sep 17 00:00:00 2001 From: Humza Shahid Date: Tue, 5 Aug 2025 13:24:55 +0100 Subject: [PATCH] begin reimplementing search list data structure --- fcore/search-list.sml | 605 ++++--------------------------- fcore/search/search-line-gap.sml | 49 +++ shell/update-thread.sml | 3 + shf-tests.mlb | 2 + shf.mlb | 2 + 5 files changed, 118 insertions(+), 543 deletions(-) create mode 100644 fcore/search/search-line-gap.sml diff --git a/fcore/search-list.sml b/fcore/search-list.sml index 79a2a82..2f0da00 100644 --- a/fcore/search-list.sml +++ b/fcore/search-list.sml @@ -17,19 +17,64 @@ end structure SearchList : SEARCH_LIST = struct - type t = {left: int vector list, right: int vector list} + structure IntSet = MakeGapSet ( + struct + type key = int - (* clojure's persistent vectors contain arrays of length 32 - * and this data structure is similar to that, so we also use 32 *) - val targetLength = 32 + val maxNodeSize = 32 - val empty: t = {left = [], right = []} + fun l (a: int, b) = a < b + fun eq (a: int, b) = a = b + fun g (a: int, b) = a > b + end + ) + + type t = IntSet.t + + fun helpToVector (left, right) = + case left of + hd :: tl => helpToVector (tl, hd :: right) + | [] => Vector.concat right + + (* for testing *) + fun toVector {left, right} = helpToVector (left, right) + + + val empty = IntSet.empty + + fun insert (num, set) = + let + val () = print ("adding num: " ^ Int.toString num ^ "\n") + in + IntSet.add (num, set) + end + + val append = IntSet.add + + val goToNum = IntSet.moveTo + + fun delete (start, length, searchString, set) = + if length > 0 then + let + val firstVec = toVector set + val finish = start + length + val start = start - String.size searchString + 1 + val result = IntSet.removeMany (start, finish, set) + + val secondVec = toVector result + + val () = print ("delete start has " ^ Int.toString (Vector.length + firstVec) ^ "elements\n") + val () = print ("delete result has " ^ Int.toString (Vector.length + secondVec) ^ "elements\n") + in + result + end + else + set fun isLessThanTarget (v1, v2) = - Vector.length v1 + Vector.length v2 <= targetLength - - fun isThreeLessThanTarget (v1, v2, v3) = - Vector.length v1 + Vector.length v2 + Vector.length v3 <= targetLength + Vector.length v1 + Vector.length v2 <= 32 fun joinEndOfLeft (new, left) = case left of @@ -42,496 +87,6 @@ struct new :: left | [] => new :: left - fun joinStartOfRight (new, right) = - case right of - hd :: tail => - if isLessThanTarget (new, hd) then - let val newHd = Vector.concat [new, hd] - in newHd :: tail - end - else - new :: right - | [] => new :: right - - fun insMiddle (new, middle, hd, tl, left, right) = - let - val leftSlice = VectorSlice.slice (hd, 0, SOME middle) - val rightLength = Vector.length hd - middle - val rightSlice = VectorSlice.slice (hd, middle, SOME rightLength) - - val new = Vector.fromList [new] - val new = VectorSlice.full new - in - if Vector.length hd < targetLength then - let val newHd = VectorSlice.concat [leftSlice, new, rightSlice] - in {left = joinEndOfLeft (newHd, tl), right = right} - end - else if middle < targetLength then - (* leftSlice is less than targetLength *) - let - val hd1 = VectorSlice.concat [leftSlice, new] - val hd2 = VectorSlice.vector rightSlice - in - { left = joinEndOfLeft (hd1, tl) - , right = joinStartOfRight (hd2, right) - } - end - else - let - val hd1 = VectorSlice.vector leftSlice - val hd2 = VectorSlice.concat [new, rightSlice] - in - { left = joinEndOfLeft (hd1, tl) - , right = joinStartOfRight (hd2, right) - } - end - end - - fun insLeft (new, left, right) = - case left of - hd :: tl => - let - val first = Vector.sub (hd, 0) - in - if new < first then - insLeft (new, tl, joinStartOfRight (hd, right)) - else if new > first then - let - val last = Vector.sub (hd, Vector.length hd - 1) - in - if new < last then - (* new is or should be in middle *) - let - val middle = BinSearch.equalOrMore (new, hd) - in - if new <> Vector.sub (hd, middle) then - (* not in middle, so insert *) - insMiddle (new, middle, hd, tl, left, right) - else - (* new is in middle, so just return *) - {left = left, right = right} - end - else if new > last then - (* have to insert new at end of left - * or start of right (both are equivalent) *) - { left = left - , right = joinStartOfRight (Vector.fromList [new], right) - } - else - (* new = last so just return *) - {left = left, right = right} - end - else - (* new = first *) - {left = left, right = right} - end - | [] => - let val new = Vector.fromList [new] - in {left = left, right = joinStartOfRight (new, right)} - end - - fun insRight (new, left, right) = - case right of - hd :: tl => - let - val last = Vector.sub (hd, Vector.length hd - 1) - in - if new > last then - insRight (new, joinEndOfLeft (hd, left), tl) - else if new < last then - let - val first = Vector.sub (hd, 0) - in - if new > first then - (* have to insert in middle *) - let - val middle = BinSearch.equalOrMore (new, hd) - in - if new <> Vector.sub (hd, middle) then - (* not in middle, so insert *) - insMiddle (new, middle, hd, tl, left, right) - else - (* new is in middle, so return *) - {left = left, right = right} - end - else if new < first then - (* have to insert new at start of right - * or end of left (both are equivalent) *) - { left = left - , right = joinStartOfRight (Vector.fromList [new], right) - } - else - (* new = first so just return *) - {left = left, right = right} - end - else - (* new = last *) - {left = left, right = right} - end - | [] => - let val new = Vector.fromList [new] - in {left = joinEndOfLeft (new, left), right = right} - end - - fun insert (new, {left, right}: t) = - (* look at elements to see which way to traverse *) - case right of - hd :: _ => - if new > Vector.sub (hd, 0) then insRight (new, left, right) - else insLeft (new, left, right) - | [] => insLeft (new, left, right) - - fun helpAppend (new, left, right) = - case right of - hd :: tl => helpAppend (new, joinEndOfLeft (hd, left), tl) - | [] => {left = joinEndOfLeft (Vector.fromList [new], left), right = right} - - fun append (new, {left, right}: t) = helpAppend (new, left, right) - - fun helpGoToNumLeft (num, left, right) = - case left of - hd :: tl => - if num < Vector.sub (hd, 0) then - (* continue *) - helpGoToNumLeft (num, tl, joinStartOfRight (hd, right)) - else - (* greater or equal to first element so return. - * Note: caller which destructures list expects found hd to always be - * on right. *) - {left = tl, right = joinStartOfRight (hd, right)} - | [] => {left = left, right = right} - - fun helpGoToNumRight (num, left, right) = - case right of - hd :: tl => - if num > Vector.sub (hd, Vector.length hd - 1) then - (* continue *) - helpGoToNumRight (num, joinEndOfLeft (hd, left), tl) - else - (* less than or equal to last element so return *) - {left = left, right = right} - | [] => {left = left, right = right} - - fun goToNum (num, {left, right}: t) = - case right of - hd :: tl => - if Vector.length hd > 0 then - if Vector.sub (hd, 0) >= Vector.sub (hd, 0) then - (* num is greater or equal to first el on right so go right *) - helpGoToNumRight (num, left, right) - else - (* num is less than first el on right so go left *) - helpGoToNumLeft (num, left, right) - else - helpGoToNumLeft (num, left, right) - | [] => helpGoToNumLeft (num, left, right) - - fun delRightFromHere (finish, left, right) = - case right of - hd :: tl => - let - val last = Vector.sub (hd, Vector.length hd - 1) - in - if finish > last then - delRightFromHere (finish, left, tl) - else if finish < Vector.sub (hd, 0) then - (* finish < first *) - {left = left, right = right} - else if finish < last then - let - val delstart = BinSearch.equalOrMore (finish, hd) - val dellength = Vector.length hd - delstart - val newHd = VectorSlice.slice (hd, delstart, SOME dellength) - val newHd = VectorSlice.vector newHd - in - {left = left, right = joinStartOfRight (newHd, tl)} - end - else - (* finish = last *) - {left = left, right = tl} - end - | [] => {left = left, right = right} - - fun moveRightAndDelete (start, finish, left, right) = - case right of - hd :: tl => - let - val first = Vector.sub (hd, 0) - val last = Vector.sub (hd, Vector.length hd - 1) - in - if start > last then - moveRightAndDelete (start, finish, joinEndOfLeft (hd, left), tl) - else if start > first then - if finish < last then - (* we want to delete frrom the middle of hd *) - let - val len1 = BinSearch.equalOrMore (start, hd) - val start2 = BinSearch.equalOrMore (finish, hd) - in - if len1 = start2 then - (* There is a chance the user will want to delete text - * that is not within a search point but between. - * This case just prevents an extra unnecessary vector - * allocation for tht case. *) - {left = left, right = right} - else - let - val len2 = Vector.length hd - start2 - val lhd = VectorSlice.slice (hd, 0, SOME len1) - val rhd = VectorSlice.slice (hd, start2, SOME len2) - val lhd = VectorSlice.vector lhd - val rhd = VectorSlice.vector rhd - in - { left = joinEndOfLeft (lhd, left) - , right = joinStartOfRight (rhd, tl) - } - end - end - else if finish = last then - (* deletion range is from middle of this vector to end - * which means we want to preserve first half *) - let - val length = BinSearch.equalOrMore (start, hd) - val newHd = VectorSlice.slice (hd, 0, SOME length) - val newHd = VectorSlice.vector newHd - in - {left = left, right = joinStartOfRight (newHd, tl)} - end - else - (* finish > last *) - let - val length = BinSearch.equalOrMore (start, hd) - val newHd = VectorSlice.slice (hd, 0, SOME length) - val newHd = VectorSlice.vector newHd - val left = joinEndOfLeft (newHd, left) - in - delRightFromHere (finish, left, right) - end - else if start < last then - if finish > last then - (* delete part of hd, and continue deleting rightwards *) - let - val delpoint = BinSearch.equalOrMore (start, hd) - val newHd = VectorSlice.slice (hd, 0, SOME delpoint) - val newHd = VectorSlice.vector newHd - in - delRightFromHere (finish, joinEndOfLeft (newHd, left), tl) - end - else if finish < last then - (* have to delete from middle of hd and then return *) - let - val startpoint = BinSearch.equalOrMore (start, hd) - val finishpoint = BinSearch.equalOrMore (finish, hd) - val lhd = VectorSlice.slice (hd, 0, SOME - (Vector.length hd - startpoint)) - val rhd = VectorSlice.slice (hd, finishpoint, SOME - (Vector.length hd - finishpoint)) - val lhd = VectorSlice.vector lhd - val rhd = VectorSlice.vector rhd - in - { left = joinEndOfLeft (lhd, left) - , right = joinStartOfRight (rhd, right) - } - end - else - (* finish = last, which means delete from last part of hd *) - let - val startpoint = BinSearch.equalOrMore (start, hd) - val newHd = VectorSlice.slice (hd, 0, SOME startpoint) - val newHd = VectorSlice.vector newHd - in - {left = left, right = joinStartOfRight (newHd, tl)} - end - else - (* start = last, meaning delete last and then continue deleting right*) - let - val length = Vector.length hd - 1 - val newHd = VectorSlice.slice (hd, 0, SOME length) - val newHd = VectorSlice.vector newHd - in - delRightFromHere (finish, joinEndOfLeft (newHd, left), tl) - end - end - | [] => {left = left, right = right} - - fun delLeftFromHere (start, left, right) = - case left of - hd :: tl => - let - val first = Vector.sub (hd, 0) - in - if start < first then - delLeftFromHere (start, tl, right) - else if start > Vector.sub (hd, Vector.length hd - 1) then - (* start > last *) - {left = left, right = right} - else if start > first then - let - val delpoint = BinSearch.equalOrMore (start, hd) - val newLength = Vector.length hd - delpoint - val newHd = VectorSlice.slice (hd, delpoint, SOME newLength) - val newHd = VectorSlice.vector newHd - in - {left = joinEndOfLeft (newHd, tl), right = right} - end - else - (* start = first *) - {left = tl, right = right} - end - | [] => {left = left, right = right} - - fun moveLeftAndDelete (start, finish, left, right) = - case left of - hd :: tl => - let - val first = Vector.sub (hd, 0) - val last = Vector.sub (hd, Vector.length hd - 1) - in - if finish < first then - moveLeftAndDelete (start, finish, tl, joinStartOfRight (hd, right)) - else if finish > last then - if start > last then - {left = left, right = right} - else if start = last then - let - val len = Vector.length hd - 1 - val newHd = VectorSlice.slice (hd, 0, SOME len) - val newHd = VectorSlice.vector newHd - in - {left = joinEndOfLeft (newHd, tl), right = right} - end - else - (* start < last *) - let - val len1 = BinSearch.equalOrMore (start, hd) - val start2 = BinSearch.equalOrMore (finish, hd) - in - if len1 = start2 then - {left = left, right = right} - else - let - val len2 = Vector.length hd - start2 - val lhd = VectorSlice.slice (hd, 0, SOME len1) - val rhd = VectorSlice.slice (hd, start2, SOME len2) - val lhd = VectorSlice.vector lhd - val rhd = VectorSlice.vector rhd - in - { left = joinEndOfLeft (lhd, left) - , right = joinStartOfRight (rhd, tl) - } - end - end - else if finish > first then - if start < first then - (* delete from start of hd and continue deleting leftwards *) - let - val startpoint = BinSearch.equalOrMore (finish, hd) - val len = Vector.length hd - startpoint - val newHd = VectorSlice.slice (hd, startpoint, SOME len) - val newHd = VectorSlice.vector newHd - in - delLeftFromHere (start, tl, joinStartOfRight (newHd, right)) - end - else if start > first then - (* delete from middle and then return *) - let - val llen = BinSearch.equalOrMore (start, hd) - val rstart = BinSearch.equalOrMore (finish, hd) - val rlen = Vector.length hd - rstart - val lhd = VectorSlice.slice (hd, 0, SOME llen) - val rhd = VectorSlice.slice (hd, rstart, SOME rlen) - val lhd = VectorSlice.vector lhd - val rhd = VectorSlice.vector rhd - in - { left = joinEndOfLeft (lhd, tl) - , right = joinStartOfRight (rhd, right) - } - end - else - (* start = first and finish > first - * have to delete from start of hd and return*) - let - val startpoint = BinSearch.equalOrMore (finish, hd) - val len = Vector.length hd - startpoint - val newHd = VectorSlice.slice (hd, startpoint, SOME len) - val newHd = VectorSlice.vector newHd - in - {left = joinEndOfLeft (newHd, tl), right = right} - end - else - (* finish = first *) - let - val len = Vector.length hd - 1 - val newHd = VectorSlice.slice (hd, 1, SOME len) - val newHd = VectorSlice.vector newHd - in - if start < first then - delLeftFromHere (start, tl, joinStartOfRight (newHd, right)) - else - (* start = first *) - {left = tl, right = joinStartOfRight (newHd, right)} - end - end - | [] => {left = left, right = right} - - fun delFromLeftAndRight (start, finish, left, right) = - let val {left, right} = delRightFromHere (finish, left, right) - in delLeftFromHere (start, left, right) - end - - fun del (start, finish, left, right) = - case right of - rhd :: rtl => - let - val rfirst = Vector.sub (rhd, 0) - in - if start < rfirst then - if finish < rfirst then - (case left of - lhd :: ltl => - let - val llast = Vector.sub (lhd, Vector.length lhd - 1) - in - if finish = llast then delLeftFromHere (start, left, right) - else moveLeftAndDelete (start, finish, left, right) - end - | [] => {left = left, right = right}) - else - (* finish >= rfirst *) - delFromLeftAndRight (start, finish, left, right) - else if start = rfirst then - delRightFromHere (finish, left, right) - else - (* finish > rfirst *) - moveRightAndDelete (start, finish, left, right) - end - | [] => - (case left of - lhd :: ltl => - let - val llast = Vector.sub (lhd, Vector.length lhd - 1) - in - if finish >= llast then - delLeftFromHere (start, left, right) - else - (* finish < last *) - moveLeftAndDelete (start, finish, left, right) - end - | [] => - (* left and right are both empty *) - {left = left, right = right}) - - fun delete (start, length, searchString, {left, right}: t) = - if length > 0 then - let - val finish = start + length - val start = start - String.size searchString + 1 - in - del (start, finish, left, right) - end - else - {left = left, right = right} - (* go all the way to the end of the list, mapping each hd, * joining the hd to the left, * and return when we have reached the end *) @@ -576,59 +131,23 @@ struct fun mapFrom (num, mapBy, lst) = let (* goToNum always places vector where num was found to the right list *) - val {left, right} = goToNum (num, lst) + val () = print ("mapping by " ^ Int.toString num ^ "\n") + val {left, right} = goToNum (0, lst) in - moveRightAndMap (num, mapBy, left, right) + moveRightAndMap (num, 0, left, right) end - fun helpExistsRight (num, right) = - case right of - hd :: tl => - let - val rlast = Vector.sub (hd, Vector.length hd - 1) - in - if num > rlast then helpExistsRight (num, tl) - else BinSearch.exists (num, hd) - end - | [] => false - - fun helpExistsLeft (num, left) = - case left of - hd :: tl => - let - val lfirst = Vector.sub (hd, 0) - in - if num < lfirst then helpExistsLeft (num, tl) - else BinSearch.exists (num, hd) - end - | [] => false - - fun exists (num, {left, right}) = - case right of - rhd :: rtl => - let - val rfirst = Vector.sub (rhd, 0) - in - if num = rfirst then true - else if num > rfirst then helpExistsRight (num, right) - else helpExistsLeft (num, left) - end - | [] => helpExistsLeft (num, left) - - fun helpToVector (left, right) = - case left of - hd :: tl => helpToVector (tl, hd :: right) - | [] => Vector.concat right - - (* for testing *) - fun toVector {left, right} = helpToVector (left, right) + val exists = IntSet.exists fun toString {left, right} = let val vec = toVector {left = left, right = right} + val () = print ("toString has " ^ Int.toString (Vector.length vec) ^ + "elements\n") + val strList = Vector.foldr (fn (num, acc) => Int.toString num :: acc) [] vec in - String.concatWith ", " strList + "" end end diff --git a/fcore/search/search-line-gap.sml b/fcore/search/search-line-gap.sml new file mode 100644 index 0000000..32feac1 --- /dev/null +++ b/fcore/search/search-line-gap.sml @@ -0,0 +1,49 @@ +structure SearchLineGap = +struct + fun searchStep (pos, hd, absIdx, tl, acc, searchPos, searchString) = + if searchPos < 0 then + (absIdx + 1) :: acc + else if pos < 0 then + case tl of + hd :: tl => + searchStep (String.size hd - 1, hd, absIdx, tl, acc, searchPos, searchString) + | [] => acc + else + let + val bufferChr = String.sub (hd, pos) + val searchChr = String.sub (searchString, searchPos) + in + if bufferChr = searchChr then + searchStep (pos - 1, hd, absIdx - 1, tl, acc, searchPos - 1, searchString) + else + acc + end + + fun loopSearch (pos, hd, absIdx, tl, acc, searchString) = + if pos < 0 then + case tl of + hd :: tl => + loopSearch (String.size hd - 1, hd, absIdx, tl, acc, searchString) + | [] => acc + else + let + val acc = searchStep + (pos, hd, absIdx, tl, acc, String.size searchString - 1, searchString) + in + loopSearch (pos - 1, hd, absIdx - 1, tl, acc, searchString) + end + + fun search (buffer, searchString) = + if String.size searchString = 0 then + [] + else + let + val buffer = LineGap.goToEnd buffer + val {leftStrings, idx = absIdx, ...} = buffer + in + case leftStrings of + hd :: tl => + loopSearch (String.size hd - 1, hd, absIdx - 1, tl, [], searchString) + | [] => [] + end +end diff --git a/shell/update-thread.sml b/shell/update-thread.sml index 3d6edfc..63838bd 100644 --- a/shell/update-thread.sml +++ b/shell/update-thread.sml @@ -32,6 +32,9 @@ struct val app = AppUpdate.update (app, inputMsg) handle e => ExceptionLogger.log e + val searchList = #searchList app + val searchList = SearchList.toString searchList ^ "\n" + val () = sendMsgs (#msgs app, drawMailbox) in loop (app, inputMailbox, drawMailbox) diff --git a/shf-tests.mlb b/shf-tests.mlb index 6432c9d..32f8e2e 100644 --- a/shf-tests.mlb +++ b/shf-tests.mlb @@ -2,6 +2,7 @@ $(SML_LIB)/basis/basis.mlb (* LIBRARIEES *) lib/brolib-sml/src/line_gap.sml +lib/brolib-sml/src/gap_set.sml lib/cozette-sml/fonts/cozette-ascii.mlb (* FUNCTIONAL CORE *) @@ -15,6 +16,7 @@ fcore/search-list.sml fcore/app-type.sml fcore/app-with.sml +fcore/search/search-line-gap.sml fcore/build-search-list.sml fcore/text-constants.sml ann diff --git a/shf.mlb b/shf.mlb index 5958273..fdf4c90 100644 --- a/shf.mlb +++ b/shf.mlb @@ -2,6 +2,7 @@ $(SML_LIB)/basis/basis.mlb (* LIBRARIEES *) lib/brolib-sml/src/line_gap.sml +lib/brolib-sml/src/gap_set.sml lib/cozette-sml/fonts/cozette-ascii.mlb (* FUNCTIONAL CORE *) @@ -15,6 +16,7 @@ fcore/search-list.sml fcore/app-type.sml fcore/app-with.sml +fcore/search/search-line-gap.sml fcore/build-search-list.sml fcore/text-constants.sml ann