Enforce physical equality for BottomLifted, TopLifted, Pair domains

Reviewed By: ngorogiannis

Differential Revision: D13164136

fbshipit-source-id: 7129e6ad7

infer/src/absint/AbstractDomain.ml

@@ -84,19 +84,19 @@ module BottomLifted (Domain : S) = struct
       | _, Bottom ->
           astate1
       | NonBottom a1, NonBottom a2 ->
-          NonBottom (Domain.join a1 a2)
+          PhysEqual.optim2 ~res:(NonBottom (Domain.join a1 a2)) astate1 astate2
 
 
-  let widen ~prev ~next ~num_iters =
-    if phys_equal prev next then prev
+  let widen ~prev:prev0 ~next:next0 ~num_iters =
+    if phys_equal prev0 next0 then prev0
     else
-      match (prev, next) with
+      match (prev0, next0) with
       | Bottom, _ ->
-          next
+          next0
       | _, Bottom ->
-          prev
+          prev0
       | NonBottom prev, NonBottom next ->
-          NonBottom (Domain.widen ~prev ~next ~num_iters)
+          PhysEqual.optim2 ~res:(NonBottom (Domain.widen ~prev ~next ~num_iters)) prev0 next0
 
 
   let pp fmt = function
@@ -132,17 +132,17 @@ module TopLifted (Domain : S) = struct
       | Top, _ | _, Top ->
           Top
       | NonTop a1, NonTop a2 ->
-          NonTop (Domain.join a1 a2)
+          PhysEqual.optim2 ~res:(NonTop (Domain.join a1 a2)) astate1 astate2
 
 
-  let widen ~prev ~next ~num_iters =
-    if phys_equal prev next then prev
+  let widen ~prev:prev0 ~next:next0 ~num_iters =
+    if phys_equal prev0 next0 then prev0
     else
-      match (prev, next) with
+      match (prev0, next0) with
       | Top, _ | _, Top ->
           Top
       | NonTop prev, NonTop next ->
-          NonTop (Domain.widen ~prev ~next ~num_iters)
+          PhysEqual.optim2 ~res:(NonTop (Domain.widen ~prev ~next ~num_iters)) prev0 next0
 
 
   let pp fmt = function
@@ -163,14 +163,20 @@ module Pair (Domain1 : S) (Domain2 : S) = struct
 
   let join astate1 astate2 =
     if phys_equal astate1 astate2 then astate1
-    else (Domain1.join (fst astate1) (fst astate2), Domain2.join (snd astate1) (snd astate2))
+    else
+      PhysEqual.optim2
+        ~res:(Domain1.join (fst astate1) (fst astate2), Domain2.join (snd astate1) (snd astate2))
+        astate1 astate2
 
 
   let widen ~prev ~next ~num_iters =
     if phys_equal prev next then prev
     else
-      ( Domain1.widen ~prev:(fst prev) ~next:(fst next) ~num_iters
-      , Domain2.widen ~prev:(snd prev) ~next:(snd next) ~num_iters )
+      PhysEqual.optim2
+        ~res:
+          ( Domain1.widen ~prev:(fst prev) ~next:(fst next) ~num_iters
+          , Domain2.widen ~prev:(snd prev) ~next:(snd next) ~num_iters )
+        prev next
 
 
   let pp fmt astate = Pp.pair ~fst:Domain1.pp ~snd:Domain2.pp fmt astate

infer/src/istd/PhysEqual.ml

@@ -0,0 +1,29 @@
+(*
+ * Copyright (c) 2018-present, Facebook, Inc.
+ *
+ * This source code is licensed under the MIT license found in the
+ * LICENSE file in the root directory of this source tree.
+ *)
+
+open! IStd
+
+let rec compare_fields ox oy i =
+  i < 0 || (phys_equal (Obj.field ox i) (Obj.field oy i) && compare_fields ox oy (i - 1))
+
+
+let shallow_compare x y =
+  phys_equal x y
+  ||
+  let ox = Obj.repr x in
+  let oy = Obj.repr y in
+  let tx = Obj.tag ox in
+  let ty = Obj.tag oy in
+  Int.equal tx ty && tx < Obj.no_scan_tag
+  &&
+  let sx = Obj.size ox in
+  let sy = Obj.size oy in
+  Int.equal sx sy && compare_fields ox oy (sx - 1)
+
+
+let optim2 ~res x1 x2 =
+  if shallow_compare res x1 then x1 else if shallow_compare res x2 then x2 else res

infer/src/istd/PhysEqual.mli

@@ -0,0 +1,27 @@
+(*
+ * Copyright (c) 2018-present, Facebook, Inc.
+ *
+ * This source code is licensed under the MIT license found in the
+ * LICENSE file in the root directory of this source tree.
+ *)
+
+open! IStd
+
+(**
+  Helpers function to enforce physical equality.
+
+  Let suppose [construct/deconstruct] is a 1-level-allocation OCaml construction/deconstruction,
+  such as variant type, tuple or record construction.
+  Instead of writing
+    let a = deconstruct a0 in
+    let b = deconstruct b0 in
+    let res = f a b in
+    if phys_equal res a then a0
+    else if phys_equal res b then b0
+    else construct res
+
+  Simply write
+    PhysEqual.optim2 ~res:(construct (f a b)) a0 b0
+*)
+
+val optim2 : res:'a -> 'a -> 'a -> 'a