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
   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 ;
  16
  17 : make-regexp ( string ast -- regexp )
  18     f f <options> 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 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 dfa>quotation ] unless* ] change-dfa ;
  38
  39 : <reversed-option> ( ast -- reversed )
  40     "r" string>options <with-options> ;
  41
  42 : compile-reverse ( regexp -- regexp )
  43     dup '[
  44         [
  45             _ get-ast <reversed-option>
  46             ast>dfa dfa>quotation
  47         ] unless*
  48     ] change-reverse-dfa ;
  49
  50 M: regexp match-index-from ( string regexp -- index/f )
  51     compile-regexp dfa>> <quot-matcher> match-index-from ;
  52
  53 M: reverse-matcher match-index-from ( string regexp -- index/f )
  54     [ <reversed> ] [ regexp>> compile-reverse reverse-dfa>> ] bi*
  55     <quot-matcher> match-index-from ;
  56
  57 : find-regexp-syntax ( string -- prefix suffix )
  58     {
  59         { "R/ "  "/"  }
  60         { "R! "  "!"  }
  61         { "R\" " "\"" }
  62         { "R# "  "#"  }
  63         { "R' "  "'"  }
  64         { "R( "  ")"  }
  65         { "R@ "  "@"  }
  66         { "R[ "  "]"  }
  67         { "R` "  "`"  }
  68         { "R{ "  "}"  }
  69         { "R| "  "|"  }
  70     } swap [ subseq? not nip ] curry assoc-find drop ;
  71
  72 : take-until ( end lexer -- string )
  73     dup skip-blank [
  74         [ index-from ] 2keep
  75         [ swapd subseq ]
  76         [ 2drop 1+ ] 3bi
  77     ] change-lexer-column ;
  78
  79 : parse-noblank-token ( lexer -- str/f )
  80     dup still-parsing-line? [ (parse-token) ] [ drop f ] if ;
  81
  82 : parsing-regexp ( accum end -- accum )
  83     lexer get [ take-until ] [ parse-noblank-token ] bi
  84     <optioned-regexp> compile-regexp parsed ;
  85
  86 PRIVATE>
  87
  88 : R! CHAR: ! parsing-regexp ; parsing
  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
 100 M: regexp pprint*
 101     [
 102         [
 103             [ raw>> dup find-regexp-syntax swap % swap % % ]
 104             [ options>> options>string % ] bi
 105         ] "" make
 106     ] keep present-text ;