[sledge] Detect inconsistent pure constraints during Sh simplification

Reviewed By: ngorogiannis

Differential Revision: D20120269

fbshipit-source-id: bb1a96cbd

sledge/src/symbheap/sh.ml

@@ -25,6 +25,18 @@ and disjunction = starjunction list
 
 type t = starjunction [@@deriving compare, equal, sexp]
 
+(** Basic values *)
+
+let emp =
+  { us= Var.Set.empty
+  ; xs= Var.Set.empty
+  ; cong= Equality.true_
+  ; pure= []
+  ; heap= []
+  ; djns= [] }
+
+let false_ us = {emp with us; djns= [[]]}
+
 (** Traversals *)
 
 let map_seg ~f h =
@@ -39,13 +51,16 @@ let map_seg ~f h =
   then h
   else {loc; bas; len; siz; arr}
 
-let map ~f_sjn ~f_cong ~f_trm ({us= _; xs= _; cong; pure; heap; djns} as q)
+let map ~f_sjn ~f_cong ~f_trm ({us; xs= _; cong; pure; heap; djns} as q) =
-    =
+  let exception Unsat in
+  try
     let cong = f_cong cong in
     let pure =
       List.filter_map_preserving_phys_equal pure ~f:(fun e ->
           let e' = f_trm e in
-        if Term.is_true e' then None else Some e' )
+          if Term.is_false e' then raise Unsat
+          else if Term.is_true e' then None
+          else Some e' )
     in
     let heap = List.map_preserving_phys_equal heap ~f:(map_seg ~f:f_trm) in
     let djns =
@@ -55,6 +70,7 @@ let map ~f_sjn ~f_cong ~f_trm ({us= _; xs= _; cong; pure; heap; djns} as q)
     if cong == q.cong && pure == q.pure && heap == q.heap && djns == q.djns
     then q
     else {q with cong; pure; heap; djns}
+  with Unsat -> false_ us
 
 let fold_terms_seg {loc; bas; len; siz; arr} ~init ~f =
   let f b s = f s b in
@@ -396,17 +412,6 @@ let elim_exists xs q =
 
 (** Construct *)
 
-let emp =
-  { us= Var.Set.empty
-  ; xs= Var.Set.empty
-  ; cong= Equality.true_
-  ; pure= []
-  ; heap= []
-  ; djns= [] }
-  |> check invariant
-
-let false_ us = {emp with us; djns= [[]]} |> check invariant
-
 (** conjoin an equality relation assuming vocabulary is compatible *)
 let and_cong_ cong q =
   assert (Set.is_subset (Equality.fv cong) ~of_:q.us) ;