humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

functorise some boilerplate code to start a DFA loop

Browse Source
This commit is contained in:
Humza Shahid
2025-07-20 09:39:17 +01:00
parent 25fb8bfc5e
commit 10b76d98c5
5 changed files with 122 additions and 89 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
fcore/cursor-dfa/make-dfa-loop.sml Normal file
View File

@@ -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

146
fcore/cursor-dfa/vi-WORD-dfa.sml
View File

@@ -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