blob: 7fb48167bc4545f0a9a7a76bea5a715add243f97 (
plain)
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
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Pierre Chambart, OCamlPro *)
(* Mark Shinwell and Leo White, Jane Street Europe *)
(* *)
(* Copyright 2013--2016 OCamlPro SAS *)
(* Copyright 2014--2016 Jane Street Group LLC *)
(* *)
(* 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. *)
(* *)
(**************************************************************************)
[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
open! Int_replace_polymorphic_compare
type t = {
id : Ident.t;
linkage_name : Linkage_name.t;
hash : int;
}
let string_for_printing t = Ident.name t.id
include Identifiable.Make (struct
type nonrec t = t
(* Multiple units can have the same [id] if they come from different packs.
To distinguish these we also keep the linkage name, which contains the
name of the pack. *)
let compare v1 v2 =
if v1 == v2 then 0
else
let c = compare v1.hash v2.hash in
if c = 0 then
let v1_id = Ident.name v1.id in
let v2_id = Ident.name v2.id in
let c = String.compare v1_id v2_id in
if c = 0 then
Linkage_name.compare v1.linkage_name v2.linkage_name
else
c
else c
let equal x y =
if x == y then true
else compare x y = 0
let print ppf t = Format.pp_print_string ppf (string_for_printing t)
let output oc x = output_string oc (Ident.name x.id)
let hash x = x.hash
end)
let create (id : Ident.t) linkage_name =
if not (Ident.persistent id) then begin
Misc.fatal_error "Compilation_unit.create with non-persistent Ident.t"
end;
{ id; linkage_name; hash = Hashtbl.hash (Ident.name id); }
let get_persistent_ident cu = cu.id
let get_linkage_name cu = cu.linkage_name
let current = ref None
let is_current arg =
match !current with
| None -> Misc.fatal_error "Current compilation unit is not set!"
| Some cur -> equal cur arg
let set_current t = current := Some t
let get_current () = !current
let get_current_exn () =
match !current with
| Some current -> current
| None -> Misc.fatal_error "Compilation_unit.get_current_exn"
let get_current_id_exn () = get_persistent_ident (get_current_exn ())
|
