59 lines | 2521 chars
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 |