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

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