79 lines | 2930 chars
1 | (**************************************************************************) |
2 | (* *) |
3 | (* OCaml *) |
4 | (* *) |
5 | (* Pierre Chambart, OCamlPro *) |
6 | (* Mark Shinwell and Leo White, Jane Street Europe *) |
7 | (* *) |
8 | (* Copyright 2013--2016 OCamlPro SAS *) |
9 | (* Copyright 2014--2016 Jane Street Group LLC *) |
10 | (* *) |
11 | (* All rights reserved. This file is distributed under the terms of *) |
12 | (* the GNU Lesser General Public License version 2.1, with the *) |
13 | (* special exception on linking described in the file LICENSE. *) |
14 | (* *) |
15 | (**************************************************************************) |
16 | |
17 | [@@@ocaml.warning "+a-4-9-30-40-41-42-66"] |
18 | open! Int_replace_polymorphic_compare |
19 | |
20 | type t = { |
21 | id : Ident.t; |
22 | linkage_name : Linkage_name.t; |
23 | hash : int; |
24 | } |
25 | |
26 | let string_for_printing t = Ident.name t.id |
27 | |
28 | include Identifiable.Make (struct |
29 | type nonrec t = t |
30 | |
31 | (* Multiple units can have the same [id] if they come from different packs. |
32 | To distinguish these we also keep the linkage name, which contains the |
33 | name of the pack. *) |
34 | let compare v1 v2 = |
35 | if v1 == v2 then 0 |
36 | else |
37 | let c = compare v1.hash v2.hash in |
38 | if c = 0 then |
39 | let v1_id = Ident.name v1.id in |
40 | let v2_id = Ident.name v2.id in |
41 | let c = String.compare v1_id v2_id in |
42 | if c = 0 then |
43 | Linkage_name.compare v1.linkage_name v2.linkage_name |
44 | else |
45 | c |
46 | else c |
47 | |
48 | let equal x y = |
49 | if x == y then true |
50 | else compare x y = 0 |
51 | |
52 | let print ppf t = Format.pp_print_string ppf (string_for_printing t) |
53 | |
54 | let output oc x = output_string oc (Ident.name x.id) |
55 | let hash x = x.hash |
56 | end) |
57 | |
58 | let create (id : Ident.t) linkage_name = |
59 | if not (Ident.persistent id) then begin |
60 | Misc.fatal_error "Compilation_unit.create with non-persistent Ident.t" |
61 | end; |
62 | { id; linkage_name; hash = Hashtbl.hash (Ident.name id); } |
63 | |
64 | let get_persistent_ident cu = cu.id |
65 | let get_linkage_name cu = cu.linkage_name |
66 | |
67 | let current = ref None |
68 | let is_current arg = |
69 | match !current with |
70 | | None -> Misc.fatal_error "Current compilation unit is not set!" |
71 | | Some cur -> equal cur arg |
72 | let set_current t = current := Some t |
73 | let get_current () = !current |
74 | let get_current_exn () = |
75 | match !current with |
76 | | Some current -> current |
77 | | None -> Misc.fatal_error "Compilation_unit.get_current_exn" |
78 | let get_current_id_exn () = get_persistent_ident (get_current_exn ()) |
79 |