Source file cmi_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
type pers_flags = Deprecated of string
type error =
| Not_an_interface of string
| Wrong_version_interface of string * string
| Corrupted_interface of string
exception Error of error
type cmi_infos = {
cmi_name : string;
cmi_sign : Types.signature_item list;
cmi_crcs : (string * Digest.t option) list;
cmi_flags : pers_flags list;
}
let input_cmi ic =
let name, sign = input_value ic in
let crcs = input_value ic in
let flags = input_value ic in
{ cmi_name = name; cmi_sign = sign; cmi_crcs = crcs; cmi_flags = flags }
let read_cmi filename =
let ic = open_in_bin filename in
try
let buffer =
really_input_string ic (String.length Config.cmi_magic_number)
in
if buffer <> Config.cmi_magic_number then (
close_in ic;
let pre_len = String.length Config.cmi_magic_number - 3 in
if
String.sub buffer 0 pre_len
= String.sub Config.cmi_magic_number 0 pre_len
then
let msg =
if buffer < Config.cmi_magic_number then "an older" else "a newer"
in
raise (Error (Wrong_version_interface (filename, msg)))
else raise (Error (Not_an_interface filename)));
let cmi = input_cmi ic in
close_in ic;
cmi
with
| End_of_file | Failure _ ->
close_in ic;
raise (Error (Corrupted_interface filename))
| Error e ->
close_in ic;
raise (Error e)