Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 481 lines (397 sloc) 13.461 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 This module is for various utility functions on QML AST.
21 See also QmlAst, QmlAstWalk and QmlAstCons for more basic operations.
22
23 @author Louis Gesbert
24 @author Rudy Sicard
25 @author Esther Baruk
26 @author Mathieu Barbin
27 @author Valentin Gatien-Baron
28 @author Quentin Bourgerie
29 *)
30
31 (** {6 Design Note (TODO)} *)
32
33 (**
34 TODO:introduce in the ast definition a notion of structural ignored
35 directives for common utils. By default, an util must traverse all
36 these directives.
37
38 {[
39 type structural_ignored_directives = [ `tracker | `coerce | `expanded_bypass, etc..]
40 let util ... =
41 let rec aux ... = function
42 | Directive (#structural_ignored_directive, e, ...) -> aux e
43 | ...
44 ]}
45
46 TODO:refactor with Lang design.
47 Currently a lot of utils are considering some assemptions about the
48 expr that are applied to, and so have [assert false] or [invalid_arg]
49 in their implementation.
50 Instead of defining them to the type [expr], they should take arguments
51 of the corresponding constructor.
52
53 TODO:the utils should define a type 'a utils working an arguments of the
54 constructor.
55
56 {[
57 (* in Lang.Ast *)
58 type expr =
59 | A of int
60 | B of expr * expr
61 | Directive of (variant, ....)
62
63 module QmlUtils =
64 struct
65 module B =
66 struct
67 let utils_1 e e' = <impl>
68 instead of
69 let old_utils_1 e =
70 match e with
71 | B (e, e') -> <impl>
72 | _ -> assert false
73 end
74 end
75 ]}
76 Typically, user of utils are doing things like :
77 {[
78 match e with
79 | ....
80 | B (a, b) ->
81 (* oups, I need an utils on B *)
82 B.utils a b
83 (* instead of *)
84 B.old_utils e
85 ]}
86 *)
87
88 val map_exprident : QmlAst.code -> ( Ident.t -> Ident.t ) -> QmlAst.code
89
90 (**
91 take the deeper expression, go through all letin, lambda ...,
92 except paramater can be used to stop on a particular expression
93 *)
94 val get_deeper_expr : ?except:(QmlAst.expr-> bool) -> QmlAst.expr -> QmlAst.expr
95 (**
96 substitute old_expr new_expr global_expr
97 =>replace in global_expr every occurence of old_expr (based on the annotation number) with new_expr
98 *)
99 val substitute : QmlAst.expr -> QmlAst.expr -> QmlAst.expr -> QmlAst.expr
100 (**
101 collect sub_expr global_expr
102 =>collect all occurence of sub_expr (based on the annotation number)
103 *)
104 val collect : QmlAst.expr -> QmlAst.expr -> QmlAst.expr list
105 (**
106 collect_annot sub_expr_annot global_expr
107 =>same as collect, but you give only the annotation number
108 *)
109 val collect_annot : Annot.t -> QmlAst.expr -> QmlAst.expr list
110
111 (**
112 checks whether a Qml expression is expensive or not
113 *)
114 val is_expansive : QmlAst.expr -> bool
115 val is_expansive_strict : QmlAst.expr -> bool
116 val is_expansive_with_options : [`disabled|`normal|`strict] -> (QmlAst.expr -> bool)
117
118 module App : sig
119 (**
120 The type of utils for an [Apply] Node
121 *)
122 type 'a util = QmlAst.expr -> QmlAst.expr list -> 'a
123
124 (**
125 Gives the number of arguments with which an expression is applied
126 Example:
127 {[
128 (((f x) y) z)
129 ]}
130 The [nary_args_number] is [1].
131
132 {[
133 ((f x) y z)
134 ]}
135 The [nary_args_number] is [2].
136
137 Not Implemented because QmlAst is not ready yet for nary applications.
138 Currently the implementation is [assert false]
139
140 {[
141 | Apply (f, args) -> nary_args_number f args
142 ]}
143 The argument [f] is not used, but we follow the interface of App.
144 *)
145 val nary_args_number : int util
146
147 (**
148 Gives the number of arguments with which an expression is applied
149 Example:
150 {[
151 (((f x) y) z t)
152 ]}
153 The [curryfied_args_number] is [4].
154 @see "nary_args_number" for nary support
155 *)
156 val curryfied_args_number : int util
157
158 (** {6 Old Util: TODO use util type} *)
159
160 val to_list : ?strict:bool -> QmlAst.expr -> QmlAst.expr list
161 (** transform an apply() to a list of function :: args
162 @param strict if [true], means there must be at list one apply node
163 for this function to succeed (so the output list has at least length 2)
164 if [false], this function never fails
165 Default is [true]
166 *)
167
168 val from_list : QmlAst.expr list -> QmlAst.expr
169 (**
170 inverse of to_list, regardless of the [strict] flag that was used
171 @raise Invalid_argument if the list is empty
172 *)
173
174 end
175
176 module ExprIdent :
177 sig
178 (**
179 get the uniq ident string from an ident expression
180 *)
181 val string : QmlAst.expr -> string
182
183 (**
184 change the content of an ident keeping the same annotation
185 *)
186 val change_ident : QmlAst.ident -> QmlAst.expr -> QmlAst.expr
187
188 (**
189 substitute all occurences of an ident by another expression
190 dont care about annotmap and annot unicity, you are warned
191 can embbed side effet in the ident substitution map,
192 to count substitution for instance
193 *)
194 val substitute : (unit -> QmlAst.expr) IdentMap.t -> QmlAst.expr -> QmlAst.expr
195 end
196
197 module Lambda :
198 sig
199 (**
200 The type of utils for a [Lambda] Node
201
202 The functions must take the two arguments of the constructor :
203 the ident and the expression
204
205 Example :
206 {[val toto e = match e with
207 | Lambda (params, expr) -> QmlAstUtils.curryfied_arity params expr
208 | _ -> 0]}
209
210 gives the curryfied_arity of the expression [e], assuming that it is a lambda
211 or 0 instead.
212 *)
213 type 'a util = QmlAst.ident list -> QmlAst.expr -> 'a
214
215 (**
216 Returns the number of arguments of [lambda] taking in consideration the nary informations.
217 Examples :
218 {[
219 fun x -> fun y, z -> x + y
220 ]}
221 The [nary_arity] is [1], where the [curryfied_arity] is [3]
222 *)
223 val nary_arity : int util
224
225 (**
226 Returns the number of arguments of a lambda without distinction between a function
227 which returns a function and its curryfied version.
228
229 {[
230 fun x -> fun y, z -> x + y
231 ]}
232 The [curryfied_arity] is [3], where the [nary_arity] is [1]
233 *)
234 val curryfied_arity : int util
235
236 (** {6 Old Utils: TODO use lambda_utils type} *)
237
238 (**
239 The function that count successive lambda node, traversing coercion node only
240 Examples :
241 count {[
242 fun x -> fun y, z -> x + y
243 ]}
244
245 return 3
246
247 @deprecated use [curryfied_arity] instead
248 *)
249 val count : QmlAst.expr -> int
250
251 (** eta-expands an expression by int argument *)
252 val eta_expand_ast : int -> QmlAst.expr -> QmlAst.expr
253
254 end
255
256 module Const : sig
257 (**
258 Compare at compile time 2 constants.
259 Assume that the two constant are of the same type,
260 assert false otherwise.
261 *)
262 val compare : QmlAst.const_expr -> QmlAst.const_expr -> int
263
264 (**
265 Checks if compare returns 0
266 *)
267 val equal : QmlAst.const_expr -> QmlAst.const_expr -> bool
268 end
269
270 module Coerce : sig
271 (** remove all nested coerces at the root of the expression, and keep information to recoerce
272 as a list of annotation and type *)
273 val uncoerce : QmlAst.expr -> QmlAst.expr * (Annot.label * QmlAst.ty) list
274
275 (** inverse of uncoerce
276 warning: the annotations are restored as they were (no consistency with an annotmap in case of type change) *)
277 val recoerce : QmlAst.expr -> (Annot.label * QmlAst.ty) list -> QmlAst.expr
278
279 (** non reversible coerce removing *)
280 val rm_coerces : QmlAst.expr -> QmlAst.expr
281 end
282
283 (** Returns an IdentSet.t of the free vars in an expression *)
284 module FreeVars :
285 sig
286 val pat : QmlAst.pat -> IdentSet.t
287 val expr : QmlAst.expr -> IdentSet.t
288
289 val pat_fold : ('a -> Annot.t -> QmlAst.ident -> 'a) -> QmlAst.pat -> 'a -> 'a
290 val expr_fold : ('a -> Annot.t -> QmlAst.ident -> 'a) -> QmlAst.expr -> 'a -> 'a
291 end
292
293 module Bypass:
294 sig
295
296 (**
297 used to introspect `expanded_bypass. return the node Bypass or `restricted bypass and the skey.
298
299 The [expr] passed to this function should be the one directly protected by the expanded_bypass
300 directive.
301
302 {[
303 | Directive (`expanded_bypass, _, Some expr, _) -> unexpand expr
304 ]}
305
306 @raise Invalid_argument if the expr is not a valid bypass
307 *)
308 val unexpand : QmlAst.expr -> BslKey.t * QmlAst.expr
309
310 (**
311 A private type for cons/decons
312 *)
313 type t
314 val unexpand_t : QmlAst.expr -> t * (BslKey.t * QmlAst.expr)
315 val expand_t : t -> QmlAst.expr -> QmlAst.expr
316 end
317
318 (**
319 Utils on Record node.
320 *)
321 module Record :
322 sig
323 type 'a util = (string * QmlAst.expr) list -> 'a
324
325 (**
326 uncons a tuple.
327 If the record is a standard tuple, ["f1", "f2", .. "fn"], will return
328 an option of the list of data of length [n]. if not, returns [None]
329 *)
330 val uncons_tuple : QmlAst.expr list option util
331
332 (**
333 special case for deprecated qml couple.
334 @deprecated Opa tuple are now the standard tuples.
335 *)
336 val uncons_qml_tuple : QmlAst.expr list option util
337
338 (**
339 Uncons a record returning the list of its fields and the list of its expressions
340 *)
341 val uncons : (string list * QmlAst.expr list) util
342
343 (**
344 Construct a record given the list of its fields and the list of expressions corresponding to the fields
345 *)
346 val cons : string list -> QmlAst.expr list -> QmlAst.expr
347
348 end
349
350 (**
351 Utils on tuples (Decons).
352
353 In the opa compiler, a tuple is a standard record where fields are nammed ["f1", "f2", "f3", etc...]
354
355 In qml side, it used to have only couple ["fst", "snd"].
356 Qml couple are deprecated, but still used in existing code.
357 Please, do not use them in new code, use only standard tuples.
358
359 Some utils are related to Types. QmlAstUtils and QmlTypesUtils will be merged
360 into QmlUtils, taking part of qmllang.
361
362 For constructing expression or type, cf module [QmlAstCons]
363 *)
364 module Tuple :
365 sig
366 (**
367 Will call internally [Record.uncons_tuple].
368 If the expression is not a record, will return [None]
369 *)
370 val uncons : QmlAst.expr -> QmlAst.expr list option
371
372 (**
373 Inspect a typeident and see if it is a tuple type. If the type is a tuple, returns its arity.
374 if not, returns [None]
375 *)
376 val uncons_typeident : QmlAst.TypeIdent.t -> int option
377
378 (**
379 Will call internally [Record.uncons_qml_couple].
380 If the expression is not a record, will return [None].
381 @deprecated Opa tuple are now the standard tuples.
382 *)
383 val uncons_qml_tuple : QmlAst.expr -> QmlAst.expr list option
384 end
385
386 (**
387 Utils on patterns
388 *)
389 module Pat :
390 sig
391 type 'a util = QmlAst.pat -> 'a
392
393 (** Tell if the pat is [true] or [false], traversing patcoercion of [TypeName "bool"] or structural patcoerce *)
394 val is_bool : bool option util
395 end
396
397 (**
398 Utils on Match node
399 *)
400 module Match :
401 sig
402 type 'a util = QmlAst.expr -> (QmlAst.pat * QmlAst.expr) list -> 'a
403
404 (** Uncons a match which was built with QmlAstCons.ifthenelse *)
405 val uncons_ifthenelse : (QmlAst.expr * QmlAst.expr * QmlAst.expr) option util
406
407 (**
408 Uncons a match, returning a triplet of
409 - the expression matched,
410 - the list of patterns,
411 - the list of resulting expressions
412 (elements in the last two lists have corresponding orders)
413 *)
414 val uncons : (QmlAst.expr * QmlAst.pat list * QmlAst.expr list) util
415
416 (**
417 Construct a match given
418 - its expression matched,
419 - its list of patterns,
420 - its list of resulting expressions
421 (elements in the last two lists have corresponding orders)
422 *)
423 val cons : QmlAst.expr -> QmlAst.pat list -> QmlAst.expr list -> QmlAst.expr
424 end
425
426 (**
427 Utils on LetIn node
428 *)
429 module LetIn :
430 sig
431 type 'a util = (QmlAst.ident * QmlAst.expr) list -> QmlAst.expr -> 'a
432
433 (** Uncons a LetIn node, returning the pair of the list of declarations list and the last expression *)
434 val uncons : ((QmlAst.ident * QmlAst.expr) list list * QmlAst.expr) util
435
436 (** Construct a LetIn node given the list of declaration list and the last expression *)
437 val cons : (QmlAst.ident * QmlAst.expr) list list -> QmlAst.expr -> QmlAst.expr
438 end
439
440 (**
441 Utils on LetRecIn node
442 *)
443 module LetRecIn :
444 sig
445 type 'a util = (QmlAst.ident * QmlAst.expr) list -> QmlAst.expr -> 'a
446
447 (** Uncons a LetRecIn node, returning the pair of the list of declarations list and the last expression *)
448 val uncons : ((QmlAst.ident * QmlAst.expr) list list * QmlAst.expr) util
449
450 (** Construct a LetRecIn node given the list of declaration list and the last expression *)
451 val cons : (QmlAst.ident * QmlAst.expr) list list -> QmlAst.expr -> QmlAst.expr
452 end
453
454 (**
455 Utils on full code
456 *)
457 module Code :
458 sig
459
460 (**
461 Insertion of a portion of code with dependencies.
462 The code is inserted just after the first dependencies starting from the end of the code.
463 Example:
464 {[
465 insert (["a"; "b"; "c"], "val h = a+b+c", ...)
466
467 g = 7
468 a = 6
469 b = 7
470 c = 7
471 h = a+b+c
472 ...
473 ]}
474 *)
475 val insert :
476 deps:IdentSet.t ->
477 insert:QmlAst.code ->
478 QmlAst.code ->
479 QmlAst.code
480 end
Something went wrong with that request. Please try again.