[absint] make Set and Map functors take an ordered type

Reviewed By: jeremydubreil

Differential Revision: D5080742

fbshipit-source-id: 19245a8

infer/src/IR/Pvar.re

@@ -36,9 +36,6 @@ type pvar_kind =
 /** Names for program variables. */
 and t = {pv_hash: int, pv_name: Mangled.t, pv_kind: pvar_kind} [@@deriving compare];
 
-let compare_alpha pv1 pv2 =>
-  [%compare : (Mangled.t, pvar_kind)] (pv1.pv_name, pv1.pv_kind) (pv2.pv_name, pv2.pv_kind);
-
 let equal = [%compare.equal : t];
 
 let pp_translation_unit fmt =>
@@ -384,11 +381,3 @@ let get_initializer_pname {pv_name, pv_kind} =>
     )
   | _ => None
   };
-
-module Set =
-  PrettyPrintable.MakePPCompareSet {
-    type nonrec t = t;
-    let compare = compare;
-    let compare_pp = compare_alpha;
-    let pp = pp Pp.text;
-  };

infer/src/IR/Pvar.rei

@@ -32,10 +32,6 @@ type t [@@deriving compare];
 let equal: t => t => bool;
 
 
-/** Compare two pvar's in alphabetical order */
-let compare_alpha: t => t => int;
-
-
 /** Dump a program variable. */
 let d: t => unit;
 
@@ -174,5 +170,3 @@ let is_pod: t => bool;
 
 /** Get the procname of the initializer function for the given global variable */
 let get_initializer_pname: t => option Typ.Procname.t;
-
-module Set: PrettyPrintable.PPSet with type elt = t;

infer/src/backend/preanal.ml

@@ -95,7 +95,7 @@ module BackwardCfg = ProcCfg.OneInstrPerNode(ProcCfg.Backward(ProcCfg.Exceptiona
 
 module LivenessAnalysis = AbstractInterpreter.Make (BackwardCfg) (Liveness.TransferFunctions)
 
-module VarDomain = AbstractDomain.FiniteSet(Var.Set)
+module VarDomain = Liveness.Domain
 
 (** computes the non-nullified reaching definitions at the end of each node by building on the
     results of a liveness analysis to be precise, what we want to compute is:
@@ -208,7 +208,7 @@ let add_nullify_instrs pdesc tenv liveness_inv_map =
         match NullifyAnalysis.extract_post (ProcCfg.Exceptional.id node) nullify_inv_map with
         | Some (_, to_nullify) ->
             let pvars_to_nullify, ids_to_remove =
-              Var.Set.fold
+              VarDomain.fold
                 (fun var (pvars_acc, ids_acc) -> match Var.to_exp var with
                    (* we nullify all address taken variables at the end of the procedure *)
                    | Exp.Lvar pvar when not (AddressTaken.Domain.mem pvar address_taken_vars) ->

infer/src/base/PrettyPrintable.ml

@@ -48,17 +48,6 @@ module MakePPSet (Ord : PrintableOrderedType) = struct
     pp_collection ~pp_item:pp_element fmt (elements s)
 end
 
-module MakePPCompareSet
-    (Ord : sig include PrintableOrderedType val compare_pp : t -> t -> int end) = struct
-  include Caml.Set.Make(Ord)
-
-  let pp_element = Ord.pp
-
-  let pp fmt s =
-    let elements_alpha = List.sort ~cmp:Ord.compare_pp (elements s) in
-    pp_collection ~pp_item:pp_element fmt elements_alpha
-end
-
 module MakePPMap (Ord : PrintableOrderedType) = struct
   include Caml.Map.Make(Ord)
 

infer/src/base/PrettyPrintable.mli

@@ -35,12 +35,4 @@ end
 
 module MakePPSet (Ord : PrintableOrderedType) : (PPSet with type elt = Ord.t)
 
-(** Use a comparison function to determine the order of the elements printed *)
-module MakePPCompareSet
-    (Ord : sig
-       include PrintableOrderedType
-       val compare_pp : t -> t -> int
-     end)
-  : (PPSet with type elt = Ord.t)
-
 module MakePPMap (Ord : PrintableOrderedType) : (PPMap with type key = Ord.t)

infer/src/bufferoverrun/absLoc.ml

@@ -57,7 +57,7 @@ end
 
 module PowLoc =
 struct
-  include AbstractDomain.FiniteSet(PrettyPrintable.MakePPSet(Loc))
+  include AbstractDomain.FiniteSet(Loc)
 
   let bot = empty
   let is_bot = is_empty

infer/src/bufferoverrun/arrayBlk.ml

@@ -116,16 +116,7 @@ struct
     = fun arr1 arr2 -> { arr1 with offset = Itv.prune_ne arr1.offset arr2.offset }
 end
 
-module PPMap =
-struct
-  include PrettyPrintable.MakePPMap (Allocsite)
-
-  let pp ~pp_value fmt m =
-    let pp_item fmt (k, v) = F.fprintf fmt "(%a, %a)" pp_key k pp_value v in
-    PrettyPrintable.pp_collection ~pp_item fmt (bindings m)
-end
-
-include AbstractDomain.Map (PPMap) (ArrInfo)
+include AbstractDomain.Map (Allocsite) (ArrInfo)
 
 let bot : astate
   = empty

infer/src/bufferoverrun/bufferOverrunDomain.ml

@@ -161,8 +161,7 @@ end
 
 module ConditionSet =
 struct
-  module PPSet = PrettyPrintable.MakePPSet (Condition)
-  include AbstractDomain.FiniteSet (PPSet)
+  include AbstractDomain.FiniteSet (Condition)
 
   module Map = Caml.Map.Make (struct
       type t = Location.t [@@deriving compare]
@@ -419,28 +418,7 @@ end
 
 module Stack =
 struct
-  module PPMap =
-  struct
-    include PrettyPrintable.MakePPMap (Loc)
-
-    let pp_collection
-      : pp_item:(F.formatter -> 'a -> unit) -> F.formatter -> 'a list -> unit
-      = fun ~pp_item fmt c ->
-        let pp_sep fmt () = F.fprintf fmt ",@," in
-        F.pp_print_list ~pp_sep pp_item fmt c
-
-    let pp
-      : pp_value:(F.formatter -> 'a -> unit) -> F.formatter -> 'a t -> unit
-      = fun ~pp_value fmt m ->
-        let pp_item fmt (k, v) =
-          F.fprintf fmt "%a -> %a" Loc.pp k pp_value v
-        in
-        F.fprintf fmt "@[<v 2>{ ";
-        pp_collection ~pp_item fmt (bindings m);
-        F.fprintf fmt " }@]"
-  end
-
-  include AbstractDomain.Map (PPMap) (Val)
+  include AbstractDomain.Map (Loc) (Val)
 
   let bot = empty
 
@@ -493,7 +471,7 @@ struct
         F.fprintf fmt " }@]"
   end
 
-  include AbstractDomain.Map (PPMap) (Val)
+  include AbstractDomain.Map (Loc) (Val)
 
   let bot = empty
 

infer/src/checkers/AbstractDomain.ml

@@ -136,8 +136,8 @@ module Pair (Domain1 : S) (Domain2 : S) = struct
     F.fprintf fmt "(%a, %a)" Domain1.pp astate1 Domain2.pp astate2
 end
 
-module FiniteSet (S : PrettyPrintable.PPSet) = struct
-  include S
+module FiniteSet (Element : PrettyPrintable.PrintableOrderedType) = struct
+  include PrettyPrintable.MakePPSet(Element)
   type astate = t
 
   let (<=) ~lhs ~rhs =
@@ -172,7 +172,8 @@ module InvertedSet (S : PrettyPrintable.PPSet) = struct
     join prev next
 end
 
-module Map (M : PrettyPrintable.PPMap) (ValueDomain : S) = struct
+module Map (Key : PrettyPrintable.PrintableOrderedType) (ValueDomain : S) = struct
+  module M = PrettyPrintable.MakePPMap(Key)
   include M
   type astate = ValueDomain.astate M.t
 

infer/src/checkers/AbstractDomain.mli

@@ -67,8 +67,8 @@ module Pair (Domain1 : S) (Domain2 : S) : S with type astate = Domain1.astate *
 
 (** Lift a set to a powerset domain ordered by subset. The elements of the set should be drawn from
     a *finite* collection of possible values, since the widening operator here is just union. *)
-module FiniteSet (Set : PrettyPrintable.PPSet) : sig
-  include PrettyPrintable.PPSet with type t = Set.t and type elt = Set.elt
+module FiniteSet (Element : PrettyPrintable.PrintableOrderedType) : sig
+  include (module type of PrettyPrintable.MakePPSet(Element))
   include WithBottom with type astate = t
 end
 
@@ -80,9 +80,9 @@ end
 
 (** Map domain ordered by union over the set of bindings, so the bottom element is the empty map.
     Every element implicitly maps to bottom unless it is explicitly bound to something else *)
-module Map (Map : PrettyPrintable.PPMap) (ValueDomain : S) : sig
-  include PrettyPrintable.PPMap with type 'a t = 'a Map.t and type key = Map.key
-  include WithBottom with type astate = ValueDomain.astate Map.t
+module Map (Key : PrettyPrintable.PrintableOrderedType) (ValueDomain : S) : sig
+  include (module type of PrettyPrintable.MakePPMap(Key))
+  include WithBottom with type astate = ValueDomain.astate t
 end
 
 (** Map domain ordered by intersection over the set of bindings, so the top element is the empty

infer/src/checkers/AnnotReachabilityDomain.ml

@@ -7,8 +7,8 @@
  * of patent rights can be found in the PATENTS file in the same directory.
  *)
 
-module CallSites = AbstractDomain.FiniteSet (CallSite.Set)
+module CallSites = AbstractDomain.FiniteSet (CallSite)
 
-module SinkMap = AbstractDomain.Map (Typ.Procname.Map) (CallSites)
+module SinkMap = AbstractDomain.Map (Typ.Procname) (CallSites)
 
-include AbstractDomain.Map (Annot.Map) (SinkMap)
+include AbstractDomain.Map (Annot) (SinkMap)

infer/src/checkers/BoundedCallTree.ml

@@ -14,7 +14,7 @@ module L = Logging
 
 (** find transitive procedure calls for each procedure *)
 
-module Domain = AbstractDomain.FiniteSet(Typ.Procname.Set)
+module Domain = AbstractDomain.FiniteSet(Typ.Procname)
 
 (* Store a single stacktree frame per method. That is, callees is
    always []. Instead, the expanded per-method summaries are directly stored

infer/src/checkers/NullabilityPreanalysis.ml

@@ -14,20 +14,14 @@ open! IStd
 module F = Format
 module L = Logging
 
+module FieldsAssignedInConstructors =
+  AbstractDomain.FiniteSet(struct
     type t = Fieldname.t * Typ.t [@@deriving compare]
 
     let pp fmt (fieldname, typ) =
       F.fprintf fmt "(%a, %a)" Fieldname.pp fieldname (Typ.pp_full Pp.text) typ
-
-module DomainSet =
-  PrettyPrintable.MakePPSet(struct
-    type nonrec t = t
-    let compare = compare
-    let pp = pp
   end)
 
-module FieldsAssignedInConstructors = AbstractDomain.FiniteSet(DomainSet)
-
 module TransferFunctions (CFG : ProcCfg.S) = struct
   module CFG = CFG
   module Domain = FieldsAssignedInConstructors
@@ -94,7 +88,7 @@ let add_nonnull_to_fields fields tenv =
                  ~fields: fields_with_annot ~statics ~supers ~methods ~annots typ_name)
          | None -> ())
     | None -> () in
-  DomainSet.iter add_nonnull_to_field fields
+  FieldsAssignedInConstructors.iter add_nonnull_to_field fields
 
 let analysis cfg tenv =
   let initial = FieldsAssignedInConstructors.empty in

infer/src/checkers/SimpleChecker.ml

@@ -46,13 +46,12 @@ module Make (Spec : Spec) : S = struct
   module Domain = struct
     include
       AbstractDomain.FiniteSet
-        (PrettyPrintable.MakePPSet(
-          struct
+        (struct
           type t = Spec.astate
           let compare = Spec.compare
           let pp _ _ = ()
         end)
-        )
+
 
     let widen ~prev ~next ~num_iters =
       let iters_befor_timeout = 1000 in

infer/src/checkers/SiofDomain.ml

@@ -9,13 +9,13 @@
 
 open! IStd
 
-module VarNames = PrettyPrintable.MakePPSet(String)
+module VarNames = AbstractDomain.FiniteSet(String)
 
 module BottomSiofTrace = AbstractDomain.BottomLifted(SiofTrace)
 
 include AbstractDomain.Pair
     (BottomSiofTrace)
-    (AbstractDomain.FiniteSet(VarNames))
+    (VarNames)
 
 (** group together procedure-local accesses *)
 let normalize ((trace, initialized) as astate) = match trace with

infer/src/checkers/SiofDomain.mli

@@ -7,7 +7,9 @@
  * of patent rights can be found in the PATENTS file in the same directory.
  *)
 
-module VarNames : PrettyPrintable.PPSet with type elt = string
+open! IStd
+
+module VarNames : module type of AbstractDomain.FiniteSet(String)
 
 module BottomSiofTrace : module type of AbstractDomain.BottomLifted(SiofTrace)
 
@@ -28,7 +30,7 @@ module BottomSiofTrace : module type of AbstractDomain.BottomLifted(SiofTrace)
    std::ios_base::Init::Init(). *)
 include module type of AbstractDomain.Pair
     (AbstractDomain.BottomLifted(SiofTrace))
-    (AbstractDomain.FiniteSet(VarNames))
+    (VarNames)
 
 (** group together procedure-local accesses *)
 val normalize : astate -> astate

infer/src/checkers/ThreadSafetyDomain.ml

@@ -173,16 +173,10 @@ module AccessPrecondition = struct
     | Protected -> F.fprintf fmt "Protected"
     | Unprotected (Some index) -> F.fprintf fmt "Unprotected(%d)" index
     | Unprotected None -> F.fprintf fmt "Unprotected"
-
-  module Map = PrettyPrintable.MakePPMap(struct
-      type nonrec t = t
-      let compare = compare
-      let pp = pp
-    end)
 end
 
 module AccessDomain = struct
-  include AbstractDomain.Map (AccessPrecondition.Map) (PathDomain)
+  include AbstractDomain.Map (AccessPrecondition) (PathDomain)
 
   let add_access precondition access_path t =
     let precondition_accesses =

infer/src/checkers/ThreadSafetyDomain.mli

@@ -101,14 +101,12 @@ module AccessPrecondition : sig
   val unprotected : t
 
   val pp : F.formatter -> t -> unit
-
-  module Map : PrettyPrintable.PPMap with type key = t
 end
 
 (** map of access precondition |-> set of accesses. the map should hold all accesses to a
     possibly-unowned access path *)
 module AccessDomain : sig
-  include module type of AbstractDomain.Map (AccessPrecondition.Map) (PathDomain)
+  include module type of AbstractDomain.Map (AccessPrecondition) (PathDomain)
 
   (* add the given (access, precondition) pair to the map *)
   val add_access : AccessPrecondition.t -> TraceElem.t -> astate -> astate

infer/src/checkers/addressTaken.ml

@@ -9,7 +9,10 @@
 
 open! IStd
 
-module Domain = AbstractDomain.FiniteSet(Pvar.Set)
+module Domain = AbstractDomain.FiniteSet(struct
+    include Pvar
+    let pp = pp Pp.text
+  end)
 
 module TransferFunctions (CFG : ProcCfg.S) = struct
   module CFG = CFG

infer/src/checkers/annotationReachability.ml

@@ -42,7 +42,7 @@ let src_snk_pairs =
     specs
 
 module Domain = struct
-  module TrackingVar = AbstractDomain.FiniteSet (Var.Set)
+  module TrackingVar = AbstractDomain.FiniteSet (Var)
   module TrackingDomain = AbstractDomain.BottomLifted (TrackingVar)
   include AbstractDomain.Pair (AnnotReachabilityDomain) (TrackingDomain)
 
@@ -159,7 +159,7 @@ let lookup_annotation_calls caller_pdesc annot pname =
   | Some { Specs.payload = { Specs.annot_map = Some annot_map; }; } ->
       begin
         try
-          Annot.Map.find annot annot_map
+          AnnotReachabilityDomain.find annot annot_map
         with Not_found ->
           AnnotReachabilityDomain.SinkMap.empty
       end
@@ -309,7 +309,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
           if AnnotReachabilityDomain.CallSites.is_empty calls
           then astate
           else Domain.add_call_site annot sink call_site astate in
-        Annot.Map.fold
+        AnnotReachabilityDomain.fold
           (fun annot sink_map astate ->
              AnnotReachabilityDomain.SinkMap.fold
                (add_call_site annot)
@@ -389,7 +389,7 @@ module Interprocedural = struct
             (CallSite.make proc_name loc)
             sink_map in
       try
-        let sink_map = Annot.Map.find snk_annot annot_map in
+        let sink_map = AnnotReachabilityDomain.find snk_annot annot_map in
         List.iter ~f:(report_src_snk_path sink_map) src_annot_list
       with Not_found -> () in
 

infer/src/checkers/liveness.ml

@@ -14,7 +14,7 @@ module L = Logging
 
 (** backward analysis for computing set of maybe-live variables at each program point *)
 
-module Domain = AbstractDomain.FiniteSet(Var.Set)
+module Domain = AbstractDomain.FiniteSet(Var)
 
 (* compilers 101-style backward transfer functions for liveness analysis. gen a variable when it is
    read, kill the variable when it is assigned *)

infer/src/checkers/var.ml

@@ -28,10 +28,6 @@ let to_exp = function
   | ProgramVar pvar -> Exp.Lvar pvar
   | LogicalVar id -> Exp.Var id
 
-let compare_alpha v1 v2 = match v1, v2 with
-  | ProgramVar pv1, ProgramVar pv2 -> Pvar.compare_alpha pv1 pv2
-  | _ -> compare v1 v2
-
 let pp fmt = function
   | ProgramVar pv -> (Pvar.pp Pp.text) fmt pv
   | LogicalVar id -> (Ident.pp Pp.text) fmt id
@@ -41,10 +37,3 @@ module Map = PrettyPrintable.MakePPMap(struct
     let compare = compare
     let pp = pp
   end)
-
-module Set = PrettyPrintable.MakePPCompareSet(struct
-    type nonrec t = t
-    let compare = compare
-    let compare_pp = compare_alpha
-    let pp = pp
-  end)

infer/src/checkers/var.mli

@@ -27,5 +27,3 @@ val to_exp : t -> Exp.t
 val pp : Format.formatter -> t -> unit
 
 module Map : PrettyPrintable.PPMap with type key = t
-
-module Set : PrettyPrintable.PPSet with type elt = t

infer/src/unit/accessTreeTests.ml

@@ -13,7 +13,7 @@ module F = Format
 
 (* string set domain we use to ensure we're getting the expected traces *)
 module MockTraceDomain = struct
-  include AbstractDomain.FiniteSet (PrettyPrintable.MakePPSet (String))
+  include AbstractDomain.FiniteSet (String)
 
   let top_str = "T"
 

infer/src/unit/addressTakenTests.ml

@@ -93,7 +93,7 @@ let tests =
             );
       invariant "{ &b, &d }";
       var_assign_addrof_var ~rhs_typ:int_ptr_typ "e" "f";
-      invariant "{ &b, &d, &f }"
+      invariant "{ &b, &f, &d }"
     ];
   ] |> TestInterpreter.create_tests ProcData.empty_extras ~initial:AddressTaken.Domain.empty in
   "address_taken_suite">:::test_list

infer/src/unit/livenessTests.ml

@@ -42,7 +42,7 @@ let tests =
     ];
     "iterative_live",
     [
-      invariant "{ &b, &d, &f }";
+      invariant "{ &b, &f, &d }";
       id_assign_var "e" "f";
       invariant "{ &b, &d }";
       id_assign_var "c" "d";
@@ -91,7 +91,7 @@ let tests =
     ];
     "call_params_live",
     [
-      invariant "{ &a, &b, &c }";
+      invariant "{ &b, &a, &c }";
       call_unknown_no_ret ["a"; "b"; "c";]
     ];
     "dead_after_call_with_retval",