1 ! Copyright (C) 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs fry hashtables kernel sequences
4 vectors locals regexp.classes sets ;
5 IN: regexp.transition-tables
7 TUPLE: transition-table transitions start-state final-states ;
9 : <transition-table> ( -- transition-table )
11 H{ } clone >>transitions
12 HS{ } clone >>final-states ;
14 :: (set-transition) ( from to obj hash -- )
16 [ [ to obj ] dip set-at ]
17 [ to obj associate from hash set-at ] if* ;
19 : set-transition ( from to obj transition-table -- )
20 transitions>> (set-transition) ;
22 :: (add-transition) ( from to obj hash -- )
24 [ [ to obj ] dip push-at ]
25 [ to 1vector obj associate from hash set-at ] if* ;
27 : add-transition ( from to obj transition-table -- )
28 transitions>> (add-transition) ;
30 : map-set ( set quot -- new-set )
31 over [ [ members ] dip map ] dip set-like ; inline
33 : number-transitions ( transitions numbering -- new-transitions )
36 [ [ _ condition-at ] assoc-map ] bi*
39 : transitions-at ( transition-table assoc -- transition-table )
41 [ '[ _ condition-at ] change-start-state ]
42 [ '[ [ _ at ] map-set ] change-final-states ]
43 [ '[ _ number-transitions ] change-transitions ] tri ;
45 : expand-one-or ( or-class transition -- alist )
46 [ seq>> ] dip '[ _ 2array ] map ;
48 : expand-or ( state-transitions -- new-transitions )
51 [ expand-one-or ] [ 2array 1array ] if
52 ] map concat >hashtable ;
54 : expand-ors ( transition-table -- transition-table )
55 [ [ expand-or ] assoc-map ] change-transitions ;