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 open Misc
17 open Compile_common
18
19 let tool_name = "ocamlc"
20
21 let with_info =
22 Compile_common.with_info ~native:false ~tool_name
23
24 let interface ~source_file ~output_prefix =
25 with_info ~source_file ~output_prefix ~dump_ext:"cmi" @@ fun info ->
26 Compile_common.interface info
27
28 (** Bytecode compilation backend for .ml files. *)
29
30 let to_bytecode i (typedtree, coercion) =
31 (typedtree, coercion)
32 |> Profile.(record transl)
33 (Translmod.transl_implementation i.module_name)
34 |> Profile.(record ~accumulate:true generate)
35 (fun { Lambda.code = lambda; required_globals } ->
36 lambda
37 |> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.lambda
38 |> Simplif.simplify_lambda
39 |> print_if i.ppf_dump Clflags.dump_lambda Printlambda.lambda
40 |> Bytegen.compile_implementation i.module_name
41 |> print_if i.ppf_dump Clflags.dump_instr Printinstr.instrlist
42 |> fun bytecode -> bytecode, required_globals
43 )
44
45 let emit_bytecode i (bytecode, required_globals) =
46 let cmofile = cmo i in
47 let oc = open_out_bin cmofile in
48 Misc.try_finally
49 ~always:(fun () -> close_out oc)
50 ~exceptionally:(fun () -> Misc.remove_file cmofile)
51 (fun () ->
52 bytecode
53 |> Profile.(record ~accumulate:true generate)
54 (Emitcode.to_file oc i.module_name cmofile ~required_globals);
55 )
56
57 let implementation ~source_file ~output_prefix =
58 let backend info typed =
59 let bytecode = to_bytecode info typed in
60 emit_bytecode info bytecode
61 in
62 with_info ~source_file ~output_prefix ~dump_ext:"cmo" @@ fun info ->
63 Compile_common.implementation info ~backend
64