(* 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
	    val canStart = D.canStart 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)

    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
