Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 250 lines (214 sloc) 8.97 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 #
19 #extra _grammar : {string Tgrammar.PreGrammar.pre_grammar}
20 #extra _file_name : {string}
21 #extra _module_name : {string}
22 #extra _stoppable : {bool}
23 #
24 #/** TRX grammar **/
25 #+Grammar : {string Tgrammar.PreGrammar.pre_grammar} <- Spacing GElems EOF {{ __2 }}
26 #
27 #/** list of TRX elements **/
28 #GElems <- IncludeRead GElems {{ let key, id = __1 in { __2 with PreGrammar.incl = StringMap.add key id __2.PreGrammar.incl } }}
29 # / Extra GElems {{ { __2 with PreGrammar.pextra = __1 :: __2.PreGrammar.pextra } }}
30 # / Option GElems {{ { __2 with PreGrammar.poptions = __1 :: __2.PreGrammar.poptions } }}
31 # / HeaderCode GElems {{ { __2 with PreGrammar.pheader = __1 :: __2.PreGrammar.pheader } }}
32 # / Function GElems {{ add_function __2 __1 }}
33 # / Definition GElems {{ add_definition __2 __1 }}
34 # / Spacing {{ _grammar }}
35 #
36 #strict_GElem <- IncludeRead {{ `read __1 }}
37 # / Extra {{ `extra __1 }}
38 # / Option {{ `option __1 }}
39 # / HeaderCode {{ `header __1 }}
40 # / Function {{ `func __1 }}
41 # / Definition {{ `def __1 }}
42 #
43 #/** TRX element **/
44 #GElem <- strict_GElem {{ __1 }}
45 # / Spacing {{ `spacing }} ;
46 #
47 #GElem_no_sp <- Spacing strict_GElem Spacing {{ __2 }} ;
48 #
49 #maybe_GElem_no_sp <- GElem_no_sp {{ `success __1 }}
50 # / (!GElem_no_sp .)+ {{ `failure (Base.String.of_chars __1, _pos_beg, _pos_end) }} ;
51 #maybe_GElems_no_sp <- maybe_GElem_no_sp* ;
52 #maybe_GElems_no_sp_eof <- maybe_GElems_no_sp EOF ;
53 #
54 #/** TRX rule **/
55 #Definition <- SEMI? rule_annots:annots KEEP_CACHE?:cache DEBUG?:debug MARK?:mark Identifier:id Type?:rtype DefExpr:expr SEMI?
56 # {{ jlog ~level:2 (sprintf "definition: %s" id) ;
57 # let entry =
58 # { PreGrammar.expression = expr
59 # ; debug = debug <> None
60 # ; mark = mark <> None
61 # ; retain_cache = cache <> None
62 # ; rule_type = rtype
63 # ; origin = Some { file_name = _file_name; line_number = fst (FilePos.get_pos _file_name _pos_beg) }
64 # }
65 # in
66 # (id, (entry, annots))
67 # }}
68
69 let construct_name_aux prefix suffix =
70 prefix Spacing ((!(Spacing suffix) .)* $_) Spacing suffix Spacing {{ __3 }}
71
72 construct_name_primary = construct_name_aux("/**", "**/");
73 construct_name_secondary = construct_name_aux("/*", "*/" );
74
75 /* optional rule name */
76 construct_name_opt <- construct_name_primary {{ PrimaryName __1 }}
77 / construct_name_secondary {{ SecondaryName __1 }}
78
79 /* memoization annotation */
80 memo_opt <- "{$"
81 ( "0" {{ MemoNone }}
82 / "F" {{ MemoFail }}
83 / "S" {{ MemoSuccess }}
84 / "1" {{ MemoFull }}
85 )
86 "}" Spacing {{ __2 }}
87
88 /* rule annotations */
89 rule_annots <- construct_name_opt? memo_opt?
90 {{ let name = match __1 with Some r -> r | None -> NoName in
91 let memo = match __2 with Some m -> m | None -> MemoNoInfo in
92 { rule_name = name; rule_memo = memo }
93 }}
94
95 DefExpr <- LEFTARROW Expression {{ PreGrammar.Expr __2 }}
96 / EQUAL Identifier Exprs {{ PreGrammar.App (__2, __3) }}
97
98 /* list of expressions */
99 Exprs <- OPEN Expression (COMMA Expression {{ __2 }})* CLOSE {{ __2 :: __3 }}
100 / !OPEN Expression {{ [ __2 ] }}
101
102 /** TRX function **/
103 Function <- rule_annots LET Identifier Identifier+ EQUAL Expression SEMI?
104 {{ (*jlog (sprintf "function: %s" __3) ;*)
105 (__3, ({ PreGrammar.vars = __4 ; expr = PreGrammar.Expr __6 }, __1)) }}
106
107 /** include directive **/
108 IncludeRead <- ("include" {{ PreGrammar.Incl }} / "read" {{ PreGrammar.Read }}) Spacing Filename Spacing ("global" Spacing Names {{ __3 }})?
109 {{ __3, { PreGrammar.it = __1 ; gl = match __5 with Some l -> l | _ -> [] } }}
110
111 Type <- Spacing ":" Spacing LBRACE ((!RBRACE .)* $_):t RBRACE Spacing {{ t }}
112
113 /* extra directive */
114 Extra <- "extra" Space Spacing mlvar:var Type:vartype {{ var, vartype }}
115
116 /* TRX option */
117 Option <- "%%" optionType Spacing "=" Spacing mlvar Spacing {{ __2, __6 }}
118
119 /* element name */
120 mlvar <- [a-z_][a-zA-Z0-9_]* $_
121 /* TRX option name */
122 optionType <- [a-z][a-zA-Z0-9_\-]* $_
123 /* file name */
124 Filename <- Literal / (!Space .)+ $_
125
126 /** rule body **/
127 Expression <- SLASH? Sequence (SLASH Sequence {{ __2 }})* {{ __2 :: __3 }}
128
129 item_list <- (Prefix Primary Suffix (Spacing [:] [_]? Spacing mlvar Spacing {{ __5, __3 <> None }})? {{ (__1, __2, __3), __4 }})+
130 {{ List.fold_left_i (
131 fun (liste,map) (item, option) num ->
132 match option with
133 None -> (liste @ [item]), map
134 | Some (label, b) -> (liste @ [item]), (StringMap.add label ((string_of_int (num+1)),b) map)
135 ) ([], StringMap.empty) __1 }}
136
137 /* a sequence of parsing expressions */
138 Sequence <- item_list Code? {{ let liste, map = __1 in liste, map, __2 }}
139
140 BackId <- [`] Identifier $_
141
142 HeaderCode <- ( "inside:" {{fun x -> `inside x}}
143 / "types:" {{fun x -> `types x}}
144 / "decls:" {{fun x -> `decls x}}
145 / "" {{fun x -> `normal x}}
146 ):variant DefaultCodeNoStop:code
147 {{ variant code, Some { file_name = _file_name; line_number = fst (FilePos.get_pos _file_name _pos_beg) } }}
148
149 CodeRange <- (":_" Spacing)? {{ __1 <> None }}
150 StoppableCode <- ("!!" Spacing)? {{ __1 <> None }}
151
152 let code_aux beg end =
153 beg Spacing StoppableCode CodeRange ((!end .)* $_) end {{ __4, (if __3 then __5 else sprintf "Some (%s)" __5) }}
154
155 DefaultCode <- (=code_aux(BEGIn, ENd)) {{ let (u, v) = __1 in u, v, true }}
156 / (=code_aux(BEGIN, END)) {{ let (u, v) = __1 in u, v, false }}
157 DefaultCodeNoStop <- BEGIN ((!END .)* $_) END {{ __2 }}
158
159 /* rule production */
160 Code <- DefaultCode
161 / "$_" CodeRange Spacing {{ __2, ".sub", false }}
162 / "$:" ([0-9]+ $_) Spacing {{ true, sprintf "%s__%s" ("") __2, false }}
163 / DOLLAR {{ false, sprintf "%s()" (""), false }}
164 PrefixElement <- AND {{ `AND }} / NOT {{ `NOT }}
165 SuffixElement <- QUESTION {{`QUESTION }} / STAR {{`STAR}} / PLUS {{`PLUS}}
166 /* element's prefix */
167 Prefix <- PrefixElement? {{ match __1 with None -> `NORMAL | Some x -> x }}
168 /* element's suffix */
169 Suffix <- SuffixElement? {{ match __1 with None -> `NORMAL | Some x -> x }}
170 /* parsing element */
171 Primary <- Identifier !LEFTARROW {{ PreGrammar.Ident __1 }}
172 / OPEN EQUAL Identifier Exprs CLOSE {{ PreGrammar.Paren (PreGrammar.App (__3, __4)) }}
173 / OPEN Expression CLOSE {{ PreGrammar.Paren (PreGrammar.Expr __2) }}
174 / Literal TILDE? {{ PreGrammar.Literal (__1, is_none __2) }}
175 / Class {{ let range, negation = __1 in
176 let _class = PreGrammar.Class range in
177 if negation then
178 PreGrammar.Paren (PreGrammar.Expr [[`NOT, _class, `NORMAL ; `NORMAL, PreGrammar.Class [Any], `NORMAL], StringMap.empty, None])
179 else
180 _class
181 }}
182 / DOT {{ PreGrammar.Class [Any] }}
183
184 # Lexical syntax
185
186 Module <- [A-Z][A-Za-z0-9_]* $_
187 Name <- [a-zA-Z_] [a-zA-Z0-9_]* $_
188 Names <- OPEN (Name Spacing COMMA? {{ __1 }})* CLOSE {{ __2 }}
189
190 /* identifier */
191 Identifier <- (
192 / Module [.] Name {{ __1 ^ "_" ^ __3 }}
193 #/ Name {{ _module_name ^ "_" ^ __1 }}
194 ) Spacing {{ __1 }}
195 /* literal */
196 Literal <- ['] (!['] Char {{ __2 }})* ['] Spacing {{ string_of_chars __2 }}
197 / [\"] (![\"] Char {{ __2 }})* [\"] Spacing {{ string_of_chars __2 }}
198 /* class of symbols */
199 Class <- '[' '^'? (!']' Range {{ __2 }})* ']' Spacing {{ __3, (Option.is_some __2) }}
200
201
202 Range <- Char '-' Char {{ Range (__1, __3) }}
203 / Char {{ One __1 }}
204 Char <- '\\' [nrt'\"\\\[\]\-] {{ match __2 with 'n' -> '\n' | 'r' -> '\r' | 't' -> '\t' | x -> x }}
205 / '\\' [0-9]+ {{ char_of_int (int_of_chars __2) }}
206 / !'\\' .
207
208 MARK <- [+]
209 KEEP_CACHE <- "<icache>" Spacing
210 DEBUG <- [%]
211 LBRACE <- '{' Spacing
212 RBRACE <- '}' Spacing
213 BEGIN <- '{{'
214 END <- '}}' Spacing
215 BEGIn <- '{|'
216 ENd <- '|}' Spacing
217 LEFTARROW <- '<-' Spacing
218 RIGHTARROW <- '->' Spacing
219 SLASH <- [/] Spacing
220 AND <- [&] Spacing
221 NOT <- [!] Spacing
222 QUESTION <- [?] Spacing
223 STAR <- [*] Spacing
224 PLUS <- [+] Spacing
225 OPEN <- [(] Spacing
226 CLOSE <- [)] Spacing
227 DOT <- [.] Spacing
228 DOLLAR <- [$] Spacing
229 TILDE <- [~] Spacing
230 EQUAL <- [=] Spacing
231 COMMA <- [,] Spacing
232 SEMI <- [;] Spacing
233 COLON <- [:] Spacing
234
235 LET <- "let" Spacing
236
237 /* spacing */
238 Spacing <- (Space $/ Comment)*
239 /* a comment */
240 Comment <- '#' (!EOL .)* (EOL / EOF) $
241 / mlcomment
242 mlcomment <- mlCOMMENTSTART (!mlCOMMENTSTOP (mlcomment / . $))* mlCOMMENTSTOP $
243 mlCOMMENTSTART <- '(*' Spacing
244 mlCOMMENTSTOP <- '*)' Spacing
245
246 Space <- [ \t] $ / EOL $
247 /* end of line */
248 EOL <- [\n\r] $ / '\r' '\n' $
249 EOF <- !.
Something went wrong with that request. Please try again.