basis/regexp/regexp.factor

   1 ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators kernel math sequences strings sets
   4 assocs prettyprint.backend prettyprint.custom make lexer
   5 namespaces parser arrays fry locals regexp.minimize
   6 regexp.parser regexp.nfa regexp.dfa regexp.traversal
   7 regexp.transition-tables splitting sorting regexp.ast
   8 regexp.negation regexp.matchers regexp.compiler ;
   9 IN: regexp
  10
  11 TUPLE: regexp
  12     { raw read-only }
  13     { parse-tree read-only }
  14     { options read-only }
  15     dfa reverse-dfa dfa-quot ;
  16
  17 : make-regexp ( string ast -- regexp )
  18     f f <options> f f f regexp boa ; foldable
  19     ! Foldable because, when the dfa slot is set,
  20     ! it'll be set to the same thing regardless of who sets it
  21
  22 : <optioned-regexp> ( string options -- regexp )
  23     [ dup parse-regexp ] [ string>options ] bi*
  24     f f f regexp boa ;
  25
  26 : <regexp> ( string -- regexp ) "" <optioned-regexp> ;
  27
  28 TUPLE: reverse-matcher regexp ;
  29 C: <reverse-matcher> reverse-matcher
  30
  31 <PRIVATE
  32
  33 : get-ast ( regexp -- ast )
  34     [ parse-tree>> ] [ options>> ] bi <with-options> ;
  35
  36 : compile-regexp ( regexp -- regexp )
  37     dup '[ [ _ get-ast ast>dfa ] unless* ] change-dfa ;
  38
  39 : compile-dfa-quot ( regexp -- regexp )
  40     dup '[ [ _ compile-regexp dfa>> dfa>quotation ] unless* ] change-dfa-quot ;
  41
  42 : <reversed-option> ( ast -- reversed )
  43     "r" string>options <with-options> ;
  44
  45 : compile-reverse ( regexp -- regexp )
  46     dup '[ [ _ get-ast <reversed-option> ast>dfa ] unless* ] change-reverse-dfa ;
  47
  48 M: regexp match-index ( string regexp -- index/f )
  49     dup dfa-quot>>
  50     [ <quot-matcher> ]
  51     [ compile-regexp dfa>> <dfa-matcher> ] ?if
  52     match-index ;
  53
  54 M: reverse-matcher match-index ( string regexp -- index/f )
  55     [ <reversed> ] [ regexp>> compile-reverse reverse-dfa>> ] bi*
  56     <dfa-traverser> do-match match-index>> ;
  57
  58 : find-regexp-syntax ( string -- prefix suffix )
  59     {
  60         { "R/ "  "/"  }
  61         { "R! "  "!"  }
  62         { "R\" " "\"" }
  63         { "R# "  "#"  }
  64         { "R' "  "'"  }
  65         { "R( "  ")"  }
  66         { "R@ "  "@"  }
  67         { "R[ "  "]"  }
  68         { "R` "  "`"  }
  69         { "R{ "  "}"  }
  70         { "R| "  "|"  }
  71     } swap [ subseq? not nip ] curry assoc-find drop ;
  72
  73 : take-until ( end lexer -- string )
  74     dup skip-blank [
  75         [ index-from ] 2keep
  76         [ swapd subseq ]
  77         [ 2drop 1+ ] 3bi
  78     ] change-lexer-column ;
  79
  80 : parse-noblank-token ( lexer -- str/f )
  81     dup still-parsing-line? [ (parse-token) ] [ drop f ] if ;
  82
  83 : parsing-regexp ( accum end -- accum )
  84     lexer get [ take-until ] [ parse-noblank-token ] bi
  85     <optioned-regexp> compile-dfa-quot parsed ;
  86
  87 PRIVATE>
  88
  89 : R! CHAR: ! parsing-regexp ; parsing
  90 : R" CHAR: " parsing-regexp ; parsing
  91 : R# CHAR: # parsing-regexp ; parsing
  92 : R' CHAR: ' parsing-regexp ; parsing
  93 : R( CHAR: ) parsing-regexp ; parsing
  94 : R/ CHAR: / parsing-regexp ; parsing
  95 : R@ CHAR: @ parsing-regexp ; parsing
  96 : R[ CHAR: ] parsing-regexp ; parsing
  97 : R` CHAR: ` parsing-regexp ; parsing
  98 : R{ CHAR: } parsing-regexp ; parsing
  99 : R| CHAR: | parsing-regexp ; parsing
 100
 101 M: regexp pprint*
 102     [
 103         [
 104             [ raw>> dup find-regexp-syntax swap % swap % % ]
 105             [ options>> options>string % ] bi
 106         ] "" make
 107     ] keep present-text ;