variable.ml

(**************************************************************************)
(*                                                                        *)
(*                                 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 = {
  compilation_unit : Compilation_unit.t;
  name : string;
  name_stamp : int;
  (** [name_stamp]s are unique within any given compilation unit. *)
}

include Identifiable.Make (struct
  type nonrec t = t

  let compare t1 t2 =
    if t1 == t2 then 0
    else
      let c = t1.name_stamp - t2.name_stamp in
      if c <> 0 then c
      else Compilation_unit.compare t1.compilation_unit t2.compilation_unit

  let equal t1 t2 =
    if t1 == t2 then true
    else
      t1.name_stamp = t2.name_stamp
        && Compilation_unit.equal t1.compilation_unit t2.compilation_unit

  let output chan t =
    output_string chan t.name;
    output_string chan "_";
    output_string chan (Int.to_string t.name_stamp)

  let hash t = t.name_stamp lxor (Compilation_unit.hash t.compilation_unit)

  let print ppf t =
    if Compilation_unit.equal t.compilation_unit
        (Compilation_unit.get_current_exn ())
    then begin
      Format.fprintf ppf "%s/%d"
        t.name t.name_stamp
    end else begin
      Format.fprintf ppf "%a.%s/%d"
        Compilation_unit.print t.compilation_unit
        t.name t.name_stamp
    end
end)

let previous_name_stamp = ref (-1)

let create_with_name_string ?current_compilation_unit name =
  let compilation_unit =
    match current_compilation_unit with
    | Some compilation_unit -> compilation_unit
    | None -> Compilation_unit.get_current_exn ()
  in
  let name_stamp =
    incr previous_name_stamp;
    !previous_name_stamp
  in
  { compilation_unit;
    name;
    name_stamp;
  }

let create ?current_compilation_unit name =
  let name = (name : Internal_variable_names.t :> string) in
  create_with_name_string ?current_compilation_unit name

let create_with_same_name_as_ident ident =
  create_with_name_string (Ident.name ident)

let rename ?current_compilation_unit t =
  create_with_name_string ?current_compilation_unit t.name

let in_compilation_unit t cu =
  Compilation_unit.equal cu t.compilation_unit

let get_compilation_unit t = t.compilation_unit

let name t = t.name

let unique_name t =
  t.name ^ "_" ^ (Int.to_string t.name_stamp)

let print_list ppf ts =
  List.iter (fun t -> Format.fprintf ppf "@ %a" print t) ts

let debug_when_stamp_matches t ~stamp ~f =
  if t.name_stamp = stamp then f ()

let print_opt ppf = function
  | None -> Format.fprintf ppf "<no var>"
  | Some t -> print ppf t

type pair = t * t
module Pair = Identifiable.Make (Identifiable.Pair (T) (T))

let compare_lists l1 l2 =
  Misc.Stdlib.List.compare compare l1 l2

let output_full chan t =
  Compilation_unit.output chan t.compilation_unit;
  output_string chan ".";
  output chan t