[sledge] Improve using extended open

Summary:
OCaml 4.08 supports `open` of arbitrary module expressions. This
enables some code simplifications.

Reviewed By: ngorogiannis

Differential Revision: D18736381

fbshipit-source-id: c729dcfbd

sledge/src/llair/frontend.ml

@@ -37,92 +37,93 @@ let scope_tbl :
     Hashtbl.t =
   Hashtbl.Poly.create ~size:32_768 ()
 
-let ( (scan_names_and_locs : Llvm.llmodule -> unit)
-    , (find_name : Llvm.llvalue -> string)
-    , (find_loc : Llvm.llvalue -> Loc.t) ) =
-  let loc_of_global g =
-    Loc.mk
-      ?dir:(Llvm.get_debug_loc_directory g)
-      ?file:(Llvm.get_debug_loc_filename g)
-      ~line:(Llvm.get_debug_loc_line g)
-      ?col:None
-  in
-  let loc_of_function f =
-    Loc.mk
-      ?dir:(Llvm.get_debug_loc_directory f)
-      ?file:(Llvm.get_debug_loc_filename f)
-      ~line:(Llvm.get_debug_loc_line f)
-      ?col:None
-  in
-  let loc_of_instr i =
-    Loc.mk
-      ?dir:(Llvm.get_debug_loc_directory i)
-      ?file:(Llvm.get_debug_loc_filename i)
-      ~line:(Llvm.get_debug_loc_line i)
-      ~col:(Llvm.get_debug_loc_column i)
-  in
-  let add_sym llv loc =
-    let maybe_scope =
-      match Llvm.classify_value llv with
-      | Argument -> Some (`Fun (Llvm.param_parent llv))
-      | BasicBlock ->
-          Some (`Fun (Llvm.block_parent (Llvm.block_of_value llv)))
-      | Instruction _ ->
-          Some (`Fun (Llvm.block_parent (Llvm.instr_parent llv)))
-      | GlobalVariable | Function -> Some (`Mod (Llvm.global_parent llv))
-      | UndefValue -> None
-      | ConstantExpr -> None
-      | ConstantPointerNull -> None
-      | _ ->
-          warn "Unexpected type of llv, might crash: %a" pp_llvalue llv () ;
-          Some (`Mod (Llvm.global_parent llv))
-    in
-    match maybe_scope with
-    | None -> ()
-    | Some scope ->
-        let next, void_tbl =
-          Hashtbl.find_or_add scope_tbl scope ~default:(fun () ->
-              (ref 0, Hashtbl.Poly.create ()) )
-        in
-        let name =
-          match Llvm.classify_type (Llvm.type_of llv) with
-          | Void -> (
-              let fname =
-                match Llvm.classify_value llv with
-                | Instruction (Call | Invoke) -> (
-                  match
-                    Llvm.value_name
-                      (Llvm.operand llv (Llvm.num_operands llv - 1))
-                  with
-                  | "" -> Int.to_string (!next - 1)
-                  | s -> s )
-                | _ -> "void"
-              in
-              match Hashtbl.find void_tbl fname with
-              | None ->
-                  Hashtbl.set void_tbl ~key:fname ~data:1 ;
-                  fname ^ ".void"
-              | Some count ->
-                  Hashtbl.set void_tbl ~key:fname ~data:(count + 1) ;
-                  String.concat_array
-                    [|fname; ".void."; Int.to_string count|] )
-          | _ -> (
-            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
-              | _ ->
-                  (* escape to avoid clash with names of anonymous values *)
-                  String.concat_array [|"\""; name; "\""|]
-              | exception _ -> name ) )
-        in
-        Hashtbl.set sym_tbl ~key:llv ~data:(name, loc)
-  in
-  let scan_names_and_locs m =
+open struct
+  open struct
+    let loc_of_global g =
+      Loc.mk
+        ?dir:(Llvm.get_debug_loc_directory g)
+        ?file:(Llvm.get_debug_loc_filename g)
+        ~line:(Llvm.get_debug_loc_line g)
+        ?col:None
+
+    let loc_of_function f =
+      Loc.mk
+        ?dir:(Llvm.get_debug_loc_directory f)
+        ?file:(Llvm.get_debug_loc_filename f)
+        ~line:(Llvm.get_debug_loc_line f)
+        ?col:None
+
+    let loc_of_instr i =
+      Loc.mk
+        ?dir:(Llvm.get_debug_loc_directory i)
+        ?file:(Llvm.get_debug_loc_filename i)
+        ~line:(Llvm.get_debug_loc_line i)
+        ~col:(Llvm.get_debug_loc_column i)
+
+    let add_sym llv loc =
+      let maybe_scope =
+        match Llvm.classify_value llv with
+        | Argument -> Some (`Fun (Llvm.param_parent llv))
+        | BasicBlock ->
+            Some (`Fun (Llvm.block_parent (Llvm.block_of_value llv)))
+        | Instruction _ ->
+            Some (`Fun (Llvm.block_parent (Llvm.instr_parent llv)))
+        | GlobalVariable | Function -> Some (`Mod (Llvm.global_parent llv))
+        | UndefValue -> None
+        | ConstantExpr -> None
+        | ConstantPointerNull -> None
+        | _ ->
+            warn "Unexpected type of llv, might crash: %a" pp_llvalue llv () ;
+            Some (`Mod (Llvm.global_parent llv))
+      in
+      match maybe_scope with
+      | None -> ()
+      | Some scope ->
+          let next, void_tbl =
+            Hashtbl.find_or_add scope_tbl scope ~default:(fun () ->
+                (ref 0, Hashtbl.Poly.create ()) )
+          in
+          let name =
+            match Llvm.classify_type (Llvm.type_of llv) with
+            | Void -> (
+                let fname =
+                  match Llvm.classify_value llv with
+                  | Instruction (Call | Invoke) -> (
+                    match
+                      Llvm.value_name
+                        (Llvm.operand llv (Llvm.num_operands llv - 1))
+                    with
+                    | "" -> Int.to_string (!next - 1)
+                    | s -> s )
+                  | _ -> "void"
+                in
+                match Hashtbl.find void_tbl fname with
+                | None ->
+                    Hashtbl.set void_tbl ~key:fname ~data:1 ;
+                    fname ^ ".void"
+                | Some count ->
+                    Hashtbl.set void_tbl ~key:fname ~data:(count + 1) ;
+                    String.concat_array
+                      [|fname; ".void."; Int.to_string count|] )
+            | _ -> (
+              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
+                | _ ->
+                    (* escape to avoid clash with names of anonymous values *)
+                    String.concat_array [|"\""; name; "\""|]
+                | exception _ -> name ) )
+          in
+          Hashtbl.set sym_tbl ~key:llv ~data:(name, loc)
+  end
+
+  let scan_names_and_locs : Llvm.llmodule -> unit =
+   fun m ->
     let scan_global g = add_sym g (loc_of_global g) in
     let scan_instr i =
       let loc = loc_of_instr i in
@@ -152,10 +153,13 @@ let ( (scan_names_and_locs : Llvm.llmodule -> unit)
     in
     Llvm.iter_globals scan_global m ;
     Llvm.iter_functions scan_function m
-  in
-  let find_name v = fst (Hashtbl.find_exn sym_tbl v) in
-  let find_loc v = snd (Hashtbl.find_exn sym_tbl v) in
-  (scan_names_and_locs, find_name, find_loc)
+
+  let find_name : Llvm.llvalue -> string =
+   fun v -> fst (Hashtbl.find_exn sym_tbl v)
+
+  let find_loc : Llvm.llvalue -> Loc.t =
+   fun v -> snd (Hashtbl.find_exn sym_tbl v)
+end
 
 let label_of_block : Llvm.llbasicblock -> string =
  fun blk -> find_name (Llvm.value_of_block blk)