basis/regexp/parser/parser.factor

   1 ! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs combinators
   4 combinators.short-circuit interval-maps kernel locals
   5 math.parser memoize multiline peg.ebnf regexp.ast regexp.classes
   6 sequences sets splitting strings unicode unicode.data
   7 unicode.script ;
   8 IN: regexp.parser
   9
  10 : allowed-char? ( ch -- ? )
  11     ".()|[*+?$^" member? not ;
  12
  13 ERROR: bad-number ;
  14
  15 : ensure-number ( n -- n )
  16     [ bad-number ] unless* ;
  17
  18 :: at-error ( key assoc quot: ( key -- replacement ) -- value )
  19     key assoc at* [ drop key quot call ] unless ; inline
  20
  21 ERROR: bad-class name ;
  22
  23 : simple ( str -- simple )
  24     ! Alternatively, first collation key level?
  25     >case-fold [ " \t_" member? ] reject ;
  26
  27 : simple-table ( seq -- table )
  28     [ [ simple ] keep ] H{ } map>assoc ;
  29
  30 MEMO: simple-script-table ( -- table )
  31     script-table interval-values members simple-table ;
  32
  33 MEMO: simple-category-table ( -- table )
  34     categories simple-table ;
  35
  36 : parse-unicode-class ( name -- class )
  37     {
  38         { [ dup { [ length 1 = ] [ first "clmnpsz" member? ] } 1&& ] [
  39             >upper first
  40             <category-range-class>
  41         ] }
  42         { [ dup >title categories member? ] [
  43             simple-category-table at <category-class>
  44         ] }
  45         { [ "script=" ?head ] [
  46             dup simple-script-table at
  47             [ <script-class> ]
  48             [ "script=" prepend bad-class ] ?if
  49         ] }
  50         [ bad-class ]
  51     } cond ;
  52
  53 : unicode-class ( name -- class )
  54     dup parse-unicode-class [ ] [ bad-class ] ?if ;
  55
  56 : name>class ( name -- class )
  57     >string simple {
  58         { "lower" letter-class }
  59         { "upper" LETTER-class }
  60         { "alpha" Letter-class }
  61         { "ascii" ascii-class }
  62         { "digit" digit-class }
  63         { "alnum" alpha-class }
  64         { "punct" punctuation-class }
  65         { "graph" java-printable-class }
  66         { "blank" non-newline-blank-class }
  67         { "cntrl" control-character-class }
  68         { "xdigit" hex-digit-class }
  69         { "space" java-blank-class }
  70     } [ unicode-class ] at-error ;
  71
  72 : lookup-escape ( char -- ast )
  73     {
  74         { CHAR: a [ CHAR: \a ] }
  75         { CHAR: e [ CHAR: \e ] }
  76         { CHAR: f [ CHAR: \f ] }
  77         { CHAR: n [ CHAR: \n ] }
  78         { CHAR: r [ CHAR: \r ] }
  79         { CHAR: t [ CHAR: \t ] }
  80         { CHAR: v [ CHAR: \v ] }
  81         { CHAR: 0 [ CHAR: \0 ] }
  82
  83         { CHAR: w [ c-identifier-class <primitive-class> ] }
  84         { CHAR: W [ c-identifier-class <primitive-class> <not-class> ] }
  85         { CHAR: s [ java-blank-class <primitive-class> ] }
  86         { CHAR: S [ java-blank-class <primitive-class> <not-class> ] }
  87         { CHAR: d [ digit-class <primitive-class> ] }
  88         { CHAR: D [ digit-class <primitive-class> <not-class> ] }
  89
  90         { CHAR: z [ end-of-input <tagged-epsilon> ] }
  91         { CHAR: Z [ end-of-file <tagged-epsilon> ] }
  92         { CHAR: A [ beginning-of-input <tagged-epsilon> ] }
  93         { CHAR: b [ word-break <tagged-epsilon> ] }
  94         { CHAR: B [ word-break <not-class> <tagged-epsilon> ] }
  95         [ ]
  96     } case ;
  97
  98 : options-assoc ( -- assoc )
  99     H{
 100         { CHAR: i case-insensitive }
 101         { CHAR: d unix-lines }
 102         { CHAR: m multiline }
 103         { CHAR: r reversed-regexp }
 104         { CHAR: s dotall }
 105     } ;
 106
 107 ERROR: nonexistent-option name ;
 108
 109 : ch>option ( ch -- singleton )
 110     dup options-assoc at [ ] [ nonexistent-option ] ?if ;
 111
 112 : option>ch ( option -- string )
 113     options-assoc value-at ;
 114
 115 : parse-options ( on off -- options )
 116     [ [ ch>option ] { } map-as ] bi@ <options> ;
 117
 118 : string>options ( string -- options )
 119     "-" split1 parse-options ;
 120
 121 : options>string ( options -- string )
 122     [ on>> ] [ off>> ] bi
 123     [ [ option>ch ] map ] bi@
 124     [ "-" glue ] unless-empty
 125     "" like ;
 126
 127 ! TODO: add syntax for various parenthized things,
 128 !       add greedy and nongreedy forms of matching
 129 ! (once it's all implemented)
 130
 131 EBNF: parse-regexp [=[
 132
 133 CharacterInBracket = !("}") Character
 134
 135 QuotedCharacter = !("\\E") .
 136
 137 Escape = "p{" CharacterInBracket*:s "}" => [[ s name>class <primitive-class> ]]
 138        | "P{" CharacterInBracket*:s "}" => [[ s name>class <primitive-class> <not-class> ]]
 139        | "Q" QuotedCharacter*:s "\\E" => [[ s <concatenation> ]]
 140        | "u" Character:a Character:b Character:c Character:d
 141             => [[ { a b c d } hex> ensure-number ]]
 142        | "x" Character:a Character:b
 143             => [[ { a b } hex> ensure-number ]]
 144        | "0" Character:a Character:b Character:c
 145             => [[ { a b c } oct> ensure-number ]]
 146        | . => [[ lookup-escape ]]
 147
 148 EscapeSequence = "\\" Escape:e => [[ e ]]
 149
 150 Character = EscapeSequence
 151           | "$" => [[ $ <tagged-epsilon> ]]
 152           | "^" => [[ ^ <tagged-epsilon> ]]
 153           | . ?[ allowed-char? ]?
 154
 155 AnyRangeCharacter = !("&&"|"||"|"--"|"~~") (EscapeSequence | .)
 156
 157 RangeCharacter = !("]") AnyRangeCharacter
 158
 159 Range = RangeCharacter:a "-" !("-") RangeCharacter:b => [[ a b <range-class> ]]
 160       | RangeCharacter
 161
 162 StartRange = AnyRangeCharacter:a "-" !("-") RangeCharacter:b => [[ a b <range-class> ]]
 163            | AnyRangeCharacter
 164
 165 Ranges = StartRange:s Range*:r => [[ r s prefix ]]
 166
 167 BasicCharClass =  "^"?:n Ranges:e => [[ e n char-class ]]
 168
 169 CharClass = BasicCharClass:b "&&" CharClass:c
 170                 => [[ b c 2array <and-class> ]]
 171           | BasicCharClass:b "||" CharClass:c
 172                 => [[ b c 2array <or-class> ]]
 173           | BasicCharClass:b "~~" CharClass:c
 174                 => [[ b c <sym-diff-class> ]]
 175           | BasicCharClass:b "--" CharClass:c
 176                 => [[ b c <minus-class> ]]
 177           | BasicCharClass
 178
 179 Options = [idmsux]*
 180
 181 Parenthized = "?:" Alternation:a => [[ a ]]
 182             | "?" Options:on "-"? Options:off ":" Alternation:a
 183                 => [[ a on off parse-options <with-options> ]]
 184             | "?#" [^)]* => [[ f ]]
 185             | "?~" Alternation:a => [[ a <negation> ]]
 186             | "?=" Alternation:a => [[ a <lookahead> <tagged-epsilon> ]]
 187             | "?!" Alternation:a => [[ a <lookahead> <not-class> <tagged-epsilon> ]]
 188             | "?<=" Alternation:a => [[ a <lookbehind> <tagged-epsilon> ]]
 189             | "?<!" Alternation:a => [[ a <lookbehind> <not-class> <tagged-epsilon> ]]
 190             | Alternation
 191
 192 Element = "(" Parenthized:p ")" => [[ p ]]
 193         | "[" CharClass:r "]" => [[ r ]]
 194         | ".":d => [[ dot ]]
 195         | Character
 196
 197 Number = (!(","|"}").)* => [[ string>number ensure-number ]]
 198
 199 Times = "," Number:n "}" => [[ 0 n <from-to> ]]
 200       | Number:n ",}" => [[ n <at-least> ]]
 201       | Number:n "}" => [[ n n <from-to> ]]
 202       | "}" => [[ bad-number ]]
 203       | Number:n "," Number:m "}" => [[ n m <from-to> ]]
 204
 205 Repeated = Element:e "{" Times:t => [[ e t <times> ]]
 206          | Element:e "??" => [[ e <maybe> ]]
 207          | Element:e "*?" => [[ e <star> ]]
 208          | Element:e "+?" => [[ e <plus> ]]
 209          | Element:e "?" => [[ e <maybe> ]]
 210          | Element:e "*" => [[ e <star> ]]
 211          | Element:e "+" => [[ e <plus> ]]
 212          | Element
 213
 214 Concatenation = Repeated*:r => [[ r sift <concatenation> ]]
 215
 216 Alternation = Concatenation:c ("|" Concatenation)*:a
 217                 => [[ a empty? [ c ] [ a values c prefix <alternation> ] if ]]
 218
 219 End = !(.)
 220
 221 Main = Alternation End
 222 ]=]