simon/sidekick
1
0
Fork 0
mirror of https://github.com/c-cube/sidekick.git synced 2025-12-11 05:28:34 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

refactor some names related to proofs; wip add unit paramod

Browse source
This commit is contained in:
Simon Cruanes 2021-10-03 20:32:37 -04:00
parent 04f1ba063d
commit bbb995b0d5
No known key found for this signature in database
GPG key ID: 4AC01D0849AA62B6
12 changed files with 219 additions and 194 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/cc/Sidekick_cc.ml
View file

@ -16,7 +16,7 @@ module Make (A: CC_ARG)
: S with module T = A.T : S with module T = A.T
and module Lit = A.Lit and module Lit = A.Lit
and type proof = A.proof and type proof = A.proof
and type step_id = A.step_id and type proof_step = A.proof_step
and module Actions = A.Actions and module Actions = A.Actions
= struct = struct
module T = A.T module T = A.T
@ -28,8 +28,8 @@ module Make (A: CC_ARG)
type lit = Lit.t type lit = Lit.t
type fun_ = T.Fun.t type fun_ = T.Fun.t
type proof = A.proof type proof = A.proof
type step_id = A.step_id type proof_step = A.proof_step
type pstep = proof -> step_id type proof_rule = proof -> proof_step
type actions = Actions.t type actions = Actions.t
module Term = T.Term module Term = T.Term

2
src/cc/Sidekick_cc.mli
View file

@ -7,5 +7,5 @@ module Make (A: CC_ARG)
: S with module T = A.T : S with module T = A.T
and module Lit = A.Lit and module Lit = A.Lit
and type proof = A.proof and type proof = A.proof
and type step_id = A.step_id and type proof_step = A.proof_step
and module Actions = A.Actions and module Actions = A.Actions

4
src/checker/drup_check.ml
View file

@ -137,7 +137,7 @@ end = struct
let ok = check_op self i op in let ok = check_op self i op in
if ok then ( if ok then (
Log.debugf 50 Log.debugf 50
(fun k->k"(@[check.step.ok@ :idx %d@ :op %a@])" i Trace.pp_op op); (fun k->k"(@[check.proof_rule.ok@ :idx %d@ :op %a@])" i Trace.pp_op op);
(* check if op adds the empty clause *) (* check if op adds the empty clause *)
begin match op with begin match op with
@ -147,7 +147,7 @@ end = struct
end; end;
) else ( ) else (
Log.debugf 10 Log.debugf 10
(fun k->k"(@[check.step.fail@ :idx %d@ :op %a@])" i Trace.pp_op op); (fun k->k"(@[check.proof_rule.fail@ :idx %d@ :op %a@])" i Trace.pp_op op);
VecI32.push self.errors i VecI32.push self.errors i
)); ));

135
src/core/Sidekick_core.ml
View file

@ -147,11 +147,11 @@ end
(** Proofs for the congruence closure *) (** Proofs for the congruence closure *)
module type CC_PROOF = sig module type CC_PROOF = sig
type step_id type proof_step
type t type t
type lit type lit
val lemma_cc : lit Iter.t -> t -> step_id val lemma_cc : lit Iter.t -> t -> proof_step
(** [lemma_cc proof lits] asserts that [lits] form a tautology for the theory (** [lemma_cc proof lits] asserts that [lits] form a tautology for the theory
of uninterpreted functions. *) of uninterpreted functions. *)
end end
@ -161,17 +161,17 @@ module type SAT_PROOF = sig
type t type t
(** The stored proof (possibly nil, possibly on disk, possibly in memory) *) (** The stored proof (possibly nil, possibly on disk, possibly in memory) *)
type step_id type proof_step
(** identifier for a proof step *) (** identifier for a proof proof_rule *)
module Step_vec : Vec_sig.S with type elt = step_id module Step_vec : Vec_sig.S with type elt = proof_step
(** A vector of steps *) (** A vector of steps *)
type lit type lit
(** A boolean literal for the proof trace *) (** A boolean literal for the proof trace *)
type pstep = t -> step_id type proof_rule = t -> proof_step
(** A proof step constructor, used to obtain proofs from theories *) (** A proof proof_rule constructor, used to obtain proofs from theories *)
val enabled : t -> bool val enabled : t -> bool
(** Returns true if proof production is enabled *) (** Returns true if proof production is enabled *)
@ -179,23 +179,23 @@ module type SAT_PROOF = sig
val with_proof : t -> (t -> 'a) -> 'a val with_proof : t -> (t -> 'a) -> 'a
(** If proof is enabled, call [f] on it to emit steps. (** If proof is enabled, call [f] on it to emit steps.
if proof is disabled, the callback won't even be called, and if proof is disabled, the callback won't even be called, and
a dummy step is returned. *) a dummy proof_rule is returned. *)
val emit_input_clause : lit Iter.t -> pstep val emit_input_clause : lit Iter.t -> proof_rule
(** Emit an input clause. *) (** Emit an input clause. *)
val emit_redundant_clause : lit Iter.t -> hyps:step_id Iter.t -> pstep val emit_redundant_clause : lit Iter.t -> hyps:proof_step Iter.t -> proof_rule
(** Emit a clause deduced by the SAT solver, redundant wrt previous clauses. (** Emit a clause deduced by the SAT solver, redundant wrt previous clauses.
The clause must be RUP wrt [hyps]. *) The clause must be RUP wrt [hyps]. *)
val emit_unsat_core : lit Iter.t -> pstep val emit_unsat_core : lit Iter.t -> proof_rule
(** Produce a proof of the empty clause given this subset of the assumptions. (** Produce a proof of the empty clause given this subset of the assumptions.
FIXME: probably needs the list of step_id that disprove the lits? *) FIXME: probably needs the list of proof_step that disprove the lits? *)
val emit_unsat : step_id -> t -> unit val emit_unsat : proof_step -> t -> unit
(** Signal "unsat" result at the given step *) (** Signal "unsat" result at the given proof_rule *)
val del_clause : step_id -> t -> unit val del_clause : proof_step -> t -> unit
(** Forget a clause. Only useful for performance considerations. *) (** Forget a clause. Only useful for performance considerations. *)
end end
@ -206,33 +206,39 @@ module type PROOF = sig
a clause to be {b valid} (true in every possible interpretation a clause to be {b valid} (true in every possible interpretation
of the problem's assertions, and the theories) *) of the problem's assertions, and the theories) *)
type step_id type proof_step
(** Identifier for a proof step (like a unique ID for a clause previously (** Identifier for a proof proof_rule (like a unique ID for a clause previously
added/proved) *) added/proved) *)
type term type term
type lit type lit
type step = t -> step_id type proof_rule = t -> proof_step
include CC_PROOF include CC_PROOF
with type t := t with type t := t
and type lit := lit and type lit := lit
and type step_id := step_id and type proof_step := proof_step
include SAT_PROOF include SAT_PROOF
with type t := t with type t := t
and type lit := lit and type lit := lit
and type step_id := step_id and type proof_step := proof_step
and type proof_rule := proof_rule
val define_term : term -> term -> step val define_term : term -> term -> proof_rule
(** [define_term cst u proof] defines the new constant [cst] as being equal (** [define_term cst u proof] defines the new constant [cst] as being equal
to [u]. to [u].
The result is a proof of the clause [cst = u] *) The result is a proof of the clause [cst = u] *)
val lemma_true : term -> step val proof_p1 : proof_step -> proof_step -> proof_rule
(** [proof_p1 p1 p2], where [p1] proves the unit clause [t=u] (t:bool)
and [p2] proves [C \/ t], is the rule that produces [C \/ u],
i.e unit paramodulation. *)
val lemma_true : term -> proof_rule
(** [lemma_true (true) p] asserts the clause [(true)] *) (** [lemma_true (true) p] asserts the clause [(true)] *)
val lemma_preprocess : term -> term -> using:step_id Iter.t -> step val lemma_preprocess : term -> term -> using:proof_step Iter.t -> proof_rule
(** [lemma_preprocess t u ~using p] asserts that [t = u] is a tautology (** [lemma_preprocess t u ~using p] asserts that [t = u] is a tautology
and that [t] has been preprocessed into [u]. and that [t] has been preprocessed into [u].
@ -241,7 +247,7 @@ module type PROOF = sig
a unit equality. a unit equality.
From now on, [t] and [u] will be used interchangeably. From now on, [t] and [u] will be used interchangeably.
@return a step ID for the clause [(t=u)]. *) @return a proof_rule ID for the clause [(t=u)]. *)
end end
(** Literals (** Literals
@ -300,8 +306,8 @@ module type CC_ACTIONS = sig
module Lit : LIT with module T = T module Lit : LIT with module T = T
type proof type proof
type step_id type proof_step
type pstep = proof -> step_id type proof_rule = proof -> proof_step
module P : CC_PROOF with type lit = Lit.t and type t = proof module P : CC_PROOF with type lit = Lit.t and type t = proof
type t type t
@ -309,13 +315,13 @@ module type CC_ACTIONS = sig
to perform the actions below. How it performs the actions to perform the actions below. How it performs the actions
is not specified and is solver-specific. *) is not specified and is solver-specific. *)
val raise_conflict : t -> Lit.t list -> pstep -> 'a val raise_conflict : t -> Lit.t list -> proof_rule -> 'a
(** [raise_conflict acts c pr] declares that [c] is a tautology of (** [raise_conflict acts c pr] declares that [c] is a tautology of
the theory of congruence. This does not return (it should raise an the theory of congruence. This does not return (it should raise an
exception). exception).
@param pr the proof of [c] being a tautology *) @param pr the proof of [c] being a tautology *)
val propagate : t -> Lit.t -> reason:(unit -> Lit.t list * pstep) -> unit val propagate : t -> Lit.t -> reason:(unit -> Lit.t list * proof_rule) -> unit
(** [propagate acts lit ~reason pr] declares that [reason() => lit] (** [propagate acts lit ~reason pr] declares that [reason() => lit]
is a tautology. is a tautology.
@ -331,16 +337,16 @@ module type CC_ARG = sig
module T : TERM module T : TERM
module Lit : LIT with module T = T module Lit : LIT with module T = T
type proof type proof
type step_id type proof_step
module P : CC_PROOF module P : CC_PROOF
with type lit = Lit.t with type lit = Lit.t
and type t = proof and type t = proof
and type step_id = step_id and type proof_step = proof_step
module Actions : CC_ACTIONS module Actions : CC_ACTIONS
with module T=T with module T=T
and module Lit = Lit and module Lit = Lit
and type proof = proof and type proof = proof
and type step_id = step_id and type proof_step = proof_step
val cc_view : T.Term.t -> (T.Fun.t, T.Term.t, T.Term.t Iter.t) CC_view.t val cc_view : T.Term.t -> (T.Fun.t, T.Term.t, T.Term.t Iter.t) CC_view.t
(** View the term through the lens of the congruence closure *) (** View the term through the lens of the congruence closure *)
@ -368,17 +374,17 @@ module type CC_S = sig
module T : TERM module T : TERM
module Lit : LIT with module T = T module Lit : LIT with module T = T
type proof type proof
type step_id type proof_step
type pstep = proof -> step_id type proof_rule = proof -> proof_step
module P : CC_PROOF module P : CC_PROOF
with type lit = Lit.t with type lit = Lit.t
and type t = proof and type t = proof
and type step_id = step_id and type proof_step = proof_step
module Actions : CC_ACTIONS module Actions : CC_ACTIONS
with module T = T with module T = T
and module Lit = Lit and module Lit = Lit
and type proof = proof and type proof = proof
and type step_id = step_id and type proof_step = proof_step
type term_store = T.Term.store type term_store = T.Term.store
type term = T.Term.t type term = T.Term.t
type fun_ = T.Fun.t type fun_ = T.Fun.t
@ -519,7 +525,7 @@ module type CC_S = sig
participating in the conflict are purely syntactic theories participating in the conflict are purely syntactic theories
like injectivity of constructors. *) like injectivity of constructors. *)
type ev_on_propagate = t -> lit -> (unit -> lit list * pstep) -> unit type ev_on_propagate = t -> lit -> (unit -> lit list * proof_rule) -> unit
(** [ev_on_propagate cc lit reason] is called whenever [reason() => lit] (** [ev_on_propagate cc lit reason] is called whenever [reason() => lit]
is a propagated lemma. See {!CC_ACTIONS.propagate}. *) is a propagated lemma. See {!CC_ACTIONS.propagate}. *)
@ -673,12 +679,16 @@ module type SOLVER_INTERNAL = sig
type ty_store = T.Ty.store type ty_store = T.Ty.store
type clause_pool type clause_pool
type proof type proof
type step_id type proof_step
type pstep = proof -> step_id type proof_rule = proof -> proof_step
(** Delayed proof. This is used to build a proof step on demand. *) (** Delayed proof. This is used to build a proof proof_rule on demand. *)
(** {3 Proofs} *) (** {3 Proofs} *)
module P : PROOF with type lit = Lit.t and type term = term and type t = proof module P : PROOF
with type lit = Lit.t
and type term = term
and type t = proof
and type proof_step = proof_step
(** {3 Main type for a solver} *) (** {3 Main type for a solver} *)
type t type t
@ -730,24 +740,24 @@ module type SOLVER_INTERNAL = sig
val clear : t -> unit val clear : t -> unit
(** Reset internal cache, etc. *) (** Reset internal cache, etc. *)
val with_proof : t -> (proof -> unit) -> unit val with_proof : t -> (proof -> 'a) -> 'a
type hook = t -> term -> term option type hook = t -> term -> (term * proof_step Iter.t) option
(** Given a term, try to simplify it. Return [None] if it didn't change. (** Given a term, try to simplify it. Return [None] if it didn't change.
A simple example could be a hook that takes a term [t], A simple example could be a hook that takes a term [t],
and if [t] is [app "+" (const x) (const y)] where [x] and [y] are number, and if [t] is [app "+" (const x) (const y)] where [x] and [y] are number,
returns [Some (const (x+y))], and [None] otherwise. *) returns [Some (const (x+y))], and [None] otherwise. *)
val normalize : t -> term -> term option val normalize : t -> term -> (term * proof_step Iter.t) option
(** Normalize a term using all the hooks. This performs (** Normalize a term using all the hooks. This performs
a fixpoint, i.e. it only stops when no hook applies anywhere inside a fixpoint, i.e. it only stops when no hook applies anywhere inside
the term. *) the term. *)
val normalize_t : t -> term -> term val normalize_t : t -> term -> term * proof_step Iter.t
(** Normalize a term using all the hooks, along with a proof that the (** Normalize a term using all the hooks, along with a proof that the
simplification is correct. simplification is correct.
returns [t, refl t] if no simplification occurred. *) returns [t, ø] if no simplification occurred. *)
end end
type simplify_hook = Simplify.hook type simplify_hook = Simplify.hook
@ -755,13 +765,11 @@ module type SOLVER_INTERNAL = sig
val add_simplifier : t -> Simplify.hook -> unit val add_simplifier : t -> Simplify.hook -> unit
(** Add a simplifier hook for preprocessing. *) (** Add a simplifier hook for preprocessing. *)
val simplifier : t -> Simplify.t val simplify_t : t -> term -> (term * proof_step) option
val simplify_t : t -> term -> term option
(** Simplify input term, returns [Some u] if some (** Simplify input term, returns [Some u] if some
simplification occurred. *) simplification occurred. *)
val simp_t : t -> term -> term val simp_t : t -> term -> term * proof_step option
(** [simp_t si t] returns [u] even if no simplification occurred (** [simp_t si t] returns [u] even if no simplification occurred
(in which case [t == u] syntactically). (in which case [t == u] syntactically).
It emits [|- t=u]. It emits [|- t=u].
@ -776,7 +784,7 @@ module type SOLVER_INTERNAL = sig
val mk_lit : ?sign:bool -> term -> lit val mk_lit : ?sign:bool -> term -> lit
(** creates a new literal for a boolean term. *) (** creates a new literal for a boolean term. *)
val add_clause : lit list -> pstep -> unit val add_clause : lit list -> proof_rule -> unit
(** pushes a new clause into the SAT solver. *) (** pushes a new clause into the SAT solver. *)
val add_lit : ?default_pol:bool -> lit -> unit val add_lit : ?default_pol:bool -> lit -> unit
@ -789,7 +797,7 @@ module type SOLVER_INTERNAL = sig
type preprocess_hook = type preprocess_hook =
t -> t ->
preprocess_actions -> preprocess_actions ->
term -> term option term -> (term * proof_step Iter.t) option
(** Given a term, try to preprocess it. Return [None] if it didn't change, (** Given a term, try to preprocess it. Return [None] if it didn't change,
or [Some (u)] if [t=u]. or [Some (u)] if [t=u].
Can also add clauses to define new terms. Can also add clauses to define new terms.
@ -809,7 +817,7 @@ module type SOLVER_INTERNAL = sig
(** {3 hooks for the theory} *) (** {3 hooks for the theory} *)
val raise_conflict : t -> theory_actions -> lit list -> pstep -> 'a val raise_conflict : t -> theory_actions -> lit list -> proof_rule -> 'a
(** Give a conflict clause to the solver *) (** Give a conflict clause to the solver *)
val push_decision : t -> theory_actions -> lit -> unit val push_decision : t -> theory_actions -> lit -> unit
@ -818,19 +826,19 @@ module type SOLVER_INTERNAL = sig
If the SAT solver backtracks, this (potential) decision is removed If the SAT solver backtracks, this (potential) decision is removed
and forgotten. *) and forgotten. *)
val propagate: t -> theory_actions -> lit -> reason:(unit -> lit list * pstep) -> unit val propagate: t -> theory_actions -> lit -> reason:(unit -> lit list * proof_rule) -> unit
(** Propagate a boolean using a unit clause. (** Propagate a boolean using a unit clause.
[expl => lit] must be a theory lemma, that is, a T-tautology *) [expl => lit] must be a theory lemma, that is, a T-tautology *)
val propagate_l: t -> theory_actions -> lit -> lit list -> pstep -> unit val propagate_l: t -> theory_actions -> lit -> lit list -> proof_rule -> unit
(** Propagate a boolean using a unit clause. (** Propagate a boolean using a unit clause.
[expl => lit] must be a theory lemma, that is, a T-tautology *) [expl => lit] must be a theory lemma, that is, a T-tautology *)
val add_clause_temp : t -> theory_actions -> lit list -> pstep -> unit val add_clause_temp : t -> theory_actions -> lit list -> proof_rule -> unit
(** Add local clause to the SAT solver. This clause will be (** Add local clause to the SAT solver. This clause will be
removed when the solver backtracks. *) removed when the solver backtracks. *)
val add_clause_permanent : t -> theory_actions -> lit list -> pstep -> unit val add_clause_permanent : t -> theory_actions -> lit list -> proof_rule -> unit
(** Add toplevel clause to the SAT solver. This clause will (** Add toplevel clause to the SAT solver. This clause will
not be backtracked. *) not be backtracked. *)
@ -894,7 +902,7 @@ module type SOLVER_INTERNAL = sig
val on_cc_conflict : t -> (CC.t -> th:bool -> lit list -> unit) -> unit val on_cc_conflict : t -> (CC.t -> th:bool -> lit list -> unit) -> unit
(** Callback called on every CC conflict *) (** Callback called on every CC conflict *)
val on_cc_propagate : t -> (CC.t -> lit -> (unit -> lit list * pstep) -> unit) -> unit val on_cc_propagate : t -> (CC.t -> lit -> (unit -> lit list * proof_rule) -> unit) -> unit
(** Callback called on every CC propagation *) (** Callback called on every CC propagation *)
val on_partial_check : t -> (t -> theory_actions -> lit Iter.t -> unit) -> unit val on_partial_check : t -> (t -> theory_actions -> lit Iter.t -> unit) -> unit
@ -941,11 +949,11 @@ module type SOLVER = sig
module T : TERM module T : TERM
module Lit : LIT with module T = T module Lit : LIT with module T = T
type proof type proof
type step_id type proof_step
module P : PROOF module P : PROOF
with type lit = Lit.t with type lit = Lit.t
and type t = proof and type t = proof
and type step_id = step_id and type proof_step = proof_step
and type term = T.Term.t and type term = T.Term.t
module Solver_internal module Solver_internal
@ -953,6 +961,7 @@ module type SOLVER = sig
with module T = T with module T = T
and module Lit = Lit and module Lit = Lit
and type proof = proof and type proof = proof
and type proof_step = proof_step
and module P = P and module P = P
(** Internal solver, available to theories. *) (** Internal solver, available to theories. *)
@ -963,8 +972,8 @@ module type SOLVER = sig
type term = T.Term.t type term = T.Term.t
type ty = T.Ty.t type ty = T.Ty.t
type lit = Lit.t type lit = Lit.t
type pstep = proof -> step_id type proof_rule = proof -> proof_step
(** Proof step. *) (** Proof proof_rule. *)
(** {3 A theory} (** {3 A theory}
@ -1099,11 +1108,11 @@ module type SOLVER = sig
The proof of [|- lit = lit'] is directly added to the solver's proof. *) The proof of [|- lit = lit'] is directly added to the solver's proof. *)
val add_clause : t -> lit IArray.t -> pstep -> unit val add_clause : t -> lit IArray.t -> proof_rule -> unit
(** [add_clause solver cs] adds a boolean clause to the solver. (** [add_clause solver cs] adds a boolean clause to the solver.
Subsequent calls to {!solve} will need to satisfy this clause. *) Subsequent calls to {!solve} will need to satisfy this clause. *)
val add_clause_l : t -> lit list -> pstep -> unit val add_clause_l : t -> lit list -> proof_rule -> unit
(** Add a clause to the solver, given as a list. *) (** Add a clause to the solver, given as a list. *)
val assert_terms : t -> term list -> unit val assert_terms : t -> term list -> unit

2
src/drup/sidekick_drup.ml
View file

@ -1,7 +1,7 @@
(** DRUP trace checker. (** DRUP trace checker.
This module provides a checker for DRUP traces, including step-by-step This module provides a checker for DRUP traces, including proof_rule-by-proof_rule
checking for traces that interleave DRUP steps with other kinds of steps. checking for traces that interleave DRUP steps with other kinds of steps.
*) *)

2
src/lra/simplex2.ml
View file

@ -138,7 +138,7 @@ end
(* TODO(optim): page 14, paragraph 2: we could detect which variables occur in no (* TODO(optim): page 14, paragraph 2: we could detect which variables occur in no
atom after preprocessing; then these variables can be "inlined" (removed atom after preprocessing; then these variables can be "inlined" (removed
by Gaussian elimination) as a preprocessing step, and this removes one column by Gaussian elimination) as a preprocessing proof_rule, and this removes one column
and maybe one row if it was basic. *) and maybe one row if it was basic. *)
module Make(Q : RATIONAL)(Var: VAR) module Make(Q : RATIONAL)(Var: VAR)

8
src/lra/tests/test_simplex2.real.ml
View file

@ -98,7 +98,7 @@ module Step = struct
let rec aux n vars acc = let rec aux n vars acc =
if n<=0 then return (List.rev acc) if n<=0 then return (List.rev acc)
else ( else (
let* vars, step = let* vars, proof_rule =
frequency @@ List.flatten [ frequency @@ List.flatten [
(* add a bound *) (* add a bound *)
(match vars with (match vars with
@ -138,7 +138,7 @@ module Step = struct
) else []); ) else []);
] ]
in in
aux (n-1) vars (step::acc) aux (n-1) vars (proof_rule::acc)
) )
in in
aux n [] [] aux n [] []
@ -162,7 +162,7 @@ end
let on_propagate _ ~reason:_ = () let on_propagate _ ~reason:_ = ()
(* add a single step to the simplexe *) (* add a single proof_rule to the simplexe *)
let add_step simplex (s:Step.t) : unit = let add_step simplex (s:Step.t) : unit =
begin match s with begin match s with
| Step.S_new_var v -> Spl.add_var simplex v | Step.S_new_var v -> Spl.add_var simplex v
@ -242,7 +242,7 @@ let prop_sound ?(inv=false) pb =
let v_x = get_val x in let v_x = get_val x in
if Q.(v_x < n) then failwith (spf "val=%s, n=%s"(q_dbg v_x)(q_dbg n)) if Q.(v_x < n) then failwith (spf "val=%s, n=%s"(q_dbg v_x)(q_dbg n))
with e -> with e ->
QC.Test.fail_reportf "step failed: %a@.exn:@.%s@." QC.Test.fail_reportf "proof_rule failed: %a@.exn:@.%s@."
Step.pp_ s (Printexc.to_string e) Step.pp_ s (Printexc.to_string e)
); );
if inv then Spl._check_invariants simplex; if inv then Spl._check_invariants simplex;

22
src/proof/Proof.ml
View file

@ -59,7 +59,7 @@ type t =
| Composite of { | Composite of {
(* some named (atomic) assumptions *) (* some named (atomic) assumptions *)
assumptions: (string * lit) list; assumptions: (string * lit) list;
steps: composite_step array; (* last step is the proof *) steps: composite_step array; (* last proof_rule is the proof *)
} }
and bool_c_name = string and bool_c_name = string
@ -75,7 +75,7 @@ and composite_step =
(* TODO: be able to name clauses, to be expanded at parsing. (* TODO: be able to name clauses, to be expanded at parsing.
note that this is not the same as [S_step_c] which defines an note that this is not the same as [S_step_c] which defines an
explicit step with a conclusion and proofs that can be exploited explicit proof_rule with a conclusion and proofs that can be exploited
separately. separately.
We could introduce that in Compress.rename… We could introduce that in Compress.rename…
@ -192,7 +192,7 @@ module Compress = struct
type 'a shared_status = type 'a shared_status =
| First (* first occurrence of t *) | First (* first occurrence of t *)
| Shared (* multiple occurrences observed *) | Shared (* multiple occurrences observed *)
| Pre_named of 'a (* another step names it *) | Pre_named of 'a (* another proof_rule names it *)
| Named of 'a (* already named it *) | Named of 'a (* already named it *)
(* is [t] too small to be shared? *) (* is [t] too small to be shared? *)
@ -301,15 +301,15 @@ module Compress = struct
| _ -> ()) | _ -> ())
in in
(* introduce naming in [step], then push it into {!new_steps} *) (* introduce naming in [proof_rule], then push it into {!new_steps} *)
let process_step_ step = let process_step_ proof_rule =
traverse_step_ step ~f_t:traverse_t; traverse_step_ proof_rule ~f_t:traverse_t;
(* see if we print the step or skip it *) (* see if we print the proof_rule or skip it *)
begin match step with begin match proof_rule with
| S_define_t (t,_) when T.Tbl.mem skip_name_t t -> () | S_define_t (t,_) when T.Tbl.mem skip_name_t t -> ()
| S_define_t_name (s,_) when Hashtbl.mem skip_name_s s -> () | S_define_t_name (s,_) when Hashtbl.mem skip_name_s s -> ()
| _ -> | _ ->
Vec.push new_steps step; Vec.push new_steps proof_rule;
end end
in in
@ -426,10 +426,10 @@ module Quip = struct
l[a"steps";l(List.map pp_ass assumptions); l[a"steps";l(List.map pp_ass assumptions);
iter_toplist (pp_composite_step sharing) (Iter.of_array steps)] iter_toplist (pp_composite_step sharing) (Iter.of_array steps)]
and pp_composite_step sharing step : printer = and pp_composite_step sharing proof_rule : printer =
let pp_t = pp_t sharing in let pp_t = pp_t sharing in
let pp_cl = pp_cl ~pp_t in let pp_cl = pp_cl ~pp_t in
match step with match proof_rule with
| S_step_c {name;res;proof} -> | S_step_c {name;res;proof} ->
l[a"stepc";a name;pp_cl res;pp_rec sharing proof] l[a"stepc";a name;pp_cl res;pp_rec sharing proof]
| S_define_t (c,rhs) -> | S_define_t (c,rhs) ->

80
src/sat/Solver.ml
View file

@ -19,8 +19,8 @@ module Make(Plugin : PLUGIN)
type lit = Plugin.lit type lit = Plugin.lit
type theory = Plugin.t type theory = Plugin.t
type proof = Plugin.proof type proof = Plugin.proof
type step_id = Plugin.step_id type proof_step = Plugin.proof_step
type pstep = proof -> step_id type proof_rule = proof -> proof_step
type clause_pool_id = Clause_pool_id.t type clause_pool_id = Clause_pool_id.t
module Lit = Plugin.Lit module Lit = Plugin.Lit
@ -95,7 +95,7 @@ module Make(Plugin : PLUGIN)
c_lits: atom array Vec.t; (* storage for clause content *) c_lits: atom array Vec.t; (* storage for clause content *)
c_activity: Vec_float.t; c_activity: Vec_float.t;
c_recycle_idx: VecI32.t; (* recycle clause numbers that were GC'd *) c_recycle_idx: VecI32.t; (* recycle clause numbers that were GC'd *)
c_proof: Step_vec.t; (* clause -> step for its proof *) c_proof: Step_vec.t; (* clause -> proof_rule for its proof *)
c_attached: Bitvec.t; c_attached: Bitvec.t;
c_marked: Bitvec.t; c_marked: Bitvec.t;
c_removable: Bitvec.t; c_removable: Bitvec.t;
@ -253,9 +253,9 @@ module Make(Plugin : PLUGIN)
(** Make a clause with the given atoms *) (** Make a clause with the given atoms *)
val make_a : store -> removable:bool -> atom array -> step_id -> t val make_a : store -> removable:bool -> atom array -> proof_step -> t
val make_l : store -> removable:bool -> atom list -> step_id -> t val make_l : store -> removable:bool -> atom list -> proof_step -> t
val make_vec : store -> removable:bool -> atom Vec.t -> step_id -> t val make_vec : store -> removable:bool -> atom Vec.t -> proof_step -> t
val n_atoms : store -> t -> int val n_atoms : store -> t -> int
@ -271,8 +271,8 @@ module Make(Plugin : PLUGIN)
val dealloc : store -> t -> unit val dealloc : store -> t -> unit
(** Delete the clause *) (** Delete the clause *)
val set_proof_step : store -> t -> step_id -> unit val set_proof_step : store -> t -> proof_step -> unit
val proof_step : store -> t -> step_id val proof_step : store -> t -> proof_step
val activity : store -> t -> float val activity : store -> t -> float
val set_activity : store -> t -> float -> unit val set_activity : store -> t -> float -> unit
@ -296,7 +296,7 @@ module Make(Plugin : PLUGIN)
(* TODO: store watch lists inside clauses *) (* TODO: store watch lists inside clauses *)
let make_a (store:store) ~removable (atoms:atom array) step_id : t = let make_a (store:store) ~removable (atoms:atom array) proof_step : t =
let { let {
c_recycle_idx; c_lits; c_activity; c_recycle_idx; c_lits; c_activity;
c_attached; c_dead; c_removable; c_marked; c_proof; c_attached; c_dead; c_removable; c_marked; c_proof;
@ -323,16 +323,16 @@ module Make(Plugin : PLUGIN)
end; end;
Vec.set c_lits cid atoms; Vec.set c_lits cid atoms;
Step_vec.set c_proof cid step_id; Step_vec.set c_proof cid proof_step;
let c = of_int_unsafe cid in let c = of_int_unsafe cid in
c c
let make_l store ~removable atoms step : t = let make_l store ~removable atoms proof_rule : t =
make_a store ~removable (Array.of_list atoms) step make_a store ~removable (Array.of_list atoms) proof_rule
let make_vec store ~removable atoms step : t = let make_vec store ~removable atoms proof_rule : t =
make_a store ~removable (Vec.to_array atoms) step make_a store ~removable (Vec.to_array atoms) proof_rule
let[@inline] n_atoms (store:store) (c:t) : int = let[@inline] n_atoms (store:store) (c:t) : int =
Array.length (Vec.get store.c_store.c_lits (c:t:>int)) Array.length (Vec.get store.c_store.c_lits (c:t:>int))
@ -394,14 +394,14 @@ module Make(Plugin : PLUGIN)
let[@inline] activity store c = Vec_float.get store.c_store.c_activity (c:t:>int) let[@inline] activity store c = Vec_float.get store.c_store.c_activity (c:t:>int)
let[@inline] set_activity store c f = Vec_float.set store.c_store.c_activity (c:t:>int) f let[@inline] set_activity store c f = Vec_float.set store.c_store.c_activity (c:t:>int) f
let[@inline] make_removable store l step : t = let[@inline] make_removable store l proof_rule : t =
make_l store ~removable:true l step make_l store ~removable:true l proof_rule
let[@inline] make_removable_a store a step = let[@inline] make_removable_a store a proof_rule =
make_a store ~removable:true a step make_a store ~removable:true a proof_rule
let[@inline] make_permanent store l step : t = let[@inline] make_permanent store l proof_rule : t =
let c = make_l store ~removable:false l step in let c = make_l store ~removable:false l proof_rule in
assert (not (removable store c)); (* permanent by default *) assert (not (removable store c)); (* permanent by default *)
c c
@ -1377,7 +1377,7 @@ module Make(Plugin : PLUGIN)
} }
(* FIXME (* FIXME
let prove_unsat_ (self:t) (conflict:conflict_res) : step_id = let prove_unsat_ (self:t) (conflict:conflict_res) : proof_step =
if Array.length conflict.atoms = 0 then ( if Array.length conflict.atoms = 0 then (
conflict conflict
) else ( ) else (
@ -1620,20 +1620,20 @@ module Make(Plugin : PLUGIN)
let[@inline] slice_get st i = AVec.get st.trail i let[@inline] slice_get st i = AVec.get st.trail i
let acts_add_clause self ?(keep=false) (l:lit list) (pstep:pstep): unit = let acts_add_clause self ?(keep=false) (l:lit list) (proof_rule:proof_rule): unit =
let atoms = List.rev_map (make_atom_ self) l in let atoms = List.rev_map (make_atom_ self) l in
let removable = not keep in let removable = not keep in
let c = let c =
let p = Proof.with_proof self.proof pstep in let p = Proof.with_proof self.proof proof_rule in
Clause.make_l self.store ~removable atoms p in Clause.make_l self.store ~removable atoms p in
Log.debugf 5 (fun k->k "(@[sat.th.add-clause@ %a@])" (Clause.debug self.store) c); Log.debugf 5 (fun k->k "(@[sat.th.add-clause@ %a@])" (Clause.debug self.store) c);
CVec.push self.clauses_to_add_learnt c CVec.push self.clauses_to_add_learnt c
let acts_add_clause_in_pool self ~pool (l:lit list) (pstep:pstep): unit = let acts_add_clause_in_pool self ~pool (l:lit list) (proof_rule:proof_rule): unit =
let atoms = List.rev_map (make_atom_ self) l in let atoms = List.rev_map (make_atom_ self) l in
let removable = true in let removable = true in
let c = let c =
let p = Proof.with_proof self.proof pstep in let p = Proof.with_proof self.proof proof_rule in
Clause.make_l self.store ~removable atoms p in Clause.make_l self.store ~removable atoms p in
let pool = Vec.get self.clause_pools (pool:clause_pool_id:>int) in let pool = Vec.get self.clause_pools (pool:clause_pool_id:>int) in
Log.debugf 5 (fun k->k "(@[sat.th.add-clause-in-pool@ %a@ :pool %s@])" Log.debugf 5 (fun k->k "(@[sat.th.add-clause-in-pool@ %a@ :pool %s@])"
@ -1650,11 +1650,11 @@ module Make(Plugin : PLUGIN)
self.next_decisions <- a :: self.next_decisions self.next_decisions <- a :: self.next_decisions
) )
let acts_raise self (l:lit list) (pstep:pstep) : 'a = let acts_raise self (l:lit list) (proof_rule:proof_rule) : 'a =
let atoms = List.rev_map (make_atom_ self) l in let atoms = List.rev_map (make_atom_ self) l in
(* conflicts can be removed *) (* conflicts can be removed *)
let c = let c =
let p = Proof.with_proof self.proof pstep in let p = Proof.with_proof self.proof proof_rule in
Clause.make_l self.store ~removable:true atoms p in Clause.make_l self.store ~removable:true atoms p in
Log.debugf 5 (fun k->k "(@[@{<yellow>sat.th.raise-conflict@}@ %a@])" Log.debugf 5 (fun k->k "(@[@{<yellow>sat.th.raise-conflict@}@ %a@])"
(Clause.debug self.store) c); (Clause.debug self.store) c);
@ -1676,17 +1676,17 @@ module Make(Plugin : PLUGIN)
let p = make_atom_ self f in let p = make_atom_ self f in
if Atom.is_true store p then () if Atom.is_true store p then ()
else if Atom.is_false store p then ( else if Atom.is_false store p then (
let lits, pstep = mk_expl() in let lits, proof_rule = mk_expl() in
let l = List.rev_map (fun f -> Atom.neg @@ make_atom_ self f) lits in let l = List.rev_map (fun f -> Atom.neg @@ make_atom_ self f) lits in
check_consequence_lits_false_ self l; check_consequence_lits_false_ self l;
let c = let c =
let proof = Proof.with_proof self.proof pstep in let proof = Proof.with_proof self.proof proof_rule in
Clause.make_l store ~removable:true (p :: l) proof in Clause.make_l store ~removable:true (p :: l) proof in
raise_notrace (Th_conflict c) raise_notrace (Th_conflict c)
) else ( ) else (
insert_var_order self (Atom.var p); insert_var_order self (Atom.var p);
let c = lazy ( let c = lazy (
let lits, pstep = mk_expl () in let lits, proof_rule = mk_expl () in
let l = List.rev_map (fun f -> Atom.neg @@ make_atom_ self f) lits in let l = List.rev_map (fun f -> Atom.neg @@ make_atom_ self f) lits in
(* note: we can check that invariant here in the [lazy] block, (* note: we can check that invariant here in the [lazy] block,
as conflict analysis will run in an environment where as conflict analysis will run in an environment where
@ -1695,7 +1695,7 @@ module Make(Plugin : PLUGIN)
(otherwise the propagated lit would have been backtracked and (otherwise the propagated lit would have been backtracked and
discarded already.) *) discarded already.) *)
check_consequence_lits_false_ self l; check_consequence_lits_false_ self l;
let proof = Proof.with_proof self.proof pstep in let proof = Proof.with_proof self.proof proof_rule in
Clause.make_l store ~removable:true (p :: l) proof Clause.make_l store ~removable:true (p :: l) proof
) in ) in
let level = decision_level self in let level = decision_level self in
@ -1724,8 +1724,8 @@ module Make(Plugin : PLUGIN)
let[@inline] current_slice st : _ Solver_intf.acts = let[@inline] current_slice st : _ Solver_intf.acts =
let module M = struct let module M = struct
type nonrec proof = proof type nonrec proof = proof
type nonrec step_id = step_id type nonrec proof_step = proof_step
type pstep = proof -> step_id type proof_rule = proof -> proof_step
type nonrec clause_pool_id = clause_pool_id type nonrec clause_pool_id = clause_pool_id
type nonrec lit = lit type nonrec lit = lit
let iter_assumptions=acts_iter st ~full:false st.th_head let iter_assumptions=acts_iter st ~full:false st.th_head
@ -1743,8 +1743,8 @@ module Make(Plugin : PLUGIN)
let[@inline] full_slice st : _ Solver_intf.acts = let[@inline] full_slice st : _ Solver_intf.acts =
let module M = struct let module M = struct
type nonrec proof = proof type nonrec proof = proof
type nonrec step_id = step_id type nonrec proof_step = proof_step
type pstep = proof -> step_id type proof_rule = proof -> proof_step
type nonrec clause_pool_id = clause_pool_id type nonrec clause_pool_id = clause_pool_id
type nonrec lit = lit type nonrec lit = lit
let iter_assumptions=acts_iter st ~full:true st.th_head let iter_assumptions=acts_iter st ~full:true st.th_head
@ -2120,7 +2120,7 @@ module Make(Plugin : PLUGIN)
(* Result type *) (* Result type *)
type res = type res =
| Sat of Lit.t Solver_intf.sat_state | Sat of Lit.t Solver_intf.sat_state
| Unsat of (lit,clause,step_id) Solver_intf.unsat_state | Unsat of (lit,clause,proof_step) Solver_intf.unsat_state
let pp_all self lvl status = let pp_all self lvl status =
Log.debugf lvl Log.debugf lvl
@ -2169,7 +2169,7 @@ module Make(Plugin : PLUGIN)
in in
let module M = struct let module M = struct
type nonrec lit = lit type nonrec lit = lit
type nonrec proof = step_id type nonrec proof = proof_step
type clause = Clause.t type clause = Clause.t
let unsat_conflict = unsat_conflict let unsat_conflict = unsat_conflict
let unsat_assumptions = unsat_assumptions let unsat_assumptions = unsat_assumptions
@ -2179,9 +2179,9 @@ module Make(Plugin : PLUGIN)
end in end in
(module M) (module M)
let add_clause_atoms_ self ~pool ~removable (c:atom array) step : unit = let add_clause_atoms_ self ~pool ~removable (c:atom array) proof_rule : unit =
try try
let proof = Proof.with_proof self.proof step in let proof = Proof.with_proof self.proof proof_rule in
let c = Clause.make_a self.store ~removable c proof in let c = Clause.make_a self.store ~removable c proof in
add_clause_ ~pool self c add_clause_ ~pool self c
with with
@ -2270,7 +2270,7 @@ module Make_pure_sat(Plugin : Solver_intf.PLUGIN_SAT) =
Make(struct Make(struct
type lit = Plugin.lit type lit = Plugin.lit
type proof = Plugin.proof type proof = Plugin.proof
type step_id = Plugin.step_id type proof_step = Plugin.proof_step
module Lit = Plugin.Lit module Lit = Plugin.Lit
module Proof = Plugin.Proof module Proof = Plugin.Proof
type t = unit type t = unit

34
src/sat/Solver_intf.ml
View file

@ -102,9 +102,9 @@ end
module type ACTS = sig module type ACTS = sig
type lit type lit
type proof type proof
type step_id type proof_step
type clause_pool_id = Clause_pool_id.t type clause_pool_id = Clause_pool_id.t
type pstep = proof -> step_id type proof_rule = proof -> proof_step
val iter_assumptions: (lit -> unit) -> unit val iter_assumptions: (lit -> unit) -> unit
(** Traverse the new assumptions on the boolean trail. *) (** Traverse the new assumptions on the boolean trail. *)
@ -116,7 +116,7 @@ module type ACTS = sig
(** Map the given lit to an internal atom, which will be decided by the (** Map the given lit to an internal atom, which will be decided by the
SAT solver. *) SAT solver. *)
val add_clause: ?keep:bool -> lit list -> pstep -> unit val add_clause: ?keep:bool -> lit list -> proof_rule -> unit
(** Add a clause to the solver. (** Add a clause to the solver.
@param keep if true, the clause will be kept by the solver. @param keep if true, the clause will be kept by the solver.
Otherwise the solver is allowed to GC the clause and propose this Otherwise the solver is allowed to GC the clause and propose this
@ -124,16 +124,16 @@ module type ACTS = sig
- [C_use_allocator alloc] puts the clause in the given allocator. - [C_use_allocator alloc] puts the clause in the given allocator.
*) *)
val add_clause_in_pool : pool:clause_pool_id -> lit list -> pstep -> unit val add_clause_in_pool : pool:clause_pool_id -> lit list -> proof_rule -> unit
(** Like {!add_clause} but uses a custom clause pool for the clause, (** Like {!add_clause} but uses a custom clause pool for the clause,
with its own lifetime. *) with its own lifetime. *)
val raise_conflict: lit list -> pstep -> 'b val raise_conflict: lit list -> proof_rule -> 'b
(** Raise a conflict, yielding control back to the solver. (** Raise a conflict, yielding control back to the solver.
The list of atoms must be a valid theory lemma that is false in the The list of atoms must be a valid theory lemma that is false in the
current trail. *) current trail. *)
val propagate: lit -> (lit, pstep) reason -> unit val propagate: lit -> (lit, proof_rule) reason -> unit
(** Propagate a lit, i.e. the theory can evaluate the lit to be true (** Propagate a lit, i.e. the theory can evaluate the lit to be true
(see the definition of {!type:eval_res} *) (see the definition of {!type:eval_res} *)
@ -189,13 +189,13 @@ module type PLUGIN_CDCL_T = sig
type proof type proof
(** Proof storage/recording *) (** Proof storage/recording *)
type step_id type proof_step
(** Identifier for a clause precendently added/proved *) (** Identifier for a clause precendently added/proved *)
module Proof : PROOF module Proof : PROOF
with type t = proof with type t = proof
and type lit = lit and type lit = lit
and type step_id = step_id and type proof_step = proof_step
val push_level : t -> unit val push_level : t -> unit
(** Create a new backtrack level *) (** Create a new backtrack level *)
@ -221,11 +221,11 @@ module type PLUGIN_SAT = sig
module Lit : LIT with type t = lit module Lit : LIT with type t = lit
type proof type proof
type step_id type proof_step
module Proof : PROOF module Proof : PROOF
with type t = proof with type t = proof
and type lit = lit and type lit = lit
and type step_id = step_id and type proof_step = proof_step
end end
(** The external interface implemented by safe solvers, such as the one (** The external interface implemented by safe solvers, such as the one
@ -249,9 +249,9 @@ module type S = sig
type proof type proof
(** A representation of a full proof *) (** A representation of a full proof *)
type step_id type proof_step
type pstep = proof -> step_id type proof_rule = proof -> proof_step
type solver type solver
(** The main solver type. *) (** The main solver type. *)
@ -345,7 +345,7 @@ module type S = sig
(** Result type for the solver *) (** Result type for the solver *)
type res = type res =
| Sat of lit sat_state (** Returned when the solver reaches SAT, with a model *) | Sat of lit sat_state (** Returned when the solver reaches SAT, with a model *)
| Unsat of (lit,clause,step_id) unsat_state (** Returned when the solver reaches UNSAT, with a proof *) | Unsat of (lit,clause,proof_step) unsat_state (** Returned when the solver reaches UNSAT, with a proof *)
exception UndecidedLit exception UndecidedLit
(** Exception raised by the evaluating functions when a literal (** Exception raised by the evaluating functions when a literal
@ -357,10 +357,10 @@ module type S = sig
(** Add the list of clauses to the current set of assumptions. (** Add the list of clauses to the current set of assumptions.
Modifies the sat solver state in place. *) Modifies the sat solver state in place. *)
val add_clause : t -> lit list -> pstep -> unit val add_clause : t -> lit list -> proof_rule -> unit
(** Lower level addition of clauses *) (** Lower level addition of clauses *)
val add_clause_a : t -> lit array -> pstep -> unit val add_clause_a : t -> lit array -> proof_rule -> unit
(** Lower level addition of clauses *) (** Lower level addition of clauses *)
val add_input_clause : t -> lit list -> unit val add_input_clause : t -> lit list -> unit
@ -369,10 +369,10 @@ module type S = sig
val add_input_clause_a : t -> lit array -> unit val add_input_clause_a : t -> lit array -> unit
(** Like {!add_clause_a} but with justification of being an input clause *) (** Like {!add_clause_a} but with justification of being an input clause *)
val add_clause_in_pool : t -> pool:clause_pool_id -> lit list -> pstep -> unit val add_clause_in_pool : t -> pool:clause_pool_id -> lit list -> proof_rule -> unit
(** Like {!add_clause} but using a specific clause pool *) (** Like {!add_clause} but using a specific clause pool *)
val add_clause_a_in_pool : t -> pool:clause_pool_id -> lit array -> pstep -> unit val add_clause_a_in_pool : t -> pool:clause_pool_id -> lit array -> proof_rule -> unit
(** Like {!add_clause_a} but using a specific clause pool *) (** Like {!add_clause_a} but using a specific clause pool *)
(* TODO: API to push/pop/clear assumptions from an inner vector *) (* TODO: API to push/pop/clear assumptions from an inner vector *)

23
src/smt-solver/Sidekick_smt_solver.ml
View file

@ -13,9 +13,11 @@ module type ARG = sig
module T : TERM module T : TERM
module Lit : LIT with module T = T module Lit : LIT with module T = T
type proof type proof
type proof_step
module P : PROOF module P : PROOF
with type term = T.Term.t with type term = T.Term.t
and type t = proof and type t = proof
and type proof_step = proof_step
and type lit = Lit.t and type lit = Lit.t
val cc_view : T.Term.t -> (T.Fun.t, T.Term.t, T.Term.t Iter.t) CC_view.t val cc_view : T.Term.t -> (T.Fun.t, T.Term.t, T.Term.t Iter.t) CC_view.t
@ -32,6 +34,7 @@ module Make(A : ARG)
: S : S
with module T = A.T with module T = A.T
and type proof = A.proof and type proof = A.proof
and type proof_step = A.proof_step
and module Lit = A.Lit and module Lit = A.Lit
and module P = A.P and module P = A.P
= struct = struct
@ -43,7 +46,8 @@ module Make(A : ARG)
type term = Term.t type term = Term.t
type ty = Ty.t type ty = Ty.t
type proof = A.proof type proof = A.proof
type dproof = proof -> unit type proof_step = A.proof_step
type proof_rule = proof -> proof_step
type lit = Lit.t type lit = Lit.t
(* actions from the sat solver *) (* actions from the sat solver *)
@ -85,7 +89,8 @@ module Make(A : ARG)
module CC = CC module CC = CC
module N = CC.N module N = CC.N
type nonrec proof = proof type nonrec proof = proof
type dproof = proof -> unit type nonrec proof_step = proof_step
type proof_rule = proof -> proof_step
type term = Term.t type term = Term.t
type ty = Ty.t type ty = Ty.t
type lit = Lit.t type lit = Lit.t
@ -160,7 +165,7 @@ module Make(A : ARG)
module type PREPROCESS_ACTS = sig module type PREPROCESS_ACTS = sig
val mk_lit : ?sign:bool -> term -> lit val mk_lit : ?sign:bool -> term -> lit
val add_clause : lit list -> dproof -> unit val add_clause : lit list -> proof_rule -> unit
val add_lit : ?default_pol:bool -> lit -> unit val add_lit : ?default_pol:bool -> lit -> unit
end end
type preprocess_actions = (module PREPROCESS_ACTS) type preprocess_actions = (module PREPROCESS_ACTS)
@ -236,12 +241,12 @@ module Make(A : ARG)
let[@inline] propagate_l self acts p cs proof : unit = let[@inline] propagate_l self acts p cs proof : unit =
propagate self acts p ~reason:(fun()->cs,proof) propagate self acts p ~reason:(fun()->cs,proof)
let add_sat_clause_ self (acts:theory_actions) ~keep lits (proof:dproof) : unit = let add_sat_clause_ self (acts:theory_actions) ~keep lits (proof:proof_rule) : unit =
let (module A) = acts in let (module A) = acts in
Stat.incr self.count_axiom; Stat.incr self.count_axiom;
A.add_clause ~keep lits proof A.add_clause ~keep lits proof
let add_sat_clause_pool_ self (acts:theory_actions) ~pool lits (proof:dproof) : unit = let add_sat_clause_pool_ self (acts:theory_actions) ~pool lits (proof:proof_rule) : unit =
let (module A) = acts in let (module A) = acts in
Stat.incr self.count_axiom; Stat.incr self.count_axiom;
A.add_clause_in_pool ~pool lits proof A.add_clause_in_pool ~pool lits proof
@ -371,7 +376,7 @@ module Make(A : ARG)
Lit.atom self.tst ~sign u Lit.atom self.tst ~sign u
(* add a clause using [acts] *) (* add a clause using [acts] *)
let add_clause_ self acts lits (proof:dproof) : unit = let add_clause_ self acts lits (proof:proof_rule) : unit =
add_sat_clause_ self acts ~keep:true lits proof add_sat_clause_ self acts ~keep:true lits proof
let[@inline] add_lit _self (acts:theory_actions) ?default_pol lit : unit = let[@inline] add_lit _self (acts:theory_actions) ?default_pol lit : unit =
@ -398,11 +403,11 @@ module Make(A : ARG)
let[@inline] preprocess_term self (pacts:preprocess_actions) (t:term) : term = let[@inline] preprocess_term self (pacts:preprocess_actions) (t:term) : term =
preprocess_term_ self pacts t preprocess_term_ self pacts t
let[@inline] add_clause_temp self acts c (proof:dproof) : unit = let[@inline] add_clause_temp self acts c (proof:proof_rule) : unit =
let c = preprocess_clause_ self acts c in let c = preprocess_clause_ self acts c in
add_sat_clause_ self acts ~keep:false c proof add_sat_clause_ self acts ~keep:false c proof
let[@inline] add_clause_permanent self acts c (proof:dproof) : unit = let[@inline] add_clause_permanent self acts c (proof:proof_rule) : unit =
let c = preprocess_clause_ self acts c in let c = preprocess_clause_ self acts c in
add_sat_clause_ self acts ~keep:true c proof add_sat_clause_ self acts ~keep:true c proof
@ -687,7 +692,7 @@ module Make(A : ARG)
let pp_stats out (self:t) : unit = let pp_stats out (self:t) : unit =
Stat.pp_all out (Stat.all @@ stats self) Stat.pp_all out (Stat.all @@ stats self)
let add_clause (self:t) (c:lit IArray.t) (proof:dproof) : unit = let add_clause (self:t) (c:lit IArray.t) (proof:proof_rule) : unit =
Stat.incr self.count_clause; Stat.incr self.count_clause;
Log.debugf 50 (fun k-> Log.debugf 50 (fun k->
k "(@[solver.add-clause@ %a@])" k "(@[solver.add-clause@ %a@])"

95
src/th-bool-static/Sidekick_th_bool_static.ml
View file

@ -36,20 +36,20 @@ module type ARG = sig
Only enable if some theories are susceptible to Only enable if some theories are susceptible to
create boolean formulas during the proof search. *) create boolean formulas during the proof search. *)
val lemma_bool_tauto : S.Lit.t Iter.t -> S.P.t -> unit val lemma_bool_tauto : S.Lit.t Iter.t -> S.P.proof_rule
(** Boolean tautology lemma (clause) *) (** Boolean tautology lemma (clause) *)
val lemma_bool_c : string -> term list -> S.P.t -> unit val lemma_bool_c : string -> term list -> S.P.proof_rule
(** Basic boolean logic lemma for a clause [|- c]. (** Basic boolean logic lemma for a clause [|- c].
[proof_bool_c b name cs] is the rule designated by [name]. *) [proof_bool_c b name cs] is the rule designated by [name]. *)
val lemma_bool_equiv : term -> term -> S.P.t -> unit val lemma_bool_equiv : term -> term -> S.P.proof_rule
(** Boolean tautology lemma (equivalence) *) (** Boolean tautology lemma (equivalence) *)
val lemma_ite_true : a:term -> ite:term -> S.P.t -> unit val lemma_ite_true : a:term -> ite:term -> S.P.proof_rule
(** lemma [a => ite a b c = b] *) (** lemma [a => ite a b c = b] *)
val lemma_ite_false : a:term -> ite:term -> S.P.t -> unit val lemma_ite_false : a:term -> ite:term -> S.P.proof_rule
(** lemma [¬a => ite a b c = c] *) (** lemma [¬a => ite a b c = c] *)
(** Fresh symbol generator. (** Fresh symbol generator.
@ -116,21 +116,24 @@ module Make(A : ARG) : S with module A = A = struct
let is_true t = match T.as_bool t with Some true -> true | _ -> false let is_true t = match T.as_bool t with Some true -> true | _ -> false
let is_false t = match T.as_bool t with Some false -> true | _ -> false let is_false t = match T.as_bool t with Some false -> true | _ -> false
let simplify (self:state) (simp:SI.Simplify.t) (t:T.t) : T.t option = let simplify (self:state) (simp:SI.Simplify.t) (t:T.t) : (T.t * SI.proof_step Iter.t) option =
let tst = self.tst in let tst = self.tst in
let ret u = let steps = ref [] in
if not (T.equal t u) then ( let add_step_ s = steps := s :: !steps in
SI.Simplify.with_proof simp (fun p ->
A.lemma_bool_equiv t u p; let[@inline] ret u =
A.S.P.lemma_preprocess t u p; Some (u, Iter.of_list !steps)
);
);
Some u
in in
(* proof is [t <=> u] *)
let ret_bequiv t1 u =
add_step_ @@ SI.Simplify.with_proof simp (A.lemma_bool_equiv t1 u);
ret u
in
match A.view_as_bool t with match A.view_as_bool t with
| B_bool _ -> None | B_bool _ -> None
| B_not u when is_true u -> ret (T.bool tst false) | B_not u when is_true u -> ret_bequiv t (T.bool tst false)
| B_not u when is_false u -> ret (T.bool tst true) | B_not u when is_false u -> ret_bequiv t (T.bool tst true)
| B_not _ -> None | B_not _ -> None
| B_opaque_bool _ -> None | B_opaque_bool _ -> None
| B_and a -> | B_and a ->
@ -148,28 +151,29 @@ module Make(A : ARG) : S with module A = A = struct
| B_ite (a,b,c) -> | B_ite (a,b,c) ->
(* directly simplify [a] so that maybe we never will simplify one (* directly simplify [a] so that maybe we never will simplify one
of the branches *) of the branches *)
let a = SI.Simplify.normalize_t simp a in let a, prf_a = SI.Simplify.normalize_t simp a in
Iter.iter add_step_ prf_a;
begin match A.view_as_bool a with begin match A.view_as_bool a with
| B_bool true -> | B_bool true ->
SI.Simplify.with_proof simp (A.lemma_ite_true ~a ~ite:t); add_step_ @@ SI.Simplify.with_proof simp (A.lemma_ite_true ~a ~ite:t);
Some b ret b
| B_bool false -> | B_bool false ->
SI.Simplify.with_proof simp (A.lemma_ite_false ~a ~ite:t); add_step_ @@ SI.Simplify.with_proof simp (A.lemma_ite_false ~a ~ite:t);
Some c ret c
| _ -> | _ ->
None None
end end
| B_equiv (a,b) when is_true a -> ret b | B_equiv (a,b) when is_true a -> ret_bequiv t b
| B_equiv (a,b) when is_false a -> ret (not_ tst b) | B_equiv (a,b) when is_false a -> ret_bequiv t (not_ tst b)
| B_equiv (a,b) when is_true b -> ret a | B_equiv (a,b) when is_true b -> ret_bequiv t a
| B_equiv (a,b) when is_false b -> ret (not_ tst a) | B_equiv (a,b) when is_false b -> ret_bequiv t (not_ tst a)
| B_xor (a,b) when is_false a -> ret b | B_xor (a,b) when is_false a -> ret_bequiv t b
| B_xor (a,b) when is_true a -> ret (not_ tst b) | B_xor (a,b) when is_true a -> ret_bequiv t (not_ tst b)
| B_xor (a,b) when is_false b -> ret a | B_xor (a,b) when is_false b -> ret_bequiv t a
| B_xor (a,b) when is_true b -> ret (not_ tst a) | B_xor (a,b) when is_true b -> ret_bequiv t (not_ tst a)
| B_equiv _ | B_xor _ -> None | B_equiv _ | B_xor _ -> None
| B_eq (a,b) when T.equal a b -> ret (T.bool tst true) | B_eq (a,b) when T.equal a b -> ret_bequiv t (T.bool tst true)
| B_neq (a,b) when T.equal a b -> ret (T.bool tst true) | B_neq (a,b) when T.equal a b -> ret_bequiv t (T.bool tst true)
| B_eq _ | B_neq _ -> None | B_eq _ | B_neq _ -> None
| B_atom _ -> None | B_atom _ -> None
@ -186,28 +190,35 @@ module Make(A : ARG) : S with module A = A = struct
proxy, mk_lit proxy proxy, mk_lit proxy
(* preprocess "ite" away *) (* preprocess "ite" away *)
let preproc_ite self si (module PA:SI.PREPROCESS_ACTS) (t:T.t) : T.t option = let preproc_ite self si (module PA:SI.PREPROCESS_ACTS) (t:T.t) : (T.t * SI.proof_step Iter.t) option =
let steps = ref [] in
let add_step_ s = steps := s :: !steps in
let ret t = Some (t, Iter.of_list !steps) in
match A.view_as_bool t with match A.view_as_bool t with
| B_ite (a,b,c) -> | B_ite (a,b,c) ->
let a = SI.simp_t si a in let a', pr_a = SI.simp_t si a in
begin match A.view_as_bool a with CCOpt.iter add_step_ pr_a;
begin match A.view_as_bool a' with
| B_bool true -> | B_bool true ->
(* [a=true |- ite a b c=b], [|- a=true] ==> [|- t=b] *) (* [a=true |- ite a b c=b], [|- a=true] ==> [|- t=b] *)
SI.with_proof si (A.lemma_ite_true ~a ~ite:t); add_step_ @@ SI.with_proof si (A.lemma_ite_true ~a:a' ~ite:t);
Some b ret b
| B_bool false -> | B_bool false ->
(* [a=false |- ite a b c=c], [|- a=false] ==> [|- t=c] *) (* [a=false |- ite a b c=c], [|- a=false] ==> [|- t=c] *)
SI.with_proof si (A.lemma_ite_false ~a ~ite:t); add_step_ @@ SI.with_proof si (A.lemma_ite_false ~a:a' ~ite:t);
Some c ret c
| _ -> | _ ->
let t_ite = fresh_term self ~for_t:t ~pre:"ite" (T.ty b) in let t_ite = fresh_term self ~for_t:t ~pre:"ite" (T.ty b) in
SI.define_const si ~const:t_ite ~rhs:t; SI.define_const si ~const:t_ite ~rhs:t;
SI.with_proof si (SI.P.define_term t_ite t); let pr = SI.with_proof si (SI.P.define_term t_ite t) in
let lit_a = PA.mk_lit a in let lit_a = PA.mk_lit a' in
(* TODO: use unit paramod on each clause with side t=t_ite and on a=a' *)
PA.add_clause [Lit.neg lit_a; PA.mk_lit (eq self.tst t_ite b)] PA.add_clause [Lit.neg lit_a; PA.mk_lit (eq self.tst t_ite b)]
(fun p -> A.lemma_ite_true ~a ~ite:t p); (fun p -> SI.P.proof_p1 pr_a (A.lemma_ite_true ~a:a' ~ite:t p) p);
PA.add_clause [lit_a; PA.mk_lit (eq self.tst t_ite c)] PA.add_clause [lit_a; PA.mk_lit (eq self.tst t_ite c)]
(fun p -> A.lemma_ite_false p ~a ~ite:t); (fun p -> A.lemma_ite_false p ~a:a' ~ite:t);
Some t_ite Some t_ite
end end
| _ -> None | _ -> None