progress using dfa for searching

fcore/search-list.sml

@@ -1,252 +0,0 @@
-structure SearchList =
-struct
-  val empty = PersistentVector.empty
-
-  fun backtrackFull (pos, hd, absIdx, tl, acc, searchPos, searchString, prevTl) =
-    if pos < 0 then
-      case prevTl of
-        prevHd :: prevTl =>
-          let
-            val tl = hd :: tl
-          in
-            backtrackFull
-              ( String.size prevHd - 1
-              , prevHd
-              , absIdx
-              , tl
-              , acc
-              , searchPos
-              , searchString
-              , prevTl
-              )
-          end
-      | [] =>
-          (* Should never be called *)
-          raise Fail "SearchList.backtrackFull error: line 24\n"
-    else if searchPos <= 1 then
-      (* we are trying to backtrack to index 1, 
-       * and then continue are search from here *)
-      loopSearch (pos, hd, absIdx, tl, acc, 0, searchString, prevTl)
-    else
-      backtrackFull
-        (pos - 1, hd, absIdx - 1, tl, acc, searchPos - 1, searchString, prevTl)
-
-  and loopSearch (pos, hd, absIdx, tl, acc, searchPos, searchString, prevTl) =
-    if pos = String.size hd then
-      case tl of
-        newHd :: newTl =>
-          loopSearch
-            ( 0
-            , newHd
-            , absIdx
-            , newTl
-            , acc
-            , searchPos
-            , searchString
-            , hd :: prevTl
-            )
-      | [] => acc
-    else
-      let
-        val bufferChr = String.sub (hd, pos)
-        val searchChr = String.sub (searchString, searchPos)
-      in
-        if bufferChr = searchChr then
-          if searchPos + 1 = String.size searchString then
-            (* we fully matched the search string *)
-            let
-              val foundIdx = absIdx - String.size searchString + 1
-              val acc = PersistentVector.append (foundIdx, absIdx, acc)
-            in
-              loopSearch
-                (pos + 1, hd, absIdx + 1, tl, acc, 0, searchString, prevTl)
-            end
-          else
-            loopSearch
-              ( pos + 1
-              , hd
-              , absIdx + 1
-              , tl
-              , acc
-              , searchPos + 1
-              , searchString
-              , prevTl
-              )
-        else
-          (if searchPos = 0 then
-             loopSearch
-               (pos + 1, hd, absIdx + 1, tl, acc, 0, searchString, prevTl)
-           else
-             backtrackFull
-               (pos, hd, absIdx, tl, acc, searchPos, searchString, prevTl))
-      end
-
-  fun search ({rightStrings, leftStrings, ...}: LineGap.t, searchString) =
-    case rightStrings of
-      hd :: tl =>
-        loopSearch (0, hd, 0, tl, PersistentVector.empty, 0, searchString, [])
-    | [] => PersistentVector.empty
-
-  (* Prerequisite: move buffer/LineGap to start *)
-  fun build (buffer, searchString) =
-    if String.size searchString > 0 then search (buffer, searchString)
-    else PersistentVector.empty
-
-  fun backtrackRange
-    (pos, hd, absIdx, tl, acc, searchPos, searchString, finish, prevTl) =
-    if pos < 0 then
-      case prevTl of
-        prevHd :: prevTl =>
-          let
-            val tl = hd :: tl
-          in
-            backtrackRange
-              ( String.size prevHd - 1
-              , prevHd
-              , absIdx
-              , tl
-              , acc
-              , searchPos
-              , searchString
-              , finish
-              , prevTl
-              )
-          end
-      | [] =>
-          (* Should never be called *)
-          raise Fail "SearchList.backtrackRange error: line 120\n"
-    else if searchPos <= 1 then
-      loopRange (pos, hd, absIdx, tl, acc, 0, searchString, finish, prevTl)
-    else
-      backtrackRange
-        ( pos - 1
-        , hd
-        , absIdx - 1
-        , tl
-        , acc
-        , searchPos - 1
-        , searchString
-        , finish
-        , prevTl
-        )
-
-  and loopRange
-    (pos, hd, absIdx, tl, acc, searchPos, searchString, finish, prevTl) =
-    if pos = String.size hd then
-      case tl of
-        newHd :: newTl =>
-          let
-            val prevTl = hd :: prevTl
-          in
-            loopRange
-              ( 0
-              , newHd
-              , absIdx
-              , newTl
-              , acc
-              , searchPos
-              , searchString
-              , finish
-              , prevTl
-              )
-          end
-      | [] => acc
-    else if absIdx = finish then
-      acc
-    else
-      let
-        val bufferChr = String.sub (hd, pos)
-        val searchChr = String.sub (searchString, searchPos)
-      in
-        if bufferChr = searchChr then
-          if searchPos + 1 = String.size searchString then
-            (* full match *)
-            let
-              val foundIdx = absIdx - String.size searchString + 1
-              val acc = PersistentVector.append (foundIdx, absIdx, acc)
-            in
-              loopRange
-                ( pos + 1
-                , hd
-                , absIdx + 1
-                , tl
-                , acc
-                , 0
-                , searchString
-                , finish
-                , prevTl
-                )
-            end
-          else
-            loopRange
-              ( pos + 1
-              , hd
-              , absIdx + 1
-              , tl
-              , acc
-              , searchPos + 1
-              , searchString
-              , finish
-              , prevTl
-              )
-        else
-          ((if searchPos = 0 then
-              loopRange
-                ( pos + 1
-                , hd
-                , absIdx + 1
-                , tl
-                , acc
-                , 0
-                , searchString
-                , finish
-                , prevTl
-                )
-            else
-              backtrackRange
-                ( pos
-                , hd
-                , absIdx
-                , tl
-                , acc
-                , searchPos
-                , searchString
-                , finish
-                , prevTl
-                )))
-      end
-
-  fun searchRange (buffer: LineGap.t, searchString, finish) =
-    let
-      val {rightStrings, idx = absIdx, ...} = buffer
-    in
-      case rightStrings of
-        hd :: tl =>
-          loopRange
-            ( 0
-            , hd
-            , absIdx
-            , tl
-            , PersistentVector.empty
-            , 0
-            , searchString
-            , finish
-            , []
-            )
-      | [] => PersistentVector.empty
-    end
-
-  fun buildRange (buffer, searchString, finishIdx) =
-    if String.size searchString > 0 then
-      case Nfa.parse searchString of
-        SOME nfa =>
-          Nfa.getMatchesInRange
-            (#idx buffer, finishIdx, buffer : LineGap.t, nfa)
-      | NONE => (buffer, PersistentVector.empty)
-    else
-      (buffer, PersistentVector.empty)
-
-  fun nextMatch (cursorIdx, searchList, count) = raise Fail "todo: reimplement"
-
-  fun prevMatch (cursorIdx, searchList, count) = raise Fail "todo: reimplement"
-end

fcore/search-list/dfa-gen.sml

@@ -501,7 +501,7 @@ struct
   end
 
   fun fromString str =
-    case ParseDfa.parse (str, 0) of
+    case ParseDfa.parse (str ^ "\^@", 0) of
       SOME (ast, _) => ToDfa.convert ast
     | NONE => Vector.fromList []
 
@@ -513,7 +513,11 @@ struct
     end
 
   fun isFinal (dfa: dfa, curState) =
+    curState <> ~1
+    andalso
     let val curTable = Vector.sub (dfa, curState)
     in Vector.sub (curTable, 0) <> ~1
     end
+
+  fun isDead curState = curState = ~1
 end

fcore/search-list/search-list.sml

@@ -0,0 +1,190 @@
+structure SearchList =
+struct
+  val empty = PersistentVector.empty
+
+  fun backtrackFull (pos, hd, absIdx, tl, acc, searchPos, searchString, prevTl) =
+    if pos < 0 then
+      case prevTl of
+        prevHd :: prevTl =>
+          let
+            val tl = hd :: tl
+          in
+            backtrackFull
+              ( String.size prevHd - 1
+              , prevHd
+              , absIdx
+              , tl
+              , acc
+              , searchPos
+              , searchString
+              , prevTl
+              )
+          end
+      | [] =>
+          (* Should never be called *)
+          raise Fail "SearchList.backtrackFull error: line 24\n"
+    else if searchPos <= 1 then
+      (* we are trying to backtrack to index 1, 
+       * and then continue are search from here *)
+      loopSearch (pos, hd, absIdx, tl, acc, 0, searchString, prevTl)
+    else
+      backtrackFull
+        (pos - 1, hd, absIdx - 1, tl, acc, searchPos - 1, searchString, prevTl)
+
+  and loopSearch (pos, hd, absIdx, tl, acc, searchPos, searchString, prevTl) =
+    if pos = String.size hd then
+      case tl of
+        newHd :: newTl =>
+          loopSearch
+            ( 0
+            , newHd
+            , absIdx
+            , newTl
+            , acc
+            , searchPos
+            , searchString
+            , hd :: prevTl
+            )
+      | [] => acc
+    else
+      let
+        val bufferChr = String.sub (hd, pos)
+        val searchChr = String.sub (searchString, searchPos)
+      in
+        if bufferChr = searchChr then
+          if searchPos + 1 = String.size searchString then
+            (* we fully matched the search string *)
+            let
+              val foundIdx = absIdx - String.size searchString + 1
+              val acc = PersistentVector.append (foundIdx, absIdx, acc)
+            in
+              loopSearch
+                (pos + 1, hd, absIdx + 1, tl, acc, 0, searchString, prevTl)
+            end
+          else
+            loopSearch
+              ( pos + 1
+              , hd
+              , absIdx + 1
+              , tl
+              , acc
+              , searchPos + 1
+              , searchString
+              , prevTl
+              )
+        else
+          (if searchPos = 0 then
+             loopSearch
+               (pos + 1, hd, absIdx + 1, tl, acc, 0, searchString, prevTl)
+           else
+             backtrackFull
+               (pos, hd, absIdx, tl, acc, searchPos, searchString, prevTl))
+      end
+
+  fun search ({rightStrings, leftStrings, ...}: LineGap.t, searchString) =
+    case rightStrings of
+      hd :: tl =>
+        loopSearch (0, hd, 0, tl, PersistentVector.empty, 0, searchString, [])
+    | [] => PersistentVector.empty
+
+  (* Prerequisite: move buffer/LineGap to start *)
+  fun build (buffer, searchString) =
+    if String.size searchString > 0 then search (buffer, searchString)
+    else PersistentVector.empty
+
+  fun rangeLoop
+    ( dfa
+    , bufferPos
+    , buffer
+    , finishIdx
+    , searchList
+    , curState
+    , startPos
+    , prevFinalPos
+    ) =
+    if bufferPos = #textLength buffer orelse bufferPos > finishIdx then
+      let
+        val searchList =
+          if prevFinalPos = ~1 then searchList
+          else PersistentVector.append (startPos, prevFinalPos, searchList)
+      in
+        (buffer, searchList)
+      end
+    else
+      let
+        val buffer = LineGap.goToIdx (bufferPos, buffer)
+        val chr = LineGap.sub (bufferPos, buffer)
+        val newState = DfaGen.nextState (dfa, curState, chr)
+        val prevFinalPos =
+          if DfaGen.isFinal (dfa, newState) then bufferPos else prevFinalPos
+      in
+        if DfaGen.isDead newState then
+          if prevFinalPos = ~1 then
+            (* no match found: restart search from `startPos + 1` *)
+            rangeLoop
+              ( dfa
+              , startPos + 1
+              , buffer
+              , finishIdx
+              , searchList
+              , 0
+              , startPos + 1
+              , ~1
+              )
+          else
+            (* match found: append and continue *)
+            let
+              val searchList =
+                PersistentVector.append (startPos, prevFinalPos, searchList)
+            in
+              rangeLoop
+                ( dfa
+                , bufferPos + 1
+                , buffer
+                , finishIdx
+                , searchList
+                , 0
+                , bufferPos + 1
+                , ~1
+                )
+            end
+        else
+          (* continue searching for match *)
+          rangeLoop
+            ( dfa
+            , bufferPos + 1
+            , buffer
+            , finishIdx
+            , searchList
+            , newState
+            , startPos
+            , prevFinalPos
+            )
+      end
+
+  fun buildRange (buffer, searchString, finishIdx) =
+    if String.size searchString > 0 then
+      let
+        val dfa = DfaGen.fromString searchString
+      in
+        if Vector.length dfa = 0 then
+          (buffer, PersistentVector.empty)
+        else
+          rangeLoop
+            ( dfa
+            , #idx buffer
+            , buffer
+            , finishIdx
+            , PersistentVector.empty
+            , 0
+            , #idx buffer
+            , ~1
+            )
+      end
+    else
+      (buffer, PersistentVector.empty)
+
+  fun nextMatch (cursorIdx, searchList, count) = raise Fail "todo: reimplement"
+
+  fun prevMatch (cursorIdx, searchList, count) = raise Fail "todo: reimplement"
+end

shf.mlb

@@ -15,7 +15,7 @@ in
   fcore/persistent-vector.sml
 end
 fcore/search-list/dfa-gen.sml
-fcore/search-list.sml
+fcore/search-list/search-list.sml
 
 message-types/input-msg.sml
 message-types/draw-msg.sml