package / ocaml-base-compiler.4.10.0 / middle_end / closure / closure_middle_end.ml
1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
6 (* *)
7 (* Copyright 1996 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 [@@@ocaml.warning "+a-4-30-40-41-42"]
17
18 let raw_clambda_dump_if ppf
19 ((ulambda, _, structured_constants) : Clambda.with_constants) =
20 if !Clflags.dump_rawclambda || !Clflags.dump_clambda then
21 begin
22 Format.fprintf ppf "@.clambda:@.";
23 Printclambda.clambda ppf ulambda;
24 List.iter (fun { Clambda. symbol; definition; _ } ->
25 Format.fprintf ppf "%s:@ %a@."
26 symbol
27 Printclambda.structured_constant definition)
28 structured_constants
29 end;
30 if !Clflags.dump_cmm then Format.fprintf ppf "@.cmm:@."
31
32 let lambda_to_clambda ~backend ~filename:_ ~prefixname:_ ~ppf_dump
33 (lambda : Lambda.program) =
34 let clambda =
35 Closure.intro ~backend ~size:lambda.main_module_block_size lambda.code
36 in
37 let provenance : Clambda.usymbol_provenance =
38 { original_idents = [];
39 module_path =
40 Path.Pident (Ident.create_persistent (Compilenv.current_unit_name ()));
41 }
42 in
43 let preallocated_block =
44 Clambda.{
45 symbol = Compilenv.make_symbol None;
46 exported = true;
47 tag = 0;
48 fields = List.init lambda.main_module_block_size (fun _ -> None);
49 provenance = Some provenance;
50 }
51 in
52 let constants = Compilenv.structured_constants () in
53 Compilenv.clear_structured_constants ();
54 let clambda_and_constants =
55 clambda, [preallocated_block], constants
56 in
57 raw_clambda_dump_if ppf_dump clambda_and_constants;
58 clambda_and_constants
59