Skip to content
This repository
Newer
Older
100644 417 lines (339 sloc) 14.732 kb
fccc6851 »
2011-06-21 Initial open-source release
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 read default.trx global (spacing)
19 read ocaml_keywords.trx
20 read ocaml_types.trx
21
22 {{
23 open Ocaml
24 open Printf
25
26 let make_app l =
27 assert(List.length l >= 2);
28 let rec aux r = function
29 | [] -> assert false
30 | [hd] -> App (r, hd)
31 | hd::tl -> aux (App (r, hd)) tl
32 in aux (List.hd l) (List.tl l);;
33 }}
34
35 spacing <- (Default.space $ / Default.mlcomment)* $
36
37 emptylist <- Default.lbracket spacing Default.rbracket {{ EmptyList }}
38 unit <- Default.lparen spacing Default.rparen $
39 const <-
40 Default.float spacing {{ Float __1 }}
41 / Default.int spacing {{ Int __1 }}
42 / Default.string spacing {{ String __1 }}
43 # / ['] Default.stringsinglechar ['] spacing {{ Char (__2.[0]) }}
44 / Default.charsinglequote spacing {{ Char (__1) }}
45 / unit {{ Unit }}
46 / "false" spacing {{ Bool false }}
47 / "true" spacing {{ Bool true }}
48
49
50 mlIdent_cont <- [a-zA-Z_0-9']
51 mlIdent_aux_ <- ([a-z_] mlIdent_cont* $_) {{ __1 }}
52 mlIdent_aux <- mlIdent_aux_ spacing {{ __1 }}
53 mlIdent <- !(Ocaml_keywords.KEYWORDS !mlIdent_cont) mlIdent_aux {{ __2 }}
54 / Default.lparen ([!$%&*+-./:<=>?@^|~][!$%&*+-./:<=>?@^|~]* $_) Default.rparen
55 {{ sprintf "(%s)" __2 }}
56 mlIdent_ <- !(Ocaml_keywords.KEYWORDS !mlIdent_cont) mlIdent_aux_ {{ __2 }}
57
58
59 #typeIdent_aux <- ([a-z_] mlIdent_cont* $_) spacing {{ __1 }}
60 #typeIdent <- !(Qml_keywords.KEYWORDS !mlIdent_cont) typeIdent_aux {{ __2 }}
61
62 paramFormel <- # FIXME : integrer les pattern
63 / Default.tilde_ Default.lparen mlIdent (Default.colon type {{__2}})? Default.rparen
64 {{
65 Label (__3, None, __4)
66 }}
67
68 / Default.tilde_ mlIdent_ (Default.colon pattern_aux {{__2}})? spacing
69 {{
70 Label (__2, __3, None)
71 }}
72
73 / Default.tilde_ mlIdent_ Default.colon Default.lparen pattern_aux (Default.colon type {{__2}})? Default.rparen
74 {{
75 Label (__2, Some __5, __6)
76 }}
77
78 / Default.question Default.lparen mlIdent (Default.colon type {{__2}})? (Default.equal Expr {{__2}})? Default.rparen
79 {{
80 Opt (__3, __4, __5)
81 }}
82
83 / Default.question mlIdent {{ Opt (__2, None, None) }}
84
85 / Default.lparen mlIdent (Default.colon type {{__2}})? Default.rparen
86 {{
87 match __3 with
88 | None -> Pat (PatVar (Ident.source __2))
89 | Some x -> Pat (PatAnnot (PatVar (Ident.source __2), x))
90 }}
91
92 / pattern_aux
93 {{
94 Pat __1
95 }}
96
97
98 paramEffectif <-
99 / Default.tilde_ mlIdent_ (Default.colon ExprNotApp {{__2}})? spacing
100 {{
101 Labeled (__2, __3)
102 }}
103
104 #/ capMlIdent_* ([.] (capMlIdent_))* mlIdent_ (capMlIdent / mlIdent) spacing {{ FIXME gerer les modules }}
105
106 / (moduleName_ [.] {{__1}})* mlIdent
107 {{
108 Pated (List.map Ident.source (__1 @ [__2]), false)
109 }}
110
111 / constructorName
112 {{
113 Pated (List.map Ident.source __1, true)
114 }}
115
116 capMlIdent_ <- ([`A-Z] mlIdent_cont* $_)
117 capMlIdent <- capMlIdent_ spacing {{ __1 }}
118 moduleName <- capMlIdent {{ __1 }}
119 moduleName_ <- capMlIdent_ {{ __1 }}
120 #moduleNames <- (moduleName_ [.] {{__1}})* moduleName {{ Pated (__1 @ [__2]) }}
121 constructorName <- (capMlIdent_ [.] {{__1}})* capMlIdent_ ![.] spacing {{ __1 @ [__2] }}
122
123 type <- Ocaml_types.typedef
124
125 # ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
126
127 pattern_aux_aux <- # FIXME : manque les pairs
128
129 ( mlIdent {{ PatVar (Ident.source __1) }}
130
131 / Default.lparen pattern_aux (Default.colon type)? Default.rparen {{ __2 }}
132
133 / Default.underscore {{ PatAny }}
134
135 / const {{ PatConst __1 }}
136
137 / Default.laccol mlIdent Default.equal pattern_aux (Default.semi mlIdent Default.equal pattern_aux {{__2, __4}})* Default.semi? Default.raccol
138 {{
139 PatRecord ((__2, __4)::__5)
140 }}
141
142 / Default.lbracket (pattern_aux (Default.semi pattern_aux {{__2}})* {{__1, __2}})? Default.rbracket
143 {{
144 match __2 with
145 | None -> PatEmptyList
146 | Some (a, l) ->
147 PatList (a, List.fold_right (fun e accu -> PatList (e, accu)) l PatEmptyList)
148 }}
149
150 / constructorName Default.lparen pattern_cons (Default.comma pattern_cons {{__2}})* Default.rparen
151 {{
152 PatConstructor (List.map Ident.source __1, __3::__4)
153 }}
154
155 / constructorName pattern_cons?
156 {{
157 PatConstructor (List.map Ident.source __1, match __2 with Some x -> [x] | None -> [])
158 }}
159 ) (Ocaml_keywords.AS mlIdent {{__2}})*
160 {{
161 List.fold_left (fun accu e -> PatAs (accu, Ident.source e)) __1 __2
162 }}
163
164 pattern_cons <- pattern_aux_aux (Ocaml_keywords.CONS pattern_cons {{__2}})?
165 {{
166 match __2 with
167 | None -> __1
168 | Some x -> PatList (__1, x)
169 }}
170
171 pattern_aux_l <- pattern_cons (Default.comma pattern_aux_l {{__2}})?
172 {{
173 match __2 with
174 | None -> [__1]
175 | Some s -> __1::s
176 }}
177
178 pattern_aux <- pattern_aux_l
179 {{
180 match __1 with
181 | [t] -> t
182 | _ -> PatTuple __1
183 }}
184
185 pattern <- pattern_aux (Ocaml_keywords.WHEN Expr {{__2}})?
186 {{
187 match __2 with
188 | None -> None, __1
189 | Some x -> Some x, __1
190 }}
191
192 # ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
193
194 Open <- Ocaml_keywords.OPEN moduleName {{ Open [ Ident.source __2 ]}}
195 Module <- Ocaml_keywords.MODULE moduleName
196 (Default.lparen moduleName (Default.colon moduleName {{ Signature (Referenced [__2]) }})? Default.rparen {{__2, __3}})*
197 (Default.colon moduleName {{ Signature (Referenced [__2]) }})?
198 Default.equal (Ocaml_keywords.STRUCT LetOrType* Ocaml_keywords.END {{ __2 }} / LetOrType {{ [__1] }}) {{ match __3 with [] -> Module (__2, __4, __6, None) | _ -> DeclareFunctor (__2, __3, __4, Structure __6) }}
199
200 Constructor <-
201 constructorName Default.lparen Expr Default.rparen
202 {{
203 Constructor (List.map Ident.source __1, match __3 with Tuple l -> l | x -> [x])
204 }}
205
206 / constructorName SimpleExpr
207 {{
208 Constructor (List.map Ident.source __1, [__2])
209 }}
210
211 # for cases like F [1] or F U, where U takes no arguments
212
213 / constructorName ExprNotApp?
214 {{
215 Constructor (List.map Ident.source __1, match __2 with None -> [] | Some s -> [s])
216 }}
217
218 Const <- const {{ Const __1 }}
219 Var <- paramEffectif {{ Var __1 }}
220 MakeRef <- Ocaml_keywords.REF SimpleExpr {{ MakeRef __2}}
221 GetRef <- [!] SimpleExpr {{ GetRef __2 }}
222 SetRef <- SimpleExpr Ocaml_keywords.GETREF Expr {{ SetRef (__1, __3) }}
223 Cons <- # Expr Ocaml_keywords.CONS SimpleExpr {{ FIXME }}
224 / Default.lbracket Expr_without_seq (Default.semi Expr_without_seq {{__2}})* Default.rbracket
225 {{ List.fold_right (fun e accu -> Cons (e, accu)) (__2::__3) EmptyList}}
226 EmptyList <- emptylist
227 Cond <- Ocaml_keywords.IF Expr Ocaml_keywords.THEN Expr_without_seq (Ocaml_keywords.ELSE Expr_without_seq {{__2}})?
228 {{ Cond (__2, __4, match __5 with None -> Const Unit | Some s -> s) }}
229 Abs <- (Ocaml_keywords.FUN paramFormel+ Default.rightarrow {{__2}})+ Expr {{ Abs (List.flatten __1, __2) }}
230
231 {{ let make_fun e = function | [] -> e | x -> Abs (x, e) }}
232
233 Let <- (Ocaml_keywords.LET Ocaml_keywords.REC? paramFormel paramFormel*
234 Default.equal {{__2, __3, __4}})?
235 Expr
236 (Ocaml_keywords.AND paramFormel paramFormel* Default.equal Expr {{ let tmp = make_fun __5 __3 in __2, tmp }})*
237
238 {{ match __1 with
239 | None -> __2
240 | Some (_rec, name, pfs) ->
241 match _rec with
242 | Some _ ->
243 let tmp = make_fun __2 pfs in Letrec ((name, tmp)::__3)
244 | None -> let tmp = make_fun __2 pfs in Let ((name, tmp)::__3)
245 }}
246 #Letin <- Ocaml_keywords.LET Ocaml_keywords.REC? paramFormel paramFormel* Default.equal Expr Ocaml_keywords.IN Expr
247 # {{ let tmp = make_fun __6 __4 in match __2 with None -> Letin ([__3, tmp], __8)
248 # | _ -> Letrecin ([__3, tmp], __8) }}
249 Letin <- Ocaml_keywords.LET Ocaml_keywords.REC? paramFormel paramFormel* Default.equal Expr
250 (Ocaml_keywords.AND paramFormel paramFormel* Default.equal Expr {{ let tmp = make_fun __5 __3 in __2, tmp }})*
251 Ocaml_keywords.IN Expr
252 {{ match __2 with Some _ -> let tmp = make_fun __6 __4 in Letrecin ((__3, tmp)::__7, __9)
253 | None -> let tmp = make_fun __6 __4 in Letin ((__3, tmp)::__7, __9)
254 }}
255
256
257 RNameOpt <- (mlIdent Ocaml_keywords.WITH {{ __1 }})
258 Record <- Default.laccol RNameOpt? mlIdent Default.equal Expr_without_seq
259 (Default.semi mlIdent Default.equal Expr_without_seq {{ __2, __4}})*
260 Default.semi? Default.raccol
261 {{ Record (__2,((__3, __5)::__6)) }}
262 Type <- Ocaml_types.typedeclaration {{ Type __1 }}
263 Match <-
264 Ocaml_keywords.MATCH Expr Ocaml_keywords.WITH Default.bar? matchExpr (Default.bar matchExpr {{ __2 }})*
265 {{
266 Match (__2, __5 :: __6)
267 }}
268 / Ocaml_keywords.FUNCTION Default.bar? matchExpr (Default.bar matchExpr {{ __2 }})*
269 {{
270 Function (__3::__4)
271 }}
272
273 matchExpr <- pattern Default.rightarrow Expr
274 {{
275 match __1 with
276 | Some guard, pat -> pat, Some guard, __3
277 | None, pat -> pat, None, __3
278 }}
279
280 Exception <- Ocaml_keywords.EXCEPTION capMlIdent (Ocaml_keywords.OF type)? {{ Exception (__2, None) (* FIXME *)}}
281
282 Raise <- Ocaml_keywords.RAISE capMlIdent (Default.lparen Expr Default.rparen {{__2}})?
283 {{
284 Raise ([Ident.source __2], __3)
285 }}
286
287 Try <- Ocaml_keywords.TRY Expr Ocaml_keywords.WITH Default.bar? matchExpr
288 (Default.bar matchExpr {{ __2 }})* {{ Try (__2 , __5::__6) }}
289
290 Assert <- Ocaml_keywords.ASSERT Expr {{ Assert __2 }}
291
292 ExprNotApp <- ((
293 #/ Type
294 / Open
295 / Module
296 #/ Constructor
297 / Cond
298 / Letin
299 / Match
300 / Exception
301 / Raise
302 / Try
303 / Assert
304 / MakeRef
305 / GetRef
306 / SetRef
307 / Cons
308 / EmptyList
309 / Abs
310 / SimpleExpr
311 ) (Ocaml_keywords.CONS OpLevel1 {{__2}})? {{ match __2 with | None -> __1 | Some x -> Cons (__1, x)}})
312 {{ __1 }}
313
314 # +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
315 Dot <- Default.dot ((capMlIdent_ [.] {{__1}})* {{ __1 }}) (mlIdent {{`MlIdent __1}} / Default.lparen Default.int spacing Default.rparen {{ `Int __2}}) {{ match __3 with `MlIdent s ->
316 let tmp = String.concat_map "." (fun s -> s) __2 in
317 let tmp = if tmp = "" then "" else tmp ^ "." in
318 `MlIdent (tmp ^ s) | `Int i -> `Int i }}
319
320 Paren <- Default.lparen Expr (Default.colon type)? Default.rparen {{ __2 }} / Ocaml_keywords.BEGIN Expr Ocaml_keywords.END {{ __2 }}
321 dotable <-
322 / Record
323 / Paren
324 / Var
325 SimpleExpr <-
326 / dotable Dot* (Default.leftarrow Expr_without_seq {{__2}})? {{ let tmp = List.fold_left (fun accu -> function | `MlIdent e -> Dot (accu, e)
327 | `Int i -> Dot (accu, sprintf "(%d)" i)) __1 __2 in match __3 with None -> tmp | Some s -> SetMutable (tmp, s) }}
328 / Const {{ __1 }}
329 / Default.lparen op_special Default.rparen {{ Var (Pated ([Ident.source __2], true)) }}
330
331 Expr_without_seq_aux <- OpLevel1 (Default.comma Expr_without_seq_aux {{ __2 }})? {{ match __2 with None -> [__1] | Some s -> __1::s }}
332 Expr_without_seq <- Expr_without_seq_aux {{ match __1 with [t] -> t | _ -> Tuple __1 }}
333 Expr <- Expr_without_seq (Default.semi Expr {{ __2 }})? {{ match __2 with None -> __1 | Some x -> Sequence (__1, x) }}
334 #Expr <- Expr_without_seq (Default.semi Expr_without_seq {{ __2 }})* {{ let rec aux = function [] -> assert false | [t] -> t | t::q -> Sequence (t, aux q) in aux (__1::__2) }}
335 OpLevel1 <- OpLevel2 (InfOpLevel1 OpLevel1 {{ __1, __2 }})? {{ match __2 with None -> __1 | Some (__2, __3) -> App (App (__2, __1), __3) }}
336 OpLevel2 <- OpLevel3 (InfOpLevel2 OpLevel2 {{ __1, __2 }})? {{ match __2 with None -> __1 | Some (__2, __3) -> App (App (__2, __1), __3) }}
337 OpLevel3 <- OpLevel4 (InfOpLevel3 OpLevel3 {{ __1, __2 }})? {{ match __2 with None -> __1 | Some (__2, __3) -> App (App (__2, __1), __3) }}
338 OpLevel4 <- App (InfOpLevel4 OpLevel4 {{ __1, __2 }})? {{ match __2 with None -> __1 | Some (__2, __3) -> App (App (__2, __1), __3) }}
339 App <- # / SimpleExpr [-] spacing Const {{ App (App (Var (Pated ["-"]), __1), __4) }}
340 / Constructor
341 # this is too slow;
342 #/ (SimpleExpr !"-") ExprNotApp+ {{ make_app (__1 :: __2) }}
343 # unary -, :: and := below to ban the wrong parsing and relegate below
344 / (SimpleExpr !"-" !"::" !":=") ExprNotApp* {{ match __2 with [] -> __1 | _ -> make_app (__1 :: __2) }}
345 #other, subtly different? variants:
346 #/ (SimpleExpr !"-" !(spacing "::")) ExprNotApp* {{ match __2 with [] -> __1 | _ -> make_app (__1 :: __2) }}
347 #/ (ExprNotApp !"-") ExprNotApp* {{ match __2 with [] -> __1 | _ -> make_app (__1 :: __2) }}
348 / ExprNotApp
349
350 #LetExpr <- (Type / Let) (';;' spacing)? {{ __1 }}
351
352 Operators <- InfOpLevel1 / InfOpLevel2 / InfOpLevel3 / InfOpLevel4
353
354 InfOpLevel1 <- (op_and / op_or)
355 {{
356 Ocaml.make_Var __1
357 }}
358
359 InfOpLevel2 <-
360 (op_equal_struct / op_equal / op_notequal / op_notequal_struct / LE / GE / LT / GT)
361 {{
362 Ocaml.make_Var __1
363 }}
364
365 / op_special
366 {{
367 Ocaml.make_Var __1
368 }}
369
370 InfOpLevel3 <- (PLUS / MINUS / op_concat / op_aro / op_logic)
371 {{
372 Ocaml.make_Var __1
373 }}
374
375 InfOpLevel4 <- (MULT / DIV)
376 {{
377 Ocaml.make_Var __1
378 }}
379
380 op_and <- "&&" spacing {{ __1 }}
381 op_or <- ("||" / "or") spacing {{ "||" }}
382 op_equal <- "=" spacing {{ __1 }}
383 op_equal_struct <- "==" spacing {{ __1 }}
384 op_notequal_struct <- "!=" spacing {{ __1 }}
385 op_notequal <- "<>" spacing {{ __1 }}
386
387 op_concat <- "^" spacing {{ __1 }}
388 op_aro <- "@" spacing {{ __1 }}
389 op_logic <- "asr" spacing {{ "asr" }}
390
391 op_special <- Ocaml_keywords.SPECIALS spacing {{ __1 }}
392
393 LT <- '<' spacing {{ __1 }}
394 GT <- '>' spacing {{ __1 }}
395 LE <- '<=' spacing {{ __1 }}
396 GE <- '>=' spacing {{ __1 }}
397
398 PLUS <- FPLUS / IPLUS
399 MINUS <- FMINUS / IMINUS
400 MULT <- FMULT / IMULT
401 DIV <- FDIV / IDIV
402
403 IPLUS <- '+' spacing {{ __1 }}
404 IMINUS <- '-' spacing {{ __1 }}
405 IMULT <- '*' spacing {{ __1 }}
406 IDIV <- '/' spacing {{ __1 }}
407
408 FPLUS <- '+.' spacing {{ __1 }}
409 FMINUS <- '-.' spacing {{ __1 }}
410 FMULT <- '*.' spacing {{ __1 }}
411 FDIV <- '/.' spacing {{ __1 }}
412
413 LetOrType <- spacing (Type / Let) (';;' spacing)? {{ __2 }}
414
415 +parse : {Ocaml.code} <- LetOrType parse {{ ((__1 :: __2) : Ocaml.code) }}
416 / Default.eof {{ [] }}
Something went wrong with that request. Please try again.