functorise some boilerplate code to start a DFA loop

fcore/cursor-dfa/make-dfa-loop.sml

@@ -0,0 +1,61 @@
+signature MAKE_DFA_LOOP =
+sig
+  val fNext: int * int * string * string list * Word8.word * int -> int
+  val fPrev: int * int * string * string list * Word8.word * int -> int
+  val startState: Word8.word
+end
+
+functor MakeDfaLoop(M: MAKE_DFA_LOOP) =
+struct
+  fun next (lineGap: LineGap.t, cursorIdx) =
+    let
+      val {rightStrings, idx = bufferIdx, ...} = lineGap
+    in
+      case rightStrings of
+        shd :: stl =>
+          let
+            (* convert absolute cursorIdx to idx relative to hd string *)
+            val strIdx = cursorIdx - bufferIdx
+          in
+            if strIdx < String.size shd then
+              (* strIdx is in this string *)
+              M.fNext (strIdx, cursorIdx, shd, stl, M.startState, 1)
+            else
+              (* strIdx is in tl *)
+              case stl of
+                stlhd :: stltl =>
+                  M.fNext (strIdx, cursorIdx, stlhd, stltl, M.startState, 1)
+              | _ => cursorIdx
+          end
+      | [] => cursorIdx
+    end
+
+  fun prev (lineGap: LineGap.t, cursorIdx) =
+    let
+      val {rightStrings, leftStrings, idx = bufferIdx, ...} = lineGap
+    in
+      case rightStrings of
+        shd :: stl =>
+          let
+            (* convert absolute cursorIdx to idx relative to hd string *)
+            val strIdx = cursorIdx - bufferIdx
+          in
+            if strIdx < String.size shd then
+              (* strIdx is in this string *)
+              M.fPrev (strIdx, cursorIdx, shd, leftStrings, M.startState, 1)
+            else
+              (* strIdx is in tl *)
+              (case stl of
+                 stlhd :: stltl =>
+                   let
+                     val strIdx = strIdx - String.size shd
+                     val leftStrings = shd :: leftStrings
+                   in
+                     M.fPrev
+                       (strIdx, cursorIdx, stlhd, leftStrings, M.startState, 1)
+                   end
+               | [] => cursorIdx)
+          end
+      | [] => cursorIdx
+    end
+end

fcore/cursor-dfa/vi-WORD-dfa.sml

@@ -1,38 +1,23 @@
 structure ViWORDDfa =
 struct
-  val startState = 0w0
-  val startNonBlankState = 0w1
-  val startSpaceState = 0w2
-  val nonBlankAfterSpaceState = 0w4
+  val startState: Word8.word = 0w0
+  val startNonBlankState: Word8.word = 0w1
+  val startSpaceState: Word8.word = 0w2
+  val nonBlankAfterSpaceState: Word8.word = 0w4
 
   fun makeStart i =
-    let
-      val chr = Char.chr i
-    in
-      if Char.isSpace chr then
-        startSpaceState
-      else
-        startNonBlankState
+    let val chr = Char.chr i
+    in if Char.isSpace chr then startSpaceState else startNonBlankState
     end
 
   fun makeStartNonBlankState i =
-    let
-      val chr = Char.chr i
-    in
-      if Char.isSpace chr then
-        startSpaceState
-      else
-        startNonBlankState
+    let val chr = Char.chr i
+    in if Char.isSpace chr then startSpaceState else startNonBlankState
     end
 
   fun makeStartSpace i =
-    let
-      val chr = Char.chr i
-    in
-      if Char.isSpace chr then
-        startSpaceState
-      else
-        nonBlankAfterSpaceState
+    let val chr = Char.chr i
+    in if Char.isSpace chr then startSpaceState else nonBlankAfterSpaceState
     end
 
   val startTable = Vector.tabulate (255, makeStart)
@@ -50,69 +35,54 @@ struct
       Vector.sub (currentTable, charIdx)
     end
 
-  fun loopNextWORD (idx, absIdx, str, tl, currentState, counter) =
-    if idx = String.size str then
-      case tl of
-        str :: tl  =>
-          loopNextWORD (0, absIdx, str, tl, currentState, counter)
-      | [] =>
-          Int.max (absIdx - 2, 0)
-    else
-      let
-        val chr = String.sub (str, idx)
-        val newState = next (currentState, chr)
-      in
-        if newState = nonBlankAfterSpaceState then 
-          if counter = 0 then
-            absIdx
-          else
-            (* new loop, so reset to start state and proceed *)
-            loopNextWORD (idx + 1, absIdx + 1, str, tl, startState, counter - 1)
-        else
-          loopNextWORD (idx + 1, absIdx + 1, str, tl, newState, counter)
-      end
+  structure TraverseWORD =
+    MakeDfaLoop
+      (struct
+         val startState = startState
 
-  fun loopPrevWORD (idx, absIdx, str, tl, currentState, counter) =
-    if idx < 0 then
-      case tl of
-        str :: tl =>
-          loopPrevWORD (String.size str - 1, absIdx, str, tl, currentState, counter)
-      | [] => 0
-    else
-      let
-        val chr = String.sub (str, idx)
-        val newState = next (currentState, chr)
-      in
-        if newState = nonBlankAfterSpaceState then
-          if counter = 0 then
-            absIdx
-          else
-            (* reset to start state and proceed *)
-            loopPrevWORD (idx - 1, absIdx - 1, str, tl, startState, counter - 1)
-        else
-          loopPrevWORD (idx - 1, absIdx - 1, str, tl, newState, counter)
-      end
+         fun fNext (idx, absIdx, str, tl, currentState, counter) =
+           if idx = String.size str then
+             case tl of
+               str :: tl => fNext (0, absIdx, str, tl, currentState, counter)
+             | [] => Int.max (absIdx - 2, 0)
+           else
+             let
+               val chr = String.sub (str, idx)
+               val newState = next (currentState, chr)
+             in
+               if newState = nonBlankAfterSpaceState then
+                 if counter - 1 = 0 then
+                   absIdx
+                 else
+                   (* new loop, so reset to start state and proceed *)
+                   fNext (idx + 1, absIdx + 1, str, tl, startState, counter - 1)
+               else
+                 fNext (idx + 1, absIdx + 1, str, tl, newState, counter)
+             end
 
-  fun nextWORD (lineGap: LineGap.t, cursorIdx) =
-    let
-      val {rightStrings, idx = bufferIdx, ...} = lineGap
-    in
-      case rightStrings of
-        shd :: stl =>
-          let
-            (* convert absolute cursorIdx to idx relative to hd string *)
-            val strIdx = cursorIdx - bufferIdx
-          in
-            if strIdx < String.size shd then
-              (* strIdx is in this string *)
-              loopNextWORD (strIdx, cursorIdx, shd, stl, startState, 0)
-            else
-              (* strIdx is in tl *)
-              case stl of
-                 stlhd :: stltl =>
-                   loopNextWORD (strIdx, cursorIdx, stlhd, stltl, startState, 0)
-               | _ => cursorIdx
-          end
-      | [] => cursorIdx
-    end
+         fun fPrev (idx, absIdx, str, tl, currentState, counter) =
+           if idx < 0 then
+             case tl of
+               str :: tl =>
+                 fPrev
+                   (String.size str - 1, absIdx, str, tl, currentState, counter)
+             | [] => 0
+           else
+             let
+               val chr = String.sub (str, idx)
+               val newState = next (currentState, chr)
+             in
+               if newState = nonBlankAfterSpaceState then
+                 if counter - 1 = 0 then
+                   absIdx
+                 else
+                   (* reset to start state and proceed *)
+                   fPrev (idx - 1, absIdx - 1, str, tl, startState, counter - 1)
+               else
+                 fPrev (idx - 1, absIdx - 1, str, tl, newState, counter)
+             end
+       end)
+
+  val next = TraverseWORD.next
+  val prev = TraverseWORD.prev
 end

fcore/cursor.sml

@@ -886,7 +886,7 @@ struct
     toNextWord (lineGap, cursorIdx, helpNextWord)
 
   (* equivalent of vi's 'W' command *)
-  val nextWORD = ViWORDDfa.nextWORD
+  val nextWORD = ViWORDDfa.next
 
   fun helpPrevWord (strPos, str, absIdx, strTl, lineTl) =
     if strPos < 0 then

shf-tests.mlb

@@ -22,6 +22,7 @@ ann
 in
   fcore/rect.sml
   fcore/text-builder.sml
+  fcore/cursor-dfa/make-dfa-loop.sml
   fcore/cursor-dfa/vi-WORD-dfa.sml
 end
 fcore/cursor.sml

shf.mlb

@@ -22,6 +22,7 @@ ann
 in
   fcore/rect.sml
   fcore/text-builder.sml
+  fcore/cursor-dfa/make-dfa-loop.sml
   fcore/cursor-dfa/vi-WORD-dfa.sml
 end
 fcore/cursor.sml