[sledge] Refine Theory.classify to distinguish (un)interpreted atoms

Reviewed By: jvillard

Differential Revision: D25883731

fbshipit-source-id: b63877d43
master
Josh Berdine 4 years ago committed by Facebook GitHub Bot
parent 548adedc37
commit dbfa63feaa

@ -511,14 +511,15 @@ let rec canon r a =
[%Trace.call fun {pf} -> pf "@ %a" Trm.pp a] [%Trace.call fun {pf} -> pf "@ %a" Trm.pp a]
; ;
( match Theory.classify a with ( match Theory.classify a with
| Atomic -> Subst.apply r.rep a | InterpAtom -> a
| Interpreted -> Trm.map ~f:(canon r) a | NonInterpAtom -> Subst.apply r.rep a
| Uninterpreted -> ( | InterpApp -> Trm.map ~f:(canon r) a
| UninterpApp -> (
let a' = Trm.map ~f:(canon r) a in let a' = Trm.map ~f:(canon r) a in
match Theory.classify a' with match Theory.classify a' with
| Atomic -> Subst.apply r.rep a' | InterpAtom | InterpApp -> a'
| Interpreted -> a' | NonInterpAtom -> Subst.apply r.rep a'
| Uninterpreted -> lookup r a' ) ) | UninterpApp -> lookup r a' ) )
|> |>
[%Trace.retn fun {pf} -> pf "%a" Trm.pp] [%Trace.retn fun {pf} -> pf "%a" Trm.pp]

@ -29,22 +29,29 @@ let pp ppf = function
(* Classification of terms ================================================*) (* Classification of terms ================================================*)
type kind = Interpreted | Atomic | Uninterpreted type kind = InterpApp | NonInterpAtom | InterpAtom | UninterpApp
[@@deriving compare, equal] [@@deriving compare, equal]
let classify e = let classify e =
match (e : Trm.t) with match (e : Trm.t) with
| Var _ | Z _ | Q _ | Concat [||] | Apply (_, [||]) -> Atomic | Var _ -> NonInterpAtom
| Arith a -> ( | Z _ | Q _ -> InterpAtom
match Trm.Arith.classify a with | Arith a ->
| Trm _ | Const _ -> violates Trm.invariant e if Trm.Arith.is_uninterpreted a then UninterpApp
| Interpreted -> Interpreted else (
| Uninterpreted -> Uninterpreted ) assert (
| Splat _ | Sized _ | Extract _ | Concat _ -> Interpreted match Trm.Arith.classify a with
| Apply _ -> Uninterpreted | Trm _ | Const _ -> violates Trm.invariant e
| Interpreted -> true
let is_interpreted e = equal_kind (classify e) Interpreted | Uninterpreted -> false ) ;
let is_uninterpreted e = equal_kind (classify e) Uninterpreted InterpApp )
| Concat [||] -> InterpAtom
| Splat _ | Sized _ | Extract _ | Concat _ -> InterpApp
| Apply (_, [||]) -> NonInterpAtom
| Apply _ -> UninterpApp
let is_interpreted e = equal_kind (classify e) InterpApp
let is_uninterpreted e = equal_kind (classify e) UninterpApp
(* Solving equations ======================================================*) (* Solving equations ======================================================*)

@ -16,7 +16,7 @@ type t =
val pp : t pp val pp : t pp
type kind = Interpreted | Atomic | Uninterpreted type kind = InterpApp | NonInterpAtom | InterpAtom | UninterpApp
[@@deriving compare, equal] [@@deriving compare, equal]
val classify : Trm.t -> kind val classify : Trm.t -> kind

Loading…
Cancel
Save