[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,7 +123,12 @@ open struct
       in
       match maybe_scope with
       | None -> ()
-      | Some scope ->
+      | 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 ()) )
@@ -136,8 +141,8 @@ open struct
               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. *)
+                   these as they determine the labels of newly-created
+                   return blocks. *)
                 let fname =
                   match
                     Llvm.(value_name (operand llv (num_operands llv - 1)))
@@ -163,11 +168,12 @@ open struct
                 | name -> (
                   match Int.of_string name with
                   | Some _ ->
-                    (* escape to avoid clash with names of anonymous values *)
+                      (* escape to avoid clash with names of anonymous
+                         values *)
                       "\"" ^ name ^ "\""
                   | None -> name )
             in
-          SymTbl.set sym_tbl ~key:llv ~data:(name, loc)
+            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