Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 434 lines (361 sloc) 13.911 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 (**
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 *)
46769f1 @OpaOnWindowsNow [feature] surfaceAst: create bind_ident (and use in pattern) node to …
OpaOnWindowsNow authored
67 type bind_directives = QmlAst.userland_visibility_directive (* TODO Move expand here *)
fccc685 Initial open-source release
MLstate authored
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
46769f1 @OpaOnWindowsNow [feature] surfaceAst: create bind_ident (and use in pattern) node to …
OpaOnWindowsNow authored
94 and 'ident bind_ident = {ident :'ident ; directives : bind_directives list}
fccc685 Initial open-source release
MLstate authored
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
d466bb2 @BourgerieQuentin [enhance] compiler: opalang take care of new update ast
BourgerieQuentin authored
118 | DBPath of ('ident, 'dir) dbelt * ('ident, 'dir) expr QmlAst.Db.kind
fccc685 Initial open-source release
MLstate authored
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
91ab51e @BourgerieQuentin [enhance] compiler: (big) improve path parser + opalang handles new q…
BourgerieQuentin authored
144 and ('ident, 'dir) preprocessed_db_element_node = ('ident, 'dir) expr QmlAst.Db.path_elt
fccc685 Initial open-source release
MLstate authored
145
146 (**
147 {6 Pattern}
148 *)
149
150 and 'ident pat = 'ident pat_node label
46769f1 @OpaOnWindowsNow [feature] surfaceAst: create bind_ident (and use in pattern) node to …
OpaOnWindowsNow authored
151
fccc685 Initial open-source release
MLstate authored
152 and 'ident pat_node =
153 | PatRecord of 'ident pat_record_node * QmlAst.pat_rowvar
154 | PatAny
155 | PatConst of const_expr_node
46769f1 @OpaOnWindowsNow [feature] surfaceAst: create bind_ident (and use in pattern) node to …
OpaOnWindowsNow authored
156 | PatVar of 'ident bind_ident
fccc685 Initial open-source release
MLstate authored
157 | PatCoerce of 'ident pat * 'ident ty
46769f1 @OpaOnWindowsNow [feature] surfaceAst: create bind_ident (and use in pattern) node to …
OpaOnWindowsNow authored
158 | PatAs of 'ident pat * 'ident bind_ident
fccc685 Initial open-source release
MLstate authored
159
160 and 'ident pat_record_node = (string * 'ident pat) list
161
162 (**
163 {6 Types}
164 *)
165
166 and 'ident ty = 'ident ty_node label
167 and 'ident ty_node =
168 | TypeConst of const_ty_node
169 | TypeVar of 'ident typevar
170 | TypeArrow of 'ident arrow_t_node
171 | TypeRecord of 'ident row_t_node
172 | TypeSumSugar of 'ident sum_t list
173 | TypeNamed of 'ident typeinstance_t_node
174 | TypeExternal
175 | TypeForall of 'ident typeforall
176 | TypeModule of 'ident fields_t_node
177
178 and 'ident typeforall = 'ident typevar list * 'ident ty
179
180 and 'ident typeinstance_t= 'ident typeinstance_t_node label
181 and 'ident typeinstance_t_node = 'ident typeident * 'ident ty list
182
183 and 'ident arrow_t = 'ident arrow_t_node label
184 and 'ident arrow_t_node = 'ident row_t * 'ident ty (**The type of a function.*)
185
186 and 'ident sum_t = 'ident sum_t_node label
187 and 'ident sum_t_node =
188 | SumName of 'ident typeinstance_t_node
189 | SumRecord of 'ident row_t_node (* warning: the typer won't be able to deal with row variables in columns *)
190 | SumVar of 'ident colvar
191
192 and 'ident fields_t_node = (string * 'ident ty) list
193
194 and 'ident row_t = 'ident row_t_node label
195 and 'ident row_t_node = TyRow of 'ident fields_t_node * 'ident rowvar option
196
197 and 'ident typevar = Flatvar of 'ident(**Type variables, e.g. ['a], ['b], etc.*)
198 and 'ident typeident = Typeident of 'ident(**Type identifiers, e.g. [list], [int]*)
199
200 and const_ty_node =
201 | TyInt
202 | TyFloat
203 | TyString
204
205 and 'ident rowvar = Rowvar of 'ident
206 and 'ident colvar = Colvar of 'ident
207
208 (**
209 {6 Declarations}
210 *)
211
212 and ('ident, 'dir) code_elt = ('ident, 'dir) code_elt_node label
213 and ('ident, 'dir) code_elt_node =
214 | Database of 'ident * string list * QmlAst.Db.options list
215 | NewDbDef of (('ident, 'dir) expr, 'ident ty) QmlAst.Db.db_def
216 | NewType of 'ident typedef list
217 | NewVal of ('ident pat * ('ident, 'dir) expr) list * bool (* rec *)
218 (* after dependency analysis, toplevel mutually recursive functions
219 * are regrouped in a NewVal *)
220 | Package of [`declaration | `import | `import_plugin] * string
221
222 and type_def_visibility =
223 | TDV_public (** Type definition is public, visible from anywhere. *)
224 | TDV_abstract (** Type definition is visible from anywhere but internal
225 representation is only visible inside the hosting package. Since
226 at parsing stage we don't know yet the currently compiled package,
227 the name of the package is not set and its determination is delayed
228 upon we create a QML visibility information. *)
229 | TDV_private (** Type definition is not exported outside the hosting
230 package, i.e. doesn't appear in the package's interface. Same remark
231 than above about the package name. *)
232
233 and 'ident typedef = 'ident typedef_node label
234 and 'ident typedef_node = {
235 ty_def_options : QmlAst.ty_def_options ;
236 ty_def_visibility : type_def_visibility ;
237 ty_def_name : 'ident typeident ;
238 ty_def_params : 'ident typevar list ;
239 ty_def_body :'ident ty
240 }
241
242 type ('ident, 'dir) code = ('ident, 'dir) code_elt list (**One (or more) complete source file(s)*)
243
244
245 (**
246 {5 The ast for pattern matching on xml }
247 *)
248 type 'expr namespace = {namespace : 'expr ; name : string label}
249 type 'expr xml_suffix =
250 | Xml_star
251 | Xml_plus
252 | Xml_question
253 | Xml_number of 'expr
254 | Xml_range of 'expr * 'expr
255 type 'expr xml_pattern_attribute_value =
256 | XmlExists
257 | XmlName
258 | XmlAttrStringParser of 'expr
259 | XmlAttrParser of 'expr
260 type 'expr xml_pattern_attribute =
261 (* string is a unique name used by the parser generator *)
262 'expr namespace * string option * 'expr xml_pattern_attribute_value
263 type 'expr xml_pattern =
264 | XmlLetIn of (string * 'expr) list * 'expr xml_pattern (* this node allows to bind namespaces *)
265 | XmlExpr of 'expr
266 | XmlNode of 'expr namespace *
267 'expr xml_pattern_attribute list *
268 'expr xml_named_pattern list
269 | XmlAny
270 | XmlParser of 'expr Trx_ast.item list (* no disjunction allowed to avoid parsing ambiguities *)
271 (* should we bring a node XmlSuffix -> we can write this in the syntax
272 already anyway
273 but then what about <toto a={e}>*
274 *)
275 and 'expr xml_named_pattern = string option * 'expr xml_pattern * 'expr xml_suffix label option
276 and 'expr xml_rule = 'expr xml_named_pattern list * 'expr (* one line of parser *)
277 type 'expr xml_parser =
278 'expr xml_rule list (* the alternatives *)
279
280
281 (**
282 {5 Various shorthands for directives}
283 *)
284 type magic_directive =
285 [ `magic_to_string
286 | `magic_to_xml
287
288 | `magic_do
289 (**
290 this directive is no longer used for executing a list of funaction,
291 this is just there for keeping the 'do' syntax when we reprint a parsed
292 opa code.
293 this directive is removed during the transformation into QmlAst.
294 *)
295
296 | `typeof
297 | `specialize of [ `strict | `polymorphic ]
298 ]
4692879 @OpaOnWindowsNow [feature] Internationalisation: add @i18n directive and start support…
OpaOnWindowsNow authored
299
300 type string_directive = [ `string ]
301
302 type internationalization_directive = [
303 | `i18n (* indicate a point of translation *)
304 | `i18n_lang (* return the current context lang, add a directive to later prune js code pattern matching at running time *)
305 ]
306
fccc685 Initial open-source release
MLstate authored
307 type error_directive =
308 [ `assert_
309 ]
310 type coding_directive = [
311 | `deprecated
312 | `todo
313 ]
314 type insert_server_directive =
315 [ `server_entry_point
316 ]
317 type concurrency_directive =
318 [ `spawn
319 | `wait
320 | `callcc
321 | `atomic
322 | `thread_context
323 | `with_thread_context
51f92b4 [feature] adding: a no_client_calls directive
Hugo Heuzard authored
324 | `no_client_calls
fccc685 Initial open-source release
MLstate authored
325 | `throw
326 | `catch
327 | `may_cps
43a556e [cleanup] garbage: collecting some directives
Valentin Gatien-Baron authored
328 | `async
fccc685 Initial open-source release
MLstate authored
329 ]
330 type distribution_directive = QmlAst.slicer_directive
331 type file_inclusion_directive =
332 [ `static_content of string (*Relative file name*)* bool (*[true] if a [string] is expected, [false] if a [-> string] is expected*)
333 | `static_resource of string (*Relative file name*)
334 | `static_content_directory of string (*Relative file name*)* bool (*[true] if a [string] is expected, [false] if a [-> string] is expected*)
335 | `static_resource_directory of string (*Relative file name*)
336 ]
337 type access_directive =
338 [ `private_ (* visible only in the current module *)
339 | `public (* visible to everyone *)
340 | `package (* visible only in the current package *)
341 ]
342 type hack_directive =
343 [ `unsafe_cast
344 | `fail
345 | `tracker of PassTracker.t
346 | `expand of Big_int.big_int option
347 | `compiletime of string (* see pass_CompileTimeDirective *)
348 | `opacapi (* see Opacapi, and checkopacapi *)
349 ]
350 type type_directive =
351 [ `coerce
352 | `unsafe_cast
353 | `nonexpansive
354 | `opensums
355 | `openrecord
356 | `module_
357 | `module_field_lifting
358 | `warncoerce
359 ]
360 type other_directive =
43a556e [cleanup] garbage: collecting some directives
Valentin Gatien-Baron authored
361 [ `fun_action
fccc685 Initial open-source release
MLstate authored
362 | `js_ident
363 | `sliced_expr (** the expressions is a two elements containing first the client expression and then the server expression *)
364 | `llarray
365 (** cf doc in QmlAst *)
366 | `recval (** see QmlAst *)
367 ]
368 type alpha_renaming_directive =
369 [ `open_ (** not used anymore *)
370 | `toplevel_open
371 | `module_
372 | `toplevel
373 ]
374
375 (**
376 path * access
377 *)
378 type documentation_directive =
379 [ `doctype of string list * QmlAst.doctype_access_directive ]
380
381 type opavalue_directive = [
382 | `stringifier
383 | `comparator
384 | `serializer
385 | `xmlizer
386 ]
387
2536662 @OpaOnWindowsNow [feature] closure serialisation: restrict to new @public_env directive
OpaOnWindowsNow authored
388 type closure_instrumentation_directive = QmlAst.closure_instrumentation_directive
389
fccc685 Initial open-source release
MLstate authored
390 type basic_directive =
391 [ magic_directive
4692879 @OpaOnWindowsNow [feature] Internationalisation: add @i18n directive and start support…
OpaOnWindowsNow authored
392 | string_directive
393 | internationalization_directive
fccc685 Initial open-source release
MLstate authored
394 | coding_directive
395 | error_directive
396 | concurrency_directive
397 | file_inclusion_directive
398 | hack_directive
399 | type_directive
400 | other_directive
401 | documentation_directive
402 | insert_server_directive
403 | opavalue_directive
404 | `create_lazy_record
405 | distribution_directive
2536662 @OpaOnWindowsNow [feature] closure serialisation: restrict to new @public_env directive
OpaOnWindowsNow authored
406 | closure_instrumentation_directive
fccc685 Initial open-source release
MLstate authored
407 ]
408 (** these directives are the ones that are not taken care of in the surfaceAst
409 they go straight to qml (or fail at the conversion when not implemented)
410 If you are adding a directive that needs to go though opa to be taken care of
411 in qml, it must end up in this type
412 *)
413
414
415
416 type dependency_directive =
417 [ basic_directive
418 | access_directive
419 | `local of uids ]
420
421 type renaming_directive =
422 [ access_directive
423 | basic_directive
424 | alpha_renaming_directive ]
425 type parsing_directive =
426 [ `xml_parser of (string, parsing_directive) expr xml_parser
427 | `parser_ of (string, parsing_directive) expr Trx_ast.expr
428 | renaming_directive ]
429
430 type all_directives =
431 [ parsing_directive
432 | dependency_directive
433 | renaming_directive ]
Something went wrong with that request. Please try again.