2008-08-26 21:24:14 -04:00
|
|
|
! Copyright (C) 2008 Doug Coleman.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
USING: accessors arrays assocs fry hashtables kernel sequences
|
2009-02-26 15:19:02 -05:00
|
|
|
vectors locals ;
|
2008-09-18 15:42:16 -04:00
|
|
|
IN: regexp.transition-tables
|
2008-08-26 21:24:14 -04:00
|
|
|
|
2008-11-24 23:16:29 -05:00
|
|
|
TUPLE: transition-table transitions start-state final-states ;
|
2008-08-26 21:24:14 -04:00
|
|
|
|
|
|
|
: <transition-table> ( -- transition-table )
|
|
|
|
transition-table new
|
|
|
|
H{ } clone >>transitions
|
2008-11-24 23:16:29 -05:00
|
|
|
H{ } clone >>final-states ;
|
2008-08-26 21:24:14 -04:00
|
|
|
|
2008-09-19 18:54:34 -04:00
|
|
|
: maybe-initialize-key ( key hashtable -- )
|
2009-01-23 19:20:47 -05:00
|
|
|
2dup key? [ 2drop ] [ [ H{ } clone ] 2dip set-at ] if ;
|
2008-09-19 18:54:34 -04:00
|
|
|
|
2009-03-04 01:36:03 -05:00
|
|
|
:: (set-transition) ( from to obj hash -- )
|
|
|
|
to hash maybe-initialize-key
|
|
|
|
from hash at
|
|
|
|
[ [ to obj ] dip set-at ]
|
|
|
|
[ to obj associate from hash set-at ] if* ;
|
|
|
|
|
|
|
|
: set-transition ( from to obj transition-table -- )
|
|
|
|
transitions>> (set-transition) ;
|
|
|
|
|
|
|
|
:: (add-transition) ( from to obj hash -- )
|
2009-02-26 15:19:02 -05:00
|
|
|
to hash maybe-initialize-key
|
|
|
|
from hash at
|
|
|
|
[ [ to obj ] dip push-at ]
|
|
|
|
[ to 1vector obj associate from hash set-at ] if* ;
|
2008-08-26 21:24:14 -04:00
|
|
|
|
2009-02-26 15:19:02 -05:00
|
|
|
: add-transition ( from to obj transition-table -- )
|
2009-03-04 01:36:03 -05:00
|
|
|
transitions>> (add-transition) ;
|