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
21 type t =
22 | Linkage of
23 { compilation_unit : Compilation_unit.t;
24 label : Linkage_name.t;
25 hash : int; }
26 | Variable of
27 { compilation_unit : Compilation_unit.t;
28 variable : Variable.t; }
29
30 let label t =
31 match t with
32 | Linkage { label; _ } -> label
33 | Variable { variable; _ } ->
34 (* Use the variable's compilation unit for the label, since the
35 symbol's compilation unit might be a pack *)
36 let compilation_unit = Variable.get_compilation_unit variable in
37 let unit_linkage_name =
38 Linkage_name.to_string
39 (Compilation_unit.get_linkage_name compilation_unit)
40 in
41 let label = unit_linkage_name ^ "__" ^ Variable.unique_name variable in
42 Linkage_name.create label
43
44 include Identifiable.Make (struct
45
46 type nonrec t = t
47
48 let compare t1 t2 =
49 if t1 == t2 then 0
50 else begin
51 match t1, t2 with
52 | Linkage _, Variable _ -> 1
53 | Variable _, Linkage _ -> -1
54 | Linkage l1, Linkage l2 ->
55 let c = compare l1.hash l2.hash in
56 if c <> 0 then c else begin
57 (* Linkage names are unique across a whole project, so just comparing
58 those is sufficient. *)
59 Linkage_name.compare l1.label l2.label
60 end
61 | Variable v1, Variable v2 ->
62 Variable.compare v1.variable v2.variable
63 end
64
65 let equal x y =
66 if x == y then true
67 else compare x y = 0
68
69 let output chan t =
70 Linkage_name.output chan (label t)
71
72 let hash t =
73 match t with
74 | Linkage { hash; _ } -> hash
75 | Variable { variable } -> Variable.hash variable
76
77 let print ppf t =
78 Linkage_name.print ppf (label t)
79
80 end)
81
82 let of_global_linkage compilation_unit label =
83 let hash = Linkage_name.hash label in
84 Linkage { compilation_unit; hash; label }
85
86 let of_variable variable =
87 let compilation_unit = Variable.get_compilation_unit variable in
88 Variable { variable; compilation_unit }
89
90 let import_for_pack ~pack:compilation_unit symbol =
91 match symbol with
92 | Linkage l -> Linkage { l with compilation_unit }
93 | Variable v -> Variable { v with compilation_unit }
94
95 let compilation_unit t =
96 match t with
97 | Linkage { compilation_unit; _ } -> compilation_unit
98 | Variable { compilation_unit; _ } -> compilation_unit
99
100 let print_opt ppf = function
101 | None -> Format.fprintf ppf "<no symbol>"
102 | Some t -> print ppf t
103
104 let compare_lists l1 l2 =
105 Misc.Stdlib.List.compare compare l1 l2
106