Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 430 lines (362 sloc) 13.659 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 | CChar of int (**A unicode character, represented by its number.*)
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
94 and ('ident, 'dir) expr_node =
95 | Apply of ('ident, 'dir) expr * ('ident, 'dir) record
96 (**
97 We may add a support for labeled arguement.
98 For now, those records are tuples ("f1", "f2", etc.)
99 *)
100
101 | Lambda of 'ident pat_record_node * ('ident, 'dir) expr
102 (**
103 cf remark for Apply node, about labeled argument.
104 *)
105
106 | Const of const_expr_node
107 | Ident of 'ident
108 | LetIn of bool (* rec *) * ('ident * ('ident, 'dir) expr) list * ('ident, 'dir) expr
109 | Match of ('ident, 'dir) expr * ('ident pat * ('ident, 'dir) expr) list
110 | Record of ('ident, 'dir) record_node
111 | ExtendRecord of ('ident, 'dir) record_node * ('ident, 'dir) expr (**[ExtendRecord r e] extends
112 the result of [e] with the
113 fields defined in [r].*)
114 | Dot of ('ident, 'dir) expr * string
115 | Bypass of BslKey.t (**A primitive, handled through the Bypass Standard Library*)
116
117 | DBPath of ('ident, 'dir) dbelt * QmlAst.Db.kind
118 | Directive of ('ident, 'dir) directive
119
120 (**
121 Instruction for a later compilation phase.
122
123 Usage: [Directive (directive, human_readable_name, lazy expr, how_to_type)].
124
125 [human_readable_name] is used only for pretty-printing
126
127 To obtain the type of the expression, apply [how_to_type] to the
128 type of [lazy expr] (only if lazy_expr is a one element list).
129 Expressions which should not be typeable (typically because they
130 are expected to be rewritten away before reaching the typer) should
131 have type None.
132 *)
133 and ('ident, 'dir) directive = 'dir * ('ident, 'dir) expr list * 'ident ty list
134
135 (**
136 {6 Database}
137 *)
138
139 and ('ident, 'dir) dbelt = ('ident, 'dir) dbelt_node label
140 and ('ident, 'dir) dbelt_node = ('ident, 'dir) preprocessed_db_element list
141
142 and ('ident, 'dir) preprocessed_db_element = ('ident, 'dir) preprocessed_db_element_node label
143 and ('ident, 'dir) preprocessed_db_element_node =
144 | FldKey of string
145 | ExprKey of ('ident, 'dir) expr (* not [expr_node], because consecutive labels, but unequal positions, because of brackets *)
146 | NewKey
147
148 (**
149 {6 Pattern}
150 *)
151
152 and 'ident pat = 'ident pat_node label
153 and 'ident pat_node =
154 | PatRecord of 'ident pat_record_node * QmlAst.pat_rowvar
155 | PatAny
156 | PatConst of const_expr_node
157 | PatVar of 'ident
158 | PatCoerce of 'ident pat * 'ident ty
159 | PatAs of 'ident pat * 'ident
160
161 and 'ident pat_record_node = (string * 'ident pat) list
162
163 (**
164 {6 Types}
165 *)
166
167 and 'ident ty = 'ident ty_node label
168 and 'ident ty_node =
169 | TypeConst of const_ty_node
170 | TypeVar of 'ident typevar
171 | TypeArrow of 'ident arrow_t_node
172 | TypeRecord of 'ident row_t_node
173 | TypeSumSugar of 'ident sum_t list
174 | TypeNamed of 'ident typeinstance_t_node
175 | TypeExternal
176 | TypeForall of 'ident typeforall
177 | TypeModule of 'ident fields_t_node
178
179 and 'ident typeforall = 'ident typevar list * 'ident ty
180
181 and 'ident typeinstance_t= 'ident typeinstance_t_node label
182 and 'ident typeinstance_t_node = 'ident typeident * 'ident ty list
183
184 and 'ident arrow_t = 'ident arrow_t_node label
185 and 'ident arrow_t_node = 'ident row_t * 'ident ty (**The type of a function.*)
186
187 and 'ident sum_t = 'ident sum_t_node label
188 and 'ident sum_t_node =
189 | SumName of 'ident typeinstance_t_node
190 | SumRecord of 'ident row_t_node (* warning: the typer won't be able to deal with row variables in columns *)
191 | SumVar of 'ident colvar
192
193 and 'ident fields_t_node = (string * 'ident ty) list
194
195 and 'ident row_t = 'ident row_t_node label
196 and 'ident row_t_node = TyRow of 'ident fields_t_node * 'ident rowvar option
197
198 and 'ident typevar = Flatvar of 'ident(**Type variables, e.g. ['a], ['b], etc.*)
199 and 'ident typeident = Typeident of 'ident(**Type identifiers, e.g. [list], [int]*)
200
201 and const_ty_node =
202 | TyInt
203 | TyFloat
204 | TyString
205 | TyChar
206
207 and 'ident rowvar = Rowvar of 'ident
208 and 'ident colvar = Colvar of 'ident
209
210 (**
211 {6 Declarations}
212 *)
213
214 and ('ident, 'dir) code_elt = ('ident, 'dir) code_elt_node label
215 and ('ident, 'dir) code_elt_node =
216 | Database of 'ident * string list * QmlAst.Db.options list
217 | NewDbDef of (('ident, 'dir) expr, 'ident ty) QmlAst.Db.db_def
218 | NewType of 'ident typedef list
219 | NewVal of ('ident pat * ('ident, 'dir) expr) list * bool (* rec *)
220 (* after dependency analysis, toplevel mutually recursive functions
221 * are regrouped in a NewVal *)
222 | Package of [`declaration | `import | `import_plugin] * string
223
224 and type_def_visibility =
225 | TDV_public (** Type definition is public, visible from anywhere. *)
226 | TDV_abstract (** Type definition is visible from anywhere but internal
227 representation is only visible inside the hosting package. Since
228 at parsing stage we don't know yet the currently compiled package,
229 the name of the package is not set and its determination is delayed
230 upon we create a QML visibility information. *)
231 | TDV_private (** Type definition is not exported outside the hosting
232 package, i.e. doesn't appear in the package's interface. Same remark
233 than above about the package name. *)
234
235 and 'ident typedef = 'ident typedef_node label
236 and 'ident typedef_node = {
237 ty_def_options : QmlAst.ty_def_options ;
238 ty_def_visibility : type_def_visibility ;
239 ty_def_name : 'ident typeident ;
240 ty_def_params : 'ident typevar list ;
241 ty_def_body :'ident ty
242 }
243
244 type ('ident, 'dir) code = ('ident, 'dir) code_elt list (**One (or more) complete source file(s)*)
245
246
247 (**
248 {5 The ast for pattern matching on xml }
249 *)
250 type 'expr namespace = {namespace : 'expr ; name : string label}
251 type 'expr xml_suffix =
252 | Xml_star
253 | Xml_plus
254 | Xml_question
255 | Xml_number of 'expr
256 | Xml_range of 'expr * 'expr
257 type 'expr xml_pattern_attribute_value =
258 | XmlExists
259 | XmlName
260 | XmlAttrStringParser of 'expr
261 | XmlAttrParser of 'expr
262 type 'expr xml_pattern_attribute =
263 (* string is a unique name used by the parser generator *)
264 'expr namespace * string option * 'expr xml_pattern_attribute_value
265 type 'expr xml_pattern =
266 | XmlLetIn of (string * 'expr) list * 'expr xml_pattern (* this node allows to bind namespaces *)
267 | XmlExpr of 'expr
268 | XmlNode of 'expr namespace *
269 'expr xml_pattern_attribute list *
270 'expr xml_named_pattern list
271 | XmlAny
272 | XmlParser of 'expr Trx_ast.item list (* no disjunction allowed to avoid parsing ambiguities *)
273 (* should we bring a node XmlSuffix -> we can write this in the syntax
274 already anyway
275 but then what about <toto a={e}>*
276 *)
277 and 'expr xml_named_pattern = string option * 'expr xml_pattern * 'expr xml_suffix label option
278 and 'expr xml_rule = 'expr xml_named_pattern list * 'expr (* one line of parser *)
279 type 'expr xml_parser =
280 'expr xml_rule list (* the alternatives *)
281
282
283 (**
284 {5 Various shorthands for directives}
285 *)
286 type magic_directive =
287 [ `magic_to_string
288 | `magic_to_xml
289
290 | `magic_do
291 (**
292 this directive is no longer used for executing a list of funaction,
293 this is just there for keeping the 'do' syntax when we reprint a parsed
294 opa code.
295 this directive is removed during the transformation into QmlAst.
296 *)
297
298 | `typeof
299 | `specialize of [ `strict | `polymorphic ]
300 ]
301 type error_directive =
302 [ `assert_
303 | `assert_message of string
304 (* TODO: remove ensure* directives (unused) *)
305 | `ensure
306 | `ensure_message of string
307 | `warning of string
308 ]
309 type coding_directive = [
310 | `deprecated
311 | `todo
312 ]
313 type insert_server_directive =
314 [ `server_entry_point
315 ]
316 type concurrency_directive =
317 [ `spawn
318 | `wait
319 | `lazy_
320 | `force
321 | `callcc
322 | `atomic
323 | `thread_context
324 | `with_thread_context
325 | `throw
326 | `catch
327 | `asynchronous_toplevel
328 | `may_cps
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 =
361 [ `translate
362 | `fun_action
363 | `js_ident
364 | `sliced_expr (** the expressions is a two elements containing first the client expression and then the server expression *)
365 | `llarray
366 (** cf doc in QmlAst *)
367 | `recval (** see QmlAst *)
368 ]
369 type alpha_renaming_directive =
370 [ `open_ (** not used anymore *)
371 | `toplevel_open
372 | `module_
373 | `toplevel
374 ]
375
376 (**
377 path * access
378 *)
379 type documentation_directive =
380 [ `doctype of string list * QmlAst.doctype_access_directive ]
381
382 type opavalue_directive = [
383 | `stringifier
384 | `comparator
385 | `serializer
386 | `xmlizer
387 ]
388
389 type basic_directive =
390 [ magic_directive
391 | coding_directive
392 | error_directive
393 | concurrency_directive
394 | file_inclusion_directive
395 | hack_directive
396 | type_directive
397 | other_directive
398 | documentation_directive
399 | insert_server_directive
400 | opavalue_directive
401 | `create_lazy_record
402 | distribution_directive
403 ]
404 (** these directives are the ones that are not taken care of in the surfaceAst
405 they go straight to qml (or fail at the conversion when not implemented)
406 If you are adding a directive that needs to go though opa to be taken care of
407 in qml, it must end up in this type
408 *)
409
410
411
412 type dependency_directive =
413 [ basic_directive
414 | access_directive
415 | `local of uids ]
416
417 type renaming_directive =
418 [ access_directive
419 | basic_directive
420 | alpha_renaming_directive ]
421 type parsing_directive =
422 [ `xml_parser of (string, parsing_directive) expr xml_parser
423 | `parser_ of (string, parsing_directive) expr Trx_ast.expr
424 | renaming_directive ]
425
426 type all_directives =
427 [ parsing_directive
428 | dependency_directive
429 | renaming_directive ]
Something went wrong with that request. Please try again.