1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
6 (* *)
7 (* Copyright 2002 Institut National de Recherche en Informatique et *)
8 (* en Automatique. *)
9 (* *)
10 (* All rights reserved. This file is distributed under the terms of *)
11 (* the GNU Lesser General Public License version 2.1, with the *)
12 (* special exception on linking described in the file LICENSE. *)
13 (* *)
14 (**************************************************************************)
15
16 (** The batch compiler *)
17
18 open Misc
19 open Compile_common
20
21 let tool_name = "ocamlopt"
22
23 let with_info =
24 Compile_common.with_info ~native:true ~tool_name
25
26 let interface ~source_file ~output_prefix =
27 with_info ~source_file ~output_prefix ~dump_ext:"cmi" @@ fun info ->
28 Compile_common.interface info
29
30 let (|>>) (x, y) f = (x, f y)
31
32 (** Native compilation backend for .ml files. *)
33
34 let flambda i backend typed =
35 if !Clflags.classic_inlining then begin
36 Clflags.default_simplify_rounds := 1;
37 Clflags.use_inlining_arguments_set Clflags.classic_arguments;
38 Clflags.unbox_free_vars_of_closures := false;
39 Clflags.unbox_specialised_args := false
40 end;
41 typed
42 |> Profile.(record transl)
43 (Translmod.transl_implementation_flambda i.module_name)
44 |> Profile.(record generate)
45 (fun {Lambda.module_ident; main_module_block_size;
46 required_globals; code } ->
47 ((module_ident, main_module_block_size), code)
48 |>> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.lambda
49 |>> Simplif.simplify_lambda
50 |>> print_if i.ppf_dump Clflags.dump_lambda Printlambda.lambda
51 |> (fun ((module_ident, main_module_block_size), code) ->
52 let program : Lambda.program =
53 { Lambda.
54 module_ident;
55 main_module_block_size;
56 required_globals;
57 code;
58 }
59 in
60 Asmgen.compile_implementation
61 ~backend
62 ~filename:i.source_file
63 ~prefixname:i.output_prefix
64 ~middle_end:Flambda_middle_end.lambda_to_clambda
65 ~ppf_dump:i.ppf_dump
66 program);
67 Compilenv.save_unit_info (cmx i))
68
69 let clambda i backend typed =
70 Clflags.use_inlining_arguments_set Clflags.classic_arguments;
71 typed
72 |> Profile.(record transl)
73 (Translmod.transl_store_implementation i.module_name)
74 |> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.program
75 |> Profile.(record generate)
76 (fun program ->
77 let code = Simplif.simplify_lambda program.Lambda.code in
78 { program with Lambda.code }
79 |> print_if i.ppf_dump Clflags.dump_lambda Printlambda.program
80 |> Asmgen.compile_implementation
81 ~backend
82 ~filename:i.source_file
83 ~prefixname:i.output_prefix
84 ~middle_end:Closure_middle_end.lambda_to_clambda
85 ~ppf_dump:i.ppf_dump;
86 Compilenv.save_unit_info (cmx i))
87
88 let implementation ~backend ~source_file ~output_prefix =
89 let backend info typed =
90 Compilenv.reset ?packname:!Clflags.for_package info.module_name;
91 if Config.flambda
92 then flambda info backend typed
93 else clambda info backend typed
94 in
95 with_info ~source_file ~output_prefix ~dump_ext:"cmx" @@ fun info ->
96 Compile_common.implementation info ~backend
97