! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators kernel math
quotations sequences regexp.classes fry arrays regexp.matchers
combinators.short-circuit prettyprint regexp.nfa ;
IN: regexp.traversal

TUPLE: dfa-traverser
    dfa-table
    current-state
    text
    current-index
    match-index ;

: <dfa-traverser> ( start-index text dfa -- match )
    dfa-traverser new
        swap [ start-state>> >>current-state ] [ >>dfa-table ] bi
        swap >>text
        swap >>current-index ;

: final-state? ( dfa-traverser -- ? )
    [ current-state>> ]
    [ dfa-table>> final-states>> ] bi key? ;

: end-of-text? ( dfa-traverser -- ? )
    [ current-index>> ] [ text>> length ] bi >= ; inline

: text-finished? ( dfa-traverser -- ? )
    {
        [ current-state>> not ]
        [ end-of-text? ]
    } 1|| ;

: save-final-state ( dfa-traverser -- dfa-traverser )
    dup current-index>> >>match-index ;

: match-done? ( dfa-traverser -- ? )
    dup final-state? [ save-final-state ] when text-finished? ;

: increment-state ( dfa-traverser state -- dfa-traverser )
    >>current-state
    [ 1 + ] change-current-index ;

: match-literal ( transition from-state table -- to-state/f )
    transitions>> at at ;

: match-class ( transition from-state table -- to-state/f )
    transitions>> at* [
        swap '[ drop _ swap class-member? ] assoc-find spin ?
    ] [ drop ] if ;

: match-transition ( obj from-state dfa -- to-state/f )
    { [ match-literal ] [ match-class ] } 3|| ;

: setup-match ( match -- obj state dfa-table )
    [ [ current-index>> ] [ text>> ] bi nth ]
    [ current-state>> ]
    [ dfa-table>> ] tri ;

: do-match ( dfa-traverser -- dfa-traverser )
    dup match-done? [
        dup setup-match match-transition
        [ increment-state do-match ] when*
    ] unless ;

TUPLE: dfa-matcher dfa ;
C: <dfa-matcher> dfa-matcher
M: dfa-matcher match-index-from
    dfa>> <dfa-traverser> do-match match-index>> ;