progress implementing searchList data structure

fcore/bin-search.sml

@@ -0,0 +1,72 @@
+structure BinSearch =
+struct
+  local
+    fun reverseLinearSearch (findNum, idx, vec) =
+      if idx < 0 then
+        idx
+      else
+        let
+          val curVal = Vector.sub (vec, idx)
+        in
+          if curVal < findNum then idx
+          else reverseLinearSearch (findNum, idx - 1, vec)
+        end
+
+    fun helpBinSearch (findNum, vec, low, high) =
+      let
+        val mid = low + ((high - low) div 2)
+      in
+        if high >= low then
+          let
+            val midVal = Vector.sub (vec, mid)
+          in
+            if midVal = findNum then
+              mid
+            else if midVal < findNum then
+              helpBinSearch (findNum, vec, mid + 1, high)
+            else
+              helpBinSearch (findNum, vec, low, mid - 1)
+          end
+        else
+          reverseLinearSearch (findNum, mid, vec)
+      end
+  in
+    fun equalOrLess (findNum, vec) =
+      helpBinSearch (findNum, vec, 0, Vector.length vec - 1)
+  end
+
+  local
+    fun forwardLinearSearch (findNum, idx, vec) =
+      if idx = Vector.length vec then
+        idx
+      else
+        let
+          val curVal = Vector.sub (vec, idx)
+        in
+          if curVal > findNum then idx
+          else forwardLinearSearch (findNum, idx + 1, vec)
+        end
+
+    fun helpBinSearch (findNum, vec, low, high) =
+      let
+        val mid = low + ((high - low) div 2)
+      in
+        if high >= low then
+          let
+            val midVal = Vector.sub (vec, mid)
+          in
+            if midVal = findNum then
+              mid
+            else if midVal < findNum then
+              helpBinSearch (findNum, vec, mid + 1, high)
+            else
+              helpBinSearch (findNum, vec, low, mid - 1)
+          end
+        else
+          forwardLinearSearch (findNum, mid, vec)
+      end
+  in
+    fun equalOrMore (findNum, vec) =
+      helpBinSearch (findNum, vec, 0, Vector.length vec - 1)
+  end
+end

fcore/cursor.sml

@@ -272,42 +272,6 @@ struct
       | [] => cursorIdx
     end
 
-  (* below functions, until and including getCursorColumn, 
-   * are all for helping to calculate the cursor's column 
-   * compared to the line the cursor is currently positioned in *)
-  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
-
-  fun binSearch (findNum, lines) =
-    helpBinSearch (findNum, lines, 0, Vector.length lines - 1)
-
   fun helpGetCursorColumn (distanceFromLine, strList, lineList) =
     case (strList, lineList) of
       (strHd :: strTl, lnHd :: lnTl) =>
@@ -367,7 +331,7 @@ struct
            * because we know lnHd definitely contains
            * a lineIdx less or equal to strIdx *)
           let
-            val lnIdx = binSearch (strIdx, lnHd)
+            val lnIdx = BinSearch.equalOrLess (strIdx, lnHd)
             val lnIdx = Vector.sub (lnHd, lnIdx)
           in
             if lnIdx < strIdx then

fcore/search-list.sml

@@ -0,0 +1,106 @@
+structure SearchList =
+struct
+  type t = {left: int vector list, right: int vector list}
+
+  val targetLength = 1024
+
+  val empty: t = {left = [], right = []}
+
+  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
+
+  fun joinEndOfLeft (new, left) =
+    case left of
+      hd :: tail =>
+        if isLessThanTarget (new, hd) then (hd ^ new) :: tail else new :: left
+    | [] => new :: left
+
+  fun joinStartOfRight (new, right) =
+    case right of
+      hd :: tail =>
+        if isLessThanTarget (new, hd) then (new ^ hd) :: tail else new :: right
+    | [] => new :: right
+
+  fun preferInsertLeft (new, left, right) =
+    case left of
+      hd :: tail =>
+        if isLessThanTarget (hd, new) then
+          {left = (hd ^ new) :: tail, right = right}
+        else
+          {left = left, right = joinStartOfRight (new, right)}
+    | [] => {left = left, right = joinStartOfRight (new, right)}
+
+  fun insLeft (new, left, right) =
+    case left of
+      hd :: tl =>
+        let
+          val first = Vector.sub (hd, 0)
+        in
+          if first > new then
+            insLeft (new, tl, joinStartOfRight (hd, right))
+          else if first < new then
+            let
+              val last = Vector.sub (hd, Vector.length hd - 1)
+            in
+              if last > new then
+                (* have to insert in middle *)
+                let
+                  val middle = BinSearch.equalOrMore (new, hd)
+                  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
+              else if last < new then
+                (* have to insert new at end *)
+                if Vector.length hd < targetLength then
+                  let val newHd = Vector.concat [hd, Vector.fromList [new]]
+                  in {left = joinEndOfLeft (newHd, tl), right = right}
+                  end
+                else
+                  { left = left
+                  , right = joinStartOfRight (Vector.fromList [hd], right)
+                  }
+              else
+                (* last = new so just return *)
+                {left = left, right = right}
+            end
+          else
+            (* first = new *)
+            {left = left, right = right}
+        end
+    | [] => {left = left, right = right}
+end

fcore/text-window.sml

@@ -217,7 +217,7 @@ struct
         if firstLineIdx > strIdx then
           bufferLine
         else if firstLineIdx < strIdx then
-          Cursor.binSearch (strIdx - 1, lhd) + bufferLine
+          BinSearch.equalOrLess (strIdx - 1, lhd) + bufferLine
         else
           bufferLine + 1
       end

shf.mlb

@@ -5,6 +5,7 @@ lib/brolib-sml/src/line_gap.sml
 lib/cozette-sml/fonts/cozette-ascii.mlb
 
 (* FUNCTIONAL CORE *)
+fcore/bin-search.sml
 message-types/input-msg.sml
 message-types/draw-msg.sml
 message-types/mailbox-type.sml