Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 456 lines (378 sloc) 12.815 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 {[
3394108 [clean] most passes: removing @expanded_bypass
Valentin Gatien-Baron authored
39 type structural_ignored_directives = [ `tracker | `coerce, etc..]
fccc685 Initial open-source release
MLstate authored
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
978b7c4 @akoprow [fix] typo: occurence->occurrence, occured->occurred
akoprow authored
97 =>replace in global_expr every occurrence of old_expr (based on the annotation number) with new_expr
fccc685 Initial open-source release
MLstate authored
98 *)
99 val substitute : QmlAst.expr -> QmlAst.expr -> QmlAst.expr -> QmlAst.expr
100 (**
101 collect sub_expr global_expr
978b7c4 @akoprow [fix] typo: occurence->occurrence, occured->occurred
akoprow authored
102 =>collect all occurrence of sub_expr (based on the annotation number)
fccc685 Initial open-source release
MLstate authored
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 (**
978b7c4 @akoprow [fix] typo: occurence->occurrence, occured->occurred
akoprow authored
189 substitute all occurrences of an ident by another expression
fccc685 Initial open-source release
MLstate authored
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 (**
294 Utils on Record node.
295 *)
296 module Record :
297 sig
298 type 'a util = (string * QmlAst.expr) list -> 'a
299
300 (**
301 uncons a tuple.
302 If the record is a standard tuple, ["f1", "f2", .. "fn"], will return
303 an option of the list of data of length [n]. if not, returns [None]
304 *)
305 val uncons_tuple : QmlAst.expr list option util
306
307 (**
308 special case for deprecated qml couple.
309 @deprecated Opa tuple are now the standard tuples.
310 *)
311 val uncons_qml_tuple : QmlAst.expr list option util
312
313 (**
314 Uncons a record returning the list of its fields and the list of its expressions
315 *)
316 val uncons : (string list * QmlAst.expr list) util
317
318 (**
319 Construct a record given the list of its fields and the list of expressions corresponding to the fields
320 *)
321 val cons : string list -> QmlAst.expr list -> QmlAst.expr
322
323 end
324
325 (**
326 Utils on tuples (Decons).
327
328 In the opa compiler, a tuple is a standard record where fields are nammed ["f1", "f2", "f3", etc...]
329
330 In qml side, it used to have only couple ["fst", "snd"].
331 Qml couple are deprecated, but still used in existing code.
332 Please, do not use them in new code, use only standard tuples.
333
334 Some utils are related to Types. QmlAstUtils and QmlTypesUtils will be merged
335 into QmlUtils, taking part of qmllang.
336
337 For constructing expression or type, cf module [QmlAstCons]
338 *)
339 module Tuple :
340 sig
341 (**
342 Will call internally [Record.uncons_tuple].
343 If the expression is not a record, will return [None]
344 *)
345 val uncons : QmlAst.expr -> QmlAst.expr list option
346
347 (**
348 Inspect a typeident and see if it is a tuple type. If the type is a tuple, returns its arity.
349 if not, returns [None]
350 *)
351 val uncons_typeident : QmlAst.TypeIdent.t -> int option
352
353 (**
354 Will call internally [Record.uncons_qml_couple].
355 If the expression is not a record, will return [None].
356 @deprecated Opa tuple are now the standard tuples.
357 *)
358 val uncons_qml_tuple : QmlAst.expr -> QmlAst.expr list option
359 end
360
361 (**
362 Utils on patterns
363 *)
364 module Pat :
365 sig
366 type 'a util = QmlAst.pat -> 'a
367
368 (** Tell if the pat is [true] or [false], traversing patcoercion of [TypeName "bool"] or structural patcoerce *)
369 val is_bool : bool option util
370 end
371
372 (**
373 Utils on Match node
374 *)
375 module Match :
376 sig
377 type 'a util = QmlAst.expr -> (QmlAst.pat * QmlAst.expr) list -> 'a
378
379 (** Uncons a match which was built with QmlAstCons.ifthenelse *)
380 val uncons_ifthenelse : (QmlAst.expr * QmlAst.expr * QmlAst.expr) option util
381
382 (**
383 Uncons a match, returning a triplet of
384 - the expression matched,
385 - the list of patterns,
386 - the list of resulting expressions
387 (elements in the last two lists have corresponding orders)
388 *)
389 val uncons : (QmlAst.expr * QmlAst.pat list * QmlAst.expr list) util
390
391 (**
392 Construct a match given
393 - its expression matched,
394 - its list of patterns,
395 - its list of resulting expressions
396 (elements in the last two lists have corresponding orders)
397 *)
398 val cons : QmlAst.expr -> QmlAst.pat list -> QmlAst.expr list -> QmlAst.expr
399 end
400
401 (**
402 Utils on LetIn node
403 *)
404 module LetIn :
405 sig
406 type 'a util = (QmlAst.ident * QmlAst.expr) list -> QmlAst.expr -> 'a
407
408 (** Uncons a LetIn node, returning the pair of the list of declarations list and the last expression *)
409 val uncons : ((QmlAst.ident * QmlAst.expr) list list * QmlAst.expr) util
410
411 (** Construct a LetIn node given the list of declaration list and the last expression *)
412 val cons : (QmlAst.ident * QmlAst.expr) list list -> QmlAst.expr -> QmlAst.expr
413 end
414
415 (**
416 Utils on LetRecIn node
417 *)
418 module LetRecIn :
419 sig
420 type 'a util = (QmlAst.ident * QmlAst.expr) list -> QmlAst.expr -> 'a
421
422 (** Uncons a LetRecIn node, returning the pair of the list of declarations list and the last expression *)
423 val uncons : ((QmlAst.ident * QmlAst.expr) list list * QmlAst.expr) util
424
425 (** Construct a LetRecIn node given the list of declaration list and the last expression *)
426 val cons : (QmlAst.ident * QmlAst.expr) list list -> QmlAst.expr -> QmlAst.expr
427 end
428
429 (**
430 Utils on full code
431 *)
432 module Code :
433 sig
434
435 (**
436 Insertion of a portion of code with dependencies.
437 The code is inserted just after the first dependencies starting from the end of the code.
438 Example:
439 {[
440 insert (["a"; "b"; "c"], "val h = a+b+c", ...)
441
442 g = 7
443 a = 6
444 b = 7
445 c = 7
446 h = a+b+c
447 ...
448 ]}
449 *)
450 val insert :
451 deps:IdentSet.t ->
452 insert:QmlAst.code ->
453 QmlAst.code ->
454 QmlAst.code
455 end
Something went wrong with that request. Please try again.