diff --git a/sledge/src/symbheap/equality.ml b/sledge/src/symbheap/equality.ml index 6a8b56371..dbbf3f89d 100644 --- a/sledge/src/symbheap/equality.ml +++ b/sledge/src/symbheap/equality.ml @@ -21,16 +21,16 @@ let classify e = | Ap1 _ | Ap2 _ | Ap3 _ | ApN _ -> Uninterpreted | RecN _ | Var _ | Integer _ | Float _ | Nondet _ | Label _ -> Atomic +let interpreted e = equal_kind (classify e) Interpreted +let non_interpreted e = not (interpreted e) + let rec fold_max_solvables e ~init ~f = - match classify e with - | Interpreted -> - Term.fold e ~init ~f:(fun d s -> fold_max_solvables ~f d ~init:s) - | _ -> f e init + if interpreted e then + Term.fold e ~init ~f:(fun d s -> fold_max_solvables ~f d ~init:s) + else f e init let rec iter_max_solvables e ~f = - match classify e with - | Interpreted -> Term.iter ~f:(iter_max_solvables ~f) e - | _ -> f e + if interpreted e then Term.iter ~f:(iter_max_solvables ~f) e else f e (** Solution Substitutions *) module Subst : sig @@ -261,8 +261,8 @@ and solve_ e f s = | q, ((Add _ | Mul _ | Integer _) as p) ) -> solve_poly p q s | Some (rep, var) -> - assert (Poly.(classify var <> Interpreted)) ; - assert (Poly.(classify rep <> Interpreted)) ; + assert (non_interpreted var) ; + assert (non_interpreted rep) ; extend ~var ~rep s ) |> [%Trace.retn fun {pf} -> @@ -359,7 +359,7 @@ let invariant r = @@ fun () -> Subst.iteri r.rep ~f:(fun ~key:a ~data:_ -> (* no interpreted terms in carrier *) - assert (Poly.(classify a <> Interpreted)) ; + assert (non_interpreted a) ; (* carrier is closed under subterms *) iter_max_solvables a ~f:(fun b -> assert ( @@ -485,9 +485,9 @@ let fold_uses_of r t ~init ~f = Term.fold e ~init:s ~f:(fun sub s -> if Term.equal t sub then f s e else s ) in - match classify e with - | Interpreted -> Term.fold e ~init:s ~f:(fun d s -> fold_ ~f d ~init:s) - | _ -> s + if interpreted e then + Term.fold e ~init:s ~f:(fun d s -> fold_ ~f d ~init:s) + else s in Subst.fold r.rep ~init ~f:(fun ~key:trm ~data:rep s -> let f trm s = fold_ trm ~init:s ~f in @@ -651,14 +651,13 @@ let rec solve_interp_eqs us (cls, subst) = let rec solve_interp_eqs_ cls' (cls, subst) = match cls with | [] -> (cls', subst) - | trm :: cls -> ( + | trm :: cls -> let trm' = Subst.norm subst trm in - match classify trm' with - | Interpreted -> ( + if interpreted trm' then match solve_interp_eq us trm' (cls, subst) with | Some subst -> solve_interp_eqs_ cls' (cls, subst) - | None -> solve_interp_eqs_ (trm' :: cls') (cls, subst) ) - | _ -> solve_interp_eqs_ (trm' :: cls') (cls, subst) ) + | None -> solve_interp_eqs_ (trm' :: cls') (cls, subst) + else solve_interp_eqs_ (trm' :: cls') (cls, subst) in let cls', subst' = solve_interp_eqs_ [] (cls, subst) in ( if subst' != subst then solve_interp_eqs us (cls', subst') @@ -678,7 +677,7 @@ let solve_uninterp_eqs us (cls, subst) = let rep_ito_us, cls_not_ito_us, cls_delay = List.fold cls ~init:(None, [], []) ~f:(fun (rep_ito_us, cls_not_ito_us, cls_delay) trm -> - if not (equal_kind (classify trm) Interpreted) then + if non_interpreted trm then if Set.is_subset (Term.fv trm) ~of_:us then match rep_ito_us with | Some rep when Term.compare rep trm <= 0 ->