Add 'shf/' from commit 'b6c5a95b664aeb861d7b33ffc9eefe447ba99dd7'
git-subtree-dir: shf git-subtree-mainline:401408448fgit-subtree-split:b6c5a95b66
This commit is contained in:
303
shf/fcore/cursor-dfa/make-dfa-loop.sml
Normal file
303
shf/fcore/cursor-dfa/make-dfa-loop.sml
Normal file
@@ -0,0 +1,303 @@
|
||||
signature MAKE_DFA_LOOP =
|
||||
sig
|
||||
val fStart: int * int * string * string list * Word8.word * int -> int
|
||||
val startState: Word8.word
|
||||
end
|
||||
|
||||
functor MakeNextDfaLoop(M: MAKE_DFA_LOOP) =
|
||||
struct
|
||||
fun next (lineGap: LineGap.t, cursorIdx, count) =
|
||||
let
|
||||
val {rightStrings, idx = bufferIdx, ...} = lineGap
|
||||
(* convert absolute cursorIdx to idx relative to hd string *)
|
||||
val strIdx = cursorIdx - bufferIdx
|
||||
in
|
||||
case rightStrings of
|
||||
shd :: stl =>
|
||||
if strIdx < String.size shd then
|
||||
(* strIdx is in this string *)
|
||||
M.fStart (strIdx, cursorIdx, shd, stl, M.startState, count)
|
||||
else
|
||||
(* strIdx is in tl *)
|
||||
(case stl of
|
||||
stlhd :: stltl =>
|
||||
let
|
||||
val strIdx = strIdx - String.size shd
|
||||
in
|
||||
M.fStart
|
||||
(strIdx, cursorIdx, stlhd, stltl, M.startState, count)
|
||||
end
|
||||
| _ => cursorIdx)
|
||||
| [] => cursorIdx
|
||||
end
|
||||
end
|
||||
|
||||
functor MakeNextDfaLoopPlus1(M: MAKE_DFA_LOOP) =
|
||||
struct
|
||||
fun next (lineGap: LineGap.t, cursorIdx, count) =
|
||||
let
|
||||
val {rightStrings, idx = bufferIdx, ...} = lineGap
|
||||
(* convert absolute cursorIdx to idx relative to hd string *)
|
||||
val strIdx = cursorIdx - bufferIdx + 1
|
||||
val absIdx = cursorIdx + 1
|
||||
in
|
||||
case rightStrings of
|
||||
shd :: stl =>
|
||||
if strIdx < String.size shd then
|
||||
(* strIdx is in this string *)
|
||||
M.fStart (strIdx, absIdx, shd, stl, M.startState, count)
|
||||
else
|
||||
(* strIdx is in tl *)
|
||||
(case stl of
|
||||
stlhd :: stltl =>
|
||||
let val strIdx = strIdx - String.size shd
|
||||
in M.fStart (strIdx, absIdx, stlhd, stltl, M.startState, count)
|
||||
end
|
||||
| _ => cursorIdx)
|
||||
| [] => cursorIdx
|
||||
end
|
||||
end
|
||||
|
||||
functor MakePrevDfaLoop(M: MAKE_DFA_LOOP) =
|
||||
struct
|
||||
fun startLeftStrings (leftStrings, absIdx, count) =
|
||||
case leftStrings of
|
||||
lhd :: ltl =>
|
||||
M.fStart (String.size lhd - 1, absIdx, lhd, ltl, M.startState, count)
|
||||
| [] => 0
|
||||
|
||||
fun prev (lineGap: LineGap.t, cursorIdx, count) =
|
||||
let
|
||||
val {rightStrings, leftStrings, idx = bufferIdx, ...} = lineGap
|
||||
(* convert absolute cursorIdx to idx relative to hd string *)
|
||||
val strIdx = cursorIdx - bufferIdx
|
||||
in
|
||||
case rightStrings of
|
||||
shd :: stl =>
|
||||
if strIdx < String.size shd then
|
||||
(* strIdx is in this string *)
|
||||
M.fStart (strIdx, cursorIdx, shd, leftStrings, M.startState, count)
|
||||
else
|
||||
(* strIdx is in tl *)
|
||||
(case stl of
|
||||
stlhd :: stltl =>
|
||||
let
|
||||
val strIdx = strIdx - String.size shd
|
||||
val leftStrings = shd :: leftStrings
|
||||
in
|
||||
M.fStart
|
||||
( strIdx
|
||||
, cursorIdx
|
||||
, stlhd
|
||||
, leftStrings
|
||||
, M.startState
|
||||
, count
|
||||
)
|
||||
end
|
||||
| [] => startLeftStrings (leftStrings, cursorIdx, count))
|
||||
| [] => startLeftStrings (leftStrings, cursorIdx, count)
|
||||
end
|
||||
end
|
||||
|
||||
functor MakePrevDfaLoopMinus1(M: MAKE_DFA_LOOP) =
|
||||
struct
|
||||
fun startLeftStrings (leftStrings, absIdx, count) =
|
||||
case leftStrings of
|
||||
lhd :: ltl =>
|
||||
M.fStart (String.size lhd - 1, absIdx, lhd, ltl, M.startState, count)
|
||||
| [] => 0
|
||||
|
||||
fun prev (lineGap: LineGap.t, cursorIdx, count) =
|
||||
let
|
||||
val {idx = bufferIdx, leftStrings, ...} = lineGap
|
||||
val strIdx = cursorIdx - bufferIdx - 1
|
||||
val absIdx = cursorIdx - 1
|
||||
in
|
||||
if strIdx < 0 then
|
||||
startLeftStrings (leftStrings, absIdx, count)
|
||||
else
|
||||
case #rightStrings lineGap of
|
||||
rhd :: _ =>
|
||||
M.fStart (strIdx, absIdx, rhd, leftStrings, M.startState, count)
|
||||
| [] => startLeftStrings (leftStrings, absIdx, count)
|
||||
end
|
||||
end
|
||||
|
||||
signature MAKE_CHAR_FOLDER =
|
||||
sig
|
||||
val startState: Word8.word
|
||||
val tables: Word8.word vector vector
|
||||
|
||||
val isFinal: Word8.word -> bool
|
||||
val finish: int -> int
|
||||
end
|
||||
|
||||
functor MakeCharFolderNext(Fn: MAKE_CHAR_FOLDER) =
|
||||
struct
|
||||
fun nextState (currentState, currentChar) =
|
||||
let
|
||||
val currentState = Word8.toInt currentState
|
||||
val currentTable = Vector.sub (Fn.tables, currentState)
|
||||
val charIdx = Char.ord currentChar
|
||||
in
|
||||
Vector.sub (currentTable, charIdx)
|
||||
end
|
||||
|
||||
fun foldNext (idx, absIdx, str, tl, currentState, counter) =
|
||||
if idx = String.size str then
|
||||
case tl of
|
||||
str :: tl => foldNext (0, absIdx, str, tl, currentState, counter)
|
||||
| [] => absIdx
|
||||
else
|
||||
let
|
||||
val chr = String.sub (str, idx)
|
||||
val newState = nextState (currentState, chr)
|
||||
in
|
||||
if Fn.isFinal newState then
|
||||
if counter - 1 = 0 then
|
||||
Fn.finish absIdx
|
||||
else
|
||||
(* new loop, so reset start state and proceed *)
|
||||
let val newState = nextState (Fn.startState, chr)
|
||||
in foldNext (idx + 1, absIdx + 1, str, tl, newState, counter - 1)
|
||||
end
|
||||
else
|
||||
foldNext (idx + 1, absIdx + 1, str, tl, newState, counter)
|
||||
end
|
||||
end
|
||||
|
||||
functor MakeCharFolderPrev(Fn: MAKE_CHAR_FOLDER) =
|
||||
struct
|
||||
fun nextState (currentState, currentChar) =
|
||||
let
|
||||
val currentState = Word8.toInt currentState
|
||||
val currentTable = Vector.sub (Fn.tables, currentState)
|
||||
val charIdx = Char.ord currentChar
|
||||
in
|
||||
Vector.sub (currentTable, charIdx)
|
||||
end
|
||||
|
||||
fun foldPrev (idx, absIdx, str, tl, currentState, counter) =
|
||||
if idx < 0 then
|
||||
case tl of
|
||||
str :: tl =>
|
||||
foldPrev (String.size str - 1, absIdx, str, tl, currentState, counter)
|
||||
| [] => 0
|
||||
else
|
||||
let
|
||||
val chr = String.sub (str, idx)
|
||||
val newState = nextState (currentState, chr)
|
||||
in
|
||||
if Fn.isFinal newState then
|
||||
if counter - 1 = 0 then
|
||||
Fn.finish absIdx
|
||||
else
|
||||
let val newState = nextState (Fn.startState, chr)
|
||||
in foldPrev (idx - 1, absIdx - 1, str, tl, newState, counter - 1)
|
||||
end
|
||||
else
|
||||
foldPrev (idx - 1, absIdx - 1, str, tl, newState, counter)
|
||||
end
|
||||
end
|
||||
|
||||
signature MAKE_IF_CHAR_FOLDER =
|
||||
sig
|
||||
type env
|
||||
|
||||
val fStart:
|
||||
int * string * int vector * int * string list * int vector list * env
|
||||
-> int
|
||||
end
|
||||
|
||||
functor MakeIfCharFolderPrev(Fn: MAKE_IF_CHAR_FOLDER) =
|
||||
struct
|
||||
fun foldPrev (lineGap: LineGap.t, cursorIdx, env: Fn.env) =
|
||||
let
|
||||
val
|
||||
{rightStrings, idx = bufferIdx, rightLines, leftStrings, leftLines, ...} =
|
||||
lineGap
|
||||
in
|
||||
case (rightStrings, rightLines) of
|
||||
(strHd :: strTl, lnHd :: lnTl) =>
|
||||
let
|
||||
(* convert absolute cursorIdx to idx relative to hd string *)
|
||||
val strIdx = cursorIdx - bufferIdx
|
||||
in
|
||||
if strIdx < String.size strHd then
|
||||
(* strIdx is either in this string or in leftStrings *)
|
||||
if strIdx < 0 then
|
||||
case (leftStrings, leftLines) of
|
||||
(lshd :: lstl, llhd :: lltl) =>
|
||||
Fn.fStart
|
||||
( String.size lshd - 1
|
||||
, lshd
|
||||
, llhd
|
||||
, cursorIdx
|
||||
, lstl
|
||||
, lltl
|
||||
, env
|
||||
)
|
||||
| (_, _) => 0
|
||||
else
|
||||
Fn.fStart
|
||||
(strIdx, strHd, lnHd, cursorIdx, leftStrings, leftLines, env)
|
||||
else
|
||||
(* strIdx must be in the strTl *)
|
||||
(case (strTl, lnTl) of
|
||||
(nestStrHd :: _, nestLnHd :: _) =>
|
||||
let
|
||||
val strIdx = strIdx - String.size strHd
|
||||
in
|
||||
Fn.fStart
|
||||
( strIdx
|
||||
, nestStrHd
|
||||
, nestLnHd
|
||||
, cursorIdx
|
||||
, strHd :: leftStrings
|
||||
, lnHd :: leftLines
|
||||
, env
|
||||
)
|
||||
end
|
||||
| (_, _) => cursorIdx)
|
||||
end
|
||||
| (_, _) => (* nowhere to go, so return cursorIdx *) cursorIdx
|
||||
end
|
||||
end
|
||||
|
||||
functor MakeIfCharFolderNext(Fn: MAKE_IF_CHAR_FOLDER) =
|
||||
struct
|
||||
fun foldNext (lineGap: LineGap.t, cursorIdx, env: Fn.env) =
|
||||
let
|
||||
val {rightStrings, idx = bufferIdx, rightLines, ...} = lineGap
|
||||
in
|
||||
case (rightStrings, rightLines) of
|
||||
(strHd :: strTl, lnHd :: lnTl) =>
|
||||
let
|
||||
(* convert absolute cursorIdx to idx relative to hd string *)
|
||||
val strIdx = cursorIdx - bufferIdx
|
||||
in
|
||||
if strIdx < String.size strHd then
|
||||
(* strIdx is in this string *)
|
||||
Fn.fStart (strIdx, strHd, lnHd, cursorIdx, strTl, lnTl, env)
|
||||
else
|
||||
(* strIdx must be in the strTl *)
|
||||
(case (strTl, lnTl) of
|
||||
(nestStrHd :: nestStrTl, nestLnHd :: nestLnTl) =>
|
||||
let
|
||||
val strIdx = strIdx - String.size strHd
|
||||
in
|
||||
Fn.fStart
|
||||
( strIdx
|
||||
, nestStrHd
|
||||
, nestLnHd
|
||||
, cursorIdx
|
||||
, nestStrTl
|
||||
, nestLnTl
|
||||
, env
|
||||
)
|
||||
end
|
||||
| (_, _) => cursorIdx)
|
||||
end
|
||||
| (_, _) => (* nowhere to go, so return cursorIdx *) cursorIdx
|
||||
end
|
||||
end
|
||||
Reference in New Issue
Block a user