1(**************************************************************************) 2(* *) 3(* OCaml *) 4(* *) 5(* Pierre Chambart, OCamlPro *) 6(* Mark Shinwell and Leo White, Jane Street Europe *) 7(* *) 8(* Copyright 2013--2016 OCamlPro SAS *) 9(* Copyright 2014--2016 Jane Street Group LLC *) 10(* *) 11(* All rights reserved. This file is distributed under the terms of *) 12(* the GNU Lesser General Public License version 2.1, with the *) 13(* special exception on linking described in the file LICENSE. *) 14(* *) 15(**************************************************************************) 16 17[@@@ocaml.warning "+a-4-9-30-40-41-42"] 18 19let _dump_function_sizes flam ~backend = 20 let module Backend = (val backend : Backend_intf.S) in 21 let than = max_int in 22 Flambda_iterators.iter_on_set_of_closures_of_program flam 23 ~f:(fun ~constant:_ (set_of_closures : Flambda.set_of_closures) -> 24 Variable.Map.iter (fun fun_var 25 (function_decl : Flambda.function_declaration) -> 26 let closure_id = Closure_id.wrap fun_var in 27 let symbol = Backend.closure_symbol closure_id in 28 match Inlining_cost.lambda_smaller' function_decl.body ~than with 29 | Some size -> Format.eprintf "%a %d\n" Symbol.print symbol size 30 | None -> assert false) 31 set_of_closures.function_decls.funs) 32 33let middle_end ppf ~source_provenance ~prefixname ~backend 34 ~size 35 ~filename 36 ~module_ident 37 ~module_initializer = 38 let pass_number = ref 0 in 39 let round_number = ref 0 in 40 let check flam = 41 if !Clflags.flambda_invariant_checks then begin 42 try Flambda_invariants.check_exn flam 43 with exn -> 44 Misc.fatal_errorf "After Flambda pass %d, round %d:@.%s:@.%a" 45 !pass_number !round_number (Printexc.to_string exn) 46 Flambda.print_program flam 47 end 48 in 49 let (+-+) flam (name, pass) = 50 incr pass_number; 51 if !Clflags.dump_flambda_verbose then begin 52 Format.fprintf ppf "@.PASS: %s@." name; 53 Format.fprintf ppf "Before pass %d, round %d:@ %a@." !pass_number 54 !round_number Flambda.print_program flam; 55 Format.eprintf "\n@?" 56 end; 57 let timing_pass = (Timings.Flambda_pass (name, source_provenance)) in 58 let flam = Timings.accumulate_time timing_pass pass flam in 59 if !Clflags.flambda_invariant_checks then begin 60 Timings.accumulate_time (Flambda_pass ("check", source_provenance)) 61 check flam 62 end; 63 flam 64 in 65 Timings.accumulate_time 66 (Flambda_pass ("middle_end", source_provenance)) (fun () -> 67 let flam = 68 let timing_pass = 69 Timings.Flambda_pass ("closure_conversion", source_provenance) 70 in 71 Timings.accumulate_time timing_pass (fun () -> 72 module_initializer 73 |> Closure_conversion.lambda_to_flambda ~backend ~module_ident 74 ~size ~filename) 75 () 76 in 77 if !Clflags.dump_rawflambda 78 then 79 Format.fprintf ppf "After closure conversion:@ %a@." 80 Flambda.print_program flam; 81 check flam; 82 let fast_mode flam = 83 pass_number := 0; 84 let round = 0 in 85 flam 86 +-+ ("lift_lets 1", Lift_code.lift_lets) 87 +-+ ("Lift_constants", Lift_constants.lift_constants ~backend) 88 +-+ ("Share_constants", Share_constants.share_constants) 89 +-+ ("Lift_let_to_initialize_symbol", 90 Lift_let_to_initialize_symbol.lift ~backend) 91 +-+ ("Inline_and_simplify", 92 Inline_and_simplify.run ~never_inline:false ~backend 93 ~prefixname ~round) 94 +-+ ("Remove_unused_closure_vars 2", 95 Remove_unused_closure_vars.remove_unused_closure_variables 96 ~remove_direct_call_surrogates:false) 97 +-+ ("Ref_to_variables", 98 Ref_to_variables.eliminate_ref) 99 +-+ ("Initialize_symbol_to_let_symbol", 100 Initialize_symbol_to_let_symbol.run) 101 in 102 let rec loop flam = 103 pass_number := 0; 104 let round = !round_number in 105 incr round_number; 106 if !round_number > (Clflags.rounds ()) then flam 107 else 108 flam 109 (* Beware: [Lift_constants] must be run before any pass that might 110 duplicate strings. *) 111 +-+ ("lift_lets 1", Lift_code.lift_lets) 112 +-+ ("Lift_constants", Lift_constants.lift_constants ~backend) 113 +-+ ("Share_constants", Share_constants.share_constants) 114 +-+ ("Remove_unused_program_constructs", 115 Remove_unused_program_constructs.remove_unused_program_constructs) 116 +-+ ("Lift_let_to_initialize_symbol", 117 Lift_let_to_initialize_symbol.lift ~backend) 118 +-+ ("lift_lets 2", Lift_code.lift_lets) 119 +-+ ("Remove_unused_closure_vars 1", 120 Remove_unused_closure_vars.remove_unused_closure_variables 121 ~remove_direct_call_surrogates:false) 122 +-+ ("Inline_and_simplify", 123 Inline_and_simplify.run ~never_inline:false ~backend 124 ~prefixname ~round) 125 +-+ ("Remove_unused_closure_vars 2", 126 Remove_unused_closure_vars.remove_unused_closure_variables 127 ~remove_direct_call_surrogates:false) 128 +-+ ("lift_lets 3", Lift_code.lift_lets) 129 +-+ ("Inline_and_simplify noinline", 130 Inline_and_simplify.run ~never_inline:true ~backend 131 ~prefixname ~round) 132 +-+ ("Remove_unused_closure_vars 3", 133 Remove_unused_closure_vars.remove_unused_closure_variables 134 ~remove_direct_call_surrogates:false) 135 +-+ ("Ref_to_variables", 136 Ref_to_variables.eliminate_ref) 137 +-+ ("Initialize_symbol_to_let_symbol", 138 Initialize_symbol_to_let_symbol.run) 139 |> loop 140 in 141 let back_end flam = 142 flam 143 +-+ ("Remove_unused_closure_vars", 144 Remove_unused_closure_vars.remove_unused_closure_variables 145 ~remove_direct_call_surrogates:true) 146 +-+ ("Lift_constants", Lift_constants.lift_constants ~backend) 147 +-+ ("Share_constants", Share_constants.share_constants) 148 +-+ ("Remove_unused_program_constructs", 149 Remove_unused_program_constructs.remove_unused_program_constructs) 150 in 151 let flam = 152 if !Clflags.classic_inlining then 153 fast_mode flam 154 else 155 loop flam 156 in 157 let flam = back_end flam in 158 (* Check that there aren't any unused "always inline" attributes. *) 159 Flambda_iterators.iter_apply_on_program flam ~f:(fun apply -> 160 match apply.inline with 161 | Default_inline | Never_inline -> () 162 | Always_inline -> 163 (* CR-someday mshinwell: consider a different error message if 164 this triggers as a result of the propagation of a user's 165 attribute into the second part of an over application 166 (inline_and_simplify.ml line 710). *) 167 Location.prerr_warning (Debuginfo.to_location apply.dbg) 168 (Warnings.Inlining_impossible "[@inlined] attribute was not \ 169 used on this function application (the optimizer did not \ 170 know what function was being applied)") 171 | Unroll _ -> 172 Location.prerr_warning (Debuginfo.to_location apply.dbg) 173 (Warnings.Inlining_impossible "[@unroll] attribute was not \ 174 used on this function application (the optimizer did not \ 175 know what function was being applied)")); 176 if !Clflags.dump_flambda 177 then 178 Format.fprintf ppf "End of middle end:@ %a@." 179 Flambda.print_program flam; 180 check flam; 181 (* CR-someday mshinwell: add -d... option for this *) 182 (* dump_function_sizes flam ~backend; *) 183 flam) (); 184