[sledge] Do not regenerate symbol name when updating loc in Frontend

Summary:
Sometimes symbols are added to the symbol table multiple times during
translation from LLVM to LLAIR. For example, this happens when a
`llvm.dbg.declare` instruction is encountered that attaches a debug
location to a symbol. Currently when this happens, the symbol name is
regenerated unnecessarily. This is not economical, and since counters
are used in some cases to avoid clashes, this can cause visible
changes to names.

This diff fixes this, and also makes the location update more robust
by not relying on the location added last being the best.

Reviewed By: jvillard

Differential Revision: D26250542

fbshipit-source-id: 5d52ce193

sledge/cli/frontend.ml

@@ -123,51 +123,57 @@ open struct
       in
       match maybe_scope with
       | None -> ()
-      | Some scope ->
-          let next, void_tbl =
-            ScopeTbl.find_or_add scope_tbl scope ~default:(fun () ->
-                (ref 0, String.Tbl.create ()) )
-          in
-          let name =
-            if
-              Poly.(
-                Llvm.classify_value llv = Instruction Call
-                && Llvm.classify_type (Llvm.type_of llv) = Void)
-            then (
-              (* LLVM does not give unique names to the result of
-                 void-returning function calls. We need unique names for
-                 these as they determine the labels of newly-created return
-                 blocks. *)
-              let fname =
-                match
-                  Llvm.(value_name (operand llv (num_operands llv - 1)))
-                with
-                | "" -> Int.to_string (!next - 1)
-                | s -> s
-              in
-              match String.Tbl.find void_tbl fname with
-              | None ->
-                  String.Tbl.set void_tbl ~key:fname ~data:1 ;
-                  fname ^ ".void"
-              | Some count ->
-                  String.Tbl.set void_tbl ~key:fname ~data:(count + 1) ;
-                  String.concat ~sep:""
-                    [fname; ".void."; Int.to_string count] )
-            else
-              match Llvm.value_name llv with
-              | "" ->
-                  (* anonymous values take the next SSA name *)
-                  let name = !next in
-                  next := name + 1 ;
-                  Int.to_string name
-              | name -> (
-                match Int.of_string name with
-                | Some _ ->
-                    (* escape to avoid clash with names of anonymous values *)
-                    "\"" ^ name ^ "\""
-                | None -> name )
-          in
-          SymTbl.set sym_tbl ~key:llv ~data:(name, loc)
+      | Some scope -> (
+        match SymTbl.find sym_tbl llv with
+        | Some (name, loc0) ->
+            if Loc.equal loc0 Loc.none then
+              SymTbl.set sym_tbl ~key:llv ~data:(name, loc)
+        | None ->
+            let next, void_tbl =
+              ScopeTbl.find_or_add scope_tbl scope ~default:(fun () ->
+                  (ref 0, String.Tbl.create ()) )
+            in
+            let name =
+              if
+                Poly.(
+                  Llvm.classify_value llv = Instruction Call
+                  && Llvm.classify_type (Llvm.type_of llv) = Void)
+              then (
+                (* LLVM does not give unique names to the result of
+                   void-returning function calls. We need unique names for
+                   these as they determine the labels of newly-created
+                   return blocks. *)
+                let fname =
+                  match
+                    Llvm.(value_name (operand llv (num_operands llv - 1)))
+                  with
+                  | "" -> Int.to_string (!next - 1)
+                  | s -> s
+                in
+                match String.Tbl.find void_tbl fname with
+                | None ->
+                    String.Tbl.set void_tbl ~key:fname ~data:1 ;
+                    fname ^ ".void"
+                | Some count ->
+                    String.Tbl.set void_tbl ~key:fname ~data:(count + 1) ;
+                    String.concat ~sep:""
+                      [fname; ".void."; Int.to_string count] )
+              else
+                match Llvm.value_name llv with
+                | "" ->
+                    (* anonymous values take the next SSA name *)
+                    let name = !next in
+                    next := name + 1 ;
+                    Int.to_string name
+                | name -> (
+                  match Int.of_string name with
+                  | Some _ ->
+                      (* escape to avoid clash with names of anonymous
+                         values *)
+                      "\"" ^ name ^ "\""
+                  | None -> name )
+            in
+            SymTbl.set sym_tbl ~key:llv ~data:(name, loc) )
   end
 
   let scan_names_and_locs : Llvm.llmodule -> unit =

sledge/nonstdlib/hashTable.ml

@@ -21,12 +21,13 @@ module Make (Key : HashedType) = struct
     update tbl ~k:key ~f:(fun _ -> function
       | None -> Some [data] | Some datas -> Some (data :: datas) )
 
+  let update tbl key ~f = update tbl ~k:key ~f:(fun _ dat -> f dat)
   let find_exn = find
   let find = find_opt
 
   let find_or_add tbl key ~default =
     let found = ref None in
-    update tbl ~k:key ~f:(fun _ -> function
+    update tbl key ~f:(function
       | None ->
           let v = default () in
           found := Some v ;

sledge/nonstdlib/hashTable_intf.ml

@@ -15,6 +15,7 @@ module type S = sig
   val create : ?size:int -> unit -> 'a t
   val set : 'a t -> key:key -> data:'a -> unit
   val add_multi : 'a list t -> key:key -> data:'a -> unit
+  val update : 'a t -> key -> f:('a option -> 'a option) -> unit
   val find_exn : 'a t -> key -> 'a
   val find : 'a t -> key -> 'a option
   val find_or_add : 'a t -> key -> default:(unit -> 'a) -> 'a