Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 431 lines (360 sloc) 13.704 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 *)
67
68 (**
69 Internal data structures.
70
71 Not all of these data structures are visible in the concrete syntax.
72 For instance, the concrete syntax offers [text] (Unicode ropes)
73 instead of [string] (character-neutral array-style strings).
74 *)
75 type const_expr_node =
76 | CInt of Big_int.big_int
77 | CFloat of float
78 (* | CFixed of fixed*)(**This is actually a user-level data structure.*)
79 | CString of string (**A UTF-8 encoded string.*)
80
81 and const_expr = const_expr_node label (* cf libqmlcompil/qmlLoc.ml *)
82
83 type ('ident, 'dir) record = ('ident, 'dir) record_node label
84 and ('ident, 'dir) record_node = (string * ('ident, 'dir) expr) list
85
86 (**
87 Type of an expression
88
89 @param 'ident The type of identifiers: either [nonuid] until identifiers have been made unique or [uids] once they have
90 @param 'dir The type of directives, i.e. stuff left by the compiler for a further phase to rewrite.
91 *)
92 and ('ident, 'dir) expr = ('ident, 'dir) expr_node label
93 and ('ident, 'dir) expr_node =
94 | Apply of ('ident, 'dir) expr * ('ident, 'dir) record
95 (**
96 We may add a support for labeled arguement.
97 For now, those records are tuples ("f1", "f2", etc.)
98 *)
99
100 | Lambda of 'ident pat_record_node * ('ident, 'dir) expr
101 (**
102 cf remark for Apply node, about labeled argument.
103 *)
104
105 | Const of const_expr_node
106 | Ident of 'ident
107 | LetIn of bool (* rec *) * ('ident * ('ident, 'dir) expr) list * ('ident, 'dir) expr
108 | Match of ('ident, 'dir) expr * ('ident pat * ('ident, 'dir) expr) list
109 | Record of ('ident, 'dir) record_node
110 | ExtendRecord of ('ident, 'dir) record_node * ('ident, 'dir) expr (**[ExtendRecord r e] extends
111 the result of [e] with the
112 fields defined in [r].*)
113 | Dot of ('ident, 'dir) expr * string
114 | Bypass of BslKey.t (**A primitive, handled through the Bypass Standard Library*)
115
116 | DBPath of ('ident, 'dir) dbelt * QmlAst.Db.kind
117 | Directive of ('ident, 'dir) directive
118
119 (**
120 Instruction for a later compilation phase.
121
122 Usage: [Directive (directive, human_readable_name, lazy expr, how_to_type)].
123
124 [human_readable_name] is used only for pretty-printing
125
126 To obtain the type of the expression, apply [how_to_type] to the
127 type of [lazy expr] (only if lazy_expr is a one element list).
128 Expressions which should not be typeable (typically because they
129 are expected to be rewritten away before reaching the typer) should
130 have type None.
131 *)
132 and ('ident, 'dir) directive = 'dir * ('ident, 'dir) expr list * 'ident ty list
133
134 (**
135 {6 Database}
136 *)
137
138 and ('ident, 'dir) dbelt = ('ident, 'dir) dbelt_node label
139 and ('ident, 'dir) dbelt_node = ('ident, 'dir) preprocessed_db_element list
140
141 and ('ident, 'dir) preprocessed_db_element = ('ident, 'dir) preprocessed_db_element_node label
142 and ('ident, 'dir) preprocessed_db_element_node =
143 | FldKey of string
144 | ExprKey of ('ident, 'dir) expr (* not [expr_node], because consecutive labels, but unequal positions, because of brackets *)
145 | NewKey
146
147 (**
148 {6 Pattern}
149 *)
150
151 and 'ident pat = 'ident pat_node label
152 and 'ident pat_node =
153 | PatRecord of 'ident pat_record_node * QmlAst.pat_rowvar
154 | PatAny
155 | PatConst of const_expr_node
156 | PatVar of 'ident
157 | PatCoerce of 'ident pat * 'ident ty
158 | PatAs of 'ident pat * 'ident
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 fo...
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
388 type basic_directive =
389 [ magic_directive
4692879 @OpaOnWindowsNow [feature] Internationalisation: add @i18n directive and start support fo...
OpaOnWindowsNow authored
390 | string_directive
391 | internationalization_directive
fccc685 Initial open-source release
MLstate authored
392 | coding_directive
393 | error_directive
394 | concurrency_directive
395 | file_inclusion_directive
396 | hack_directive
397 | type_directive
398 | other_directive
399 | documentation_directive
400 | insert_server_directive
401 | opavalue_directive
402 | `create_lazy_record
403 | distribution_directive
404 ]
405 (** these directives are the ones that are not taken care of in the surfaceAst
406 they go straight to qml (or fail at the conversion when not implemented)
407 If you are adding a directive that needs to go though opa to be taken care of
408 in qml, it must end up in this type
409 *)
410
411
412
413 type dependency_directive =
414 [ basic_directive
415 | access_directive
416 | `local of uids ]
417
418 type renaming_directive =
419 [ access_directive
420 | basic_directive
421 | alpha_renaming_directive ]
422 type parsing_directive =
423 [ `xml_parser of (string, parsing_directive) expr xml_parser
424 | `parser_ of (string, parsing_directive) expr Trx_ast.expr
425 | renaming_directive ]
426
427 type all_directives =
428 [ parsing_directive
429 | dependency_directive
430 | renaming_directive ]
Something went wrong with that request. Please try again.