sml-projects/dfa-gen/dfa-gen.sml

signature DFA_GEN_PARAMS =
sig
  val endMarker: char
  val charIsEqual: char * char -> bool
end

signature DFA_GEN =
sig
  type dfa = int vector vector
  type dfa_state = int

  val fromString: string -> dfa

  val nextState: dfa * dfa_state * char -> dfa_state
  val isFinal: dfa * dfa_state -> bool
  val isDead: dfa_state -> bool

  val matchString: dfa * string -> (int * int) list
end

functor MakeDfaGen(Fn: DFA_GEN_PARAMS): DFA_GEN =
struct
  datatype parse_tree =
    CHAR_LITERAL of {char: char, position: int}
  | WILDCARD of int
  | IS_ANY_CHARACTER of {chars: char vector, position: int}
  | NOT_ANY_CHARACTER of {chars: char vector, position: int}
  | CONCAT of
      {l: parse_tree, r: parse_tree, leftMaxState: int, rightMaxState: int}
  | ALTERNATION of
      {l: parse_tree, r: parse_tree, leftMaxState: int, rightMaxState: int}
  | ZERO_OR_ONE of parse_tree
  | ZERO_OR_MORE of parse_tree
  | ONE_OR_MORE of parse_tree
  | GROUP of parse_tree

  fun isNullable tree =
    case tree of
      CHAR_LITERAL _ => false
    | WILDCARD _ => false
    | IS_ANY_CHARACTER _ => false
    | NOT_ANY_CHARACTER _ => false

    | CONCAT {l, r, ...} => isNullable l andalso isNullable r
    | ALTERNATION {l, r, ...} => isNullable l orelse isNullable r

    | ZERO_OR_ONE _ => true
    | ZERO_OR_MORE _ => true
    | ONE_OR_MORE regex => isNullable regex

    | GROUP regex => isNullable regex

  fun firstpos (tree, acc) =
    case tree of
      CHAR_LITERAL {position, ...} => position :: acc
    | IS_ANY_CHARACTER {position, ...} => position :: acc
    | NOT_ANY_CHARACTER {position, ...} => position :: acc
    | WILDCARD i => i :: acc

    | CONCAT {l, r, ...} =>
        if isNullable l then
          let val acc = firstpos (l, acc)
          in firstpos (r, acc)
          end
        else
          firstpos (l, acc)
    | ALTERNATION {l, r, ...} =>
        let val acc = firstpos (l, acc)
        in firstpos (r, acc)
        end

    | ZERO_OR_ONE regex => firstpos (regex, acc)
    | ZERO_OR_MORE regex => firstpos (regex, acc)
    | ONE_OR_MORE regex => firstpos (regex, acc)
    | GROUP regex => firstpos (regex, acc)

  fun lastpos (tree, acc) =
    case tree of
      CHAR_LITERAL {position, ...} => position :: acc
    | IS_ANY_CHARACTER {position, ...} => position :: acc
    | NOT_ANY_CHARACTER {position, ...} => position :: acc
    | WILDCARD i => i :: acc

    | CONCAT {l, r, ...} =>
        if isNullable r then
          let val acc = lastpos (l, acc)
          in lastpos (r, acc)
          end
        else
          lastpos (r, acc)
    | ALTERNATION {l, r, ...} =>
        let val acc = lastpos (l, acc)
        in lastpos (r, acc)
        end

    | ZERO_OR_ONE regex => lastpos (regex, acc)
    | ZERO_OR_MORE regex => lastpos (regex, acc)
    | ONE_OR_MORE regex => lastpos (regex, acc)
    | GROUP regex => lastpos (regex, acc)

  structure Set =
  struct
    datatype 'a set = BRANCH of 'a set * int * 'a * 'a set | LEAF

    fun isEmpty set =
      case set of
        BRANCH _ => false
      | LEAF => true

    fun insertOrReplace (newKey, newVal, tree) =
      case tree of
        BRANCH (l, curKey, curVal, r) =>
          if newKey > curKey then
            let val r = insertOrReplace (newKey, newVal, r)
            in BRANCH (l, curKey, curVal, r)
            end
          else if newKey < curKey then
            let val l = insertOrReplace (newKey, newVal, l)
            in BRANCH (l, curKey, curVal, r)
            end
          else
            BRANCH (l, newKey, newVal, r)
      | LEAF => BRANCH (LEAF, newKey, newVal, LEAF)

    fun addFromList (lst, tree) =
      case lst of
        [] => tree
      | k :: tl =>
          let val tree = insertOrReplace (k, (), tree)
          in addFromList (tl, tree)
          end

    fun getOrDefault (findKey, tree, default) =
      case tree of
        BRANCH (l, curKey, curVal, r) =>
          if findKey > curKey then getOrDefault (findKey, r, default)
          else if findKey < curKey then getOrDefault (findKey, l, default)
          else curVal
      | LEAF => default

    fun helpToList (tree, acc) =
      case tree of
        BRANCH (l, curKey, curVal, r) =>
          let
            val acc = helpToList (r, acc)
            val acc = (curKey, curVal) :: acc
          in
            helpToList (l, acc)
          end
      | LEAF => acc

    fun toList tree = helpToList (tree, [])

    fun helpKeysToList (tree, acc) =
      case tree of
        BRANCH (l, curKey, _, r) =>
          let
            val acc = helpKeysToList (r, acc)
            val acc = curKey :: acc
          in
            helpKeysToList (l, acc)
          end
      | LEAF => acc

    fun keysToList tree = helpKeysToList (tree, [])

    fun helpValuesToList (tree, acc) =
      case tree of
        BRANCH (l, _, v, r) =>
          let
            val acc = helpValuesToList (r, acc)
            val acc = v :: acc
          in
            helpValuesToList (l, acc)
          end
      | LEAF => acc

    fun valuesToList tree = helpValuesToList (tree, [])

    fun map (f, tree) =
      case tree of
        BRANCH (l, key, value, r) =>
          let
            val r = map (f, r)
            val l = map (f, l)
            val value = f value
          in
            BRANCH (l, key, value, r)
          end
      | LEAF => LEAF

    fun foldl (f, tree, acc) =
      case tree of
        BRANCH (l, k, v, r) =>
          let
            val acc = foldl (f, l, acc)
            val acc = f (v, acc)
          in
            foldl (f, r, acc)
          end
      | LEAF => acc

    fun foldr (f, tree, acc) =
      case tree of
        BRANCH (l, k, v, r) =>
          let
            val acc = foldr (f, r, acc)
            val acc = f (v, acc)
          in
            foldr (f, l, acc)
          end
      | LEAF => acc
  end

  structure ParseDfa =
  struct
    (* parsing through precedence climbing algorithm. *)
    val postfixLevel = 1
    val concatLevel = 2
    val altLevel = 3

    local
      fun loop (pos, str, openParens, closeParens) =
        if pos = String.size str then
          NONE
        else
          case String.sub (str, pos) of
            #"(" => loop (pos + 1, str, openParens + 1, closeParens)
          | #")" =>
              if closeParens + 1 = openParens then SOME pos
              else loop (pos + 1, str, openParens, closeParens + 1)
          | _ => loop (pos + 1, str, openParens, closeParens)
    in
      fun getRightParenIdx (pos, str) = loop (pos, str, 1, 0)
    end

    (* assumes previous char is a backslash *)
    fun isValidEscapeSequence chr =
      case chr of
      (* regex metacharacters *)
        #"(" => (true, chr)
      | #")" => (true, chr)
      | #"[" => (true, chr)
      | #"]" => (true, chr)
      | #"+" => (true, chr)
      | #"*" => (true, chr)
      | #"|" => (true, chr)
      | #"?" => (true, chr)
      | #"." => (true, chr)
      | #"-" => (true, chr)
      (* standard escape sequences *)
      | #"a" => (true, #"\a")
      | #"b" => (true, #"\b")
      | #"t" => (true, #"\t")
      | #"n" => (true, #"\n")
      | #"v" => (true, #"\v")
      | #"f" => (true, #"\f")
      | #"r" => (true, #"\r")
      | #"\\" => (true, chr)
      | _ => (false, chr)

    fun getCharsBetween (lowChr, highChr, acc) =
      if lowChr = highChr then
        highChr :: acc
      else
        let
          val acc = lowChr :: acc
          val lowChr = Char.succ lowChr
        in
          getCharsBetween (lowChr, highChr, acc)
        end

    fun getCharsInBrackets (pos, str, acc) =
      if pos = String.size str then
        NONE
      else
        case String.sub (str, pos) of
          #"\\" =>
            (* escape sequences *)
            if pos + 1 = String.size str then
              NONE
            else
              let
                val chr = String.sub (str, pos + 1)
                val (isValid, chr) = isValidEscapeSequence chr
              in
                if isValid then
                  (* Edge case: 
                   * We have to check if there is a char range like a-z,
                   * and if there is,
                   * we have to check if the second char in the range
                   * is another escaped-character *)
                  if
                    pos + 2 < String.size str
                    andalso String.sub (str, pos + 2) = #"-"
                    andalso pos + 3 < String.size str
                  then
                    (* we do have a character range, 
                     * which may possibly be escaped *)
                    case String.sub (str, pos + 3) of
                      #"(" => NONE
                    | #")" => NONE
                    | #"[" => NONE
                    | #"]" => NONE
                    | #"+" => NONE
                    | #"*" => NONE
                    | #"|" => NONE
                    | #"?" => NONE
                    | #"." => NONE
                    | #"-" => NONE
                    | #"\\" =>
                        if pos + 4 < String.size str then
                          let
                            val chr2 = String.sub (str, pos + 4)
                            val (isValid, chr2) = isValidEscapeSequence chr2
                            val acc =
                              if chr < chr2 then
                                getCharsBetween (chr, chr2, acc)
                              else
                                getCharsBetween (chr2, chr, acc)
                          in
                            getCharsInBrackets (pos + 5, str, acc)
                          end
                        else
                          NONE
                    | chr2 =>
                        let
                          val acc =
                            if chr < chr2 then getCharsBetween (chr, chr2, acc)
                            else getCharsBetween (chr2, chr, acc)
                        in
                          getCharsInBrackets (pos + 4, str, acc)
                        end
                  else
                    (* no character range we have to check *)
                    getCharsInBrackets (pos + 2, str, chr :: acc)
                else
                  NONE
              end
        | #"]" =>
            let val chars = Vector.fromList acc
            in SOME (pos + 1, chars)
            end
        | chr =>
            if
              pos + 1 < String.size str andalso String.sub (str, pos + 1) = #"-"
              andalso pos + 2 < String.size str
            then
              (* handle character ranges like a-z.
               * There are edge cases regarding 
               * the second character in the range.
               * We have to check that any unescaped metacharacters
               * return an invalid parse state.
               * We also have to unescape any escape sequences.
               * *)
              case String.sub (str, pos + 2) of
                #"\\" =>
                  (* second char contains an escape sequence *)
                  if pos + 3 < String.size str then
                    let
                      val chr2 = String.sub (str, pos + 3)
                      val (isValid, chr2) = isValidEscapeSequence chr2
                      val acc =
                        if chr < chr2 then getCharsBetween (chr, chr2, acc)
                        else getCharsBetween (chr2, chr, acc)
                    in
                      if isValid then getCharsInBrackets (pos + 4, str, acc)
                      else NONE
                    end
                  else
                    NONE
              | #"(" => NONE
              | #")" => NONE
              | #"[" => NONE
              | #"]" => NONE
              | #"+" => NONE
              | #"*" => NONE
              | #"|" => NONE
              | #"?" => NONE
              | #"." => NONE
              | #"-" => NONE
              | chr2 =>
                  (* valid char range *)
                  let
                    val acc =
                      if chr < chr2 then getCharsBetween (chr, chr2, acc)
                      else getCharsBetween (chr2, chr, acc)
                  in
                    getCharsInBrackets (pos + 3, str, acc)
                  end
            else
              getCharsInBrackets (pos + 1, str, chr :: acc)

    fun parseCharacterClass (pos, str, stateNum) =
      case getCharsInBrackets (pos, str, []) of
        SOME (pos, chars) =>
          let
            val node = IS_ANY_CHARACTER {chars = chars, position = stateNum + 1}
          in
            SOME (pos, node, stateNum + 1)
          end
      | NONE => NONE

    fun parseNegateCharacterClass (pos, str, stateNum) =
      case getCharsInBrackets (pos, str, []) of
        SOME (pos, chars) =>
          let
            val node =
              NOT_ANY_CHARACTER {chars = chars, position = stateNum + 1}
          in
            SOME (pos, node, stateNum + 1)
          end
      | NONE => NONE

    fun computeAtom (pos, str, stateNum) =
      if pos = String.size str then
        NONE
      else
        case String.sub (str, pos) of
          #"(" =>
            (case getRightParenIdx (pos + 1, str) of
               SOME groupEndIdx =>
                 let
                   val substr = String.substring
                     (str, pos + 1, groupEndIdx - pos - 1)
                 in
                   case parse (substr, stateNum) of
                     SOME (rhs, stateNum) =>
                       SOME (groupEndIdx + 1, rhs, stateNum)
                   | NONE => NONE
                 end
             | NONE => NONE)
        | #"\\" =>
            (* escape sequences *)
            if pos + 1 = String.size str then
              NONE
            else
              let
                val chr = String.sub (str, pos + 1)
                val (isValid, chr) = isValidEscapeSequence chr
              in
                if Fn.charIsEqual (chr, Fn.endMarker) then
                  NONE
                else if isValid then
                  let
                    val chr = CHAR_LITERAL {char = chr, position = stateNum + 1}
                  in
                    SOME (pos + 2, chr, stateNum + 1)
                  end
                else
                  NONE
              end
        | #"." =>
            let val w = WILDCARD (stateNum + 1)
            in SOME (pos + 1, w, stateNum + 1)
            end
        | #"[" =>
            if pos + 1 = String.size str then
              NONE
            else if String.sub (str, pos + 1) = #"^" then
              parseNegateCharacterClass (pos + 2, str, stateNum)
            else
              parseCharacterClass (pos + 1, str, stateNum)
        | #")" => NONE
        | #"]" => NONE
        | #"+" => NONE
        | #"*" => NONE
        | #"|" => NONE
        | #"?" => NONE
        | #"-" => NONE
        | chr =>
            if Fn.charIsEqual (chr, Fn.endMarker) then
              NONE
            else
              let val chr = CHAR_LITERAL {char = chr, position = stateNum + 1}
              in SOME (pos + 1, chr, stateNum + 1)
              end

    and climb (pos, str, lhs, level, stateNum) : (int * parse_tree * int) option =
      if pos = String.size str then
        SOME (pos, lhs, stateNum)
      else
        case String.sub (str, pos) of
          #"|" =>
            if level < altLevel then
              SOME (pos, lhs, stateNum)
            else if pos + 1 < String.size str then
              let
                val chr = String.sub (str, pos + 1)
                val chr = CHAR_LITERAL {char = chr, position = stateNum + 1}
              in
                case climb (pos + 2, str, chr, altLevel, stateNum + 1) of
                  SOME (pos, rhs, rightStateNum) =>
                    let
                      val result = ALTERNATION
                        { l = lhs
                        , r = rhs
                        , leftMaxState = stateNum
                        , rightMaxState = rightStateNum
                        }
                    in
                      SOME (pos, result, rightStateNum)
                    end
                | NONE => NONE
              end
            else
              NONE
        | #"?" =>
            if level < postfixLevel then
              SOME (pos, lhs, stateNum)
            else
              let val lhs = ZERO_OR_ONE lhs
              in climb (pos + 1, str, lhs, postfixLevel, stateNum)
              end
        | #"*" =>
            if level < postfixLevel then
              SOME (pos, lhs, stateNum)
            else
              let val lhs = ZERO_OR_MORE lhs
              in climb (pos + 1, str, lhs, postfixLevel, stateNum)
              end
        | #"+" =>
            if level < postfixLevel then
              SOME (pos, lhs, stateNum)
            else
              let val lhs = ONE_OR_MORE lhs
              in climb (pos + 1, str, lhs, postfixLevel, stateNum)
              end
        | chr =>
            if level < concatLevel then
              SOME (pos, lhs, stateNum)
            else
              case computeAtom (pos, str, stateNum) of
                SOME (nextPos, curAtom, atomStateNum) =>
                  (case climb (nextPos, str, curAtom, concatLevel, atomStateNum) of
                     SOME (pos, rhs, rightStateNum) =>
                       let
                         val result = CONCAT
                           { l = lhs
                           , r = rhs
                           , leftMaxState = stateNum
                           , rightMaxState = rightStateNum
                           }
                       in
                         SOME (pos, result, rightStateNum)
                       end
                   | NONE => NONE)
              | NONE => NONE

    and loop (pos, str, ast, stateNum) =
      if pos = String.size str then
        SOME (ast, stateNum)
      else
        case climb (pos, str, ast, altLevel, stateNum) of
          SOME (pos, ast, stateNum) => loop (pos, str, ast, stateNum)
        | NONE => NONE

    and parse (str, stateNum) =
      if String.size str > 0 then
        case computeAtom (0, str, stateNum) of
          SOME (nextPos, lhs, stateNum) => loop (nextPos, str, lhs, stateNum)
        | NONE => NONE
      else
        NONE
  end

  structure ToDfa =
  struct
    type dstate_element = {marked: bool, transitions: int list}
    type dstate_vec = dstate_element vector

    fun chrExistsInVec (idx, vec, curChr) =
      if idx = Vector.length vec then
        false
      else
        let
          val idxChr = Vector.sub (vec, idx)
        in
          Fn.charIsEqual (idxChr, curChr)
          orelse chrExistsInVec (idx + 1, vec, curChr)
        end

    fun addKeysToFollowSet (lst, addSet, followSet) =
      case lst of
        hd :: tl =>
          let
            val currentFollows = Set.getOrDefault (hd, followSet, [])
            val updatedFollows = Set.addFromList (currentFollows, addSet)
            val updatedFollows: int list = Set.keysToList updatedFollows
            val followSet = Set.insertOrReplace (hd, updatedFollows, followSet)
          in
            addKeysToFollowSet (tl, addSet, followSet)
          end
      | [] => followSet

    fun addToFollowSet (tree, followSet) =
      case tree of
        WILDCARD _ => followSet
      | CHAR_LITERAL {char, position} =>
          (* we add the endMarker and its position to the followSet *)
          if char = Fn.endMarker then
            Set.insertOrReplace (position, [Char.ord Fn.endMarker], followSet)
          else
            followSet
      | IS_ANY_CHARACTER _ => followSet
      | NOT_ANY_CHARACTER _ => followSet
      | CONCAT {l, r, ...} =>
          let
            val followSet = addToFollowSet (l, followSet)
            val followSet = addToFollowSet (r, followSet)

            val lpOfLeft = lastpos (l, [])
            val fpOfRight = firstpos (r, [])
            val fpOfRight = Set.addFromList (fpOfRight, Set.LEAF)
          in
            addKeysToFollowSet (lpOfLeft, fpOfRight, followSet)
          end
      | ALTERNATION {l, r, ...} =>
          let val followSet = addToFollowSet (l, followSet)
          in addToFollowSet (r, followSet)
          end
      | ZERO_OR_MORE child =>
          let
            val followSet = addToFollowSet (child, followSet)
            val fp = firstpos (child, [])
            val fp = Set.addFromList (fp, Set.LEAF)
            val lp = lastpos (child, [])
          in
            addKeysToFollowSet (lp, fp, followSet)
          end
      | ONE_OR_MORE child =>
          let
            val followSet = addToFollowSet (child, followSet)
            val lp = lastpos (child, [])
            val fp = firstpos (child, [])
            val fp = Set.addFromList (fp, Set.LEAF)
          in
            addKeysToFollowSet (lp, fp, followSet)
          end
      | ZERO_OR_ONE child => addToFollowSet (child, followSet)
      | GROUP child => addToFollowSet (child, followSet)

    fun appendIfNew (pos, dstates, newStates) =
      if pos = Vector.length dstates then
        let
          val record = {transitions = newStates, marked = false}
          val dstates = Vector.concat [dstates, Vector.fromList [record]]
        in
          (pos, dstates)
        end
      else
        let
          val {transitions: int list, marked = _} = Vector.sub (dstates, pos)
        in
          if transitions = newStates then (pos, dstates)
          else appendIfNew (pos + 1, dstates, newStates)
        end

    fun getUnmarkedTransitionsIfExists (pos, dstates) =
      if pos = Vector.length dstates then
        NONE
      else
        let
          val record: dstate_element = Vector.sub (dstates, pos)
        in
          if #marked record then
            getUnmarkedTransitionsIfExists (pos + 1, dstates)
          else
            SOME (pos, #transitions record)
        end

    fun isCharMatch (regex, pos, curChr) =
      case regex of
        CHAR_LITERAL {char, ...} => Fn.charIsEqual (char, curChr)
      | WILDCARD _ => true
      | IS_ANY_CHARACTER {chars, ...} => chrExistsInVec (0, chars, curChr)
      | NOT_ANY_CHARACTER {chars, ...} =>
          let val charIsValid = chrExistsInVec (0, chars, curChr)
          in not charIsValid
          end
      | ALTERNATION {l, r, leftMaxState, ...} =>
          if pos > leftMaxState then isCharMatch (r, pos, curChr)
          else isCharMatch (l, pos, curChr)
      | CONCAT {l, r, leftMaxState, ...} =>
          if pos > leftMaxState then isCharMatch (r, pos, curChr)
          else isCharMatch (l, pos, curChr)
      | ZERO_OR_ONE child => isCharMatch (child, pos, curChr)
      | ZERO_OR_MORE child => isCharMatch (child, pos, curChr)
      | ONE_OR_MORE child => isCharMatch (child, pos, curChr)
      | GROUP child => isCharMatch (child, pos, curChr)

    fun positionsThatCorrespondToChar
      (char, curStates, regex, acc, followSet, hasAnyMatch) =
      case curStates of
        [] => List.concat (Set.valuesToList acc)
      | pos :: tl =>
          if isCharMatch (regex, pos, Char.chr char) then
            let
              (* get union of new and previous follows *)
              val prevFollows = Set.getOrDefault (char, acc, [])
              val newFollows = Set.getOrDefault (pos, followSet, [])

              val tempSet = Set.addFromList (prevFollows, Set.LEAF)
              val tempSet = Set.addFromList (newFollows, tempSet)
              val allFollowList = Set.keysToList tempSet

              (* store union of new and previous follows so far *)
              val acc = Set.insertOrReplace (char, allFollowList, acc)
            in
              positionsThatCorrespondToChar
                (char, tl, regex, acc, followSet, true)
            end
          else
            positionsThatCorrespondToChar
              (char, tl, regex, acc, followSet, hasAnyMatch)

    structure Dtran =
    struct
      (* vector, with idx corresponding to state in dstate,
      * an int key which corresponds to char's ascii code,
      * and an int value corresponding to state we will transition to *)
      type t = int Set.set vector

      fun insert (dStateIdx, char, toStateIdx, dtran: t) =
        if dStateIdx = Vector.length dtran then
          let
            val el = Set.insertOrReplace (char, toStateIdx, Set.LEAF)
            val el = Vector.fromList [el]
          in
            Vector.concat [dtran, el]
          end
        else if dStateIdx < Vector.length dtran then
          let
            val el = Vector.sub (dtran, dStateIdx)
            val el = Set.insertOrReplace (char, toStateIdx, el)
          in
            Vector.update (dtran, dStateIdx, el)
          end
        else
          let
            val appendLength = dStateIdx - Vector.length dtran
            val appendVecs = Vector.tabulate (appendLength, fn _ => Set.LEAF)
            val dtran = Vector.concat [dtran, appendVecs]
          in
            insert (dStateIdx, char, toStateIdx, dtran)
          end
    end

    fun convertChar
      ( char
      , regex
      , dstates
      , dtran: Dtran.t
      , unmarkedState
      , unmarkedIdx
      , followSet
      , prevDstateLength
      ) =
      if char < 0 then
        (dstates, dtran)
      else
        let
          val u = positionsThatCorrespondToChar
            (char, unmarkedState, regex, Set.LEAF, followSet, false)
        in
          case u of
            [] =>
              convertChar
                ( char - 1
                , regex
                , dstates
                , dtran
                , unmarkedState
                , unmarkedIdx
                , followSet
                , prevDstateLength
                )
          | _ =>
              let
                (* dtran is idx -> char -> state_list map *)
                val (uIdx, dstates) = appendIfNew (0, dstates, u)
                val dtran = Dtran.insert (unmarkedIdx, char, uIdx, dtran)
              in
                convertChar
                  ( char - 1
                  , regex
                  , dstates
                  , dtran
                  , unmarkedState
                  , unmarkedIdx
                  , followSet
                  , prevDstateLength
                  )
              end
        end

    fun convertLoop (regex, dstates, dtran, followSet) =
      case getUnmarkedTransitionsIfExists (0, dstates) of
        SOME (unmarkedIdx, unamarkedTransition) =>
          let
            (* mark transition *)
            val dstates =
              let
                val newMark = {marked = true, transitions = unamarkedTransition}
              in
                Vector.update (dstates, unmarkedIdx, newMark)
              end

            val (dstates, dtran) = convertChar
              ( 255
              , regex
              , dstates
              , dtran
              , unamarkedTransition
              , unmarkedIdx
              , followSet
              , Vector.length dstates
              )
          in
            convertLoop (regex, dstates, dtran, followSet)
          end
      | NONE =>
          Vector.map
            (fn set =>
               Vector.tabulate (256, fn i => Set.getOrDefault (i, set, ~1)))
            dtran

    fun convert regex =
      let
        val followSet = addToFollowSet (regex, Set.LEAF)

        (* get firstpos, sorted *)
        val first = firstpos (regex, [])
        val first = Set.addFromList (first, Set.LEAF)
        val first = Set.keysToList first

        val dstates = Vector.fromList [{transitions = first, marked = false}]
      in
        convertLoop (regex, dstates, Vector.fromList [Set.LEAF], followSet)
      end
  end

  fun fromString str =
    case ParseDfa.parse (str, 0) of
      SOME (ast, numStates) =>
        let
          val endMarker =
            CHAR_LITERAL {char = Fn.endMarker, position = numStates + 1}
          val ast = CONCAT
            { l = ast
            , leftMaxState = numStates
            , r = endMarker
            , rightMaxState = numStates + 1
            }
        in
          ToDfa.convert ast
        end
    | NONE => Vector.fromList []

  type dfa = int vector vector
  type dfa_state = int

  fun nextState (dfa: dfa, curState: dfa_state, chr) =
    let val curTable = Vector.sub (dfa, curState)
    in Vector.sub (curTable, Char.ord chr)
    end

  fun isFinal (dfa: dfa, curState: dfa_state) =
    curState <> ~1
    andalso
    let
      val curTable = Vector.sub (dfa, curState)
      val endMarkerCode = Char.ord Fn.endMarker
    in
      Vector.sub (curTable, endMarkerCode) <> ~1
    end

  fun isDead (curState: dfa_state) = curState = ~1

  fun helpMatchString (strPos, str, dfa, curState, startPos, prevFinalPos, acc) =
    if strPos = String.size str then
      let
        val acc =
          if prevFinalPos = ~1 then acc else (startPos, prevFinalPos) :: acc
      in
        List.rev acc
      end
    else
      let
        val chr = String.sub (str, strPos)
        val newState = nextState (dfa, curState, chr)
        val prevFinalPos =
          if isFinal (dfa, newState) then strPos else prevFinalPos
      in
        if isDead newState then
          if prevFinalPos = ~1 then
            (* restart from startPos *)
            helpMatchString (startPos + 1, str, dfa, 0, startPos + 1, ~1, acc)
          else
            let
              val acc = (startPos, prevFinalPos) :: acc
            in
              helpMatchString
                (prevFinalPos + 1, str, dfa, 0, prevFinalPos + 1, ~1, acc)
            end
        else
          helpMatchString
            (strPos + 1, str, dfa, newState, startPos, prevFinalPos, acc)
      end

  fun matchString (dfa, string) =
    if Vector.length dfa = 0 then []
    else helpMatchString (0, string, dfa, 0, 0, ~1, [])
end

structure CaseInsensitiveDfa =
  MakeDfaGen
    (struct
       val endMarker = #"\^@"
       fun charIsEqual (a: char, b: char) = Char.toLower a = Char.toLower b
     end)

structure CaseSensitiveDfa =
  MakeDfaGen
    (struct
       val endMarker = #"\^@"
       fun charIsEqual (a: char, b: char) = a = b
     end)