(* dfa-engine.sml
 *
 * COPYRIGHT (c) 2008 The Fellowship of SML/NJ (http://www.smlnj.org)
 * All rights reserved.
 *
 * Implements a matcher engine based on deterministic finite
 * automata.
 *)

structure DfaEngine : REGEXP_ENGINE =
  struct

    structure D = Dfa
    structure M = MatchTree

    type regexp = D.dfa

  (* a match specifies the position (as a stream) and the length of the match *)
    type 'a match = {pos : 'a, len : int} MatchTree.match_tree

    fun compile r = D.build r handle _ => raise RegExpSyntax.CannotCompile

    (* scan looks at a stream and attempts to match the dfa.
     * it returns `NONE` if it fails
     * it returns `SOME(pattern#, Match, rest of stream)` upon success
     *)
    fun scan (regexp, getc, p, stream) = let
          val move = D.move regexp
          val accepting = D.accepting regexp
          fun loop (state, p, inits, lastAccepting) = (case getc inits
                 of NONE => lastAccepting
                  | SOME(c, s') => (case move (state, c)
                       of NONE => lastAccepting
                        | SOME new => (case accepting new
                             of SOME n => loop (new, p+1, s', SOME(p+1,s',n))
                              | NONE => loop (new, p+1, s', lastAccepting)
                            (* end case *))
                      (* end case *))
              (* end case *))
          fun try0 stream = (case (accepting 0)
                 of (SOME n) => SOME(n, M.Match({pos=stream,len=0},[]), stream)
                  | NONE => NONE
                (* end case *))
          in
	    case getc stream
             of NONE => try0 stream
              | SOME(c, s') => (case loop (0, p, stream, NONE)
                   of NONE => try0 stream
                    | SOME(last, cs, n) =>
                        SOME(n, M.Match({pos=stream,len=last-p},[]), cs)
                  (* end case *))
	    (* end case *)
          end

    fun prefix regexp getc stream = (
          case scan (regexp,getc,0,stream)
           of NONE => NONE
            | SOME (n,m,cs) => SOME (m,cs)
          (* end case *))

    fun find regexp getc stream =
	let fun loop (p,s) = (case (scan (regexp,getc,p,s))
				of NONE => (case (getc (s))
					      of SOME (_,s') => loop (p+1,s')
					       | NONE => NONE)
				 | SOME (n,m,cs) => SOME (m,cs))
	in
	    loop (0,stream)
	end

    fun match [] = (fn getc => fn stream => NONE)
      | match l =
	let val dfa = D.buildPattern (map #1 l)
	    val a = Vector.fromList (map (fn (a,b) => b) l)
	in
	    fn getc => fn stream => case (scan (dfa,getc,0,stream))
				      of NONE => NONE
				       | SOME(n,m,cs) => SOME((Vector.sub (a,n)) m,cs)
	end

    end
