Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 421 lines (353 sloc) 13.385 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 ]
299 type error_directive =
300 [ `assert_
301 ]
302 type coding_directive = [
303 | `deprecated
304 | `todo
305 ]
306 type insert_server_directive =
307 [ `server_entry_point
308 ]
309 type concurrency_directive =
310 [ `spawn
311 | `wait
312 | `callcc
313 | `atomic
314 | `thread_context
315 | `with_thread_context
51f92b4 [feature] adding: a no_client_calls directive
Hugo Heuzard authored
316 | `no_client_calls
fccc685 Initial open-source release
MLstate authored
317 | `throw
318 | `catch
319 | `may_cps
43a556e [cleanup] garbage: collecting some directives
Valentin Gatien-Baron authored
320 | `async
fccc685 Initial open-source release
MLstate authored
321 ]
322 type distribution_directive = QmlAst.slicer_directive
323 type file_inclusion_directive =
324 [ `static_content of string (*Relative file name*)* bool (*[true] if a [string] is expected, [false] if a [-> string] is expected*)
325 | `static_resource of string (*Relative file name*)
326 | `static_content_directory of string (*Relative file name*)* bool (*[true] if a [string] is expected, [false] if a [-> string] is expected*)
327 | `static_resource_directory of string (*Relative file name*)
328 ]
329 type access_directive =
330 [ `private_ (* visible only in the current module *)
331 | `public (* visible to everyone *)
332 | `package (* visible only in the current package *)
333 ]
334 type hack_directive =
335 [ `unsafe_cast
336 | `fail
337 | `tracker of PassTracker.t
338 | `expand of Big_int.big_int option
339 | `compiletime of string (* see pass_CompileTimeDirective *)
340 | `opacapi (* see Opacapi, and checkopacapi *)
341 ]
342 type type_directive =
343 [ `coerce
344 | `unsafe_cast
345 | `nonexpansive
346 | `opensums
347 | `openrecord
348 | `module_
349 | `module_field_lifting
350 | `warncoerce
351 ]
352 type other_directive =
43a556e [cleanup] garbage: collecting some directives
Valentin Gatien-Baron authored
353 [ `fun_action
fccc685 Initial open-source release
MLstate authored
354 | `js_ident
355 | `sliced_expr (** the expressions is a two elements containing first the client expression and then the server expression *)
356 | `llarray
357 (** cf doc in QmlAst *)
358 | `recval (** see QmlAst *)
359 ]
360 type alpha_renaming_directive =
361 [ `open_ (** not used anymore *)
362 | `toplevel_open
363 | `module_
364 | `toplevel
365 ]
366
367 (**
368 path * access
369 *)
370 type documentation_directive =
371 [ `doctype of string list * QmlAst.doctype_access_directive ]
372
373 type opavalue_directive = [
374 | `stringifier
375 | `comparator
376 | `serializer
377 | `xmlizer
378 ]
379
380 type basic_directive =
381 [ magic_directive
382 | coding_directive
383 | error_directive
384 | concurrency_directive
385 | file_inclusion_directive
386 | hack_directive
387 | type_directive
388 | other_directive
389 | documentation_directive
390 | insert_server_directive
391 | opavalue_directive
392 | `create_lazy_record
393 | distribution_directive
394 ]
395 (** these directives are the ones that are not taken care of in the surfaceAst
396 they go straight to qml (or fail at the conversion when not implemented)
397 If you are adding a directive that needs to go though opa to be taken care of
398 in qml, it must end up in this type
399 *)
400
401
402
403 type dependency_directive =
404 [ basic_directive
405 | access_directive
406 | `local of uids ]
407
408 type renaming_directive =
409 [ access_directive
410 | basic_directive
411 | alpha_renaming_directive ]
412 type parsing_directive =
413 [ `xml_parser of (string, parsing_directive) expr xml_parser
414 | `parser_ of (string, parsing_directive) expr Trx_ast.expr
415 | renaming_directive ]
416
417 type all_directives =
418 [ parsing_directive
419 | dependency_directive
420 | renaming_directive ]
Something went wrong with that request. Please try again.