[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
master
Jules Villard 6 years ago committed by Facebook Github Bot
parent 65d031af66
commit 26d4a2d14f

@ -36,12 +36,7 @@ module MakeHILDomain (Domain : AbstractDomain.S) = struct
Domain.pp fmt astate
end
module Make
(MakeTransferFunctions : TransferFunctions.MakeHIL)
(HilConfig : HilConfig)
(CFG : ProcCfg.S) =
struct
module TransferFunctions = MakeTransferFunctions (CFG)
module Make (TransferFunctions : TransferFunctions.HIL) (HilConfig : HilConfig) = struct
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)
(MakeTransferFunctions : TransferFunctions.MakeHIL) =
struct
module Interpreter = MakeAbstractInterpreter (Make (MakeTransferFunctions) (HilConfig) (CFG))
(TransferFunctions : TransferFunctions.HIL) :
S
with type domain = TransferFunctions.Domain.t
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)

@ -15,13 +15,15 @@ end
module DefaultConfig : HilConfig
(** Functor for turning HIL transfer functions into SIL transfer functions *)
module Make
(MakeTransferFunctions : TransferFunctions.MakeHIL)
(HilConfig : HilConfig)
(CFG : ProcCfg.S) : sig
module TransferFunctions : module type of MakeTransferFunctions (CFG)
module CFG : module type of TransferFunctions.CFG
module Make (TransferFunctions : TransferFunctions.HIL) (HilConfig : HilConfig) : sig
module CFG :
ProcCfg.S
with type t = TransferFunctions.CFG.t
and type instrs_dir = TransferFunctions.CFG.instrs_dir
and type Node.t = TransferFunctions.CFG.Node.t
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)
(MakeTransferFunctions : TransferFunctions.MakeHIL) : sig
module Interpreter :
module type of AbstractInterpreter.MakeRPO (Make (MakeTransferFunctions) (HilConfig) (CFG))
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
(TransferFunctions : TransferFunctions.HIL) :
S
with type domain = TransferFunctions.Domain.t
and module Interpreter = MakeAbstractInterpreter(Make(TransferFunctions)(HilConfig))
(** Simpler version of the above wrapper that uses the default HIL config *)
module MakeAbstractInterpreter
(CFG : ProcCfg.S)
(MakeTransferFunctions : TransferFunctions.MakeHIL) : sig
module MakeAbstractInterpreter (TransferFunctions : TransferFunctions.HIL) : sig
include module type of
MakeAbstractInterpreterWithConfig (AbstractInterpreter.MakeRPO) (DefaultConfig) (CFG)
(MakeTransferFunctions)
MakeAbstractInterpreterWithConfig (AbstractInterpreter.MakeRPO) (DefaultConfig)
(TransferFunctions)
end

@ -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

@ -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

@ -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

@ -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 =

@ -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)
(ProcCfg.Exceptional)
(TransferFunctions)
LowerHil.MakeAbstractInterpreterWithConfig (AbstractInterpreter.MakeWTO) (HilConfig)
(TransferFunctions (ProcCfg.Exceptional))
let checker {Callbacks.proc_desc; tenv; summary} =
let proc_data = ProcData.make proc_desc tenv summary in

@ -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)

@ -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 =

@ -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

@ -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

@ -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 *)
module Analyzer =
LowerHil.MakeAbstractInterpreter
(* Type of CFG to analyze--Exceptional to follow exceptional control-flow edges, Normal to
(** 5(a) Type of CFG to analyze--Exceptional to follow exceptional control-flow edges, Normal to
ignore them *)
(ProcCfg.Normal)
(* 5(a) *)
(TransferFunctions)
module CFG = ProcCfg.Normal
(* 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 =

@ -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

@ -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 =

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

@ -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

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

@ -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

@ -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

@ -149,11 +149,10 @@ end
module MakeMake
(MakeAbstractInterpreter : AbstractInterpreter.Make)
(CFG : ProcCfg.S with type Node.t = Procdesc.Node.t)
(T : TransferFunctions.MakeSIL) =
(T : TransferFunctions.SIL with type CFG.Node.t = Procdesc.Node.t) =
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) =
struct
module AI_RPO = MakeMake (AbstractInterpreter.MakeRPO) (CFG) (T)
module AI_WTO = MakeMake (AbstractInterpreter.MakeWTO) (CFG) (T)
module Make (T : TransferFunctions.SIL with type CFG.Node.t = Procdesc.Node.t) = struct
module AI_RPO = MakeMake (AbstractInterpreter.MakeRPO) (T)
module AI_WTO = MakeMake (AbstractInterpreter.MakeWTO) (T)
let ai_list = [("ai_rpo", AI_RPO.create_test); ("ai_wto", AI_WTO.create_test)]

@ -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

Loading…
Cancel
Save