Skip to content
This repository
Newer
Older
100644 436 lines (364 sloc) 14.014 kb
fccc6851 » MLstate
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
19 (**
20 The OPA Surface AST.
21
22 @author David Rajchenbach-Teller
23 @author Rudy Sicard
24 *)
25
26 (**
27 {5 Definitions}
28 *)
29 type 'a label = 'a QmlLoc.label
30
31 (**
32 {6 Identifiers}
33
34 Not-quite-phantom types used to guarantee that we never confuse
35 unique identifiers and not-made-unique-yet identifiers.
36 *)
37
38
39 type uids = Ident.t
40 (**
41 A key to determine the (non)-equality of identifiers.
42
43 This is useful as the same source code can often contain two
44 identical identifiers (say [x]) with different definitions (say
45 [let x = 1 in let x = 2 in e]). While here both identifiers will
46 be called [x], they will have distinct hashes.
47 *)
48
49 type nonuid = string
50 (**A name as parsed in the source*)
51
52 let hash : string -> string -> uids =
53 fun name description -> Ident.next ~descr:description name
54 (** Generate a unique hash for a name.
55
56 Usage: [hash name description]. *)
57
58 let string_of_hash : uids -> string = Ident.stident
59
60 (**
61 {6 Expressions}
62 *)
63
64 (**
65 {7 Other expressions}
66 *)
46769f16 » OpaOnWindowsNow
2011-09-08 [feature] surfaceAst: create bind_ident (and use in pattern) node to …
67 type bind_directives = QmlAst.userland_visibility_directive (* TODO Move expand here *)
fccc6851 » MLstate
2011-06-21 Initial open-source release
68
69 (**
70 Internal data structures.
71
72 Not all of these data structures are visible in the concrete syntax.
73 For instance, the concrete syntax offers [text] (Unicode ropes)
74 instead of [string] (character-neutral array-style strings).
75 *)
76 type const_expr_node =
77 | CInt of Big_int.big_int
78 | CFloat of float
79 (* | CFixed of fixed*)(**This is actually a user-level data structure.*)
80 | CString of string (**A UTF-8 encoded string.*)
81
82 and const_expr = const_expr_node label (* cf libqmlcompil/qmlLoc.ml *)
83
84 type ('ident, 'dir) record = ('ident, 'dir) record_node label
85 and ('ident, 'dir) record_node = (string * ('ident, 'dir) expr) list
86
87 (**
88 Type of an expression
89
90 @param 'ident The type of identifiers: either [nonuid] until identifiers have been made unique or [uids] once they have
91 @param 'dir The type of directives, i.e. stuff left by the compiler for a further phase to rewrite.
92 *)
93 and ('ident, 'dir) expr = ('ident, 'dir) expr_node label
46769f16 » OpaOnWindowsNow
2011-09-08 [feature] surfaceAst: create bind_ident (and use in pattern) node to …
94 and 'ident bind_ident = {ident :'ident ; directives : bind_directives list}
fccc6851 » MLstate
2011-06-21 Initial open-source release
95 and ('ident, 'dir) expr_node =
96 | Apply of ('ident, 'dir) expr * ('ident, 'dir) record
97 (**
98 We may add a support for labeled arguement.
99 For now, those records are tuples ("f1", "f2", etc.)
100 *)
101
102 | Lambda of 'ident pat_record_node * ('ident, 'dir) expr
103 (**
104 cf remark for Apply node, about labeled argument.
105 *)
106
107 | Const of const_expr_node
108 | Ident of 'ident
109 | LetIn of bool (* rec *) * ('ident * ('ident, 'dir) expr) list * ('ident, 'dir) expr
110 | Match of ('ident, 'dir) expr * ('ident pat * ('ident, 'dir) expr) list
111 | Record of ('ident, 'dir) record_node
112 | ExtendRecord of ('ident, 'dir) record_node * ('ident, 'dir) expr (**[ExtendRecord r e] extends
113 the result of [e] with the
114 fields defined in [r].*)
115 | Dot of ('ident, 'dir) expr * string
116 | Bypass of BslKey.t (**A primitive, handled through the Bypass Standard Library*)
117
118 | DBPath of ('ident, 'dir) dbelt * QmlAst.Db.kind
119 | Directive of ('ident, 'dir) directive
120
121 (**
122 Instruction for a later compilation phase.
123
124 Usage: [Directive (directive, human_readable_name, lazy expr, how_to_type)].
125
126 [human_readable_name] is used only for pretty-printing
127
128 To obtain the type of the expression, apply [how_to_type] to the
129 type of [lazy expr] (only if lazy_expr is a one element list).
130 Expressions which should not be typeable (typically because they
131 are expected to be rewritten away before reaching the typer) should
132 have type None.
133 *)
134 and ('ident, 'dir) directive = 'dir * ('ident, 'dir) expr list * 'ident ty list
135
136 (**
137 {6 Database}
138 *)
139
140 and ('ident, 'dir) dbelt = ('ident, 'dir) dbelt_node label
141 and ('ident, 'dir) dbelt_node = ('ident, 'dir) preprocessed_db_element list
142
143 and ('ident, 'dir) preprocessed_db_element = ('ident, 'dir) preprocessed_db_element_node label
144 and ('ident, 'dir) preprocessed_db_element_node =
145 | FldKey of string
146 | ExprKey of ('ident, 'dir) expr (* not [expr_node], because consecutive labels, but unequal positions, because of brackets *)
147 | NewKey
148
149 (**
150 {6 Pattern}
151 *)
152
153 and 'ident pat = 'ident pat_node label
46769f16 » OpaOnWindowsNow
2011-09-08 [feature] surfaceAst: create bind_ident (and use in pattern) node to …
154
fccc6851 » MLstate
2011-06-21 Initial open-source release
155 and 'ident pat_node =
156 | PatRecord of 'ident pat_record_node * QmlAst.pat_rowvar
157 | PatAny
158 | PatConst of const_expr_node
46769f16 » OpaOnWindowsNow
2011-09-08 [feature] surfaceAst: create bind_ident (and use in pattern) node to …
159 | PatVar of 'ident bind_ident
fccc6851 » MLstate
2011-06-21 Initial open-source release
160 | PatCoerce of 'ident pat * 'ident ty
46769f16 » OpaOnWindowsNow
2011-09-08 [feature] surfaceAst: create bind_ident (and use in pattern) node to …
161 | PatAs of 'ident pat * 'ident bind_ident
fccc6851 » MLstate
2011-06-21 Initial open-source release
162
163 and 'ident pat_record_node = (string * 'ident pat) list
164
165 (**
166 {6 Types}
167 *)
168
169 and 'ident ty = 'ident ty_node label
170 and 'ident ty_node =
171 | TypeConst of const_ty_node
172 | TypeVar of 'ident typevar
173 | TypeArrow of 'ident arrow_t_node
174 | TypeRecord of 'ident row_t_node
175 | TypeSumSugar of 'ident sum_t list
176 | TypeNamed of 'ident typeinstance_t_node
177 | TypeExternal
178 | TypeForall of 'ident typeforall
179 | TypeModule of 'ident fields_t_node
180
181 and 'ident typeforall = 'ident typevar list * 'ident ty
182
183 and 'ident typeinstance_t= 'ident typeinstance_t_node label
184 and 'ident typeinstance_t_node = 'ident typeident * 'ident ty list
185
186 and 'ident arrow_t = 'ident arrow_t_node label
187 and 'ident arrow_t_node = 'ident row_t * 'ident ty (**The type of a function.*)
188
189 and 'ident sum_t = 'ident sum_t_node label
190 and 'ident sum_t_node =
191 | SumName of 'ident typeinstance_t_node
192 | SumRecord of 'ident row_t_node (* warning: the typer won't be able to deal with row variables in columns *)
193 | SumVar of 'ident colvar
194
195 and 'ident fields_t_node = (string * 'ident ty) list
196
197 and 'ident row_t = 'ident row_t_node label
198 and 'ident row_t_node = TyRow of 'ident fields_t_node * 'ident rowvar option
199
200 and 'ident typevar = Flatvar of 'ident(**Type variables, e.g. ['a], ['b], etc.*)
201 and 'ident typeident = Typeident of 'ident(**Type identifiers, e.g. [list], [int]*)
202
203 and const_ty_node =
204 | TyInt
205 | TyFloat
206 | TyString
207
208 and 'ident rowvar = Rowvar of 'ident
209 and 'ident colvar = Colvar of 'ident
210
211 (**
212 {6 Declarations}
213 *)
214
215 and ('ident, 'dir) code_elt = ('ident, 'dir) code_elt_node label
216 and ('ident, 'dir) code_elt_node =
217 | Database of 'ident * string list * QmlAst.Db.options list
218 | NewDbDef of (('ident, 'dir) expr, 'ident ty) QmlAst.Db.db_def
219 | NewType of 'ident typedef list
220 | NewVal of ('ident pat * ('ident, 'dir) expr) list * bool (* rec *)
221 (* after dependency analysis, toplevel mutually recursive functions
222 * are regrouped in a NewVal *)
223 | Package of [`declaration | `import | `import_plugin] * string
224
225 and type_def_visibility =
226 | TDV_public (** Type definition is public, visible from anywhere. *)
227 | TDV_abstract (** Type definition is visible from anywhere but internal
228 representation is only visible inside the hosting package. Since
229 at parsing stage we don't know yet the currently compiled package,
230 the name of the package is not set and its determination is delayed
231 upon we create a QML visibility information. *)
232 | TDV_private (** Type definition is not exported outside the hosting
233 package, i.e. doesn't appear in the package's interface. Same remark
234 than above about the package name. *)
235
236 and 'ident typedef = 'ident typedef_node label
237 and 'ident typedef_node = {
238 ty_def_options : QmlAst.ty_def_options ;
239 ty_def_visibility : type_def_visibility ;
240 ty_def_name : 'ident typeident ;
241 ty_def_params : 'ident typevar list ;
242 ty_def_body :'ident ty
243 }
244
245 type ('ident, 'dir) code = ('ident, 'dir) code_elt list (**One (or more) complete source file(s)*)
246
247
248 (**
249 {5 The ast for pattern matching on xml }
250 *)
251 type 'expr namespace = {namespace : 'expr ; name : string label}
252 type 'expr xml_suffix =
253 | Xml_star
254 | Xml_plus
255 | Xml_question
256 | Xml_number of 'expr
257 | Xml_range of 'expr * 'expr
258 type 'expr xml_pattern_attribute_value =
259 | XmlExists
260 | XmlName
261 | XmlAttrStringParser of 'expr
262 | XmlAttrParser of 'expr
263 type 'expr xml_pattern_attribute =
264 (* string is a unique name used by the parser generator *)
265 'expr namespace * string option * 'expr xml_pattern_attribute_value
266 type 'expr xml_pattern =
267 | XmlLetIn of (string * 'expr) list * 'expr xml_pattern (* this node allows to bind namespaces *)
268 | XmlExpr of 'expr
269 | XmlNode of 'expr namespace *
270 'expr xml_pattern_attribute list *
271 'expr xml_named_pattern list
272 | XmlAny
273 | XmlParser of 'expr Trx_ast.item list (* no disjunction allowed to avoid parsing ambiguities *)
274 (* should we bring a node XmlSuffix -> we can write this in the syntax
275 already anyway
276 but then what about <toto a={e}>*
277 *)
278 and 'expr xml_named_pattern = string option * 'expr xml_pattern * 'expr xml_suffix label option
279 and 'expr xml_rule = 'expr xml_named_pattern list * 'expr (* one line of parser *)
280 type 'expr xml_parser =
281 'expr xml_rule list (* the alternatives *)
282
283
284 (**
285 {5 Various shorthands for directives}
286 *)
287 type magic_directive =
288 [ `magic_to_string
289 | `magic_to_xml
290
291 | `magic_do
292 (**
293 this directive is no longer used for executing a list of funaction,
294 this is just there for keeping the 'do' syntax when we reprint a parsed
295 opa code.
296 this directive is removed during the transformation into QmlAst.
297 *)
298
299 | `typeof
300 | `specialize of [ `strict | `polymorphic ]
301 ]
46928796 » OpaOnWindowsNow
2011-09-08 [feature] Internationalisation: add @i18n directive and start support…
302
303 type string_directive = [ `string ]
304
305 type internationalization_directive = [
306 | `i18n (* indicate a point of translation *)
307 | `i18n_lang (* return the current context lang, add a directive to later prune js code pattern matching at running time *)
308 ]
309
fccc6851 » MLstate
2011-06-21 Initial open-source release
310 type error_directive =
311 [ `assert_
312 ]
313 type coding_directive = [
314 | `deprecated
315 | `todo
316 ]
317 type insert_server_directive =
318 [ `server_entry_point
319 ]
320 type concurrency_directive =
321 [ `spawn
322 | `wait
323 | `callcc
324 | `atomic
325 | `thread_context
326 | `with_thread_context
51f92b4d » Hugo Heuzard
2011-09-09 [feature] adding: a no_client_calls directive
327 | `no_client_calls
fccc6851 » MLstate
2011-06-21 Initial open-source release
328 | `throw
329 | `catch
330 | `may_cps
43a556ef » Valentin Gatien-Baron
2011-07-06 [cleanup] garbage: collecting some directives
331 | `async
fccc6851 » MLstate
2011-06-21 Initial open-source release
332 ]
333 type distribution_directive = QmlAst.slicer_directive
334 type file_inclusion_directive =
335 [ `static_content of string (*Relative file name*)* bool (*[true] if a [string] is expected, [false] if a [-> string] is expected*)
336 | `static_resource of string (*Relative file name*)
337 | `static_content_directory of string (*Relative file name*)* bool (*[true] if a [string] is expected, [false] if a [-> string] is expected*)
338 | `static_resource_directory of string (*Relative file name*)
339 ]
340 type access_directive =
341 [ `private_ (* visible only in the current module *)
342 | `public (* visible to everyone *)
343 | `package (* visible only in the current package *)
344 ]
345 type hack_directive =
346 [ `unsafe_cast
347 | `fail
348 | `tracker of PassTracker.t
349 | `expand of Big_int.big_int option
350 | `compiletime of string (* see pass_CompileTimeDirective *)
351 | `opacapi (* see Opacapi, and checkopacapi *)
352 ]
353 type type_directive =
354 [ `coerce
355 | `unsafe_cast
356 | `nonexpansive
357 | `opensums
358 | `openrecord
359 | `module_
360 | `module_field_lifting
361 | `warncoerce
362 ]
363 type other_directive =
43a556ef » Valentin Gatien-Baron
2011-07-06 [cleanup] garbage: collecting some directives
364 [ `fun_action
fccc6851 » MLstate
2011-06-21 Initial open-source release
365 | `js_ident
366 | `sliced_expr (** the expressions is a two elements containing first the client expression and then the server expression *)
367 | `llarray
368 (** cf doc in QmlAst *)
369 | `recval (** see QmlAst *)
370 ]
371 type alpha_renaming_directive =
372 [ `open_ (** not used anymore *)
373 | `toplevel_open
374 | `module_
375 | `toplevel
376 ]
377
378 (**
379 path * access
380 *)
381 type documentation_directive =
382 [ `doctype of string list * QmlAst.doctype_access_directive ]
383
384 type opavalue_directive = [
385 | `stringifier
386 | `comparator
387 | `serializer
388 | `xmlizer
389 ]
390
2536662d » OpaOnWindowsNow
2011-09-23 [feature] closure serialisation: restrict to new @public_env directive
391 type closure_instrumentation_directive = QmlAst.closure_instrumentation_directive
392
fccc6851 » MLstate
2011-06-21 Initial open-source release
393 type basic_directive =
394 [ magic_directive
46928796 » OpaOnWindowsNow
2011-09-08 [feature] Internationalisation: add @i18n directive and start support…
395 | string_directive
396 | internationalization_directive
fccc6851 » MLstate
2011-06-21 Initial open-source release
397 | coding_directive
398 | error_directive
399 | concurrency_directive
400 | file_inclusion_directive
401 | hack_directive
402 | type_directive
403 | other_directive
404 | documentation_directive
405 | insert_server_directive
406 | opavalue_directive
407 | `create_lazy_record
408 | distribution_directive
2536662d » OpaOnWindowsNow
2011-09-23 [feature] closure serialisation: restrict to new @public_env directive
409 | closure_instrumentation_directive
fccc6851 » MLstate
2011-06-21 Initial open-source release
410 ]
411 (** these directives are the ones that are not taken care of in the surfaceAst
412 they go straight to qml (or fail at the conversion when not implemented)
413 If you are adding a directive that needs to go though opa to be taken care of
414 in qml, it must end up in this type
415 *)
416
417
418
419 type dependency_directive =
420 [ basic_directive
421 | access_directive
422 | `local of uids ]
423
424 type renaming_directive =
425 [ access_directive
426 | basic_directive
427 | alpha_renaming_directive ]
428 type parsing_directive =
429 [ `xml_parser of (string, parsing_directive) expr xml_parser
430 | `parser_ of (string, parsing_directive) expr Trx_ast.expr
431 | renaming_directive ]
432
433 type all_directives =
434 [ parsing_directive
435 | dependency_directive
436 | renaming_directive ]
Something went wrong with that request. Please try again.