Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 528 lines (422 sloc) 18.276 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 Generic Library for compilers working in passes.
20
21 @author Mathieu Barbin
22 @author Quentin Bourgerie
23 @author Valentin Gatien-Baron
24 *)
25
26 (**
27 {6 A compiler working in passes}
28
29 - First {b parse command line} with module [Arg] and adding to options
30 specifications [Arg.options].
31
32 - Second {b write your passes} Your passes can have
33 preconditions and/or postconditions (See {!passCond}). And it
34 should have a function which compute on a environment and
35 eventually redefine [printer] and [iter_tracker], mostly if the
36 environment type has been transformed.
37
38 - Third {b create initial environment}, you can use either
39 [init] for make a empty environment or [make_env] for make your
40 initial environment.
41
42 - Finally {b handle your passes}. You can use two programming
43 style for make this.
44
45 {9 Simple programming style}
46
47 Use the pass handlers functions (See Section {!passHandlers})
48 Thereafter a typical example :
49 {[
50 let _ = Arg.parse (PassHandler.Arg.options @ ... ) ...
51
52 (* An if function *)
53 let if_toto ~options e = options.toto
54
55 (* The main handling *)
56 let e = PassHandler.init
57 let e = PassHandler.handler "MyFirstPass" pass_First
58 let e = PassHandler.if_handler ~if_:if_toto "MyTotoPass" pass_Toto
59 ...
60 let r = PassHandler.return e
61 ]}
62
63 {9 Binary operators programming style}
64
65 For handle your passes you can use also the binary operators (See
66 {!binop}), it's a most pretty programming style. You can see that
67 on this example :
68 {[
69 (* Parsing command line *)
70 let _ = Arg.parse (PassHandler.Arg.options @ ... ) ...
71
72 (* An if function *)
73 let if_toto ~options e = options.toto
74
75 (* The main handling *)
76 open PassHandler
77
78 let r =
79 init
80 |+> ("MyFirstPass", pass_First)
81 |?> (if_toto,
82 "MyTotoPass", pass_Toto)
83 ...
84 |> return
85 ]}
86
87 *)
88
89 (** {6 Options} *)
90 (** Provides a specification list for parse line command. *)
91 module Arg : sig
92 (* TODO: document this *)
93 (** The specification list of options for [PassHandler]. Define :
94 - --check-all
95 - --check-pass
96 - --check
97 - --track-all
98 - --track-pass
99 - --track
100 - --track-dir
101 - --print-all
102 - --print-pass
103 - --print
104 *)
105 val options : (Base.Arg.key * Base.Arg.spec * Base.Arg.doc) list
106
107 end
108
109 (** Set title of the pass system.*)
110 val set_title : string -> unit
111
112 (**{6 Passes environment} *)
113
114 (** Just a alias for readability of the interface *)
115 type passname = string
116
117 (** Type of a env printer *)
118 type 'env printer = 'env PassTracker.printer
119
120 (** Type of a env tracker *)
121 type 'env tracker = 'env PassTracker.tracker
122
123 (**
124 Type for identifying printers and trackers
125
126 use [--print-help | --track-help] for listing all available printers
127 and trackers.
128 Constructor of id are [define_printer] and [define_tracker]
129 *)
130 (** *)
131 type printer_id
132 type tracker_id
133
134 (**
135 Type of environment
136
137 The environment contains a local ['env] which is the real compilation
138 environment, the [options] of the compilation, and [printers] and [trackers]
139 are functions to follow the transformations of the 'env along of passes.
140
141 Todo: see if there is generalization problems if we remove the ['opt ->]
142 from [printers and trackers]. Maybe the interface would be simpler.
143 *)
144 type ('opt, 'env) one_env = {
145 env : 'env;
146 options : 'opt;
147 printers : 'opt -> (printer_id * 'env printer) list;
148 trackers : 'opt -> (tracker_id * 'env tracker) list;
149 }
150
151 (** Create a environment. By default have no printers and no
152 trackers. *)
153 val make_env :
154 ?printers:('opt -> (printer_id * 'env printer) list) ->
155 ?trackers:('opt -> (tracker_id * 'env tracker) list) ->
156 'opt -> 'env -> ('opt, 'env) one_env
157
158 (**{6:passCond Passes condition} *)
159 (** Type of identifier of condition *)
160 type cond_id
161
162 (** Type of pass condition *)
163 type 'env cond
164
165 (**
166 Define a condition on the pass handler system.
167
168 This function does a side effect on a local table.
169 Conditions are related to a specific warning class,
170 which must be a child of the [cond] warning class.
171 @see "WarningClass" for pre/post conditions warnings
172 @raise Invalid_argument if the condition is already
173 defined.
174 *)
175 val define_cond : WarningClass.wclass -> cond_id
176
177 (**
178 Define a printer on the pass handler system.
179
180 Like [define_cond], this function does a side effect on
181 a local table, for checking the presence of a printer
182 when the compiler is called with the option [--print]
183 @raise Invalid_argument if the condition is already
184 defined.
185 *)
186 val define_printer : string -> printer_id
187
188 (**
189 Same function than [define_printer] but for tracker [--track]
190 instead of printer.
191 *)
192 val define_tracker : string -> tracker_id
193
194 (**
195 Return the string version of a cond_id.
196 It is the same string than the string version
197 of the warning class, which is the same string
198 than what parse WarningClass.Arg.options.
199
200 Example: ["cond.annot.unicity"]
201 Warning class are hierarchic, and children are separated
202 by a '.'
203
204 @see "WarningClass" for more details.
205 *)
206 val cond_id : cond_id -> string
207
208 (**
209 Return the string version of a printer_id
210 *)
211 val printer_id : printer_id -> string
212
213 (**
214 Return the string version of a tracker_id
215 *)
216 val tracker_id : tracker_id -> string
217
218 (** Make a condition.
219 + The first argument is the [cond_id] of the
220 condition which must have been created with [define_cond].
221 + Second it's a function to check the environment.
222 The function which checks the environment should necessarily use
223 a function dedicated to condition checkers if it want to fail.
224 + ErrorManagment in this module
225 + [LangCheck.check_fail] and related functions
226
227 Internally, the good way for a checker to fail is to perform
228 a warning of its class definition. That is what is done
229 in any higher level function which takes all the [cond_id]
230 as argument which has been built with the warning class,
231 so that no confusion is possible.
232
233 Read carefully the documentation before writing a checker.*)
234 val make_condition : cond_id -> ('env -> unit) -> 'env cond
235
236 (**
237 Compose condition.
238 It asserts that all conditions have been built with the same [cond_id].
239 Uses [List.hd] internally.
240 *)
241 val compose_condition : 'env cond list -> 'env cond
242
243 (**
244 Apply a function before the condition evaluation
245 *)
246 val compose_fun_condition : ('env_a -> 'env_b) -> 'env_b cond -> 'env_a cond
247
248 (** Check a condition. Usefull for check yourself a condition. *)
249 val check_condition : 'env -> 'env cond -> unit
250
251 (**{6 Invariants} *)
252 (** Type of an invariant *)
253 type ('env, 'env2) invariant
254
255 (** Make an invariant with two conditions. These conditions must be
256 have the same id else raise [Invalid_argument]. *)
257 val make_invariant : 'env cond -> 'env2 cond -> ('env, 'env2) invariant
258
259 (**
260 Make a new invariant with another environement : we apply a function before the invariant checking
261 *)
262 val compose_fun_invariant : ('env_1b -> 'env_1a) -> ('env_2b -> 'env_2a) -> ('env_1a, 'env_2a) invariant -> ('env_1b, 'env_2b) invariant
263
264 (** Make an invariant for a constant pass. *)
265 val make_cons_invariant : 'env cond -> ('env, 'env) invariant
266
267 (** {6 Passes}*)
268 (** Type of pass. *)
269 type ('opt, 'opt2, 'env, 'env2) pass = {
270 invariant : ('env, 'env2) invariant list;
271 precond : 'env cond list;
272 postcond : 'env2 cond list;
273 f : ('opt, 'env) one_env -> ('opt2, 'env2) one_env;
274 }
275
276 (** Make a pass from a function which takes a environment and returns an
277 another. And from optional pre and post conditions. *)
278 val make_pass :
279 ?invariant:('env, 'env2) invariant list ->
280 ?precond:'env cond list ->
281 ?postcond:'env2 cond list ->
282 (('opt, 'env) one_env -> ('opt2, 'env2) one_env) ->
283 ('opt, 'opt2, 'env, 'env2) pass
284
285 (**{6:passHandlers Passes handlers} *)
286 (** Initial (or unit) environment. *)
287 val init : (unit, unit) one_env
288
289 (** Return handler, extract environment of generic environment. *)
290 val return : ('opt, 'env) one_env -> 'env
291
292 (** [handler name pass] Handle [pass] named by the given [name].
293 [count_time] indicates whether the time of this pass should be stored
294 *)
295 val handler :
296 ?count_time:bool ->
297 passname -> ('opt, 'opt2, 'env, 'env2) pass ->
298 ('opt, 'env) one_env -> ('opt2, 'env2) one_env
299
300 (** Handle pass if [_if] returns true. *)
301 val if_handler :
302 ?if_:(options:'opt -> 'env -> bool) ->
303 passname -> ('opt, 'opt, 'env, 'env) pass ->
304 ('opt, 'env) one_env -> ('opt, 'env) one_env
305
306 (** [alt_handler if_ (name1, pass1) (name2, pass2)] handle pass1 if
307 [if_] return [true] else handle pass2 *)
308 val alt_handler :
309 (options:'opt -> 'env -> bool) ->
310 (string * (('opt, 'opt2, 'env, 'env2) pass)) ->
311 (string * (('opt, 'opt2, 'env, 'env2) pass)) ->
312 ('opt, 'env) one_env -> ('opt2, 'env2) one_env
313
314 (** Compose if functions. The resulting function return true if all
315 composed functions returns true.*)
316 val and_if :
317 (options:'opt -> 'env -> bool) list -> (options:'opt -> 'env -> bool)
318
319 (** Compose if functions. The resulting function return true if at
320 least one composed functions returns true.*)
321 val or_if :
322 (options:'opt -> 'env -> bool) list -> (options:'opt -> 'env -> bool)
323
324 (**{6:binop Binary operators} *)
325 (** A binary operator for [handler] *)
326 val (|+>) :
327 ('opt, 'env) one_env ->
328 (passname * ('opt, 'opt2, 'env, 'env2) pass) ->
329 ('opt2, 'env2) one_env
330
331 (** A binary operator for [if_handler] *)
332 val (|?>) :
333 ('opt, 'env) one_env ->
334 ((options:'opt -> 'env -> bool) *
335 passname * ('opt, 'opt, 'env, 'env) pass) ->
336 ('opt, 'env) one_env
337
338 (** A binary options for [alt_handler] *)
339 val (<?>) :
340 ('opt, 'env) one_env ->
341 ((options:'opt -> 'env -> bool)
342 * (passname * (('opt, 'opt2, 'env, 'env2) pass))
343 * (passname * (('opt, 'opt2, 'env, 'env2) pass))) ->
344 ('opt2, 'env2) one_env
345
346 (** A binary operator for make a pipe [a |> f] equals to [f a] *)
347 val (|>) : 'a -> ('a -> 'b) -> 'b
348
349 (**
350 A few combinators for if_handlers
351 *)
352 val (or) : (options:'opt -> 'env -> bool) -> (options:'opt -> 'env -> bool) -> (options:'opt -> 'env -> bool)
353 val (&) : (options:'opt -> 'env -> bool) -> (options:'opt -> 'env -> bool) -> (options:'opt -> 'env -> bool)
354 val neg : (options:'opt -> 'env -> bool) -> (options:'opt -> 'env -> bool)
355
356 (**{6 Error management} *)
357
358 (**
359 Internally, the [handler] function performs checks, printing, tracking, etc...
360 For the good behavior of the system, error flows should be controlled,
361 for an optimal reporting.
362
363 That means that a discipline is asked to what passes and checkers do
364 in case of errors. They should follow the rules.
365 *)
366
367 (**{9 Functions used by passes}*)
368
369 (**
370 This functions are called indirectly by a pass when a condition has been
371 violated but was not checked before the pass.
372 It is not called directly, but overlayed with a [LangError] module, which
373 precise once for all the ['context printer] corresponding to the context
374 of the language it checks.
375
376 During the passsystem, if this function is called, it will lead to try to
377 start the corresponding check on the previous compilation environment
378 (the one returned by the previous pass), for having a better error report.
379
380 If the precondition is found in the list of precondition of the pass,
381 the check is done. If the test was already activated, somebody is laying,
382 this error is reported too. If the precondition is not part of the pass,
383 the pass is declared incoherent, and the error is reported.
384
385 It stores everything possible in the track system, and exit.
386
387 Do not use this function Outside of the passsystem, this function
388 would raise an internal exception not exported in the api.
389 *)
390 val cond_violation : 'context printer -> cond_id -> 'context -> ('c, 'error) OManager.oformat -> 'c
391
392 (**
393 The same function as [cond_violation] but returns unit.
394 It allows you to report several errors before failing.
395 *)
396 val scond_violation : 'context printer -> cond_id -> 'context -> ('c, unit) OManager.oformat -> 'c
397
398 (**
399 Anonymous Internal error.
400
401 Sense of the [cond_id option]
402 + With [Some cond_id] : it is an alias for [cond_violation]
403 + With [None] :
404 Basically the same function than [cond_violation], but this error cannot be related to a precondition.
405
406 Why we let the [cond_id option] in the interface ? So that if you uses this function, and
407 ask yourself about what you should do with it, it will normally lead you until this part
408 of the documentation. So please, read the following :
409
410 <!> The case [None] is pretty rare, so consider that if you are using this function without precising
411 a related condition to your internal error, you could maybe extract for your current problem
412 a generic enough invariant to be checked officially at some point during the passes, and let
413 potentially other passes take benefits of this check.
414
415 If you need a new condition, consider adding this condition in the [LangCheck] module
416 corresponding to the language your are compiling, and then add the precondition to your pass,
417 and finally use [Some cond] or directly [cond_violation] instead of [i_error] in your pass.
418 *)
419 val i_error : 'context printer -> cond_id option -> 'context -> ('c, 'error) OManager.oformat -> 'c
420
421 (** The same function [i_error] but returns unit for several errors reporting *)
422 val i_serror : 'context printer -> cond_id option -> 'context -> ('c, unit) OManager.oformat -> 'c
423
424 (** {9 Functions used by conditions checkers} *)
425
426 (**
427 Condition failure: [check_fail] and [scheck_fail].
428
429 + These functions are usually not called directly by checkers because it would duplicate
430 the work of context formatting for a same language. (how to print an error message depending
431 on the expressions, code kind your are manipulating, etc...)
432 + Normally, you should find a [LangError] module dedicated to your language which uses
433 this functions but applying specifics [printers] and [context] once for all, so that
434 you can call directly functions from [LangError] without specifying the printers used
435 for error reporting in your language.
436 + There is a simple functor in [PassError] for making the life of [LangError] easier.
437 + If you are outside of a language, or if your context is very different that the
438 common error context defined in [LangError], you are invited to call this function directly,
439 specifying [printers] which apply to your local ad-hoc context.
440 + Typically, these functions are indirectly used in [LangCheck] modules, using the [LangError]
441 redefinition. [LangError] is invited to keep the same names by redefining functions, for clarity.
442 + These functions should not be used by a pass, only by checkers !
443 if a pass failed because of a broken invariant related to a cond,
444 the pass should use a function from [LangError] dedicated to this case.
445
446 Order of args are for partial application :
447 The [LangError] module knows how to print its own context
448 because it defines the type context :
449
450 In langError.ml :
451 {[
452 type context = ...
453 let context_printer = ....
454 let check_fail c = PassHandler.check_fail context_printer c
455 ]}
456
457 In a checker, we will use :
458 {[
459 let rewrite ... =
460 let context = ... in
461 Lang.Error.check_fail context Lang.Check.Cond.check "%s is broken" "this invariant"
462 ]}
463
464 Finally for readability of the code, you can define as soon as you have the context in your scope
465 an alias for [Lang.Error.check_fail] with e.g. ['!!'] which looks like a danger sign.
466
467 {[
468 let my_check code =
469 let rec aux expr =
470 ....
471 (* from there you can build your context, and then : *)
472 let (!!) = Lang.error.check_fail mycond_id context in
473 ...
474 match ... with
475 | ... -> !! "this is an %s" "error"
476 | e -> !! "an other one related to %s" (... e)
477 ]}
478
479 *)
480
481 (**
482 What is happening with a [check_fail] ?
483
484 + Will store the full context in the track system, using the [full] printer
485 + Will print a reduced version on stderr using the [console] printer
486 + Will call a warning with the given format, using the warning class of the cond_id
487
488 @see "PassError" for a common implementation of context overlay.
489 *)
490 val check_fail : full:'context printer -> console:'context printer -> cond_id -> 'context -> ('c, 'error) OManager.oformat -> 'c
491
492 (**
493 The same function, but for outputting many messages without killing the check with the first error.
494 *)
495 val scheck_fail : full:'context printer -> console:'context printer -> cond_id -> 'context -> ('c, unit) OManager.oformat -> 'c
496
497 (** {6 Marshal Pass} *)
498
499 val register_printer : (PassTracker.passname -> ('opt -> (printer_id * 'env PassTracker.printer) list) option) -> unit
500
501 (** {6 Deprecated API} *)
502
503 (** Old passes handlers
504 This handlers shouldn't used except for handle old passes which are not yet ported, or which will never be. *)
505
506 (** Type of an old pass.
507 @deprecated Use [pass]
508 *)
509 type ('opt, 'env, 'env2) old_pass = options:'opt -> 'env -> 'env2
510
511 (** Handle old passes which transform environment. Generated
512 environment contains default printer and tracker.
513 @deprecated Use [handler] *)
514 val old_handler :
515 ?precond:('env cond list) ->
516 ?postcond:('env2 cond list) ->
517 passname -> ('opt, 'env, 'env2) old_pass ->
518 ('opt, 'env) one_env -> ('opt, 'env2) one_env
519
520 (** Handle old passes.
521 @deprecated Use [if_handler] *)
522 val old_if_handler :
523 ?if_:(options:'opt -> 'env -> bool) ->
524 ?precond:('env cond list) ->
525 ?postcond:('env cond list) ->
526 passname -> ('opt, 'env, 'env) old_pass ->
527 ('opt, 'env) one_env -> ('opt, 'env) one_env
Something went wrong with that request. Please try again.