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 |