[sqlite] create `SQLite` serialization/deserialization modules where needed

Summary: This factors out some duplicated code for {,de}serializing source files.

Reviewed By: mbouaziz

Differential Revision: D6324234

fbshipit-source-id: 1741657

infer/src/IR/Attributes.ml

@@ -23,31 +23,6 @@ let proc_kind_of_attr (proc_attributes: ProcAttributes.t) =
   else ProcUndefined
 
 
-module type Data = sig
-  val of_pname : Typ.Procname.t -> Sqlite3.Data.t
-
-  val of_source_file : SourceFile.t -> Sqlite3.Data.t
-
-  val of_proc_attr : ProcAttributes.t -> Sqlite3.Data.t
-
-  val to_proc_attr : Sqlite3.Data.t -> ProcAttributes.t
-end
-
-module Data : Data = struct
-  let pname_to_key = Base.Hashtbl.create (module Typ.Procname) ()
-
-  let of_pname pname =
-    let default () = Sqlite3.Data.TEXT (Typ.Procname.to_filename pname) in
-    Base.Hashtbl.find_or_add pname_to_key pname ~default
-
-
-  let of_source_file file = Sqlite3.Data.TEXT (SourceFile.to_string file)
-
-  let to_proc_attr = function[@warning "-8"] Sqlite3.Data.BLOB b -> Marshal.from_string b 0
-
-  let of_proc_attr x = Sqlite3.Data.BLOB (Marshal.to_string x [])
-end
-
 let get_replace_statement =
   (* The innermost SELECT returns either the current attributes_kind and source_file associated with
      the given proc name, or default values of (-1,""). These default values have the property that
@@ -128,19 +103,21 @@ let find ~defined pname_blob =
   Sqlite3.bind select_stmt 1 pname_blob
   |> SqliteUtils.check_sqlite_error ~log:"find bind proc name" ;
   SqliteUtils.sqlite_result_step ~finalize:false ~log:"Attributes.find" select_stmt
-  |> Option.map ~f:Data.to_proc_attr
+  |> Option.map ~f:ProcAttributes.SQLite.deserialize
 
 
-let load pname = Data.of_pname pname |> find ~defined:false
+let load pname = Typ.Procname.SQLite.serialize pname |> find ~defined:false
 
 let store (attr: ProcAttributes.t) =
   let pkind = proc_kind_of_attr attr in
-  let key = Data.of_pname attr.proc_name in
+  let key = Typ.Procname.SQLite.serialize attr.proc_name in
   if should_try_to_update key pkind then
-    replace key pkind (Data.of_source_file attr.loc.Location.file) (Data.of_proc_attr attr)
+    replace key pkind
+      (SourceFile.SQLite.serialize attr.loc.Location.file)
+      (ProcAttributes.SQLite.serialize attr)
 
 
-let load_defined pname = Data.of_pname pname |> find ~defined:true
+let load_defined pname = Typ.Procname.SQLite.serialize pname |> find ~defined:true
 
 let find_file_capturing_procedure pname =
   Option.map (load pname) ~f:(fun proc_attributes ->

infer/src/IR/Cfg.ml

@@ -94,32 +94,20 @@ let check_cfg_connectedness cfg =
   List.iter ~f:do_pdesc pdescs
 
 
-module type Data = sig
-  val of_cfg : t -> Sqlite3.Data.t
-
-  val of_source_file : SourceFile.t -> Sqlite3.Data.t
-
-  val to_cfg : Sqlite3.Data.t -> t
-end
-
-module Data : Data = struct
-  let of_source_file file = Sqlite3.Data.TEXT (SourceFile.to_string file)
-
-  let of_cfg x = Sqlite3.Data.BLOB (Marshal.to_string x [])
-
-  let to_cfg = function[@warning "-8"] Sqlite3.Data.BLOB b -> Marshal.from_string b 0
-end
-
 let get_load_statement =
   ResultsDatabase.register_statement "SELECT cfgs FROM cfg WHERE source_file = :k"
 
 
+module SQLite = SqliteUtils.MarshalledData (struct
+  type nonrec t = t
+end)
+
 let load source =
   let load_stmt = get_load_statement () in
-  Data.of_source_file source |> Sqlite3.bind load_stmt 1
+  SourceFile.SQLite.serialize source |> Sqlite3.bind load_stmt 1
   |> SqliteUtils.check_sqlite_error ~log:"load bind source file" ;
   SqliteUtils.sqlite_result_step ~finalize:false ~log:"Cfg.load" load_stmt
-  |> Option.map ~f:Data.to_cfg
+  |> Option.map ~f:SQLite.deserialize
 
 
 (** Save the .attr files for the procedures in the cfg. *)
@@ -304,10 +292,10 @@ let store source_file cfg =
      sure that all attributes were written to disk (but not necessarily flushed) *)
   save_attributes source_file cfg ;
   let store_stmt = get_store_statement () in
-  Data.of_source_file source_file |> Sqlite3.bind store_stmt 1
+  SourceFile.SQLite.serialize source_file |> Sqlite3.bind store_stmt 1
   (* :source *)
   |> SqliteUtils.check_sqlite_error ~log:"store bind source file" ;
-  Data.of_cfg cfg |> Sqlite3.bind store_stmt 2
+  SQLite.serialize cfg |> Sqlite3.bind store_stmt 2
   (* :cfg *)
   |> SqliteUtils.check_sqlite_error ~log:"store bind cfg" ;
   SqliteUtils.sqlite_unit_step ~finalize:false ~log:"Cfg.store" store_stmt

infer/src/IR/ProcAttributes.ml

@@ -104,3 +104,8 @@ let default proc_name =
   ; proc_name
   ; ret_type= Typ.mk Typ.Tvoid
   ; source_file_captured= SourceFile.invalid __FILE__ }
+
+
+module SQLite = SqliteUtils.MarshalledData (struct
+  type nonrec t = t
+end)

infer/src/IR/ProcAttributes.mli

@@ -77,3 +77,5 @@ type t =
 
 val default : Typ.Procname.t -> t
 (** Create a proc_attributes with default values. *)
+
+module SQLite : SqliteUtils.Data with type t = t

infer/src/IR/Typ.ml

@@ -1052,8 +1052,6 @@ module Procname = struct
         to_unique_id p
 
 
-  let sexp_of_t p = Sexp.Atom (to_string p)
-
   (** Convenient representation of a procname for external tools (e.g. eclipse plugin) *)
   let rec to_simplified_string ?(withclass= false) p =
     match p with
@@ -1170,6 +1168,27 @@ module Procname = struct
         to_concrete_filename ?crc_only pname
 
 
+  module SQLite = struct
+    let pname_to_key =
+      Base.Hashtbl.create
+        ( module struct
+          type nonrec t = t
+
+          let compare = compare
+
+          let hash = hash
+
+          let sexp_of_t p = Sexp.Atom (to_string p)
+        end )
+        ()
+
+
+    let serialize pname =
+      let default () = Sqlite3.Data.TEXT (to_filename pname) in
+      Base.Hashtbl.find_or_add pname_to_key pname ~default
+
+  end
+
   (** given two template arguments, try to generate mapping from generic ones to concrete ones. *)
   let get_template_args_mapping generic_procname concrete_procname =
     let mapping_for_template_args (generic_name, generic_args) (concrete_name, concrete_args) =

infer/src/IR/Typ.mli

@@ -314,8 +314,6 @@ module Procname : sig
 
   val hash : t -> int
 
-  val sexp_of_t : t -> Sexp.t
-
   type java_type = string option * string
 
   type method_kind =
@@ -329,13 +327,15 @@ module Procname : sig
   module Hash : Caml.Hashtbl.S with type key = t
 
   (** Maps from proc names. *)
-
   module Map : PrettyPrintable.PPMap with type key = t
 
   (** Sets of proc names. *)
-
   module Set : PrettyPrintable.PPSet with type elt = t
 
+  module SQLite : sig
+    val serialize : t -> Sqlite3.Data.t
+  end
+
   val c : QualifiedCppName.t -> string -> template_spec_info -> is_generic_model:bool -> c
   (** Create a C procedure name from plain and mangled name. *)
 

infer/src/base/SourceFile.ml

@@ -162,3 +162,22 @@ let changed_sources_from_changed_files changed_files =
       | None ->
           changed_files' )
 
+
+module SQLite = struct
+  type nonrec t = t
+
+  let serialize = function
+    | RelativeProjectRoot path ->
+        (* show the most common paths as text (for debugging, possibly perf) *)
+        Sqlite3.Data.TEXT path
+    | _ as x ->
+        Sqlite3.Data.BLOB (Marshal.to_string x [])
+
+
+  let deserialize = function[@warning "-8"]
+    | Sqlite3.Data.TEXT rel_path ->
+        RelativeProjectRoot rel_path
+    | Sqlite3.Data.BLOB b ->
+        Marshal.from_string b 0
+
+end

infer/src/base/SourceFile.mli

@@ -71,3 +71,5 @@ val to_string : t -> string
 (** convert a source file to a string
     WARNING: result may not be valid file path, do not use this function to perform operations
              on filenames *)
+
+module SQLite : SqliteUtils.Data with type t = t

infer/src/base/SqliteUtils.ml

@@ -79,3 +79,22 @@ let db_close db =
             (Sqlite3.errcode db |> Sqlite3.Rc.to_string)
             (Sqlite3.errmsg db)))
 
+
+module type Data = sig
+  type t
+
+  val serialize : t -> Sqlite3.Data.t
+
+  val deserialize : Sqlite3.Data.t -> t
+end
+
+module MarshalledData (D : sig
+  type t
+end) =
+struct
+  type t = D.t
+
+  let deserialize = function[@warning "-8"] Sqlite3.Data.BLOB b -> Marshal.from_string b 0
+
+  let serialize x = Sqlite3.Data.BLOB (Marshal.to_string x [])
+end

infer/src/base/SqliteUtils.mli

@@ -33,3 +33,18 @@ val sqlite_unit_step : ?finalize:bool -> log:string -> Sqlite3.stmt -> unit
 
 val db_close : Sqlite3.db -> unit
 (** Close the given database and asserts that it was effective. Raises [Error] if not. *)
+
+(** An API commonly needed to store and retrieve objects from the database *)
+module type Data = sig
+  type t
+
+  val serialize : t -> Sqlite3.Data.t
+
+  val deserialize : Sqlite3.Data.t -> t
+end
+
+(** A default implementation of the Data API that encodes every objects as marshalled blobs *)
+module MarshalledData (D : sig
+  type t
+end) :
+  Data with type t = D.t