Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 543 lines (435 sloc) 18.826 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
adc190b @BourgerieQuentin [enhance] compiler: Added to PassHandler the switch handler
BourgerieQuentin authored
314 (** [switch_handler select switch_pass] [select] should produce from
315 pass environment a value that be used by [switch_pass] to switch
316 to the wanted pass. *)
317 val switch_handler :
318 (options:'opt -> 'env -> 'switch) ->
319 ('switch -> (string * (('opt, 'opt2, 'env, 'env2) pass))) ->
320 ('opt, 'env) one_env -> ('opt2, 'env2) one_env
321
fccc685 Initial open-source release
MLstate authored
322 (** Compose if functions. The resulting function return true if all
323 composed functions returns true.*)
324 val and_if :
325 (options:'opt -> 'env -> bool) list -> (options:'opt -> 'env -> bool)
326
327 (** Compose if functions. The resulting function return true if at
328 least one composed functions returns true.*)
329 val or_if :
330 (options:'opt -> 'env -> bool) list -> (options:'opt -> 'env -> bool)
331
332 (**{6:binop Binary operators} *)
333 (** A binary operator for [handler] *)
334 val (|+>) :
335 ('opt, 'env) one_env ->
336 (passname * ('opt, 'opt2, 'env, 'env2) pass) ->
337 ('opt2, 'env2) one_env
338
339 (** A binary operator for [if_handler] *)
340 val (|?>) :
341 ('opt, 'env) one_env ->
342 ((options:'opt -> 'env -> bool) *
343 passname * ('opt, 'opt, 'env, 'env) pass) ->
344 ('opt, 'env) one_env
345
adc190b @BourgerieQuentin [enhance] compiler: Added to PassHandler the switch handler
BourgerieQuentin authored
346 (** A binary operator for [alt_handler] *)
fccc685 Initial open-source release
MLstate authored
347 val (<?>) :
348 ('opt, 'env) one_env ->
349 ((options:'opt -> 'env -> bool)
350 * (passname * (('opt, 'opt2, 'env, 'env2) pass))
351 * (passname * (('opt, 'opt2, 'env, 'env2) pass))) ->
352 ('opt2, 'env2) one_env
353
adc190b @BourgerieQuentin [enhance] compiler: Added to PassHandler the switch handler
BourgerieQuentin authored
354 (** A binary operator for [switch_handler] *)
355 val (|?|) :
356 ('opt, 'env) one_env ->
357 (options:'opt -> 'env -> 'switch) *
358 ('switch -> (string * (('opt, 'opt2, 'env, 'env2) pass))) ->
359 ('opt2, 'env2) one_env
360
fccc685 Initial open-source release
MLstate authored
361 (** A binary operator for make a pipe [a |> f] equals to [f a] *)
362 val (|>) : 'a -> ('a -> 'b) -> 'b
363
364 (**
365 A few combinators for if_handlers
366 *)
367 val (or) : (options:'opt -> 'env -> bool) -> (options:'opt -> 'env -> bool) -> (options:'opt -> 'env -> bool)
368 val (&) : (options:'opt -> 'env -> bool) -> (options:'opt -> 'env -> bool) -> (options:'opt -> 'env -> bool)
369 val neg : (options:'opt -> 'env -> bool) -> (options:'opt -> 'env -> bool)
370
371 (**{6 Error management} *)
372
373 (**
374 Internally, the [handler] function performs checks, printing, tracking, etc...
375 For the good behavior of the system, error flows should be controlled,
376 for an optimal reporting.
377
378 That means that a discipline is asked to what passes and checkers do
379 in case of errors. They should follow the rules.
380 *)
381
382 (**{9 Functions used by passes}*)
383
384 (**
385 This functions are called indirectly by a pass when a condition has been
386 violated but was not checked before the pass.
387 It is not called directly, but overlayed with a [LangError] module, which
388 precise once for all the ['context printer] corresponding to the context
389 of the language it checks.
390
391 During the passsystem, if this function is called, it will lead to try to
392 start the corresponding check on the previous compilation environment
393 (the one returned by the previous pass), for having a better error report.
394
395 If the precondition is found in the list of precondition of the pass,
396 the check is done. If the test was already activated, somebody is laying,
397 this error is reported too. If the precondition is not part of the pass,
398 the pass is declared incoherent, and the error is reported.
399
400 It stores everything possible in the track system, and exit.
401
402 Do not use this function Outside of the passsystem, this function
403 would raise an internal exception not exported in the api.
404 *)
405 val cond_violation : 'context printer -> cond_id -> 'context -> ('c, 'error) OManager.oformat -> 'c
406
407 (**
408 The same function as [cond_violation] but returns unit.
409 It allows you to report several errors before failing.
410 *)
411 val scond_violation : 'context printer -> cond_id -> 'context -> ('c, unit) OManager.oformat -> 'c
412
413 (**
414 Anonymous Internal error.
415
416 Sense of the [cond_id option]
417 + With [Some cond_id] : it is an alias for [cond_violation]
418 + With [None] :
419 Basically the same function than [cond_violation], but this error cannot be related to a precondition.
420
421 Why we let the [cond_id option] in the interface ? So that if you uses this function, and
422 ask yourself about what you should do with it, it will normally lead you until this part
423 of the documentation. So please, read the following :
424
425 <!> The case [None] is pretty rare, so consider that if you are using this function without precising
426 a related condition to your internal error, you could maybe extract for your current problem
427 a generic enough invariant to be checked officially at some point during the passes, and let
428 potentially other passes take benefits of this check.
429
430 If you need a new condition, consider adding this condition in the [LangCheck] module
431 corresponding to the language your are compiling, and then add the precondition to your pass,
432 and finally use [Some cond] or directly [cond_violation] instead of [i_error] in your pass.
433 *)
434 val i_error : 'context printer -> cond_id option -> 'context -> ('c, 'error) OManager.oformat -> 'c
435
436 (** The same function [i_error] but returns unit for several errors reporting *)
437 val i_serror : 'context printer -> cond_id option -> 'context -> ('c, unit) OManager.oformat -> 'c
438
439 (** {9 Functions used by conditions checkers} *)
440
441 (**
442 Condition failure: [check_fail] and [scheck_fail].
443
444 + These functions are usually not called directly by checkers because it would duplicate
445 the work of context formatting for a same language. (how to print an error message depending
446 on the expressions, code kind your are manipulating, etc...)
447 + Normally, you should find a [LangError] module dedicated to your language which uses
448 this functions but applying specifics [printers] and [context] once for all, so that
449 you can call directly functions from [LangError] without specifying the printers used
450 for error reporting in your language.
451 + There is a simple functor in [PassError] for making the life of [LangError] easier.
452 + If you are outside of a language, or if your context is very different that the
453 common error context defined in [LangError], you are invited to call this function directly,
454 specifying [printers] which apply to your local ad-hoc context.
455 + Typically, these functions are indirectly used in [LangCheck] modules, using the [LangError]
456 redefinition. [LangError] is invited to keep the same names by redefining functions, for clarity.
457 + These functions should not be used by a pass, only by checkers !
458 if a pass failed because of a broken invariant related to a cond,
459 the pass should use a function from [LangError] dedicated to this case.
460
461 Order of args are for partial application :
462 The [LangError] module knows how to print its own context
463 because it defines the type context :
464
465 In langError.ml :
466 {[
467 type context = ...
468 let context_printer = ....
469 let check_fail c = PassHandler.check_fail context_printer c
470 ]}
471
472 In a checker, we will use :
473 {[
474 let rewrite ... =
475 let context = ... in
476 Lang.Error.check_fail context Lang.Check.Cond.check "%s is broken" "this invariant"
477 ]}
478
479 Finally for readability of the code, you can define as soon as you have the context in your scope
480 an alias for [Lang.Error.check_fail] with e.g. ['!!'] which looks like a danger sign.
481
482 {[
483 let my_check code =
484 let rec aux expr =
485 ....
486 (* from there you can build your context, and then : *)
487 let (!!) = Lang.error.check_fail mycond_id context in
488 ...
489 match ... with
490 | ... -> !! "this is an %s" "error"
491 | e -> !! "an other one related to %s" (... e)
492 ]}
493
494 *)
495
496 (**
497 What is happening with a [check_fail] ?
498
499 + Will store the full context in the track system, using the [full] printer
500 + Will print a reduced version on stderr using the [console] printer
501 + Will call a warning with the given format, using the warning class of the cond_id
502
503 @see "PassError" for a common implementation of context overlay.
504 *)
505 val check_fail : full:'context printer -> console:'context printer -> cond_id -> 'context -> ('c, 'error) OManager.oformat -> 'c
506
507 (**
508 The same function, but for outputting many messages without killing the check with the first error.
509 *)
510 val scheck_fail : full:'context printer -> console:'context printer -> cond_id -> 'context -> ('c, unit) OManager.oformat -> 'c
511
512 (** {6 Marshal Pass} *)
513
514 val register_printer : (PassTracker.passname -> ('opt -> (printer_id * 'env PassTracker.printer) list) option) -> unit
515
516 (** {6 Deprecated API} *)
517
518 (** Old passes handlers
519 This handlers shouldn't used except for handle old passes which are not yet ported, or which will never be. *)
520
521 (** Type of an old pass.
522 @deprecated Use [pass]
523 *)
524 type ('opt, 'env, 'env2) old_pass = options:'opt -> 'env -> 'env2
525
526 (** Handle old passes which transform environment. Generated
527 environment contains default printer and tracker.
528 @deprecated Use [handler] *)
529 val old_handler :
530 ?precond:('env cond list) ->
531 ?postcond:('env2 cond list) ->
532 passname -> ('opt, 'env, 'env2) old_pass ->
533 ('opt, 'env) one_env -> ('opt, 'env2) one_env
534
535 (** Handle old passes.
536 @deprecated Use [if_handler] *)
537 val old_if_handler :
538 ?if_:(options:'opt -> 'env -> bool) ->
539 ?precond:('env cond list) ->
540 ?postcond:('env cond list) ->
541 passname -> ('opt, 'env, 'env) old_pass ->
542 ('opt, 'env) one_env -> ('opt, 'env) one_env
Something went wrong with that request. Please try again.