1 ! Copyright (C) 2009 Daniel Ehrenberg.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: regexp.nfa regexp.disambiguate kernel sequences
4 assocs regexp.classes hashtables accessors fry vectors
5 regexp.ast regexp.transition-tables regexp.minimize
6 regexp.dfa namespaces sets ;
9 CONSTANT: fail-state -1
11 : add-default-transition ( state's-transitions -- new-state's-transitions )
13 [ [ fail-state ] dip keys [ <not-class> ] map <and-class> ] keep set-at ;
15 : fail-state-recurses ( transitions -- new-transitions )
17 [ fail-state t associate fail-state ] dip set-at ;
19 : add-fail-state ( transitions -- new-transitions )
20 [ add-default-transition ] assoc-map
23 : inverse-final-states ( transition-table -- final-states )
24 [ transitions>> keys ] [ final-states>> ] bi diff fast-set ;
26 : negate-table ( transition-table -- transition-table )
28 [ add-fail-state ] change-transitions
29 dup inverse-final-states >>final-states ;
31 : renumber-states ( transition-table -- transition-table )
32 dup transitions>> keys [ next-state ] H{ } map>assoc
35 : box-transitions ( transition-table -- transition-table )
36 [ [ [ 1vector ] assoc-map ] assoc-map ] change-transitions ;
38 : unify-final-state ( transition-table -- transition-table )
39 dup [ final-states>> members ] keep
40 '[ -2 epsilon _ set-transition ] each
41 HS{ -2 } clone >>final-states ;
43 : adjoin-dfa ( transition-table -- start end )
44 unify-final-state renumber-states box-transitions
46 [ final-states>> members first ]
47 [ nfa-table get [ transitions>> ] bi@ swap assoc-union! drop ] tri ;
49 : ast>nfa ( parse-tree -- minimal-dfa )
50 construct-nfa disambiguate ;
52 : ast>dfa ( parse-tree -- minimal-dfa )
53 ast>nfa construct-dfa minimize ;
55 M: negation nfa-node ( node -- start end )
56 term>> ast>dfa negate-table adjoin-dfa ;