basis/regexp/disambiguate/disambiguate.factor

   1 ! Copyright (C) 2009 Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel accessors regexp.classes math.bits assocs sequences
   4 arrays sets regexp.dfa math fry regexp.minimize regexp.ast ;
   5 IN: regexp.disambiguate
   6
   7 TUPLE: parts in out ;
   8
   9 : make-partition ( choices classes -- partition )
  10     zip [ first ] partition [ values ] bi@ parts boa ;
  11
  12 : powerset-partition ( classes -- partitions )
  13     [ length [ 2^ ] keep ] keep '[
  14         _ <bits> _ make-partition
  15     ] map rest ;
  16
  17 : partition>class ( parts -- class )
  18     [ out>> [ <not-class> ] map ]
  19     [ in>> <and-class> ] bi
  20     prefix <and-class> ;
  21
  22 : get-transitions ( partition state-transitions -- next-states )
  23     [ in>> ] dip '[ _ at ] gather sift ;
  24
  25 : new-transitions ( transitions -- assoc ) ! assoc is class, partition
  26     values [ keys ] gather
  27     [ tagged-epsilon? not ] filter
  28     powerset-partition
  29     [ [ partition>class ] keep ] { } map>assoc
  30     [ drop ] assoc-filter ;
  31
  32 : preserving-epsilon ( state-transitions quot -- new-state-transitions )
  33     [ [ drop tagged-epsilon? ] assoc-filter ] bi
  34     assoc-union H{ } assoc-like ; inline
  35
  36 : disambiguate ( nfa -- nfa )
  37     [
  38         dup new-transitions '[
  39             [
  40                 _ swap '[ _ get-transitions ] assoc-map
  41                 [ nip empty? not ] assoc-filter
  42             ] preserving-epsilon
  43         ] assoc-map
  44     ] change-transitions ;