Skip to content
Newer
Older
100644 283 lines (251 sloc) 13 KB
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
1 (*
2 Copyright © 2011 MLstate
3
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored Jul 9, 2012
4 This file is part of Opa.
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
5
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored Jul 9, 2012
6 Opa is free software: you can redistribute it and/or modify it under the
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored Jul 9, 2012
10 Opa is distributed in the hope that it will be useful, but WITHOUT ANY
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
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
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored Jul 9, 2012
16 along with Opa. If not, see <http://www.gnu.org/licenses/>.
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
17 *)
18 # TODO
19 # - Implement trxdefine
20 # - Debug Prevent and SubPattern
21 # - Move over to trx_expr (difficult)
22 read default.trx
23 read ocaml_parser.trx
24 #read trx_expr.trx
25
26 types:{{
27 open Ocaml
28 open Tgrammar
29
30 type expr =
31 | Debugvar of string
32 | Generate of string
33 | Protocol of string
34 | Include of string
35 | Define of expr * expr list
36 | TrxDefine of string Tgrammar.PreGrammar.sequence list * expr list
37 | SubPattern of string * string * expr list
38 | Constr of string * expr list
39 | Import of expr
40 | MOpen of string
41 | MAlias of string * string
42 | Set of expr * string
43 | Literal of string * string option
44 | Ident of string
45 | Prevent of string
46 | GVar of string * Ocaml.type_expr
47 | GLet of expr * expr
48 | Errcont of string
49 | MType of string * Ocaml.type_expr
50 | MVal of string * Ocaml.type_expr
51 | Raw of string * (string * string list)
52 * (string * Ocaml.type_expr option * (string * string list) option * (string * string) option) list
53 | Case of (expr * expr option) * expr list
54 | Timeout of string * expr list
55 | Upto of Ocaml.expr * expr list * expr list * expr option
56 | Fixed of Ocaml.expr * expr list * expr list * expr option
57 | ReadRaw of expr list * expr list * expr option
58 | Content of Ocaml.expr * expr list * expr list * expr option
59 | Receive of string option * string option * expr list * expr list * expr option
60 | Call of string * expr list
61 | Send of string
62 | SendBuf of Ocaml.expr
63 | SendBufLen of Ocaml.expr * Ocaml.expr
64 | WriteConn of string
65 | ReadConn of expr * string
66 | Sleep of Ocaml.expr
67 | Listen of expr * Ocaml.expr * string list (* let key = listen(port_spec,function_name,function_args) *)
68 | Connect of Ocaml.expr * string list (* (port_spec,function_name,function_args) *)
69 | SendAll of string
70 | GVerbatim of string option * int option * bool * string option * string
71 | OcamlTop of Ocaml.expr list
72 | Ocaml of string option * int option * bool * string option * Ocaml.expr
73 | Async of bool * string option * Ocaml.expr
74 | Startfun of string * expr list * expr list
75 | Fun of string * expr list * expr list
76 | Block of expr list
77 | If of expr * expr * expr
78 | GMatch of bool * string option * Ocaml.expr * ((Ocaml.expr option * Ocaml.pattern) * expr) list
79 | Underscore
80 | Close
81 }}
82
83 ########################
84 # Primitives #
85 ########################
86 allowed_chars <- [a-zA-Z0-9_'\-éèàêç]
87 qallowed_chars <- [.] / allowed_chars
88 callowed_chars <- [:] / allowed_chars
89 keywords <- (("begin" / "end" / "if" / "then" / "else" / "match" / "with" / "when" / "after" / "as" / "debug" / "release" / "let"
90 / "connect" / "writeconn" / "readconn" / "listen" / "send_all" / "send_buf" / "send" / "receive" / "catch"
91 / "upto" / "fixed" / "read_content" / "rawread" / "sleep"
92 / ";;" / "->" / ":" / "~" / "*" / "+" / "?" / "=" / "-!-" / "<<" / ">>" / "[[" / "]]" / "{{" / "}}"
93 / "-trxdefine" / "-debugvar" / "-generate" / "-protocol" / "client" / "server" / "-include" / "-open" / "-modalias"
94 / "-define" / "-raw" / "-import" / "-set" / "-type" / "-val" / "<lws>") !allowed_chars) $_
95 quote <- '"'
96 capital <- [A-Z]
97 tos <- ' ' / '\t' / "\\\n"
98 delimitor <- ";;" $ / Default.eol $
99 ident_ <- (allowed_chars)+ $_
100 ident <- (!keywords ident_) $_
101 qident_ <- (qallowed_chars)+ $_
102 qident <- (!keywords qident_) $_
103 cident_ <- (callowed_chars)+ $_
104 cident <- (!keywords cident_) $_
105 literal <- quote Default.stringchar* quote $_
106
107
108 #######################
109 # Miscellaneous #
110 #######################
111 percentcomment <- '%' (!Default.eol .)* (Default.eol+ / Default.eof+) $
112 spc <- (percentcomment $ / Default.space $ / Default.mlcomment $)* $
113
114 mods <- "~" / "*" / "+" / "?" $_
115 word <- literal mods? {{ Literal (__1,__2) }}
116 / ident {{ Ident __1 }}
117 / '!' (literal / ident) {{ Prevent __2 }}
118 / '(' spc pattern spc ')' ('*'/'+'/'?') spc "as" spc ident {{ SubPattern (__10, __6, __3) }}
119
120 constr <- capital allowed_chars* $_
121
122 real_param <- (!"when" (ident / literal)) spc ":" spc type {{ GVar (__1, __5) }}
123 / (!"when" (ident / literal)) {{ GVar (__1, TypeConst TypeString) }}
124 param <- '(' spc real_param spc ')' {{ __3 }}
125 / real_param
126
127 real_pl <- spc param (spc ',' spc param {{ __4 }})* {{ __2::__3 }}
128 plist <- '(' real_pl ')' {{ __2 }}
129 / real_pl
130
131 real_tp <- constr (spc plist {{ __2 }})? {{ let x = (match __2 with None -> [] | Some lst -> lst) in Constr (__1, x) }}
132 typepattern <- '(' spc real_tp spc ')' {{ __3 }}
133 / real_tp {{ __1 }}
134
135 #trxtypepat <- Trx_expr.Expression {{ __1 }}
136 #trxdefine <- "-trxdefine" spc trxtypepat spc "=" spc pattern spc delimitor? spc {{ TrxDefine ( __3, __7) }}
137
138
139 #####################
140 # Related to: types #
141 #####################
142 typident <- Ocaml_types.typevars? Ocaml_types.typeIdent $_
143 type <- Ocaml_types.typedeflist
144
145
146 ###########################
147 # Related to rule: define #
148 ###########################
149 pattern <- spc tos* word (tos+ word {{ __2 }})* spc tos* {{ __3::__4 }}
150
151
152 ################################
153 # Related to rules: func, call #
154 ################################
155 statecall <- ident spc '(' args? ')' {{ __1, (match __4 with None -> [] | Some lst -> lst) }}
156 statedef <- ident spc '(' real_pl? ')' {{ __1, (match __4 with None -> [] | Some lst -> lst) }}
157 arg <- (ident {{ Ocaml (None,None,false,None,Ocaml.make_Var __1) }} / ocaml / verbatim)
158 args <- (spc arg spc ',' {{ __2 }})* spc arg spc {{ __1 @ [__3] }}
159
160
161 ############################
162 # Related to rule: receive #
163 ############################
164 guard <- "when" spc (ocaml / verbatim) {{ __3 }}
165 timeout <- "after" spc (Default.strfloat {{ "(Time.seconds_float " ^ __1 ^ ")" }} / qident $_) spc "->" spc code+ {{ Timeout (__3, __7) }}
166 matching <- spc '|' spc '_' spc guard? "->" spc code+ {{ Case ((Underscore, __6), __9) }}
167 / spc '|' spc typepattern spc guard? "->" spc code+ {{ Case ((__4, __6), __9) }}
168 / spc '|' spc ident spc guard? "->" spc code+ {{ Case ((Ident __4, __6), __9) }}
169 maybewith <- "with" spc ident spc {{ __3 }}
170 maybeas <- "as" spc ident spc {{ __3 }}
171
172 # Ho hum. We need to protect these from running into idents.
173 DEBUG <- "debug" !allowed_chars $_
174 RELEASE <- "release" !allowed_chars $_
175 LET <- "let" !allowed_chars $_
176 BEGIN <- "begin" !allowed_chars $_
177 END <- "end" !allowed_chars $_
178 IF <- "if" !allowed_chars $_
179 THEN <- "then" !allowed_chars $_
180 ELSE <- "else" !allowed_chars $_
181 MATCH <- "match" !allowed_chars $_
182 WITH <- "with" !allowed_chars $_
183 WRITECONN <- "writeconn" !allowed_chars $_
184 SLEEP <- "sleep" !allowed_chars $_
185 READCONN <- "readconn" !allowed_chars $_
186 CONNECT <- "connect" !allowed_chars $_
187 LISTEN <- "listen" !allowed_chars $_
188 SEND <- "send" !allowed_chars $_
189 SEND_ALL <- "send_all" !allowed_chars $_
190 SEND_BUF <- "send_buf" !allowed_chars $_
191 UPTO <- "upto" !allowed_chars $_
192 FIXED <- "fixed" !allowed_chars $_
193 CONTENT <- "read_content" !allowed_chars $_
194 RAWREAD <- "rawread" !allowed_chars $_
195 RECEIVE <- "receive" !allowed_chars $_
196 CATCH <- "catch" !allowed_chars $_
197 SLEEP <- "sleep" !allowed_chars $_
198 ERRCONT <- "errcont" !allowed_chars $_
199
200 #########################
201 # Related to rule: code #
202 #########################
203 # TODO: remove verbatim when ocaml_parser.trx is more complete
204 otrm <- spc ';'? spc
205 rtrm <- spc ';' spc
206 close <- "-!-" otrm {{ Close }}
207 call <- statecall ';'? Default.space+ spc {{ Call (fst __1, snd __1) }}
208 ocamltop <- "{{" spc Ocaml_parser.LetOrType (spc Ocaml_parser.LetOrType {{ __2 }})* spc "}}" otrm {{ OcamlTop (__3::__4) }}
209 dbgrls <- (DEBUG / RELEASE)? {{ __1 }}
210 async <- "!"? spc literal? spc "<<" spc Ocaml_parser.Expr spc ">>" otrm {{ Async (Option.is_some __1,__3,__7) }}
211 ocaml <- dbgrls spc Default.int? spc "!"? spc literal? spc "{{" spc Ocaml_parser.Expr spc "}}" otrm
212 {{ Ocaml (__1,__3,(Option.is_some __5),__7,__11) }}
213 verbatim <- dbgrls spc Default.int? spc "!"? spc literal? spc "[[" ((!"]]" .)+ $_) "]]" otrm
214 {{ GVerbatim (__1,__3,(Option.is_some __5),__7,__10) }}
215 letin <- LET spc param spc '=' spc (ocaml / verbatim / async) otrm {{ GLet (__3, __7) }}
216 errcont <- ERRCONT spc "(" spc ident spc ")" spc otrm {{ Errcont __5 }}
217 sequence <- BEGIN spc code+ END spc {{ Block __3 }}
218 cond <- IF spc (ocaml / verbatim) THEN spc code+ ELSE spc code+ (END spc $_)? {{ If (__3, Block __6, Block __9) }}
219 patexp <- spc '|' spc Ocaml_parser.pattern spc "->" spc code+ {{ (__4, Block __8) }}
220 match <- MATCH spc "!"? spc literal? spc "{{" spc Ocaml_parser.Expr spc "}}" spc WITH spc patexp+ otrm
221 {{ GMatch ((Option.is_some __3),__5,__9,__15) }}
222 connwrite <- WRITECONN spc ((!';' .)* $_) rtrm {{ WriteConn __3 }}
223 sleep <- SLEEP spc "{{" spc Ocaml_parser.Expr spc "}}" otrm {{ Sleep __5 }}
224 connread <- LET spc param spc '=' spc READCONN spc ((!';' .)* $_) rtrm {{ ReadConn (__3,__9) }}
225 not_ident <- ',' / ')' / ' ' / '\t'
226 comma_ident <- ',' spc ident {{ __3 }}
227 comma_idents <- comma_ident spc (comma_ident spc {{ __1 }})* {{ __1::__3 }}
228 connect <- CONNECT spc '(' spc "{{" spc Ocaml_parser.Expr spc "}}" spc comma_idents spc ')' otrm {{ Connect (__7,__11) }}
229 listen <- LET spc param spc '=' spc
230 LISTEN spc '(' spc "{{" spc Ocaml_parser.Expr spc "}}" spc comma_idents spc ')' otrm
231 {{ Listen (__3,__13,__17) }}
232 send <- SEND spc ((!';' .)* $_) rtrm {{ Send __3 }}
233 sendbuf <- SEND_BUF spc "{{" spc Ocaml_parser.Expr spc "}}" otrm {{ SendBuf __5 }}
234 sendall <- SEND_ALL spc ((!';' .)* $_) spc ';' spc {{ SendAll __3 }}
235 upto <- UPTO spc "{{" spc Ocaml_parser.Expr spc "}}" matching+ (CATCH spc matching+ {{__3}})? timeout? otrm
236 {{ Upto (__5, __8, (match __9 with Some l -> l | None -> []), __10) }}
237 fixed <- FIXED spc "{{" spc Ocaml_parser.Expr spc "}}" matching+ (CATCH spc matching+ {{__3}})? timeout? otrm
238 {{ Fixed (__5, __8, (match __9 with Some l -> l | None -> []), __10) }}
239 content <- CONTENT spc "{{" spc Ocaml_parser.Expr spc "}}" matching+ (CATCH spc matching+ {{__3}})? timeout? otrm
240 {{ Content (__5, __8, (match __9 with Some l -> l | None -> []), __10) }}
241 rawread <- RAWREAD spc matching+ (CATCH spc matching+ {{__3}})? timeout? otrm
242 {{ ReadRaw (__3, (match __4 with Some l -> l | None -> []), __5) }}
243 receive <- RECEIVE spc maybewith? maybeas? matching+ CATCH spc matching+ timeout? spc
244 {{ Receive (__3, __4, __5, __8, __9) }}
245 / RECEIVE spc maybewith? maybeas? matching+ timeout? spc
246 {{ Receive (__3, __4, __5, [], __6) }}
247
248 code <- receive / sendall / send / sendbuf / connect / connwrite / connread / listen
249 / upto / fixed / content / rawread / sleep / errcont
250 / ocaml / verbatim / async / letin / sequence / cond / match / close / call
251
252
253 #########################
254 # Related to rule: prog #
255 #########################
256 dbgvar <- "-debugvar" spc ident spc {{ Debugvar __3 }}
257 gen <- "-generate" spc ("client" $_ / "server" $_) spc delimitor? spc {{ Generate __3 }}
258 protocol<- "-protocol" spc ident:protocol spc {{ Protocol protocol }}
259 incl <- "-include" spc Default.stringnosp spc delimitor? spc {{ Include __3 }}
260 mopen <- "-open" spc ((!Default.space .)* $_) spc delimitor? spc {{ MOpen __3 }}
261 malias <- "-modalias" spc ((!Default.space .)* $_) spc "=" spc ((!Default.space .)* $_) delimitor? spc {{ MAlias (__3,__7) }}
262 define <- "-define" spc typepattern spc "=" spc pattern spc delimitor? spc {{ Define (__3, __7) }}
263 import <- "-import" spc param spc delimitor? spc {{ Import __3 }}
264 set <- "-set" spc param spc "=" spc ((!delimitor .)+ $_) delimitor? spc {{ Set (__3, __7) }}
265 deftype <- "-type" spc typident spc '=' spc type spc delimitor? spc {{ MType (__3, __7) }}
266 defval <- "-val" spc typident spc ':' spc type spc delimitor? spc {{ MVal (__3, __7) }}
267 func <- '+'? spc statedef spc ':' spc code+ spc delimitor? spc
268 {{ match __1 with
269 | None -> Fun (fst __3, snd __3, __7)
270 | Some _ -> Startfun (fst __3, snd __3, __7) }}
271
272 lopt <- ("s"~ / "l"~ / "m"~ / "i"~ / "t"~) {{ String.lowercase __1 }}
273 litopt <- literal lopt* {{ (__1, __2) }}
274 convfn <- "(" spc ident spc spc "," spc ident spc ")" {{ (__3, __8) }}
275 rawmtch <- ident spc type? spc litopt? spc convfn? spc {{ (__1, __3, __5, __7) }}
276 raw <- "-raw" spc ident spc "=" spc litopt spc rawmtch* spc delimitor? spc
277 {{ Raw (__3, __7, __9) }}
278
279 +prog : {expr list} <- spc (ocamltop / verbatim / dbgvar / gen / protocol / incl / mopen / malias / define / raw #/ trxdefine
280 / import / set / deftype / defval / func)* {{ __2 }}
281
282 # End of file: grammar.trx
Something went wrong with that request. Please try again.