Summary: This does several things because it was hard to split it more: 1. Split most of the arithmetic reasoning to PulseArithmetic.ml. This doesn't need to be reviewed thoroughly because an upcoming diff changes the domain from just `EqualTo of Const.t` to an interval domain! 2. When going through a prune node intra-procedurally, abduce arithmetic facts to the pre (instead of just propagating them). This is the "assume as assert" trick used by biabduction 1.0 too and allows to propagate arithmetic constraints to callers. 3. Use 2 when applying summaries by pruning specs whose preconditions have un-satisfiable arithmetic constraints. This changes one of the tests! Pulse now does a bit more work to find the false positive, as can be seen in the longer trace. Reviewed By: skcho Differential Revision: D18117160 fbshipit-source-id: af3b2c8c0master
parent
702602dcec
commit
b20c22a5ee
@ -0,0 +1,68 @@
|
||||
(*
|
||||
* Copyright (c) Facebook, Inc. and its affiliates.
|
||||
*
|
||||
* This source code is licensed under the MIT license found in the
|
||||
* LICENSE file in the root directory of this source tree.
|
||||
*)
|
||||
open! IStd
|
||||
module F = Format
|
||||
|
||||
type t = EqualTo of Const.t [@@deriving compare]
|
||||
|
||||
let pp fmt = function EqualTo c -> F.fprintf fmt "=%a" (Const.pp Pp.text) c
|
||||
|
||||
(** booleans with \top *)
|
||||
module TBool = struct
|
||||
type t = True | False | Top
|
||||
end
|
||||
|
||||
let flip_abduced (tbool, c1, c2) = (tbool, c2, c1)
|
||||
|
||||
let rec abduce_eq a1 a2 =
|
||||
match (a1, a2) with
|
||||
| Some (EqualTo c1), Some (EqualTo c2) when Const.equal c1 c2 ->
|
||||
(TBool.True, None, None)
|
||||
| Some (EqualTo _c1), Some (EqualTo _c2) (* c1≠c2 *) ->
|
||||
(TBool.False, None, None)
|
||||
| None, Some _ ->
|
||||
abduce_eq a2 a1 |> flip_abduced
|
||||
| Some (EqualTo _c), None ->
|
||||
(TBool.True, None, a1)
|
||||
| None, None ->
|
||||
(TBool.Top, None, None)
|
||||
|
||||
|
||||
let abduce_ne a1 a2 =
|
||||
match (a1, a2) with
|
||||
| Some (EqualTo c1), Some (EqualTo c2) when Const.equal c1 c2 ->
|
||||
(TBool.False, None, None)
|
||||
| Some (EqualTo _c1), Some (EqualTo _c2) (* c1≠c2 *) ->
|
||||
(TBool.True, None, None)
|
||||
| None, Some _ | Some _, None ->
|
||||
(* cannot express ≠c so go to Top *)
|
||||
(TBool.Top, None, None)
|
||||
| None, None ->
|
||||
(TBool.Top, None, None)
|
||||
|
||||
|
||||
let abduce_binop_constraints ~negated (bop : Binop.t) a1 a2 =
|
||||
let open Binop in
|
||||
match (bop, negated) with
|
||||
| Eq, false | Ne, true ->
|
||||
abduce_eq a1 a2
|
||||
| Eq, true | Ne, false ->
|
||||
abduce_ne a1 a2
|
||||
| _ ->
|
||||
(TBool.Top, None, None)
|
||||
|
||||
|
||||
let abduce_binop_is_true_aux ~negated bop a1_opt a2_opt =
|
||||
Logging.d_printfln "abduce_binop_is_true ~negated:%b %s (%a) (%a)" negated
|
||||
(Binop.str Pp.text bop) (Pp.option pp) a1_opt (Pp.option pp) a2_opt ;
|
||||
abduce_binop_constraints ~negated bop a1_opt a2_opt
|
||||
|
||||
|
||||
let abduce_binop_is_true ~negated bop v1 v2 =
|
||||
let result, abduced1, abduced2 = abduce_binop_is_true_aux ~negated bop v1 v2 in
|
||||
let can_go_through = match result with Top | True -> true | False -> false in
|
||||
(can_go_through, abduced1, abduced2)
|
@ -0,0 +1,25 @@
|
||||
(*
|
||||
* Copyright (c) Facebook, Inc. and its affiliates.
|
||||
*
|
||||
* This source code is licensed under the MIT license found in the
|
||||
* LICENSE file in the root directory of this source tree.
|
||||
*)
|
||||
open! IStd
|
||||
module F = Format
|
||||
|
||||
type t = EqualTo of Const.t [@@deriving compare]
|
||||
|
||||
val pp : F.formatter -> t -> unit
|
||||
|
||||
val abduce_binop_is_true :
|
||||
negated:bool -> Binop.t -> t option -> t option -> bool * t option * t option
|
||||
(** given [arith_lhs_opt bop arith_rhs_opt], return a triple
|
||||
[(satisfiable,abduced_lhs_opt,abduced_rhs_opt)] such that (taking lhs=true if lhs_opt is [None],
|
||||
same for rhs):
|
||||
|
||||
- [satisfiable] iff lhs bop rhs ≠ ∅
|
||||
|
||||
- [abduced_lhs_opt=Some alhs] if [satisfiable] and (lhs bop rhs ≠ ∅ => alhs⇔lhs) (and similarly for rhs)
|
||||
|
||||
- likewise if [negated] with (lhs bop rhs = ∅) in the two points above
|
||||
*)
|
Loading…
Reference in new issue