[HIL] simplify some functors around TransferFunctions

Summary:
A lot of functors that take a `Make{SIL,HIL}` can take a `{SIL,HIL}`
directly instead. This makes my head hurt a bit less.

Reviewed By: mbouaziz

Differential Revision: D13416967

fbshipit-source-id: eb0b33bc4

infer/src/absint/LowerHil.ml

@@ -36,12 +36,7 @@ module MakeHILDomain (Domain : AbstractDomain.S) = struct
     Domain.pp fmt astate
 end
 
-module Make
+module Make (TransferFunctions : TransferFunctions.HIL) (HilConfig : HilConfig) = struct
-    (MakeTransferFunctions : TransferFunctions.MakeHIL)
-    (HilConfig : HilConfig)
-    (CFG : ProcCfg.S) =
-struct
-  module TransferFunctions = MakeTransferFunctions (CFG)
   module CFG = TransferFunctions.CFG
   module Domain = MakeHILDomain (TransferFunctions.Domain)
 
@@ -95,13 +90,25 @@ struct
     else (actual_state', id_map')
 end
 
+module type S = sig
+  module Interpreter : AbstractInterpreter.S
+
+  type domain
+
+  val compute_post :
+    Interpreter.TransferFunctions.extras ProcData.t -> initial:domain -> domain option
+end
+
 module MakeAbstractInterpreterWithConfig
     (MakeAbstractInterpreter : AbstractInterpreter.Make)
     (HilConfig : HilConfig)
-    (CFG : ProcCfg.S)
+    (TransferFunctions : TransferFunctions.HIL) :
-    (MakeTransferFunctions : TransferFunctions.MakeHIL) =
+  S
-struct
+  with type domain = TransferFunctions.Domain.t
-  module Interpreter = MakeAbstractInterpreter (Make (MakeTransferFunctions) (HilConfig) (CFG))
+   and module Interpreter = MakeAbstractInterpreter(Make(TransferFunctions)(HilConfig)) = struct
+  module Interpreter = MakeAbstractInterpreter (Make (TransferFunctions) (HilConfig))
+
+  type domain = TransferFunctions.Domain.t
 
   let compute_post ({ProcData.pdesc; tenv} as proc_data) ~initial =
     Preanal.do_preanalysis pdesc tenv ;
@@ -120,5 +127,6 @@ struct
     Interpreter.compute_post ~pp_instr proc_data ~initial:initial' |> Option.map ~f:fst
 end
 
-module MakeAbstractInterpreter =
+module MakeAbstractInterpreter (TransferFunctions : TransferFunctions.HIL) =
   MakeAbstractInterpreterWithConfig (AbstractInterpreter.MakeRPO) (DefaultConfig)
+    (TransferFunctions)

infer/src/absint/LowerHil.mli

@@ -15,13 +15,15 @@ end
 module DefaultConfig : HilConfig
 
 (** Functor for turning HIL transfer functions into SIL transfer functions *)
-module Make
+module Make (TransferFunctions : TransferFunctions.HIL) (HilConfig : HilConfig) : sig
-    (MakeTransferFunctions : TransferFunctions.MakeHIL)
+  module CFG :
-    (HilConfig : HilConfig)
+    ProcCfg.S
-    (CFG : ProcCfg.S) : sig
+    with type t = TransferFunctions.CFG.t
-  module TransferFunctions : module type of MakeTransferFunctions (CFG)
+     and type instrs_dir = TransferFunctions.CFG.instrs_dir
-
+     and type Node.t = TransferFunctions.CFG.Node.t
-  module CFG : module type of TransferFunctions.CFG
+     and type Node.id = TransferFunctions.CFG.Node.id
+     and module Node.IdMap = TransferFunctions.CFG.Node.IdMap
+     and module Node.IdSet = TransferFunctions.CFG.Node.IdSet
 
   module Domain :
       module type of AbstractDomain.Pair (TransferFunctions.Domain) (IdAccessPathMapDomain)
@@ -33,28 +35,28 @@ module Make
   val pp_session_name : CFG.Node.t -> Format.formatter -> unit
 end
 
+module type S = sig
+  module Interpreter : AbstractInterpreter.S
+
+  type domain
+
+  val compute_post :
+    Interpreter.TransferFunctions.extras ProcData.t -> initial:domain -> domain option
+  (** compute and return the postcondition for the given procedure starting from [initial]. *)
+end
+
 (** Wrapper around Interpreter to prevent clients from having to deal with IdAccessPathMapDomain *)
 module MakeAbstractInterpreterWithConfig
     (MakeAbstractInterpreter : AbstractInterpreter.Make)
     (HilConfig : HilConfig)
-    (CFG : ProcCfg.S)
+    (TransferFunctions : TransferFunctions.HIL) :
-    (MakeTransferFunctions : TransferFunctions.MakeHIL) : sig
+  S
-  module Interpreter :
+  with type domain = TransferFunctions.Domain.t
-      module type of AbstractInterpreter.MakeRPO (Make (MakeTransferFunctions) (HilConfig) (CFG))
+   and module Interpreter = MakeAbstractInterpreter(Make(TransferFunctions)(HilConfig))
-
-  val compute_post :
-       Interpreter.TransferFunctions.extras ProcData.t
-    -> initial:MakeTransferFunctions(CFG).Domain.t
-    -> MakeTransferFunctions(CFG).Domain.t option
-  (** compute and return the postcondition for the given procedure starting from [initial]. If
-      [debug] is true, print html debugging output. *)
-end
 
 (** Simpler version of the above wrapper that uses the default HIL config *)
-module MakeAbstractInterpreter
+module MakeAbstractInterpreter (TransferFunctions : TransferFunctions.HIL) : sig
-    (CFG : ProcCfg.S)
-    (MakeTransferFunctions : TransferFunctions.MakeHIL) : sig
   include module type of
-    MakeAbstractInterpreterWithConfig (AbstractInterpreter.MakeRPO) (DefaultConfig) (CFG)
+    MakeAbstractInterpreterWithConfig (AbstractInterpreter.MakeRPO) (DefaultConfig)
-      (MakeTransferFunctions)
+      (TransferFunctions)
 end

infer/src/absint/TransferFunctions.ml

@@ -28,11 +28,3 @@ end
 module type HIL = sig
   include S with type instr := HilInstr.t
 end
-
-module type MakeSIL = functor (C : ProcCfg.S) -> sig
-  include SIL with module CFG = C
-end
-
-module type MakeHIL = functor (C : ProcCfg.S) -> sig
-  include HIL with module CFG = C
-end

infer/src/absint/TransferFunctions.mli

@@ -36,11 +36,3 @@ end
 module type HIL = sig
   include S with type instr := HilInstr.t
 end
-
-module type MakeSIL = functor (C : ProcCfg.S) -> sig
-  include SIL with module CFG = C
-end
-
-module type MakeHIL = functor (C : ProcCfg.S) -> sig
-  include HIL with module CFG = C
-end

infer/src/checkers/Litho.ml

@@ -270,7 +270,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
   let pp_session_name _node fmt = F.pp_print_string fmt "litho"
 end
 
-module Analyzer = LowerHil.MakeAbstractInterpreter (ProcCfg.Exceptional) (TransferFunctions)
+module Analyzer = LowerHil.MakeAbstractInterpreter (TransferFunctions (ProcCfg.Exceptional))
 
 let checker {Callbacks.summary; proc_desc; tenv} =
   let proc_data = ProcData.make_default proc_desc tenv in

infer/src/checkers/Ownership.ml

@@ -379,7 +379,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
   let pp_session_name _node fmt = F.pp_print_string fmt "ownership"
 end
 
-module Analyzer = LowerHil.MakeAbstractInterpreter (ProcCfg.Exceptional) (TransferFunctions)
+module Analyzer = LowerHil.MakeAbstractInterpreter (TransferFunctions (ProcCfg.Exceptional))
 
 let report_invalid_return post end_loc summary =
   let locals =

infer/src/checkers/Pulse.ml

@@ -132,10 +132,10 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
   let pp_session_name _node fmt = F.pp_print_string fmt "Pulse"
 end
 
+module HilConfig = LowerHil.DefaultConfig
 module Analyzer =
-  LowerHil.MakeAbstractInterpreterWithConfig (AbstractInterpreter.MakeWTO) (LowerHil.DefaultConfig)
+  LowerHil.MakeAbstractInterpreterWithConfig (AbstractInterpreter.MakeWTO) (HilConfig)
-    (ProcCfg.Exceptional)
+    (TransferFunctions (ProcCfg.Exceptional))
-    (TransferFunctions)
 
 let checker {Callbacks.proc_desc; tenv; summary} =
   let proc_data = ProcData.make proc_desc tenv summary in

infer/src/checkers/purity.ml

@@ -121,7 +121,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
   let pp_session_name _node fmt = F.pp_print_string fmt "purity checker"
 end
 
-module Analyzer = LowerHil.MakeAbstractInterpreter (ProcCfg.Normal) (TransferFunctions)
+module Analyzer = LowerHil.MakeAbstractInterpreter (TransferFunctions (ProcCfg.Normal))
 
 let should_report pdesc =
   (not Config.loop_hoisting)

infer/src/checkers/uninit.ml

@@ -307,7 +307,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
 end
 
 module CFG = ProcCfg.Normal
-module Analyzer = LowerHil.MakeAbstractInterpreter (CFG) (TransferFunctions)
+module Analyzer = LowerHil.MakeAbstractInterpreter (TransferFunctions (CFG))
 
 module Initial = struct
   let get_locals tenv pdesc =

infer/src/concurrency/RacerD.ml

@@ -602,7 +602,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
   let pp_session_name _node fmt = F.pp_print_string fmt "racerd"
 end
 
-module Analyzer = LowerHil.MakeAbstractInterpreter (ProcCfg.Normal) (TransferFunctions)
+module Analyzer = LowerHil.MakeAbstractInterpreter (TransferFunctions (ProcCfg.Normal))
 
 let analyze_procedure {Callbacks.proc_desc; tenv; summary} =
   let open RacerDModels in

infer/src/concurrency/starvation.ml

@@ -135,7 +135,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
   let pp_session_name _node fmt = F.pp_print_string fmt "starvation"
 end
 
-module Analyzer = LowerHil.MakeAbstractInterpreter (ProcCfg.Normal) (TransferFunctions)
+module Analyzer = LowerHil.MakeAbstractInterpreter (TransferFunctions (ProcCfg.Normal))
 
 let analyze_procedure {Callbacks.proc_desc; tenv; summary} =
   let open StarvationDomain in

infer/src/labs/ResourceLeaks.ml

@@ -92,14 +92,12 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
   let pp_session_name _node fmt = F.pp_print_string fmt "resource leaks"
 end
 
-(* Create an intraprocedural abstract interpreter from the transfer functions we defined *)
+(** 5(a) Type of CFG to analyze--Exceptional to follow exceptional control-flow edges, Normal to
-module Analyzer =
-  LowerHil.MakeAbstractInterpreter
-    (* Type of CFG to analyze--Exceptional to follow exceptional control-flow edges, Normal to
    ignore them *)
-    (ProcCfg.Normal)
+module CFG = ProcCfg.Normal
-    (* 5(a) *)
+
-    (TransferFunctions)
+(* Create an intraprocedural abstract interpreter from the transfer functions we defined *)
+module Analyzer = LowerHil.MakeAbstractInterpreter (TransferFunctions (CFG))
 
 (* Callback for invoking the checker from the outside--registered in RegisterCheckers *)
 let checker {Callbacks.summary; proc_desc; tenv} : Summary.t =

infer/src/nullsafe/NullabilityCheck.ml

@@ -333,7 +333,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
   let pp_session_name _node fmt = F.pp_print_string fmt "nullability check"
 end
 
-module Analyzer = LowerHil.MakeAbstractInterpreter (ProcCfg.Exceptional) (TransferFunctions)
+module Analyzer = LowerHil.MakeAbstractInterpreter (TransferFunctions (ProcCfg.Exceptional))
 
 let checker {Callbacks.summary; proc_desc; tenv} =
   let initial = (NullableAP.empty, NullCheckedPname.empty) in

infer/src/nullsafe/NullabilitySuggest.ml

@@ -119,7 +119,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
   let pp_session_name _node fmt = F.pp_print_string fmt "nullability suggest"
 end
 
-module Analyzer = LowerHil.MakeAbstractInterpreter (ProcCfg.Exceptional) (TransferFunctions)
+module Analyzer = LowerHil.MakeAbstractInterpreter (TransferFunctions (ProcCfg.Exceptional))
 
 let make_error_trace astate ap ud =
   let name_of ap =

infer/src/quandary/TaintAnalysis.ml

@@ -738,8 +738,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct
 
   module Analyzer =
     LowerHil.MakeAbstractInterpreterWithConfig (AbstractInterpreter.MakeRPO) (HilConfig)
-      (ProcCfg.Exceptional)
+      (TransferFunctions (ProcCfg.Exceptional))
-      (TransferFunctions)
 
   (* sanity checks for summaries. should only be used in developer mode *)
   let check_invariants access_tree =

infer/src/unit/BoundedCallTreeTests.ml

@@ -7,7 +7,7 @@
 
 open! IStd
 module TestInterpreter =
-  AnalyzerTester.Make (ProcCfg.Exceptional) (BoundedCallTree.TransferFunctions)
+  AnalyzerTester.Make (BoundedCallTree.TransferFunctions (ProcCfg.Exceptional))
 
 let tests =
   let open OUnit2 in

infer/src/unit/TaintTests.ml

@@ -60,8 +60,7 @@ end)
 
 module TestInterpreter =
   AnalyzerTester.Make
-    (ProcCfg.Normal)
+    (LowerHil.Make (MockTaintAnalysis.TransferFunctions (ProcCfg.Normal)) (LowerHil.DefaultConfig))
-    (LowerHil.Make (MockTaintAnalysis.TransferFunctions) (LowerHil.DefaultConfig))
 
 let tests =
   let open OUnit2 in

infer/src/unit/abstractInterpreterTests.ml

@@ -57,9 +57,9 @@ module PathCountTransferFunctions (CFG : ProcCfg.S) = struct
   let pp_session_name _node _fmt = ()
 end
 
-module NormalTestInterpreter = AnalyzerTester.Make (ProcCfg.Normal) (PathCountTransferFunctions)
+module NormalTestInterpreter = AnalyzerTester.Make (PathCountTransferFunctions (ProcCfg.Normal))
 module ExceptionalTestInterpreter =
-  AnalyzerTester.Make (ProcCfg.Exceptional) (PathCountTransferFunctions)
+  AnalyzerTester.Make (PathCountTransferFunctions (ProcCfg.Exceptional))
 
 let tests =
   let open OUnit2 in

infer/src/unit/addressTakenTests.ml

@@ -6,7 +6,7 @@
  *)
 
 open! IStd
-module TestInterpreter = AnalyzerTester.Make (ProcCfg.Exceptional) (AddressTaken.TransferFunctions)
+module TestInterpreter = AnalyzerTester.Make (AddressTaken.TransferFunctions (ProcCfg.Exceptional))
 
 let tests =
   let open OUnit2 in

infer/src/unit/analyzerTester.ml

@@ -149,11 +149,10 @@ end
 
 module MakeMake
     (MakeAbstractInterpreter : AbstractInterpreter.Make)
-    (CFG : ProcCfg.S with type Node.t = Procdesc.Node.t)
+    (T : TransferFunctions.SIL with type CFG.Node.t = Procdesc.Node.t) =
-    (T : TransferFunctions.MakeSIL) =
 struct
   open StructuredSil
-  module I = MakeAbstractInterpreter (T (CFG))
+  module I = MakeAbstractInterpreter (T)
   module M = I.InvariantMap
 
   let structured_program_to_cfg program test_pname =
@@ -224,7 +223,7 @@ struct
           let node = create_node (Procdesc.Node.Stmt_node (Skip "Invariant")) [] in
           set_succs last_node [node] ~exn_handlers ;
           (* add the assertion to be checked after analysis converges *)
-          (node, M.add (CFG.Node.id node) (inv_str, inv_label) assert_map)
+          (node, M.add (T.CFG.Node.id node) (inv_str, inv_label) assert_map)
     and structured_instrs_to_node last_node assert_map exn_handlers instrs =
       List.fold
         ~f:(fun acc instr -> structured_instr_to_node acc exn_handlers instr)
@@ -278,10 +277,9 @@ struct
         OUnit2.assert_failure assert_fail_message
 end
 
-module Make (CFG : ProcCfg.S with type Node.t = Procdesc.Node.t) (T : TransferFunctions.MakeSIL) =
+module Make (T : TransferFunctions.SIL with type CFG.Node.t = Procdesc.Node.t) = struct
-struct
+  module AI_RPO = MakeMake (AbstractInterpreter.MakeRPO) (T)
-  module AI_RPO = MakeMake (AbstractInterpreter.MakeRPO) (CFG) (T)
+  module AI_WTO = MakeMake (AbstractInterpreter.MakeWTO) (T)
-  module AI_WTO = MakeMake (AbstractInterpreter.MakeWTO) (CFG) (T)
 
   let ai_list = [("ai_rpo", AI_RPO.create_test); ("ai_wto", AI_WTO.create_test)]
 

infer/src/unit/livenessTests.ml

@@ -7,7 +7,7 @@
 
 open! IStd
 module TestInterpreter =
-  AnalyzerTester.Make (ProcCfg.Backward (ProcCfg.Normal)) (Liveness.TransferFunctions)
+  AnalyzerTester.Make (Liveness.TransferFunctions (ProcCfg.Backward (ProcCfg.Normal)))
 
 let tests =
   let open OUnit2 in