Deriving.Map.Make with to_yojson

src/cdomains/arrayDomain_deprecated.ml

@@ -5,14 +5,6 @@ open Messages
 
 module A = Array
 
-type json = Yojson.Safe.t
-
-module Map = struct
-    module Make (X: sig include Map.OrderedType val to_yojson : t -> json end) = struct
-      include Map.Make (X)
-      let to_yojson poly_v x = [%to_yojson: (X.t * 'v) list] poly_v (bindings x)
-    end
-end
 
 module NativeArray (Base: Lattice.S) (Idx: IntDomain.S)
   : S with type value = Base.t and type idx = Idx.t =
@@ -334,7 +326,7 @@ struct
   include Printable.Std
   include Lattice.StdCousot
 
-  module M = Map.Make (Idx)
+  module M = Deriving.Map.Make (Idx)
 
   type t =
     | Mapping of Base.t M.t
@@ -507,7 +499,7 @@ end
  *)
 module CountingMap (Base: Lattice.S) (Idx: IntDomain.S) =
 struct
-  module M = Map.Make (Idx)
+  module M = Deriving.Map.Make (Idx)
 
   type scmap = (int ref) M.t [@@deriving to_yojson]
   type t = Base.t M.t (*map*) * scmap (*index map*) * int ref (*pos*) * int (*len*) [@@deriving to_yojson]

src/domains/mapDomain.ml

@@ -51,10 +51,7 @@ end
 
 module PMap (Domain: Groupable) (Range: Lattice.S) =
 struct
-  module M = struct
-    include Map.Make (Domain)
-    let to_yojson poly_v x = [%to_yojson: (Domain.t * 'v) list] poly_v (bindings x) (* TODO pull this into Prelude *)
-  end
+  module M = Deriving.Map.Make (Domain)
 
   include Printable.Std
   type key = Domain.t

src/util/deriving.ml

@@ -1,9 +1,19 @@
+type json = Yojson.Safe.t
 module Pervasives = struct
   type 'a ref = [%import: 'a Pervasives.ref] [@@deriving yojson]
 end
 module Stdlib = struct (* since ocaml 4.07, Stdlib (which includes Pervasives) is opened by default *)
   type 'a ref = [%import: 'a Pervasives.ref] [@@deriving yojson, show]
 end
+module Map = struct
+  (* include all of Map but Make *)
+  include (Map : module type of Map with module Make := Map.Make)
+  (* define Map.Make with to_yojson *)
+  module Make (K : sig include OrderedType val to_yojson : t -> json end) = struct
+    include Map.Make (K)
+    let to_yojson poly_v x = [%to_yojson: (K.t * 'v) list] poly_v (bindings x)
+  end
+end
 module Pretty = struct
   include Pretty
   let doc_to_yojson x = assert false
@@ -48,4 +58,4 @@ module Cil = struct
 
   let pp_varinfo fmt v = Format.fprintf fmt "%s" v.vname
   let show_varinfo v = v.vname
-end
+end