1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Fabrice Le Fessant, INRIA Saclay *)
6 (* *)
7 (* Copyright 2012 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
18 type pers_flags =
19 | Rectypes
20 | Alerts of alerts
21 | Opaque
22 | Unsafe_string
23
24 type error =
25 | Not_an_interface of filepath
26 | Wrong_version_interface of filepath * string
27 | Corrupted_interface of filepath
28
29 exception Error of error
30
31 type cmi_infos = {
32 cmi_name : Misc.modname;
33 cmi_sign : Types.signature_item list;
34 cmi_crcs : crcs;
35 cmi_flags : pers_flags list;
36 }
37
38 let input_cmi ic =
39 let (name, sign) = input_value ic in
40 let crcs = input_value ic in
41 let flags = input_value ic in
42 {
43 cmi_name = name;
44 cmi_sign = sign;
45 cmi_crcs = crcs;
46 cmi_flags = flags;
47 }
48
49 let read_cmi filename =
50 let ic = open_in_bin filename in
51 try
52 let buffer =
53 really_input_string ic (String.length Config.cmi_magic_number)
54 in
55 if buffer <> Config.cmi_magic_number then begin
56 close_in ic;
57 let pre_len = String.length Config.cmi_magic_number - 3 in
58 if String.sub buffer 0 pre_len
59 = String.sub Config.cmi_magic_number 0 pre_len then
60 begin
61 let msg =
62 if buffer < Config.cmi_magic_number then "an older" else "a newer" in
63 raise (Error (Wrong_version_interface (filename, msg)))
64 end else begin
65 raise(Error(Not_an_interface filename))
66 end
67 end;
68 let cmi = input_cmi ic in
69 close_in ic;
70 cmi
71 with End_of_file | Failure _ ->
72 close_in ic;
73 raise(Error(Corrupted_interface(filename)))
74 | Error e ->
75 close_in ic;
76 raise (Error e)
77
78 let output_cmi filename oc cmi =
79 (* beware: the provided signature must have been substituted for saving *)
80 output_string oc Config.cmi_magic_number;
81 output_value oc (cmi.cmi_name, cmi.cmi_sign);
82 flush oc;
83 let crc = Digest.file filename in
84 let crcs = (cmi.cmi_name, Some crc) :: cmi.cmi_crcs in
85 output_value oc crcs;
86 output_value oc cmi.cmi_flags;
87 crc
88
89 (* Error report *)
90
91 open Format
92
93 let report_error ppf = function
94 | Not_an_interface filename ->
95 fprintf ppf "%a@ is not a compiled interface"
96 Location.print_filename filename
97 | Wrong_version_interface (filename, older_newer) ->
98 fprintf ppf
99 "%a@ is not a compiled interface for this version of OCaml.@.\
100 It seems to be for %s version of OCaml."
101 Location.print_filename filename older_newer
102 | Corrupted_interface filename ->
103 fprintf ppf "Corrupted compiled interface@ %a"
104 Location.print_filename filename
105
106 let () =
107 Location.register_error_of_exn
108 (function
109 | Error err -> Some (Location.error_of_printer_file report_error err)
110 | _ -> None
111 )
112