basis/regexp/negation/negation.factor

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