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.classes
   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 ! Reverse matchers won't work properly with most combinators, for now
  31
  32 <PRIVATE
  33
  34 : get-ast ( regexp -- ast )
  35     [ parse-tree>> ] [ options>> ] bi <with-options> ;
  36
  37 : compile-regexp ( regexp -- regexp )
  38     dup '[ [ _ get-ast ast>dfa dfa>quotation ] unless* ] change-dfa ;
  39
  40 : <reversed-option> ( ast -- reversed )
  41     "r" string>options <with-options> ;
  42
  43 M: lookahead question>quot ! Returns ( index string -- ? )
  44     term>> ast>dfa dfa>shortest-quotation ;
  45
  46 M: lookbehind question>quot ! Returns ( index string -- ? )
  47     term>> <reversed-option>
  48     ast>dfa dfa>reverse-shortest-quotation
  49     [ [ 1- ] dip ] prepose ;
  50
  51 : compile-reverse ( regexp -- regexp )
  52     dup '[
  53         [
  54             _ get-ast <reversed-option>
  55             ast>dfa dfa>reverse-quotation
  56         ] unless*
  57     ] change-reverse-dfa ;
  58
  59 M: regexp match-index-from
  60     compile-regexp dfa>> <quot-matcher> match-index-from ;
  61
  62 M: reverse-matcher match-index-from
  63     regexp>> compile-reverse reverse-dfa>>
  64     <quot-matcher> match-index-from ;
  65
  66 ! The following two should do some caching
  67
  68 : find-regexp-syntax ( string -- prefix suffix )
  69     {
  70         { "R/ "  "/"  }
  71         { "R! "  "!"  }
  72         { "R\" " "\"" }
  73         { "R# "  "#"  }
  74         { "R' "  "'"  }
  75         { "R( "  ")"  }
  76         { "R@ "  "@"  }
  77         { "R[ "  "]"  }
  78         { "R` "  "`"  }
  79         { "R{ "  "}"  }
  80         { "R| "  "|"  }
  81     } swap [ subseq? not nip ] curry assoc-find drop ;
  82
  83 : take-until ( end lexer -- string )
  84     dup skip-blank [
  85         [ index-from ] 2keep
  86         [ swapd subseq ]
  87         [ 2drop 1+ ] 3bi
  88     ] change-lexer-column ;
  89
  90 : parse-noblank-token ( lexer -- str/f )
  91     dup still-parsing-line? [ (parse-token) ] [ drop f ] if ;
  92
  93 : parsing-regexp ( accum end -- accum )
  94     lexer get [ take-until ] [ parse-noblank-token ] bi
  95     <optioned-regexp> compile-regexp parsed ;
  96
  97 PRIVATE>
  98
  99 : R! CHAR: ! parsing-regexp ; parsing
 100 : R" CHAR: " parsing-regexp ; parsing
 101 : R# CHAR: # parsing-regexp ; parsing
 102 : R' CHAR: ' parsing-regexp ; parsing
 103 : R( CHAR: ) parsing-regexp ; parsing
 104 : R/ CHAR: / parsing-regexp ; parsing
 105 : R@ CHAR: @ parsing-regexp ; parsing
 106 : R[ CHAR: ] parsing-regexp ; parsing
 107 : R` CHAR: ` parsing-regexp ; parsing
 108 : R{ CHAR: } parsing-regexp ; parsing
 109 : R| CHAR: | parsing-regexp ; parsing
 110
 111 M: regexp pprint*
 112     [
 113         [
 114             [ raw>> dup find-regexp-syntax swap % swap % % ]
 115             [ options>> options>string % ] bi
 116         ] "" make
 117     ] keep present-text ;