Skip to content

Commit 82c8086

Browse files
poechselmshinwellxclerc
authored
flambda-backend: Use hooks for type tree and parse tree (#363)
Co-authored-by: Mark Shinwell <[email protected]> Co-authored-by: Xavier Clerc <[email protected]>
1 parent 33bbc93 commit 82c8086

File tree

4 files changed

+31
-8
lines changed

4 files changed

+31
-8
lines changed

driver/compile.ml

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,10 @@ let with_info =
2323

2424
let interface ~source_file ~output_prefix =
2525
with_info ~source_file ~output_prefix ~dump_ext:"cmi" @@ fun info ->
26-
Compile_common.interface info
26+
Compile_common.interface
27+
~hook_parse_tree:(fun _ -> ())
28+
~hook_typed_tree:(fun _ -> ())
29+
info
2730

2831
(** Bytecode compilation backend for .ml files. *)
2932

@@ -61,6 +64,10 @@ let implementation ~start_from ~source_file ~output_prefix =
6164
in
6265
with_info ~source_file ~output_prefix ~dump_ext:"cmo" @@ fun info ->
6366
match (start_from : Clflags.Compiler_pass.t) with
64-
| Parsing -> Compile_common.implementation info ~backend
67+
| Parsing ->
68+
Compile_common.implementation
69+
~hook_parse_tree:(fun _ -> ())
70+
~hook_typed_tree:(fun _ -> ())
71+
info ~backend
6572
| _ -> Misc.fatal_errorf "Cannot start from %s"
6673
(Clflags.Compiler_pass.to_string start_from)

driver/compile_common.ml

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -81,11 +81,13 @@ let emit_signature info ast tsg =
8181
Typemod.save_signature info.module_name tsg
8282
info.output_prefix info.source_file info.env sg
8383

84-
let interface info =
84+
let interface ~hook_parse_tree ~hook_typed_tree info =
8585
Profile.record_call info.source_file @@ fun () ->
8686
let ast = parse_intf info in
87+
hook_parse_tree ast;
8788
if Clflags.(should_stop_after Compiler_pass.Parsing) then () else begin
8889
let tsg = typecheck_intf info ast in
90+
hook_typed_tree tsg;
8991
if not !Clflags.print_types then begin
9092
emit_signature info ast tsg
9193
end
@@ -107,16 +109,18 @@ let typecheck_impl i parsetree =
107109
|> print_if i.ppf_dump Clflags.dump_typedtree
108110
Printtyped.implementation_with_coercion
109111

110-
let implementation info ~backend =
112+
let implementation ~hook_parse_tree ~hook_typed_tree info ~backend =
111113
Profile.record_call info.source_file @@ fun () ->
112114
let exceptionally () =
113115
let sufs = if info.native then [ cmx; obj ] else [ cmo ] in
114116
List.iter (fun suf -> remove_file (suf info)) sufs;
115117
in
116118
Misc.try_finally ?always:None ~exceptionally (fun () ->
117119
let parsed = parse_impl info in
120+
hook_parse_tree parsed;
118121
if Clflags.(should_stop_after Compiler_pass.Parsing) then () else begin
119122
let typed = typecheck_impl info parsed in
123+
hook_typed_tree typed;
120124
if Clflags.(should_stop_after Compiler_pass.Typing) then () else begin
121125
backend info typed
122126
end;

driver/compile_common.mli

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,10 @@ val emit_signature : info -> Parsetree.signature -> Typedtree.signature -> unit
6060
containing the given signature.
6161
*)
6262

63-
val interface : info -> unit
63+
val interface :
64+
hook_parse_tree:(Parsetree.signature -> unit)
65+
-> hook_typed_tree:(Typedtree.signature -> unit)
66+
-> info -> unit
6467
(** The complete compilation pipeline for interfaces. *)
6568

6669
(** {2 Implementations} *)
@@ -76,7 +79,9 @@ val typecheck_impl :
7679
*)
7780

7881
val implementation :
79-
info ->
82+
hook_parse_tree:(Parsetree.structure -> unit)
83+
-> hook_typed_tree:(Typedtree.structure * Typedtree.module_coercion -> unit)
84+
-> info ->
8085
backend:(info -> Typedtree.structure * Typedtree.module_coercion -> unit) ->
8186
unit
8287
(** The complete compilation pipeline for implementations. *)

driver/optcompile.ml

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,10 @@ let with_info =
2525

2626
let interface ~source_file ~output_prefix =
2727
with_info ~source_file ~output_prefix ~dump_ext:"cmi" @@ fun info ->
28-
Compile_common.interface info
28+
Compile_common.interface
29+
~hook_parse_tree:(fun _ -> ())
30+
~hook_typed_tree:(fun _ -> ())
31+
info
2932

3033
let (|>>) (x, y) f = (x, f y)
3134

@@ -93,7 +96,11 @@ let implementation ~backend ~start_from ~source_file ~output_prefix =
9396
in
9497
with_info ~source_file ~output_prefix ~dump_ext:"cmx" @@ fun info ->
9598
match (start_from:Clflags.Compiler_pass.t) with
96-
| Parsing -> Compile_common.implementation info ~backend
99+
| Parsing ->
100+
Compile_common.implementation
101+
~hook_parse_tree:(fun _ -> ())
102+
~hook_typed_tree:(fun _ -> ())
103+
info ~backend
97104
| Emit -> emit info
98105
| _ -> Misc.fatal_errorf "Cannot start from %s"
99106
(Clflags.Compiler_pass.to_string start_from)

0 commit comments

Comments
 (0)