Propagate Debugging Identifiers through the Middle End

middle_end/backend_var.ml

@@ -35,29 +35,33 @@ module Provenance = struct
     module_path : Path.t;
     location : Debuginfo.t;
     original_ident : Ident.t;
+    debug_uid : Flambda2_identifiers.Flambda_debug_uid.t
   }
 
-  let print ppf { module_path; location; original_ident; } =
+  let print ppf { module_path; location; original_ident; debug_uid } =
     let printf fmt = Format.fprintf ppf fmt in
     printf "@[<hov 1>(";
     printf "@[<hov 1>(module_path@ %a)@]@ "
       Path.print module_path;
     if !Clflags.locations then
       printf "@[<hov 1>(location@ %a)@]@ "
         Debuginfo.print_compact location;
-    printf "@[<hov 1>(original_ident@ %a)@]"
-      Ident.print original_ident;
+    printf "@[<hov 1>(original_ident@ %a,uid=%a)@]"
+      Ident.print original_ident
+      Flambda2_identifiers.Flambda_debug_uid.print debug_uid;
     printf ")@]"
 
-  let create ~module_path ~location ~original_ident =
+  let create ~module_path ~location ~original_ident ~debug_uid =
     { module_path;
       location;
       original_ident;
+      debug_uid
     }
 
   let module_path t = t.module_path
   let location t = t.location
   let original_ident t = t.original_ident
+  let debug_uid t = t.debug_uid
 
   let equal t1 t2 = Stdlib.compare t1 t2 = 0
 end

middle_end/backend_var.mli

@@ -31,11 +31,13 @@ module Provenance : sig
      : module_path:Path.t
     -> location:Debuginfo.t
     -> original_ident:Ident.t
+    -> debug_uid:Flambda2_identifiers.Flambda_debug_uid.t
     -> t
 
   val module_path : t -> Path.t
   val location : t -> Debuginfo.t
   val original_ident : t -> Ident.t
+  val debug_uid : t -> Flambda2_identifiers.Flambda_debug_uid.t
 
   val print : Format.formatter -> t -> unit
 

middle_end/flambda2/bound_identifiers/bound_parameter.ml

@@ -18,34 +18,45 @@ module Simple = Int_ids.Simple
 
 type t =
   { param : Variable.t;
+    uid : Flambda_debug_uid.t;
     kind : Flambda_kind.With_subkind.t
   }
 
 include Container_types.Make (struct
   type nonrec t = t
 
-  let compare { param = param1; kind = kind1 } { param = param2; kind = kind2 }
-      =
+  let compare { param = param1; kind = kind1; uid = uid1 }
+      { param = param2; kind = kind2; uid = uid2 } =
     let c = Variable.compare param1 param2 in
-    if c <> 0 then c else Flambda_kind.With_subkind.compare kind1 kind2
+    if c <> 0
+    then c
+    else
+      let c = Flambda_kind.With_subkind.compare kind1 kind2 in
+      if c <> 0 then c else Flambda_debug_uid.compare uid1 uid2
 
   let equal t1 t2 = compare t1 t2 = 0
 
-  let hash { param; kind } =
-    Hashtbl.hash (Variable.hash param, Flambda_kind.With_subkind.hash kind)
+  let hash { param; kind; uid } =
+    Hashtbl.hash
+      ( Variable.hash param,
+        Flambda_kind.With_subkind.hash kind,
+        Flambda_debug_uid.hash uid )
 
-  let [@ocamlformat "disable"] print ppf { param; kind; } =
-    Format.fprintf ppf "@[(%t%a%t @<1>\u{2237} %a)@]"
+  let [@ocamlformat "disable"] print ppf { param; kind; uid } =
+    Format.fprintf ppf "@[(%t%a,uid=%a%t @<1>\u{2237} %a)@]"
       Flambda_colours.parameter
       Variable.print param
+      Flambda_debug_uid.print uid
       Flambda_colours.pop
       Flambda_kind.With_subkind.print kind
 end)
 
-let create param kind = { param; kind }
+let create param kind uid = { param; kind; uid }
 
 let var t = t.param
 
+let var_and_uid t = t.param, t.uid
+
 let name t = Name.var (var t)
 
 let simple t = Simple.var (var t)
@@ -60,12 +71,12 @@ let is_renamed_version_of t t' =
   Flambda_kind.With_subkind.equal t.kind t'.kind
   && Variable.is_renamed_version_of t.param t'.param
 
-let free_names ({ param = _; kind = _ } as t) =
-  Name_occurrences.singleton_variable (var t) Name_mode.normal
+let free_names { param; kind = _; uid = _ } =
+  Name_occurrences.singleton_variable param Name_mode.normal
 
-let apply_renaming { param; kind } renaming =
+let apply_renaming { param; kind; uid } renaming =
   let param = Renaming.apply_variable renaming param in
-  create param kind
+  create param kind uid
 
-let ids_for_export { param; kind = _ } =
+let ids_for_export { param; kind = _; uid = _ } =
   Ids_for_export.add_variable Ids_for_export.empty param

middle_end/flambda2/bound_identifiers/bound_parameter.mli

@@ -18,11 +18,14 @@
 type t
 
 (** Create a kinded parameter. *)
-val create : Variable.t -> Flambda_kind.With_subkind.t -> t
+val create :
+  Variable.t -> Flambda_kind.With_subkind.t -> Flambda_debug_uid.t -> t
 
 (** The underlying variable. *)
 val var : t -> Variable.t
 
+val var_and_uid : t -> Variable.t * Flambda_debug_uid.t
+
 val name : t -> Name.t
 
 (** As for [var], but returns a [Simple.t] describing the variable. *)

middle_end/flambda2/bound_identifiers/bound_parameters.ml

@@ -52,6 +52,8 @@ let cardinal t = List.length t
 
 let vars t = List.map BP.var t
 
+let vars_and_uids t = List.map BP.var_and_uid t
+
 let simples t = List.map BP.simple t
 
 let to_set t = Bound_parameter.Set.of_list t

middle_end/flambda2/bound_identifiers/bound_parameters.mli

@@ -44,6 +44,8 @@ val to_set : t -> Bound_parameter.Set.t
 
 val vars : t -> Variable.t list
 
+val vars_and_uids : t -> (Variable.t * Flambda_debug_uid.t) list
+
 val var_set : t -> Variable.Set.t
 
 val iter : (Bound_parameter.t -> unit) -> t -> unit

middle_end/flambda2/bound_identifiers/bound_var.ml

@@ -16,19 +16,22 @@
 
 type t =
   { var : Variable.t;
+    debug_uid : Flambda_debug_uid.t;
     name_mode : Name_mode.t
   }
 
-let [@ocamlformat "disable"] print ppf { var; name_mode = _; } =
-  Variable.print ppf var
+let [@ocamlformat "disable"] print ppf { var; debug_uid; name_mode = _; } =
+  Format.fprintf ppf "%a,uid=%a" Variable.print var Flambda_debug_uid.print debug_uid
 
-let create var name_mode =
+let create var debug_uid name_mode =
   (* Note that [name_mode] might be [In_types], e.g. when dealing with function
      return types and also using [Typing_env.add_definition]. *)
-  { var; name_mode }
+  { var; debug_uid; name_mode }
 
 let var t = t.var
 
+let debug_uid t = t.debug_uid
+
 let name_mode t = t.name_mode
 
 let with_var t var = { t with var }
@@ -46,9 +49,11 @@ let apply_renaming t renaming =
 
 let free_names t = Name_occurrences.singleton_variable t.var t.name_mode
 
-let ids_for_export { var; name_mode = _ } =
+let ids_for_export { var; debug_uid = _; name_mode = _ } =
   Ids_for_export.add_variable Ids_for_export.empty var
 
-let renaming { var; name_mode = _ } ~guaranteed_fresh =
-  let { var = guaranteed_fresh; name_mode = _ } = guaranteed_fresh in
+let renaming { var; debug_uid = _; name_mode = _ } ~guaranteed_fresh =
+  let { var = guaranteed_fresh; debug_uid = _; name_mode = _ } =
+    guaranteed_fresh
+  in
   Renaming.add_fresh_variable Renaming.empty var ~guaranteed_fresh

middle_end/flambda2/bound_identifiers/bound_var.mli

@@ -19,10 +19,12 @@
 
 type t
 
-val create : Variable.t -> Name_mode.t -> t
+val create : Variable.t -> Flambda_debug_uid.t -> Name_mode.t -> t
 
 val var : t -> Variable.t
 
+val debug_uid : t -> Flambda_debug_uid.t
+
 val name_mode : t -> Name_mode.t
 
 val with_name_mode : t -> Name_mode.t -> t