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
8 : allowed-char? ( ch -- ? )
9 ".()|[*+?$^" member? not ;
13 : ensure-number ( n -- n )
14 [ bad-number ] unless* ;
16 :: at-error ( key assoc quot: ( key -- replacement ) -- value )
17 key assoc at* [ drop key quot call ] unless ; inline
19 ERROR: bad-class name ;
21 : name>class ( name -- class )
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 ;
39 : lookup-escape ( char -- ast )
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: \\ ] }
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> ] }
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> ] }
64 : options-assoc ( -- assoc )
66 { CHAR: i case-insensitive }
67 { CHAR: d unix-lines }
70 { CHAR: r reversed-regexp }
72 { CHAR: u unicode-case }
76 : ch>option ( ch -- singleton )
79 : option>ch ( option -- string )
80 options-assoc value-at ;
82 : parse-options ( on off -- options )
83 [ [ ch>option ] { } map-as ] bi@ <options> ;
85 : string>options ( string -- options )
86 "-" split1 parse-options ;
88 : options>string ( options -- string )
90 [ [ option>ch ] map ] bi@
91 [ "-" glue ] unless-empty
94 ! TODO: add syntax for various parenthized things,
95 ! add greedy and nongreedy forms of matching
96 ! (once it's all implemented)
100 CharacterInBracket = !("}") Character
102 QuotedCharacter = !("\\E") .
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 ]]
115 EscapeSequence = "\\" Escape:e => [[ e ]]
117 Character = EscapeSequence
118 | "$" => [[ $ <tagged-epsilon> ]]
119 | "^" => [[ ^ <tagged-epsilon> ]]
120 | . ?[ allowed-char? ]?
122 AnyRangeCharacter = EscapeSequence | .
124 RangeCharacter = !("]") AnyRangeCharacter
126 Range = RangeCharacter:a "-" RangeCharacter:b => [[ a b <range> ]]
129 StartRange = AnyRangeCharacter:a "-" RangeCharacter:b => [[ a b <range> ]]
132 Ranges = StartRange:s Range*:r => [[ r s prefix ]]
134 CharClass = "^"?:n Ranges:e => [[ e n char-class ]]
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> ]]
149 Element = "(" Parenthized:p ")" => [[ p ]]
150 | "[" CharClass:r "]" => [[ r ]]
151 | ".":d => [[ any-char <primitive-class> ]]
154 Number = (!(","|"}").)* => [[ string>number ensure-number ]]
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> ]]
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> ]]
171 Concatenation = Repeated*:r => [[ r sift <concatenation> ]]
173 Alternation = Concatenation:c ("|" Concatenation)*:a
174 => [[ a empty? [ c ] [ a values c prefix <alternation> ] if ]]
178 Main = Alternation End