basis/regexp/transition-tables/transition-tables.factor

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