Source file cmt_format.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*                   Fabrice Le Fessant, INRIA Saclay                     *)
(*                                                                        *)
(*   Copyright 2012 Institut National de Recherche en Informatique et     *)
(*     en Automatique.                                                    *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

open Stdlib

let read_magic_number ic =
  let len_magic_number = String.length Config.cmt_magic_number in
  really_input_string ic len_magic_number

(* Binary annotations *)
type binary_annots =
  | Packed of Types.signature * string list
  | Implementation of Typedtree.structure
  | Interface of Typedtree.signature
  | Partial_implementation of binary_part array
  | Partial_interface of binary_part array

and binary_part =
  | Partial_structure of Typedtree.structure
  | Partial_structure_item of Typedtree.structure_item
  | Partial_expression of Typedtree.expression
  | Partial_pattern of Typedtree.pattern
  | Partial_class_expr of unit
  | Partial_signature of Typedtree.signature
  | Partial_signature_item of Typedtree.signature_item
  | Partial_module_type of Typedtree.module_type

(* Simplified cmt_infos *)
type cmt_infos = {
  cmt_modname : string;
  cmt_annots : binary_annots;
  cmt_value_dependencies :
    (Types.value_description * Types.value_description) list;
  cmt_comments : (string * unit) list; (* Location.t -> unit *)
  cmt_args : string array;
  cmt_sourcefile : string option;
  cmt_builddir : string;
  cmt_loadpath : string list;
  cmt_source_digest : string option;
  cmt_initial_env : Env.t;
  cmt_imports : (string * Digest.t option) list;
  cmt_interface_digest : Digest.t option;
  cmt_use_summaries : bool;
}

(* Error handling *)
exception Error of string

let input_cmt ic = (input_value ic : cmt_infos)

let read filename =
  (*  Printf.fprintf stderr "Cmt_format.read %s\n%!" filename; *)
  let ic = open_in_bin filename in
  try
    let magic_number = read_magic_number ic in
    let cmi, cmt =
      if magic_number = Config.cmt_magic_number then (None, Some (input_cmt ic))
      else if magic_number = Config.cmi_magic_number then
        let cmi = Cmi_format.input_cmi ic in
        let cmt =
          try
            let magic_number = read_magic_number ic in
            if magic_number = Config.cmt_magic_number then
              let cmt = input_cmt ic in
              Some cmt
            else None
          with _ -> None
        in
        (Some cmi, cmt)
      else raise (Error "Invalid magic number")
    in
    close_in ic;
    (*    Printf.fprintf stderr "Cmt_format.read done\n%!"; *)
    (cmi, cmt)
  with e ->
    close_in ic;
    raise e

let read_cmt filename =
  match read filename with
  | _, None -> raise (Error "Not a typedtree")
  | _, Some cmt -> cmt

let read_cmi filename =
  match read filename with
  | None, _ -> raise (Error "Not an interface")
  | Some cmi, _ -> cmi