[sledge] Move Reg.demangle to frontend

Summary:
`Reg.demangle` is implemented by calling the `_cxa_demangle` C++
runtime system function. This will be linked into the sledge binary,
due to being linked with llvm, but will not necessarily be available
in the sledge library. So make it a dynamically-set function to avoid
calling an undefined function from the library.

Reviewed By: jvillard

Differential Revision: D20323791

fbshipit-source-id: bda9afd37

sledge/src/llair/exp.ml

@@ -339,27 +339,12 @@ module Reg = struct
     let empty = Map.empty (module T)
   end
 
-  let demangle =
-    let open Ctypes in
-    let cxa_demangle =
-      (* char *__cxa_demangle(const char *, char *, size_t *, int * ) *)
-      Foreign.foreign "__cxa_demangle"
-        ( string @-> ptr char @-> ptr size_t @-> ptr int
-        @-> returning string_opt )
-    in
-    let null_ptr_char = from_voidp char null in
-    let null_ptr_size_t = from_voidp size_t null in
-    let status = allocate int 0 in
-    fun mangled ->
-      let demangled =
-        cxa_demangle mangled null_ptr_char null_ptr_size_t status
-      in
-      if !@status = 0 then demangled else None
+  let demangle = ref (fun _ -> None)
 
   let pp_demangled fs e =
     match e.desc with
     | Reg {name} -> (
-      match demangle name with
+      match !demangle name with
       | Some demangled when not (String.equal name demangled) ->
           Format.fprintf fs "“%s”" demangled
       | _ -> () )

sledge/src/llair/exp.mli

@@ -125,6 +125,7 @@ module Reg : sig
     val empty : 'a t
   end
 
+  val demangle : (string -> string option) ref
   val pp : t pp
   val pp_demangled : t pp
 

sledge/src/llair/frontend.ml

@@ -15,6 +15,24 @@ let pp_llvalue fs t = Format.pp_print_string fs (Llvm.string_of_llvalue t)
 let pp_llblock fs t =
   Format.pp_print_string fs (Llvm.string_of_llvalue (Llvm.value_of_block t))
 
+;;
+Reg.demangle :=
+  let open Ctypes in
+  let cxa_demangle =
+    (* char *__cxa_demangle(const char *, char *, size_t *, int * ) *)
+    Foreign.foreign "__cxa_demangle"
+      ( string @-> ptr char @-> ptr size_t @-> ptr int
+      @-> returning string_opt )
+  in
+  let null_ptr_char = from_voidp char null in
+  let null_ptr_size_t = from_voidp size_t null in
+  let status = allocate int 0 in
+  fun mangled ->
+    let demangled =
+      cxa_demangle mangled null_ptr_char null_ptr_size_t status
+    in
+    if !@status = 0 then demangled else None
+
 exception Invalid_llvm of string
 
 let invalid_llvm : string -> 'a =