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: peg.ebnf kernel math.parser sequences assocs arrays fry math
   4 combinators regexp.classes strings splitting peg locals accessors
   5 regexp.ast ;
   6 IN: regexp.parser
   7
   8 : allowed-char? ( ch -- ? )
   9     ".()|[*+?$^" member? not ;
  10
  11 ERROR: bad-number ;
  12
  13 : ensure-number ( n -- n )
  14     [ bad-number ] unless* ;
  15
  16 :: at-error ( key assoc quot: ( key -- replacement ) -- value )
  17     key assoc at* [ drop key quot call ] unless ; inline
  18
  19 ERROR: bad-class name ;
  20
  21 : name>class ( name -- class )
  22     {
  23         { "Lower" letter-class }
  24         { "Upper" LETTER-class }
  25         { "Alpha" Letter-class }
  26         { "ASCII" ascii-class }
  27         { "Digit" digit-class }
  28         { "Alnum" alpha-class }
  29         { "Punct" punctuation-class }
  30         { "Graph" java-printable-class }
  31         { "Print" java-printable-class }
  32         { "Blank" non-newline-blank-class }
  33         { "Cntrl" control-character-class }
  34         { "XDigit" hex-digit-class }
  35         { "Space" java-blank-class }
  36         ! TODO: unicode-character-class
  37     } [ bad-class ] at-error ;
  38
  39 : lookup-escape ( char -- ast )
  40     {
  41         { CHAR: t [ CHAR: \t ] }
  42         { CHAR: n [ CHAR: \n ] }
  43         { CHAR: r [ CHAR: \r ] }
  44         { CHAR: f [ HEX: c ] }
  45         { CHAR: a [ HEX: 7 ] }
  46         { CHAR: e [ HEX: 1b ] }
  47         { CHAR: \\ [ CHAR: \\ ] }
  48
  49         { CHAR: w [ c-identifier-class <primitive-class> ] }
  50         { CHAR: W [ c-identifier-class <primitive-class> <not-class> ] }
  51         { CHAR: s [ java-blank-class <primitive-class> ] }
  52         { CHAR: S [ java-blank-class <primitive-class> <not-class> ] }
  53         { CHAR: d [ digit-class <primitive-class> ] }
  54         { CHAR: D [ digit-class <primitive-class> <not-class> ] }
  55
  56         { CHAR: z [ end-of-input <tagged-epsilon> ] }
  57         { CHAR: Z [ end-of-file <tagged-epsilon> ] }
  58         { CHAR: A [ beginning-of-input <tagged-epsilon> ] }
  59         { CHAR: b [ word-break <tagged-epsilon> ] }
  60         { CHAR: B [ word-break <not-class> <tagged-epsilon> ] }
  61         [ ]
  62     } case ;
  63
  64 : options-assoc ( -- assoc )
  65     H{
  66         { CHAR: i case-insensitive }
  67         { CHAR: d unix-lines }
  68         { CHAR: m multiline }
  69         { CHAR: n multiline }
  70         { CHAR: r reversed-regexp }
  71         { CHAR: s dotall }
  72         { CHAR: u unicode-case }
  73         { CHAR: x comments }
  74     } ;
  75
  76 : ch>option ( ch -- singleton )
  77     options-assoc at ;
  78
  79 : option>ch ( option -- string )
  80     options-assoc value-at ;
  81
  82 : parse-options ( on off -- options )
  83     [ [ ch>option ] { } map-as ] bi@ <options> ;
  84
  85 : string>options ( string -- options )
  86     "-" split1 parse-options ;
  87
  88 : options>string ( options -- string )
  89     [ on>> ] [ off>> ] bi
  90     [ [ option>ch ] map ] bi@
  91     [ "-" glue ] unless-empty
  92     "" like ;
  93
  94 ! TODO: add syntax for various parenthized things,
  95 !       add greedy and nongreedy forms of matching
  96 ! (once it's all implemented)
  97
  98 EBNF: parse-regexp
  99
 100 CharacterInBracket = !("}") Character
 101
 102 QuotedCharacter = !("\\E") .
 103
 104 Escape = "p{" CharacterInBracket*:s "}" => [[ s >string name>class <primitive-class> ]]
 105        | "P{" CharacterInBracket*:s "}" => [[ s >string name>class <primitive-class> <negation> ]]
 106        | "Q" QuotedCharacter*:s "\\E" => [[ s <concatenation> ]]
 107        | "u" Character:a Character:b Character:c Character:d
 108             => [[ { a b c d } hex> ensure-number ]]
 109        | "x" Character:a Character:b
 110             => [[ { a b } hex> ensure-number ]]
 111        | "0" Character:a Character:b Character:c
 112             => [[ { a b c } oct> ensure-number ]]
 113        | . => [[ lookup-escape ]]
 114
 115 EscapeSequence = "\\" Escape:e => [[ e ]]
 116
 117 Character = EscapeSequence
 118           | "$" => [[ $ <tagged-epsilon> ]]
 119           | "^" => [[ ^ <tagged-epsilon> ]]
 120           | . ?[ allowed-char? ]?
 121
 122 AnyRangeCharacter = EscapeSequence | .
 123
 124 RangeCharacter = !("]") AnyRangeCharacter
 125
 126 Range = RangeCharacter:a "-" RangeCharacter:b => [[ a b <range> ]]
 127       | RangeCharacter
 128
 129 StartRange = AnyRangeCharacter:a "-" RangeCharacter:b => [[ a b <range> ]]
 130            | AnyRangeCharacter
 131
 132 Ranges = StartRange:s Range*:r => [[ r s prefix ]]
 133
 134 CharClass = "^"?:n Ranges:e => [[ e n char-class ]]
 135
 136 Options = [idmsux]*
 137
 138 Parenthized = "?:" Alternation:a => [[ a ]]
 139             | "?" Options:on "-"? Options:off ":" Alternation:a
 140                 => [[ a on off parse-options <with-options> ]]
 141             | "?#" [^)]* => [[ f ]]
 142             | "?~" Alternation:a => [[ a <negation> ]]
 143             | "?=" Alternation:a => [[ a <lookahead> <tagged-epsilon> ]]
 144             | "?!" Alternation:a => [[ a <lookahead> <not-class> <tagged-epsilon> ]]
 145             | "?<=" Alternation:a => [[ a <lookbehind> <tagged-epsilon> ]]
 146             | "?<!" Alternation:a => [[ a <lookbehind> <not-class> <tagged-epsilon> ]]
 147             | Alternation
 148
 149 Element = "(" Parenthized:p ")" => [[ p ]]
 150         | "[" CharClass:r "]" => [[ r ]]
 151         | ".":d => [[ any-char <primitive-class> ]]
 152         | Character
 153
 154 Number = (!(","|"}").)* => [[ string>number ensure-number ]]
 155
 156 Times = "," Number:n "}" => [[ 0 n <from-to> ]]
 157       | Number:n ",}" => [[ n <at-least> ]]
 158       | Number:n "}" => [[ n n <from-to> ]]
 159       | "}" => [[ bad-number ]]
 160       | Number:n "," Number:m "}" => [[ n m <from-to> ]]
 161
 162 Repeated = Element:e "{" Times:t => [[ e t <times> ]]
 163          | Element:e "??" => [[ e <maybe> ]]
 164          | Element:e "*?" => [[ e <star> ]]
 165          | Element:e "+?" => [[ e <plus> ]]
 166          | Element:e "?" => [[ e <maybe> ]]
 167          | Element:e "*" => [[ e <star> ]]
 168          | Element:e "+" => [[ e <plus> ]]
 169          | Element
 170
 171 Concatenation = Repeated*:r => [[ r sift <concatenation> ]]
 172
 173 Alternation = Concatenation:c ("|" Concatenation)*:a
 174                 => [[ a empty? [ c ] [ a values c prefix <alternation> ] if ]]
 175
 176 End = !(.)
 177
 178 Main = Alternation End
 179 ;EBNF