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 |