mirror of
https://github.com/c-cube/sidekick.git
synced 2025-12-06 03:05:31 -05:00
add core.bool_view
This commit is contained in:
parent
c873346047
commit
c2af589282
4 changed files with 18 additions and 5 deletions
|
|
@ -23,6 +23,7 @@ module Term = struct
|
||||||
include Sidekick_core_logic.T_builtins
|
include Sidekick_core_logic.T_builtins
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Bool_view = Bool_view
|
||||||
module Bvar = Sidekick_core_logic.Bvar
|
module Bvar = Sidekick_core_logic.Bvar
|
||||||
module Lit = Lit
|
module Lit = Lit
|
||||||
module Proof_step = Proof_step
|
module Proof_step = Proof_step
|
||||||
|
|
|
||||||
15
src/core/bool_view.ml
Normal file
15
src/core/bool_view.ml
Normal file
|
|
@ -0,0 +1,15 @@
|
||||||
|
(** Boolean-oriented view of terms *)
|
||||||
|
|
||||||
|
(** View *)
|
||||||
|
type ('a, 'args) t =
|
||||||
|
| B_bool of bool
|
||||||
|
| B_not of 'a
|
||||||
|
| B_and of 'args
|
||||||
|
| B_or of 'args
|
||||||
|
| B_imply of 'args * 'a
|
||||||
|
| B_equiv of 'a * 'a
|
||||||
|
| B_xor of 'a * 'a
|
||||||
|
| B_eq of 'a * 'a
|
||||||
|
| B_neq of 'a * 'a
|
||||||
|
| B_ite of 'a * 'a * 'a
|
||||||
|
| B_atom of 'a
|
||||||
|
|
@ -53,7 +53,7 @@ end = struct
|
||||||
| B_not u when is_true u -> ret_bequiv t (T.false_ tst)
|
| B_not u when is_true u -> ret_bequiv t (T.false_ tst)
|
||||||
| B_not u when is_false u -> ret_bequiv t (T.true_ tst)
|
| B_not u when is_false u -> ret_bequiv t (T.true_ tst)
|
||||||
| B_not _ -> None
|
| B_not _ -> None
|
||||||
| B_opaque_bool _ -> None
|
| B_atom _ -> None
|
||||||
| B_and a ->
|
| B_and a ->
|
||||||
if Iter.exists is_false a then
|
if Iter.exists is_false a then
|
||||||
ret (T.false_ tst)
|
ret (T.false_ tst)
|
||||||
|
|
@ -102,7 +102,6 @@ end = struct
|
||||||
| B_eq (a, b) when T.equal a b -> ret_bequiv t (T.true_ tst)
|
| B_eq (a, b) when T.equal a b -> ret_bequiv t (T.true_ tst)
|
||||||
| B_neq (a, b) when T.equal a b -> ret_bequiv t (T.true_ tst)
|
| B_neq (a, b) when T.equal a b -> ret_bequiv t (T.true_ tst)
|
||||||
| B_eq _ | B_neq _ -> None
|
| B_eq _ | B_neq _ -> None
|
||||||
| B_atom _ -> None
|
|
||||||
|
|
||||||
let fresh_term self ~for_t ~pre ty =
|
let fresh_term self ~for_t ~pre ty =
|
||||||
let u = A.Gensym.fresh_term self.gensym ~pre ty in
|
let u = A.Gensym.fresh_term self.gensym ~pre ty in
|
||||||
|
|
@ -164,7 +163,6 @@ end = struct
|
||||||
|
|
||||||
(* make a literal for [t], with a proof of [|- abs(t) = abs(lit)] *)
|
(* make a literal for [t], with a proof of [|- abs(t) = abs(lit)] *)
|
||||||
(match A.view_as_bool t with
|
(match A.view_as_bool t with
|
||||||
| B_opaque_bool _ -> ()
|
|
||||||
| B_bool _ -> ()
|
| B_bool _ -> ()
|
||||||
| B_not _ -> ()
|
| B_not _ -> ()
|
||||||
| B_and l ->
|
| B_and l ->
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,7 @@ type term = Term.t
|
||||||
type ty = Term.t
|
type ty = Term.t
|
||||||
|
|
||||||
(** Boolean-oriented view of terms *)
|
(** Boolean-oriented view of terms *)
|
||||||
type ('a, 'args) bool_view =
|
type ('a, 'args) bool_view = ('a, 'args) Bool_view.t =
|
||||||
| B_bool of bool
|
| B_bool of bool
|
||||||
| B_not of 'a
|
| B_not of 'a
|
||||||
| B_and of 'args
|
| B_and of 'args
|
||||||
|
|
@ -17,7 +17,6 @@ type ('a, 'args) bool_view =
|
||||||
| B_eq of 'a * 'a
|
| B_eq of 'a * 'a
|
||||||
| B_neq of 'a * 'a
|
| B_neq of 'a * 'a
|
||||||
| B_ite of 'a * 'a * 'a
|
| B_ite of 'a * 'a * 'a
|
||||||
| B_opaque_bool of 'a (* do not enter *)
|
|
||||||
| B_atom of 'a
|
| B_atom of 'a
|
||||||
|
|
||||||
module type PROOF_RULES = sig
|
module type PROOF_RULES = sig
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue