sml-projects/fcore/parser/lexer.sml

structure Lexer =
struct
  structure T = Tokens

  fun validMin (a, b) =
    if a = ~1 then b else if b = ~1 then a else Int.min (a, b)

  fun addToken (acc, dfa: AllDfa.t, str, finish) =
    let
      val {lastInt, lastSpace, lastBrace, ...} = dfa
      val min = validMin (lastInt, lastSpace)
      val min = validMin (min, lastBrace)
    in
      if min = ~1 then
        NONE
      else if min = lastSpace then
        SOME (lastSpace, acc)
      else
        let
          val str = String.substring (str, min, finish - min + 1)
        in
          if min = lastInt then
            case Int.fromString str of
              SOME int => SOME (lastInt, T.INT int :: acc)
            | NONE => NONE
          else if min = lastBrace then
            if str = "{" then SOME (lastBrace, T.L_BRACE :: acc)
            else if str = "}" then SOME (lastBrace, T.R_BRACE :: acc)
            else NONE
          else
            NONE
        end
    end

  fun scanStep (pos, str, acc, dfa, finish) =
    if pos < 0 orelse AllDfa.areAllDead dfa then
      addToken (acc, dfa, str, finish)
    else
      let
        val chr = String.sub (str, pos)
        val dfa = AllDfa.update (chr, dfa, pos)
      in
        if AllDfa.areAllDead dfa then addToken (acc, dfa, str, finish)
        else scanStep (pos - 1, str, acc, dfa, finish)
      end

  fun scanLoop (pos, str, acc) =
    if pos < 0 then
      SOME acc
    else
      case scanStep (pos, str, acc, AllDfa.initial, pos) of
        SOME (pos, acc) => scanLoop (pos - 1, str, acc)
      | NONE => NONE

  fun scan str =
    scanLoop (String.size str - 1, str, [])
end