basis/regexp/ast/ast.factor

   1 ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel arrays accessors fry sequences regexp.classes
   4 math.ranges math ;
   5 IN: regexp.ast
   6
   7 TUPLE: negation term ;
   8 C: <negation> negation
   9
  10 TUPLE: from-to n m ;
  11 C: <from-to> from-to
  12
  13 TUPLE: at-least n ;
  14 C: <at-least> at-least
  15
  16 TUPLE: tagged-epsilon tag ;
  17 C: <tagged-epsilon> tagged-epsilon
  18
  19 CONSTANT: epsilon T{ tagged-epsilon { tag t } }
  20
  21 TUPLE: concatenation first second ;
  22
  23 : <concatenation> ( seq -- concatenation )
  24     [ epsilon ] [ [ ] [ concatenation boa ] map-reduce ] if-empty ;
  25
  26 TUPLE: alternation first second ;
  27
  28 : <alternation> ( seq -- alternation )
  29     [ ] [ alternation boa ] map-reduce ;
  30
  31 TUPLE: star term ;
  32 C: <star> star
  33
  34 TUPLE: with-options tree options ;
  35 C: <with-options> with-options
  36
  37 TUPLE: options on off ;
  38 C: <options> options
  39
  40 SINGLETONS: unix-lines dotall multiline case-insensitive reversed-regexp ;
  41
  42 : <maybe> ( term -- term' )
  43     f <concatenation> 2array <alternation> ;
  44
  45 : <plus> ( term -- term' )
  46     dup <star> 2array <concatenation> ;
  47
  48 : repetition ( n term -- term' )
  49     <array> <concatenation> ;
  50
  51 GENERIC: <times> ( term times -- term' )
  52
  53 M: at-least <times>
  54     n>> swap [ repetition ] [ <star> ] bi 2array <concatenation> ;
  55
  56 : to-times ( term n -- ast )
  57     dup zero?
  58     [ 2drop epsilon ]
  59     [ dupd 1 - to-times 2array <concatenation> <maybe> ]
  60     if ;
  61
  62 M: from-to <times>
  63     [ n>> swap repetition ]
  64     [ [ m>> ] [ n>> ] bi - to-times ] 2bi
  65     2array <concatenation> ;
  66
  67 : char-class ( ranges ? -- term )
  68     [ <or-class> ] dip [ <not-class> ] when ;
  69
  70 TUPLE: lookahead term ;
  71 C: <lookahead> lookahead
  72
  73 TUPLE: lookbehind term ;
  74 C: <lookbehind> lookbehind