mirror of
https://github.com/c-cube/sidekick.git
synced 2025-12-06 11:15:43 -05:00
make state explicit and add type t state-wrapper in most modules
This commit is contained in:
parent
148c1da3cc
commit
99078b2335
25 changed files with 556 additions and 489 deletions
|
|
@ -127,21 +127,18 @@ module Make(S : Res.S)(A : Arg with type hyp := S.clause
|
||||||
| S.Lemma _ ->
|
| S.Lemma _ ->
|
||||||
A.prove_lemma fmt (name clause) clause
|
A.prove_lemma fmt (name clause) clause
|
||||||
| S.Duplicate (p, l) ->
|
| S.Duplicate (p, l) ->
|
||||||
let p' = S.expand p in
|
let c = S.conclusion p in
|
||||||
let c = p'.S.conclusion in
|
|
||||||
let () = elim_duplicate fmt clause c l in
|
let () = elim_duplicate fmt clause c l in
|
||||||
clean t fmt [c]
|
clean t fmt [c]
|
||||||
| S.Resolution (p1, p2, a) ->
|
| S.Resolution (p1, p2, a) ->
|
||||||
let c1 = (S.expand p1).S.conclusion in
|
let c1 = S.conclusion p1 in
|
||||||
let c2 = (S.expand p2).S.conclusion in
|
let c2 = S.conclusion p2 in
|
||||||
if resolution fmt clause c1 c2 a then clean t fmt [c1; c2]
|
if resolution fmt clause c1 c2 a then clean t fmt [c1; c2]
|
||||||
|
|
||||||
let count_uses p =
|
let count_uses p =
|
||||||
let h = S.H.create 4013 in
|
let h = S.H.create 4013 in
|
||||||
let aux () node =
|
let aux () node =
|
||||||
List.iter (fun p' ->
|
List.iter (fun p' -> incr_use h S.(conclusion p')) (S.parents node.S.step)
|
||||||
incr_use h S.((expand p').conclusion))
|
|
||||||
(S.parents node.S.step)
|
|
||||||
in
|
in
|
||||||
let () = S.fold aux () p in
|
let () = S.fold aux () p in
|
||||||
h
|
h
|
||||||
|
|
|
||||||
|
|
@ -7,18 +7,18 @@ Copyright 2014 Simon Cruanes
|
||||||
open Msat
|
open Msat
|
||||||
|
|
||||||
module type S = sig
|
module type S = sig
|
||||||
|
type st
|
||||||
|
|
||||||
type clause
|
type clause
|
||||||
|
(** The type of clauses *)
|
||||||
|
|
||||||
val export :
|
val export :
|
||||||
|
st ->
|
||||||
Format.formatter ->
|
Format.formatter ->
|
||||||
hyps:clause Vec.t ->
|
hyps:clause Vec.t ->
|
||||||
history:clause Vec.t ->
|
history:clause Vec.t ->
|
||||||
local:clause Vec.t ->
|
local:clause Vec.t ->
|
||||||
unit
|
unit
|
||||||
(** Export the given clause vectors to the dimacs format.
|
|
||||||
The arguments should be transmitted directly from the corresponding
|
|
||||||
function of the {Internal} module. *)
|
|
||||||
|
|
||||||
val export_icnf :
|
val export_icnf :
|
||||||
Format.formatter ->
|
Format.formatter ->
|
||||||
|
|
@ -26,13 +26,11 @@ module type S = sig
|
||||||
history:clause Vec.t ->
|
history:clause Vec.t ->
|
||||||
local:clause Vec.t ->
|
local:clause Vec.t ->
|
||||||
unit
|
unit
|
||||||
(** Export the given clause vectors to the dimacs format.
|
|
||||||
The arguments should be transmitted directly from the corresponding
|
|
||||||
function of the {Internal} module. *)
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module Make(St : Solver_types_intf.S)(Dummy: sig end) = struct
|
module Make(St : Solver_types_intf.S) = struct
|
||||||
|
type st = St.t
|
||||||
|
|
||||||
(* Dimacs & iCNF export *)
|
(* Dimacs & iCNF export *)
|
||||||
let export_vec name fmt vec =
|
let export_vec name fmt vec =
|
||||||
|
|
@ -76,7 +74,7 @@ module Make(St : Solver_types_intf.S)(Dummy: sig end) = struct
|
||||||
) learnt;
|
) learnt;
|
||||||
lemmas
|
lemmas
|
||||||
|
|
||||||
let export fmt ~hyps ~history ~local =
|
let export st fmt ~hyps ~history ~local =
|
||||||
assert (Vec.for_all (fun c -> St.Clause.premise c = St.Hyp) hyps);
|
assert (Vec.for_all (fun c -> St.Clause.premise c = St.Hyp) hyps);
|
||||||
(* Learnt clauses, then filtered to only keep only
|
(* Learnt clauses, then filtered to only keep only
|
||||||
the theory lemmas; all other learnt clauses should be logical
|
the theory lemmas; all other learnt clauses should be logical
|
||||||
|
|
@ -85,7 +83,7 @@ module Make(St : Solver_types_intf.S)(Dummy: sig end) = struct
|
||||||
(* Local assertions *)
|
(* Local assertions *)
|
||||||
assert (Vec.for_all (fun c -> St.Local = St.Clause.premise c) local);
|
assert (Vec.for_all (fun c -> St.Local = St.Clause.premise c) local);
|
||||||
(* Number of atoms and clauses *)
|
(* Number of atoms and clauses *)
|
||||||
let n = St.nb_elt () in
|
let n = St.nb_elt st in
|
||||||
let m = Vec.size local + Vec.size hyps + Vec.size lemmas in
|
let m = Vec.size local + Vec.size hyps + Vec.size lemmas in
|
||||||
Format.fprintf fmt
|
Format.fprintf fmt
|
||||||
"@[<v>p cnf %d %d@,%a%a%a@]@." n m
|
"@[<v>p cnf %d %d@,%a%a%a@]@." n m
|
||||||
|
|
|
||||||
|
|
@ -13,11 +13,13 @@ Copyright 2014 Simon Cruanes
|
||||||
open Msat
|
open Msat
|
||||||
|
|
||||||
module type S = sig
|
module type S = sig
|
||||||
|
type st
|
||||||
|
|
||||||
type clause
|
type clause
|
||||||
(** The type of clauses *)
|
(** The type of clauses *)
|
||||||
|
|
||||||
val export :
|
val export :
|
||||||
|
st ->
|
||||||
Format.formatter ->
|
Format.formatter ->
|
||||||
hyps:clause Vec.t ->
|
hyps:clause Vec.t ->
|
||||||
history:clause Vec.t ->
|
history:clause Vec.t ->
|
||||||
|
|
@ -42,6 +44,6 @@ module type S = sig
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module Make(St: Solver_types_intf.S)(Dummy: sig end) : S with type clause := St.clause
|
module Make(St: Solver_types_intf.S) : S with type clause := St.clause and type st = St.t
|
||||||
(** Functor to create a module for exporting probems to the dimacs (& iCNF) formats. *)
|
(** Functor to create a module for exporting probems to the dimacs (& iCNF) formats. *)
|
||||||
|
|
||||||
|
|
|
||||||
File diff suppressed because it is too large
Load diff
|
|
@ -14,8 +14,8 @@ Copyright 2014 Simon Cruanes
|
||||||
|
|
||||||
module Make
|
module Make
|
||||||
(St : Solver_types.S)
|
(St : Solver_types.S)
|
||||||
(Th : Plugin_intf.S with type term = St.term and type formula = St.formula and type proof = St.proof)
|
(Th : Plugin_intf.S with type term = St.term
|
||||||
(Dummy: sig end)
|
and type formula = St.formula and type proof = St.proof)
|
||||||
: sig
|
: sig
|
||||||
(** Functor to create a solver parametrised by the atomic formulas and a theory. *)
|
(** Functor to create a solver parametrised by the atomic formulas and a theory. *)
|
||||||
|
|
||||||
|
|
@ -24,55 +24,63 @@ module Make
|
||||||
exception Unsat
|
exception Unsat
|
||||||
exception UndecidedLit
|
exception UndecidedLit
|
||||||
|
|
||||||
val solve : unit -> unit
|
type t
|
||||||
|
(** Solver *)
|
||||||
|
|
||||||
|
val create : ?st:St.t -> unit -> t
|
||||||
|
|
||||||
|
val st : t -> St.t
|
||||||
|
(** Underlying state *)
|
||||||
|
|
||||||
|
val solve : t -> unit
|
||||||
(** Try and solves the current set of assumptions.
|
(** Try and solves the current set of assumptions.
|
||||||
@return () if the current set of clauses is satisfiable
|
@return () if the current set of clauses is satisfiable
|
||||||
@raise Unsat if a toplevel conflict is found *)
|
@raise Unsat if a toplevel conflict is found *)
|
||||||
|
|
||||||
val assume : ?tag:int -> St.formula list list -> unit
|
val assume : t -> ?tag:int -> St.formula list list -> unit
|
||||||
(** 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 new_lit : St.term -> unit
|
val new_lit : t -> St.term -> unit
|
||||||
(** Add a new litteral (i.e term) to the solver. This term will
|
(** Add a new litteral (i.e term) to the solver. This term will
|
||||||
be decided on at some point during solving, wether it appears
|
be decided on at some point during solving, wether it appears
|
||||||
in clauses or not. *)
|
in clauses or not. *)
|
||||||
|
|
||||||
val new_atom : St.formula -> unit
|
val new_atom : t -> St.formula -> unit
|
||||||
(** Add a new atom (i.e propositional formula) to the solver.
|
(** Add a new atom (i.e propositional formula) to the solver.
|
||||||
This formula will be decided on at some point during solving,
|
This formula will be decided on at some point during solving,
|
||||||
wether it appears in clauses or not. *)
|
wether it appears in clauses or not. *)
|
||||||
|
|
||||||
val push : unit -> unit
|
val push : t -> unit
|
||||||
(** Create a decision level for local assumptions.
|
(** Create a decision level for local assumptions.
|
||||||
@raise Unsat if a conflict is detected in the current state. *)
|
@raise Unsat if a conflict is detected in the current state. *)
|
||||||
|
|
||||||
val pop : unit -> unit
|
val pop : t -> unit
|
||||||
(** Pop a decision level for local assumptions. *)
|
(** Pop a decision level for local assumptions. *)
|
||||||
|
|
||||||
val local : St.formula list -> unit
|
val local : t -> St.formula list -> unit
|
||||||
(** Add local assumptions
|
(** Add local assumptions
|
||||||
@param assumptions list of additional local assumptions to make,
|
@param assumptions list of additional local assumptions to make,
|
||||||
removed after the callback returns a value *)
|
removed after the callback returns a value *)
|
||||||
|
|
||||||
(** {2 Propositional models} *)
|
(** {2 Propositional models} *)
|
||||||
|
|
||||||
val eval : St.formula -> bool
|
val eval : t -> St.formula -> bool
|
||||||
(** Returns the valuation of a formula in the current state
|
(** Returns the valuation of a formula in the current state
|
||||||
of the sat solver.
|
of the sat solver.
|
||||||
@raise UndecidedLit if the literal is not decided *)
|
@raise UndecidedLit if the literal is not decided *)
|
||||||
|
|
||||||
val eval_level : St.formula -> bool * int
|
val eval_level : t -> St.formula -> bool * int
|
||||||
(** Return the current assignement of the literals, as well as its
|
(** Return the current assignement of the literals, as well as its
|
||||||
decision level. If the level is 0, then it is necessary for
|
decision level. If the level is 0, then it is necessary for
|
||||||
the atom to have this value; otherwise it is due to choices
|
the atom to have this value; otherwise it is due to choices
|
||||||
that can potentially be backtracked.
|
that can potentially be backtracked.
|
||||||
@raise UndecidedLit if the literal is not decided *)
|
@raise UndecidedLit if the literal is not decided *)
|
||||||
|
|
||||||
val model : unit -> (St.term * St.term) list
|
val model : t -> (St.term * St.term) list
|
||||||
(** Returns the model found if the formula is satisfiable. *)
|
(** Returns the model found if the formula is satisfiable. *)
|
||||||
|
|
||||||
val check : unit -> bool
|
val check : t -> bool
|
||||||
(** Check the satisfiability of the current model. Only has meaning
|
(** Check the satisfiability of the current model. Only has meaning
|
||||||
if the solver finished proof search and has returned [Sat]. *)
|
if the solver finished proof search and has returned [Sat]. *)
|
||||||
|
|
||||||
|
|
@ -80,11 +88,11 @@ module Make
|
||||||
|
|
||||||
module Proof : Res.S with module St = St
|
module Proof : Res.S with module St = St
|
||||||
|
|
||||||
val unsat_conflict : unit -> St.clause option
|
val unsat_conflict : t -> St.clause option
|
||||||
(** Returns the unsat clause found at the toplevel, if it exists (i.e if
|
(** Returns the unsat clause found at the toplevel, if it exists (i.e if
|
||||||
[solve] has raised [Unsat]) *)
|
[solve] has raised [Unsat]) *)
|
||||||
|
|
||||||
val full_slice : unit -> (St.term, St.formula, St.proof) Plugin_intf.slice
|
val full_slice : t -> (St.term, St.formula, St.proof) Plugin_intf.slice
|
||||||
(** View the current state of the trail as a slice. Mainly useful when the
|
(** View the current state of the trail as a slice. Mainly useful when the
|
||||||
solver has reached a SAT conclusion. *)
|
solver has reached a SAT conclusion. *)
|
||||||
|
|
||||||
|
|
@ -92,21 +100,21 @@ module Make
|
||||||
These functions expose some internal data stored by the solver, as such
|
These functions expose some internal data stored by the solver, as such
|
||||||
great care should be taken to ensure not to mess with the values returned. *)
|
great care should be taken to ensure not to mess with the values returned. *)
|
||||||
|
|
||||||
val trail : unit -> St.trail_elt Vec.t
|
val trail : t -> St.trail_elt Vec.t
|
||||||
(** Returns the current trail.
|
(** Returns the current trail.
|
||||||
*DO NOT MUTATE* *)
|
*DO NOT MUTATE* *)
|
||||||
|
|
||||||
val hyps : unit -> St.clause Vec.t
|
val hyps : t -> St.clause Vec.t
|
||||||
(** Returns the vector of assumptions used by the solver. May be slightly different
|
(** Returns the vector of assumptions used by the solver. May be slightly different
|
||||||
from the clauses assumed because of top-level simplification of clauses.
|
from the clauses assumed because of top-level simplification of clauses.
|
||||||
*DO NOT MUTATE* *)
|
*DO NOT MUTATE* *)
|
||||||
|
|
||||||
val temp : unit -> St.clause Vec.t
|
val temp : t -> St.clause Vec.t
|
||||||
(** Returns the clauses coreesponding to the local assumptions.
|
(** Returns the clauses coreesponding to the local assumptions.
|
||||||
All clauses in this vec are assured to be unit clauses.
|
All clauses in this vec are assured to be unit clauses.
|
||||||
*DO NOT MUTATE* *)
|
*DO NOT MUTATE* *)
|
||||||
|
|
||||||
val history : unit -> St.clause Vec.t
|
val history : t -> St.clause Vec.t
|
||||||
(** Returns the history of learnt clauses, with no guarantees on order.
|
(** Returns the history of learnt clauses, with no guarantees on order.
|
||||||
*DO NOT MUTATE* *)
|
*DO NOT MUTATE* *)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -178,12 +178,15 @@ module Make(St : Solver_types.S) = struct
|
||||||
end
|
end
|
||||||
| _ ->
|
| _ ->
|
||||||
Log.debugf error
|
Log.debugf error
|
||||||
(fun k -> k "While resolving clauses:@[<hov>%a@\n%a@]" St.Clause.debug c St.Clause.debug d);
|
(fun k -> k "While resolving clauses:@[<hov>%a@\n%a@]"
|
||||||
|
St.Clause.debug c St.Clause.debug d);
|
||||||
raise (Resolution_error "Clause mismatch")
|
raise (Resolution_error "Clause mismatch")
|
||||||
end
|
end
|
||||||
| _ ->
|
| _ ->
|
||||||
raise (Resolution_error "Bad history")
|
raise (Resolution_error "Bad history")
|
||||||
|
|
||||||
|
let[@inline] conclusion (p:proof) : clause = p
|
||||||
|
|
||||||
let expand conclusion =
|
let expand conclusion =
|
||||||
Log.debugf debug (fun k -> k "Expanding : @[%a@]" St.Clause.debug conclusion);
|
Log.debugf debug (fun k -> k "Expanding : @[%a@]" St.Clause.debug conclusion);
|
||||||
match conclusion.St.cpremise with
|
match conclusion.St.cpremise with
|
||||||
|
|
|
||||||
|
|
@ -95,6 +95,8 @@ module type S = sig
|
||||||
val expand : proof -> proof_node
|
val expand : proof -> proof_node
|
||||||
(** Return the proof step at the root of a given proof. *)
|
(** Return the proof step at the root of a given proof. *)
|
||||||
|
|
||||||
|
val conclusion : proof -> clause
|
||||||
|
|
||||||
val fold : ('a -> proof_node -> 'a) -> 'a -> proof -> 'a
|
val fold : ('a -> proof_node -> 'a) -> 'a -> proof -> 'a
|
||||||
(** [fold f acc p], fold [f] over the proof [p] and all its node. It is guaranteed that
|
(** [fold f acc p], fold [f] over the proof [p] and all its node. It is guaranteed that
|
||||||
[f] is executed exactly once on each proof node in the tree, and that the execution of
|
[f] is executed exactly once on each proof node in the tree, and that the execution of
|
||||||
|
|
|
||||||
|
|
@ -13,12 +13,11 @@ module Make
|
||||||
(Th : Plugin_intf.S with type term = St.term
|
(Th : Plugin_intf.S with type term = St.term
|
||||||
and type formula = St.formula
|
and type formula = St.formula
|
||||||
and type proof = St.proof)
|
and type proof = St.proof)
|
||||||
()
|
|
||||||
= struct
|
= struct
|
||||||
|
|
||||||
module St = St
|
module St = St
|
||||||
|
|
||||||
module S = Internal.Make(St)(Th)(struct end)
|
module S = Internal.Make(St)(Th)
|
||||||
|
|
||||||
module Proof = S.Proof
|
module Proof = S.Proof
|
||||||
|
|
||||||
|
|
@ -26,25 +25,30 @@ module Make
|
||||||
|
|
||||||
type atom = St.formula
|
type atom = St.formula
|
||||||
|
|
||||||
|
type t = S.t
|
||||||
|
|
||||||
|
let create = S.create
|
||||||
|
|
||||||
(* Result type *)
|
(* Result type *)
|
||||||
type res =
|
type res =
|
||||||
| Sat of (St.term,St.formula) sat_state
|
| Sat of (St.term,St.formula) sat_state
|
||||||
| Unsat of (St.clause,Proof.proof) unsat_state
|
| Unsat of (St.clause,Proof.proof) unsat_state
|
||||||
|
|
||||||
let pp_all lvl status =
|
let pp_all st lvl status =
|
||||||
Log.debugf lvl
|
Log.debugf lvl
|
||||||
(fun k -> k
|
(fun k -> k
|
||||||
"@[<v>%s - Full resume:@,@[<hov 2>Trail:@\n%a@]@,@[<hov 2>Temp:@\n%a@]@,@[<hov 2>Hyps:@\n%a@]@,@[<hov 2>Lemmas:@\n%a@]@,@]@."
|
"@[<v>%s - Full resume:@,@[<hov 2>Trail:@\n%a@]@,\
|
||||||
|
@[<hov 2>Temp:@\n%a@]@,@[<hov 2>Hyps:@\n%a@]@,@[<hov 2>Lemmas:@\n%a@]@,@]@."
|
||||||
status
|
status
|
||||||
(Vec.print ~sep:"" St.Trail_elt.debug) (S.trail ())
|
(Vec.print ~sep:"" St.Trail_elt.debug) (S.trail st)
|
||||||
(Vec.print ~sep:"" St.Clause.debug) (S.temp ())
|
(Vec.print ~sep:"" St.Clause.debug) (S.temp st)
|
||||||
(Vec.print ~sep:"" St.Clause.debug) (S.hyps ())
|
(Vec.print ~sep:"" St.Clause.debug) (S.hyps st)
|
||||||
(Vec.print ~sep:"" St.Clause.debug) (S.history ())
|
(Vec.print ~sep:"" St.Clause.debug) (S.history st)
|
||||||
)
|
)
|
||||||
|
|
||||||
let mk_sat () : (_,_) sat_state =
|
let mk_sat (st:S.t) : (_,_) sat_state =
|
||||||
pp_all 99 "SAT";
|
pp_all st 99 "SAT";
|
||||||
let t = S.trail () in
|
let t = S.trail st in
|
||||||
let iter f f' =
|
let iter f f' =
|
||||||
Vec.iter (function
|
Vec.iter (function
|
||||||
| St.Atom a -> f a.St.lit
|
| St.Atom a -> f a.St.lit
|
||||||
|
|
@ -52,16 +56,16 @@ module Make
|
||||||
t
|
t
|
||||||
in
|
in
|
||||||
{
|
{
|
||||||
eval = S.eval;
|
eval = S.eval st;
|
||||||
eval_level = S.eval_level;
|
eval_level = S.eval_level st;
|
||||||
iter_trail = iter;
|
iter_trail = iter;
|
||||||
model = S.model;
|
model = (fun () -> S.model st);
|
||||||
}
|
}
|
||||||
|
|
||||||
let mk_unsat () : (_,_) unsat_state =
|
let mk_unsat (st:S.t) : (_,_) unsat_state =
|
||||||
pp_all 99 "UNSAT";
|
pp_all st 99 "UNSAT";
|
||||||
let unsat_conflict () =
|
let unsat_conflict () =
|
||||||
match S.unsat_conflict () with
|
match S.unsat_conflict st with
|
||||||
| None -> assert false
|
| None -> assert false
|
||||||
| Some c -> c
|
| Some c -> c
|
||||||
in
|
in
|
||||||
|
|
@ -74,21 +78,21 @@ module Make
|
||||||
(* Wrappers around internal functions*)
|
(* Wrappers around internal functions*)
|
||||||
let assume = S.assume
|
let assume = S.assume
|
||||||
|
|
||||||
let solve ?(assumptions=[]) () =
|
let solve (st:t) ?(assumptions=[]) () =
|
||||||
try
|
try
|
||||||
S.pop (); (* FIXME: what?! *)
|
S.pop st; (* FIXME: what?! *)
|
||||||
S.push ();
|
S.push st;
|
||||||
S.local assumptions;
|
S.local st assumptions;
|
||||||
S.solve ();
|
S.solve st;
|
||||||
Sat (mk_sat())
|
Sat (mk_sat st)
|
||||||
with S.Unsat ->
|
with S.Unsat ->
|
||||||
Unsat (mk_unsat())
|
Unsat (mk_unsat st)
|
||||||
|
|
||||||
let unsat_core = S.Proof.unsat_core
|
let unsat_core = S.Proof.unsat_core
|
||||||
|
|
||||||
let true_at_level0 a =
|
let true_at_level0 st a =
|
||||||
try
|
try
|
||||||
let b, lev = S.eval_level a in
|
let b, lev = S.eval_level st a in
|
||||||
b && lev = 0
|
b && lev = 0
|
||||||
with S.UndecidedLit -> false
|
with S.UndecidedLit -> false
|
||||||
|
|
||||||
|
|
@ -97,9 +101,9 @@ module Make
|
||||||
let new_lit = S.new_lit
|
let new_lit = S.new_lit
|
||||||
let new_atom = S.new_atom
|
let new_atom = S.new_atom
|
||||||
|
|
||||||
let export () : St.clause export =
|
let export (st:t) : St.clause export =
|
||||||
let hyps = S.hyps () in
|
let hyps = S.hyps st in
|
||||||
let history = S.history () in
|
let history = S.history st in
|
||||||
let local = S.temp () in
|
let local = S.temp st in
|
||||||
{hyps; history; local}
|
{hyps; history; local}
|
||||||
end
|
end
|
||||||
|
|
|
||||||
|
|
@ -18,8 +18,7 @@ module Make
|
||||||
(Th : Plugin_intf.S with type term = St.term
|
(Th : Plugin_intf.S with type term = St.term
|
||||||
and type formula = St.formula
|
and type formula = St.formula
|
||||||
and type proof = St.proof)
|
and type proof = St.proof)
|
||||||
() :
|
: S with module St = St
|
||||||
S with module St = St
|
|
||||||
(** Functor to make a safe external interface. *)
|
(** Functor to make a safe external interface. *)
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -61,6 +61,13 @@ module type S = sig
|
||||||
module Proof : Res.S with module St = St
|
module Proof : Res.S with module St = St
|
||||||
(** A module to manipulate proofs. *)
|
(** A module to manipulate proofs. *)
|
||||||
|
|
||||||
|
type t
|
||||||
|
(** Main solver type, containing all state *)
|
||||||
|
|
||||||
|
val create : ?st:St.t -> unit -> t
|
||||||
|
(** Create new solver *)
|
||||||
|
(* TODO: add size hint, callbacks, etc. *)
|
||||||
|
|
||||||
(** {2 Types} *)
|
(** {2 Types} *)
|
||||||
|
|
||||||
type atom = St.formula
|
type atom = St.formula
|
||||||
|
|
@ -77,19 +84,19 @@ module type S = sig
|
||||||
|
|
||||||
(** {2 Base operations} *)
|
(** {2 Base operations} *)
|
||||||
|
|
||||||
val assume : ?tag:int -> atom list list -> unit
|
val assume : t -> ?tag:int -> atom list list -> unit
|
||||||
(** 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 solve : ?assumptions:atom list -> unit -> res
|
val solve : t -> ?assumptions:atom list -> unit -> res
|
||||||
(** Try and solves the current set of assumptions. *)
|
(** Try and solves the current set of assumptions. *)
|
||||||
|
|
||||||
val new_lit : St.term -> unit
|
val new_lit : t -> St.term -> unit
|
||||||
(** Add a new litteral (i.e term) to the solver. This term will
|
(** Add a new litteral (i.e term) to the solver. This term will
|
||||||
be decided on at some point during solving, wether it appears
|
be decided on at some point during solving, wether it appears
|
||||||
in clauses or not. *)
|
in clauses or not. *)
|
||||||
|
|
||||||
val new_atom : atom -> unit
|
val new_atom : t -> atom -> unit
|
||||||
(** Add a new atom (i.e propositional formula) to the solver.
|
(** Add a new atom (i.e propositional formula) to the solver.
|
||||||
This formula will be decided on at some point during solving,
|
This formula will be decided on at some point during solving,
|
||||||
wether it appears in clauses or not. *)
|
wether it appears in clauses or not. *)
|
||||||
|
|
@ -97,13 +104,13 @@ module type S = sig
|
||||||
val unsat_core : Proof.proof -> St.clause list
|
val unsat_core : Proof.proof -> St.clause list
|
||||||
(** Returns the unsat core of a given proof. *)
|
(** Returns the unsat core of a given proof. *)
|
||||||
|
|
||||||
val true_at_level0 : atom -> bool
|
val true_at_level0 : t -> atom -> bool
|
||||||
(** [true_at_level0 a] returns [true] if [a] was proved at level0, i.e.
|
(** [true_at_level0 a] returns [true] if [a] was proved at level0, i.e.
|
||||||
it must hold in all models *)
|
it must hold in all models *)
|
||||||
|
|
||||||
val get_tag : St.clause -> int option
|
val get_tag : St.clause -> int option
|
||||||
(** Recover tag from a clause, if any *)
|
(** Recover tag from a clause, if any *)
|
||||||
|
|
||||||
val export : unit -> St.clause export
|
val export : t -> St.clause export
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -27,7 +27,7 @@ let () = Var_fields.freeze()
|
||||||
(* Solver types for McSat Solving *)
|
(* Solver types for McSat Solving *)
|
||||||
(* ************************************************************************ *)
|
(* ************************************************************************ *)
|
||||||
|
|
||||||
module McMake (E : Expr_intf.S)() = struct
|
module McMake (E : Expr_intf.S) = struct
|
||||||
|
|
||||||
(* Flag for Mcsat v.s Pure Sat *)
|
(* Flag for Mcsat v.s Pure Sat *)
|
||||||
let mcsat = true
|
let mcsat = true
|
||||||
|
|
@ -36,6 +36,8 @@ module McMake (E : Expr_intf.S)() = struct
|
||||||
type formula = E.Formula.t
|
type formula = E.Formula.t
|
||||||
type proof = E.proof
|
type proof = E.proof
|
||||||
|
|
||||||
|
let pp_form = E.Formula.dummy
|
||||||
|
|
||||||
type seen =
|
type seen =
|
||||||
| Nope
|
| Nope
|
||||||
| Both
|
| Both
|
||||||
|
|
@ -136,16 +138,29 @@ module McMake (E : Expr_intf.S)() = struct
|
||||||
module MF = Hashtbl.Make(E.Formula)
|
module MF = Hashtbl.Make(E.Formula)
|
||||||
module MT = Hashtbl.Make(E.Term)
|
module MT = Hashtbl.Make(E.Term)
|
||||||
|
|
||||||
|
type t = {
|
||||||
|
t_map: lit MT.t;
|
||||||
|
f_map: var MF.t;
|
||||||
|
vars: elt Vec.t;
|
||||||
|
mutable cpt_mk_var: int;
|
||||||
|
mutable cpt_mk_clause: int;
|
||||||
|
}
|
||||||
|
|
||||||
|
type state = t
|
||||||
|
|
||||||
|
let create() : t = {
|
||||||
|
f_map = MF.create 4096;
|
||||||
|
t_map = MT.create 4096;
|
||||||
|
vars = Vec.make 107 (E_var dummy_var);
|
||||||
|
cpt_mk_var = 0;
|
||||||
|
cpt_mk_clause = 0;
|
||||||
|
}
|
||||||
|
|
||||||
(* TODO: embed a state `t` with these inside *)
|
(* TODO: embed a state `t` with these inside *)
|
||||||
let f_map = MF.create 4096
|
|
||||||
let t_map = MT.create 4096
|
|
||||||
|
|
||||||
let vars = Vec.make 107 (E_var dummy_var)
|
let nb_elt st = Vec.size st.vars
|
||||||
let nb_elt () = Vec.size vars
|
let get_elt st i = Vec.get st.vars i
|
||||||
let get_elt i = Vec.get vars i
|
let iter_elt st f = Vec.iter f st.vars
|
||||||
let iter_elt f = Vec.iter f vars
|
|
||||||
|
|
||||||
let cpt_mk_var = ref 0
|
|
||||||
|
|
||||||
let name_of_clause c = match c.cpremise with
|
let name_of_clause c = match c.cpremise with
|
||||||
| Hyp -> "H" ^ string_of_int c.name
|
| Hyp -> "H" ^ string_of_int c.name
|
||||||
|
|
@ -165,20 +180,20 @@ module McMake (E : Expr_intf.S)() = struct
|
||||||
let[@inline] weight l = l.l_weight
|
let[@inline] weight l = l.l_weight
|
||||||
let[@inline] set_weight l w = l.l_weight <- w
|
let[@inline] set_weight l w = l.l_weight <- w
|
||||||
|
|
||||||
let make t =
|
let make (st:state) (t:term) : t =
|
||||||
try MT.find t_map t
|
try MT.find st.t_map t
|
||||||
with Not_found ->
|
with Not_found ->
|
||||||
let res = {
|
let res = {
|
||||||
lid = !cpt_mk_var;
|
lid = st.cpt_mk_var;
|
||||||
term = t;
|
term = t;
|
||||||
l_weight = 1.;
|
l_weight = 1.;
|
||||||
l_idx= -1;
|
l_idx= -1;
|
||||||
l_level = -1;
|
l_level = -1;
|
||||||
assigned = None;
|
assigned = None;
|
||||||
} in
|
} in
|
||||||
incr cpt_mk_var;
|
st.cpt_mk_var <- st.cpt_mk_var + 1;
|
||||||
MT.add t_map t res;
|
MT.add st.t_map t res;
|
||||||
Vec.push vars (E_lit res);
|
Vec.push st.vars (E_lit res);
|
||||||
res
|
res
|
||||||
|
|
||||||
let debug_assign fmt v =
|
let debug_assign fmt v =
|
||||||
|
|
@ -208,15 +223,14 @@ module McMake (E : Expr_intf.S)() = struct
|
||||||
let[@inline] weight v = v.v_weight
|
let[@inline] weight v = v.v_weight
|
||||||
let[@inline] set_weight v w = v.v_weight <- w
|
let[@inline] set_weight v w = v.v_weight <- w
|
||||||
|
|
||||||
let make : formula -> var * Expr_intf.negated =
|
let make (st:state) (t:formula) : var * Expr_intf.negated =
|
||||||
fun t ->
|
|
||||||
let lit, negated = E.Formula.norm t in
|
let lit, negated = E.Formula.norm t in
|
||||||
try
|
try
|
||||||
MF.find f_map lit, negated
|
MF.find st.f_map lit, negated
|
||||||
with Not_found ->
|
with Not_found ->
|
||||||
let cpt_fois_2 = !cpt_mk_var lsl 1 in
|
let cpt_double = st.cpt_mk_var lsl 1 in
|
||||||
let rec var =
|
let rec var =
|
||||||
{ vid = !cpt_mk_var;
|
{ vid = st.cpt_mk_var;
|
||||||
pa = pa;
|
pa = pa;
|
||||||
na = na;
|
na = na;
|
||||||
v_fields = Var_fields.empty;
|
v_fields = Var_fields.empty;
|
||||||
|
|
@ -232,17 +246,17 @@ module McMake (E : Expr_intf.S)() = struct
|
||||||
watched = Vec.make 10 dummy_clause;
|
watched = Vec.make 10 dummy_clause;
|
||||||
neg = na;
|
neg = na;
|
||||||
is_true = false;
|
is_true = false;
|
||||||
aid = cpt_fois_2 (* aid = vid*2 *) }
|
aid = cpt_double (* aid = vid*2 *) }
|
||||||
and na =
|
and na =
|
||||||
{ var = var;
|
{ var = var;
|
||||||
lit = E.Formula.neg lit;
|
lit = E.Formula.neg lit;
|
||||||
watched = Vec.make 10 dummy_clause;
|
watched = Vec.make 10 dummy_clause;
|
||||||
neg = pa;
|
neg = pa;
|
||||||
is_true = false;
|
is_true = false;
|
||||||
aid = cpt_fois_2 + 1 (* aid = vid*2+1 *) } in
|
aid = cpt_double + 1 (* aid = vid*2+1 *) } in
|
||||||
MF.add f_map lit var;
|
MF.add st.f_map lit var;
|
||||||
incr cpt_mk_var;
|
st.cpt_mk_var <- st.cpt_mk_var + 1;
|
||||||
Vec.push vars (E_var var);
|
Vec.push st.vars (E_var var);
|
||||||
var, negated
|
var, negated
|
||||||
|
|
||||||
(* Marking helpers *)
|
(* Marking helpers *)
|
||||||
|
|
@ -281,8 +295,8 @@ module McMake (E : Expr_intf.S)() = struct
|
||||||
then a.var.v_fields <- Var_fields.set v_field_seen_pos true a.var.v_fields
|
then a.var.v_fields <- Var_fields.set v_field_seen_pos true a.var.v_fields
|
||||||
else a.var.v_fields <- Var_fields.set v_field_seen_neg true a.var.v_fields
|
else a.var.v_fields <- Var_fields.set v_field_seen_neg true a.var.v_fields
|
||||||
|
|
||||||
let[@inline] make lit =
|
let[@inline] make st lit =
|
||||||
let var, negated = Var.make lit in
|
let var, negated = Var.make st lit in
|
||||||
match negated with
|
match negated with
|
||||||
| Formula_intf.Negated -> var.na
|
| Formula_intf.Negated -> var.na
|
||||||
| Formula_intf.Same_sign -> var.pa
|
| Formula_intf.Same_sign -> var.pa
|
||||||
|
|
@ -427,19 +441,29 @@ module McMake (E : Expr_intf.S)() = struct
|
||||||
in
|
in
|
||||||
Format.fprintf fmt "%a0" aux atoms
|
Format.fprintf fmt "%a0" aux atoms
|
||||||
end
|
end
|
||||||
end
|
|
||||||
|
module Term = struct
|
||||||
|
include E.Term
|
||||||
|
let pp = print
|
||||||
|
end
|
||||||
|
|
||||||
|
module Formula = struct
|
||||||
|
include E.Formula
|
||||||
|
let pp = print
|
||||||
|
end
|
||||||
|
end[@@inline]
|
||||||
|
|
||||||
|
|
||||||
(* Solver types for pure SAT Solving *)
|
(* Solver types for pure SAT Solving *)
|
||||||
(* ************************************************************************ *)
|
(* ************************************************************************ *)
|
||||||
|
|
||||||
module SatMake (E : Formula_intf.S)() = struct
|
module SatMake (E : Formula_intf.S) = struct
|
||||||
include McMake(struct
|
include McMake(struct
|
||||||
include E
|
include E
|
||||||
module Term = E
|
module Term = E
|
||||||
module Formula = E
|
module Formula = E
|
||||||
end)(struct end)
|
end)
|
||||||
|
|
||||||
let mcsat = false
|
let mcsat = false
|
||||||
end
|
end[@@inline]
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -30,11 +30,11 @@ module type S = Solver_types_intf.S
|
||||||
|
|
||||||
module Var_fields = Solver_types_intf.Var_fields
|
module Var_fields = Solver_types_intf.Var_fields
|
||||||
|
|
||||||
module McMake (E : Expr_intf.S)():
|
module McMake (E : Expr_intf.S):
|
||||||
S with type term = E.Term.t and type formula = E.Formula.t and type proof = E.proof
|
S with type term = E.Term.t and type formula = E.Formula.t and type proof = E.proof
|
||||||
(** Functor to instantiate the types of clauses for a solver. *)
|
(** Functor to instantiate the types of clauses for a solver. *)
|
||||||
|
|
||||||
module SatMake (E : Formula_intf.S)():
|
module SatMake (E : Formula_intf.S):
|
||||||
S with type term = E.t and type formula = E.t and type proof = E.proof
|
S with type term = E.t and type formula = E.t and type proof = E.proof
|
||||||
(** Functor to instantiate the types of clauses for a solver. *)
|
(** Functor to instantiate the types of clauses for a solver. *)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -32,6 +32,12 @@ module type S = sig
|
||||||
val mcsat : bool
|
val mcsat : bool
|
||||||
(** TODO:deprecate. *)
|
(** TODO:deprecate. *)
|
||||||
|
|
||||||
|
type t
|
||||||
|
(** State for creating new terms, literals, clauses *)
|
||||||
|
|
||||||
|
(* TODO: add size hint *)
|
||||||
|
val create: unit -> t
|
||||||
|
|
||||||
(** {2 Type definitions} *)
|
(** {2 Type definitions} *)
|
||||||
|
|
||||||
type term
|
type term
|
||||||
|
|
@ -138,17 +144,19 @@ module type S = sig
|
||||||
| E_var of var (**)
|
| E_var of var (**)
|
||||||
(** Either a lit of a var *)
|
(** Either a lit of a var *)
|
||||||
|
|
||||||
val nb_elt : unit -> int
|
val nb_elt : t -> int
|
||||||
val get_elt : int -> elt
|
val get_elt : t -> int -> elt
|
||||||
val iter_elt : (elt -> unit) -> unit
|
val iter_elt : t -> (elt -> unit) -> unit
|
||||||
(** Read access to the vector of variables created *)
|
(** Read access to the vector of variables created *)
|
||||||
|
|
||||||
(** {2 Variables, Literals & Clauses } *)
|
(** {2 Variables, Literals & Clauses } *)
|
||||||
|
|
||||||
|
type state = t
|
||||||
|
|
||||||
module Lit : sig
|
module Lit : sig
|
||||||
type t = lit
|
type t = lit
|
||||||
val term : t -> term
|
val term : t -> term
|
||||||
val make : term -> t
|
val make : state -> term -> t
|
||||||
(** Returns the variable associated with the term *)
|
(** Returns the variable associated with the term *)
|
||||||
|
|
||||||
val level : t -> int
|
val level : t -> int
|
||||||
|
|
@ -167,7 +175,6 @@ module type S = sig
|
||||||
type t = var
|
type t = var
|
||||||
val dummy : t
|
val dummy : t
|
||||||
|
|
||||||
|
|
||||||
val pos : t -> atom
|
val pos : t -> atom
|
||||||
val neg : t -> atom
|
val neg : t -> atom
|
||||||
|
|
||||||
|
|
@ -180,7 +187,7 @@ module type S = sig
|
||||||
val weight : t -> float
|
val weight : t -> float
|
||||||
val set_weight : t -> float -> unit
|
val set_weight : t -> float -> unit
|
||||||
|
|
||||||
val make : formula -> t * Formula_intf.negated
|
val make : state -> formula -> t * Formula_intf.negated
|
||||||
(** Returns the variable linked with the given formula,
|
(** Returns the variable linked with the given formula,
|
||||||
and whether the atom associated with the formula
|
and whether the atom associated with the formula
|
||||||
is [var.pa] or [var.na] *)
|
is [var.pa] or [var.na] *)
|
||||||
|
|
@ -207,7 +214,7 @@ module type S = sig
|
||||||
val is_true : t -> bool
|
val is_true : t -> bool
|
||||||
val is_false : t -> bool
|
val is_false : t -> bool
|
||||||
|
|
||||||
val make : formula -> t
|
val make : state -> formula -> t
|
||||||
(** Returns the atom associated with the given formula *)
|
(** Returns the atom associated with the given formula *)
|
||||||
|
|
||||||
val mark : t -> unit
|
val mark : t -> unit
|
||||||
|
|
@ -274,5 +281,19 @@ module type S = sig
|
||||||
(** Constructors and destructors *)
|
(** Constructors and destructors *)
|
||||||
val debug : t printer
|
val debug : t printer
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Term : sig
|
||||||
|
type t = term
|
||||||
|
val equal : t -> t -> bool
|
||||||
|
val hash : t -> int
|
||||||
|
val pp : t printer
|
||||||
|
end
|
||||||
|
|
||||||
|
module Formula : sig
|
||||||
|
type t = formula
|
||||||
|
val equal : t -> t -> bool
|
||||||
|
val hash : t -> int
|
||||||
|
val pp : t printer
|
||||||
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -37,19 +37,21 @@ module Make
|
||||||
|
|
||||||
let hyps = ref []
|
let hyps = ref []
|
||||||
|
|
||||||
let check_model state =
|
let st = S.create()
|
||||||
|
|
||||||
|
let check_model sat =
|
||||||
let check_clause c =
|
let check_clause c =
|
||||||
let l = List.map (function a ->
|
let l = List.map (function a ->
|
||||||
Log.debugf 99
|
Log.debugf 99
|
||||||
(fun k -> k "Checking value of %a" S.St.Atom.debug (S.St.Atom.make a));
|
(fun k -> k "Checking value of %a" S.St.Formula.pp a);
|
||||||
state.Msat.eval a) c in
|
sat.Msat.eval a) c in
|
||||||
List.exists (fun x -> x) l
|
List.exists (fun x -> x) l
|
||||||
in
|
in
|
||||||
let l = List.map check_clause !hyps in
|
let l = List.map check_clause !hyps in
|
||||||
List.for_all (fun x -> x) l
|
List.for_all (fun x -> x) l
|
||||||
|
|
||||||
let prove ~assumptions =
|
let prove ~assumptions () =
|
||||||
let res = S.solve ~assumptions () in
|
let res = S.solve st ~assumptions () in
|
||||||
let t = Sys.time () in
|
let t = Sys.time () in
|
||||||
begin match res with
|
begin match res with
|
||||||
| S.Sat state ->
|
| S.Sat state ->
|
||||||
|
|
@ -78,15 +80,15 @@ module Make
|
||||||
| Dolmen.Statement.Clause l ->
|
| Dolmen.Statement.Clause l ->
|
||||||
let cnf = T.antecedent (Dolmen.Term.or_ l) in
|
let cnf = T.antecedent (Dolmen.Term.or_ l) in
|
||||||
hyps := cnf @ !hyps;
|
hyps := cnf @ !hyps;
|
||||||
S.assume cnf
|
S.assume st cnf
|
||||||
| Dolmen.Statement.Consequent t ->
|
| Dolmen.Statement.Consequent t ->
|
||||||
let cnf = T.consequent t in
|
let cnf = T.consequent t in
|
||||||
hyps := cnf @ !hyps;
|
hyps := cnf @ !hyps;
|
||||||
S.assume cnf
|
S.assume st cnf
|
||||||
| Dolmen.Statement.Antecedent t ->
|
| Dolmen.Statement.Antecedent t ->
|
||||||
let cnf = T.antecedent t in
|
let cnf = T.antecedent t in
|
||||||
hyps := cnf @ !hyps;
|
hyps := cnf @ !hyps;
|
||||||
S.assume cnf
|
S.assume st cnf
|
||||||
| Dolmen.Statement.Pack [
|
| Dolmen.Statement.Pack [
|
||||||
{ Dolmen.Statement.descr = Dolmen.Statement.Push 1;_ };
|
{ Dolmen.Statement.descr = Dolmen.Statement.Push 1;_ };
|
||||||
{ Dolmen.Statement.descr = Dolmen.Statement.Antecedent f;_ };
|
{ Dolmen.Statement.descr = Dolmen.Statement.Antecedent f;_ };
|
||||||
|
|
@ -94,9 +96,9 @@ module Make
|
||||||
{ Dolmen.Statement.descr = Dolmen.Statement.Pop 1;_ };
|
{ Dolmen.Statement.descr = Dolmen.Statement.Pop 1;_ };
|
||||||
] ->
|
] ->
|
||||||
let assumptions = T.assumptions f in
|
let assumptions = T.assumptions f in
|
||||||
prove ~assumptions
|
prove ~assumptions ()
|
||||||
| Dolmen.Statement.Prove ->
|
| Dolmen.Statement.Prove ->
|
||||||
prove ~assumptions:[]
|
prove ~assumptions:[] ()
|
||||||
| Dolmen.Statement.Set_info _
|
| Dolmen.Statement.Set_info _
|
||||||
| Dolmen.Statement.Set_logic _ -> ()
|
| Dolmen.Statement.Set_logic _ -> ()
|
||||||
| Dolmen.Statement.Exit -> exit 0
|
| Dolmen.Statement.Exit -> exit 0
|
||||||
|
|
@ -105,9 +107,9 @@ module Make
|
||||||
Dolmen.Statement.print s
|
Dolmen.Statement.print s
|
||||||
end
|
end
|
||||||
|
|
||||||
module Sat = Make(Minismt_sat.Make(struct end))(Minismt_sat.Type)
|
module Sat = Make(Minismt_sat)(Minismt_sat.Type)
|
||||||
module Smt = Make(Minismt_smt.Make(struct end))(Minismt_smt.Type)
|
module Smt = Make(Minismt_smt)(Minismt_smt.Type)
|
||||||
module Mcsat = Make(Minismt_mcsat.Make(struct end))(Minismt_smt.Type)
|
module Mcsat = Make(Minismt_mcsat)(Minismt_smt.Type)
|
||||||
|
|
||||||
let solver = ref (module Sat : S)
|
let solver = ref (module Sat : S)
|
||||||
let solver_list = [
|
let solver_list = [
|
||||||
|
|
|
||||||
|
|
@ -4,10 +4,10 @@ Copyright 2014 Guillaume Bury
|
||||||
Copyright 2014 Simon Cruanes
|
Copyright 2014 Simon Cruanes
|
||||||
*)
|
*)
|
||||||
|
|
||||||
module Make() =
|
include
|
||||||
Minismt.Mcsolver.Make(struct
|
Minismt.Mcsolver.Make(struct
|
||||||
type proof = unit
|
type proof = unit
|
||||||
module Term = Minismt_smt.Expr.Term
|
module Term = Minismt_smt.Expr.Term
|
||||||
module Formula = Minismt_smt.Expr.Atom
|
module Formula = Minismt_smt.Expr.Atom
|
||||||
end)(Plugin_mcsat)()
|
end)(Plugin_mcsat)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -4,5 +4,5 @@ Copyright 2014 Guillaume Bury
|
||||||
Copyright 2014 Simon Cruanes
|
Copyright 2014 Simon Cruanes
|
||||||
*)
|
*)
|
||||||
|
|
||||||
module Make() : Minismt.Solver.S with type St.formula = Minismt_smt.Expr.atom
|
include Minismt.Solver.S with type St.formula = Minismt_smt.Expr.atom
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -6,6 +6,5 @@ Copyright 2016 Guillaume Bury
|
||||||
module Expr = Expr_sat
|
module Expr = Expr_sat
|
||||||
module Type = Type_sat
|
module Type = Type_sat
|
||||||
|
|
||||||
module Make() =
|
include Minismt.Solver.Make(Expr)(Minismt.Solver.DummyTheory(Expr))
|
||||||
Minismt.Solver.Make(Expr)(Minismt.Solver.DummyTheory(Expr))()
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -12,6 +12,6 @@ Copyright 2016 Guillaume Bury
|
||||||
module Expr = Expr_sat
|
module Expr = Expr_sat
|
||||||
module Type = Type_sat
|
module Type = Type_sat
|
||||||
|
|
||||||
module Make() : Minismt.Solver.S with type St.formula = Expr.t
|
include Minismt.Solver.S with type St.formula = Expr.t
|
||||||
(** A functor that can generate as many solvers as needed. *)
|
(** A functor that can generate as many solvers as needed. *)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -9,5 +9,5 @@ module Type = Type_smt
|
||||||
|
|
||||||
module Th = Minismt.Solver.DummyTheory(Expr.Atom)
|
module Th = Minismt.Solver.DummyTheory(Expr.Atom)
|
||||||
|
|
||||||
module Make() = Minismt.Solver.Make(Expr.Atom)(Th)()
|
include Minismt.Solver.Make(Expr.Atom)(Th)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -7,5 +7,5 @@ Copyright 2014 Simon Cruanes
|
||||||
module Expr = Expr_smt
|
module Expr = Expr_smt
|
||||||
module Type = Type_smt
|
module Type = Type_smt
|
||||||
|
|
||||||
module Make() : Minismt.Solver.S with type St.formula = Expr_smt.atom
|
include Minismt.Solver.S with type St.formula = Expr_smt.atom
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -10,10 +10,6 @@ module Make (E : Expr_intf.S)
|
||||||
(Th : Plugin_intf.S with type term = E.Term.t
|
(Th : Plugin_intf.S with type term = E.Term.t
|
||||||
and type formula = E.Formula.t
|
and type formula = E.Formula.t
|
||||||
and type proof = E.proof)
|
and type proof = E.proof)
|
||||||
() =
|
= Msat.Make (Make_mcsat_expr(E)) (Th)
|
||||||
Msat.Make
|
|
||||||
(Make_mcsat_expr(E)())
|
|
||||||
(Th)
|
|
||||||
()
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -16,8 +16,7 @@ module Make (E : Expr_intf.S)
|
||||||
(Th : Plugin_intf.S with type term = E.Term.t
|
(Th : Plugin_intf.S with type term = E.Term.t
|
||||||
and type formula = E.Formula.t
|
and type formula = E.Formula.t
|
||||||
and type proof = E.proof)
|
and type proof = E.proof)
|
||||||
() :
|
: S with type St.term = E.Term.t
|
||||||
S with type St.term = E.Term.t
|
|
||||||
and type St.formula = E.Formula.t
|
and type St.formula = E.Formula.t
|
||||||
and type St.proof = E.proof
|
and type St.proof = E.proof
|
||||||
(** Functor to create a solver parametrised by the atomic formulas and a theory. *)
|
(** Functor to create a solver parametrised by the atomic formulas and a theory. *)
|
||||||
|
|
|
||||||
|
|
@ -76,10 +76,6 @@ end
|
||||||
|
|
||||||
module Make (E : Formula_intf.S)
|
module Make (E : Formula_intf.S)
|
||||||
(Th : Theory_intf.S with type formula = E.t and type proof = E.proof)
|
(Th : Theory_intf.S with type formula = E.t and type proof = E.proof)
|
||||||
() =
|
= Msat.Make (Make_smt_expr(E)) (Plugin(E)(Th))
|
||||||
Msat.Make
|
|
||||||
(Make_smt_expr(E)(struct end))
|
|
||||||
(Plugin(E)(Th))
|
|
||||||
()
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -23,8 +23,7 @@ module DummyTheory(F : Formula_intf.S) :
|
||||||
module Make (F : Formula_intf.S)
|
module Make (F : Formula_intf.S)
|
||||||
(Th : Theory_intf.S with type formula = F.t
|
(Th : Theory_intf.S with type formula = F.t
|
||||||
and type proof = F.proof)
|
and type proof = F.proof)
|
||||||
() :
|
: S with type St.formula = F.t
|
||||||
S with type St.formula = F.t
|
|
||||||
and type St.proof = F.proof
|
and type St.proof = F.proof
|
||||||
(** Functor to create a SMT Solver parametrised by the atomic
|
(** Functor to create a SMT Solver parametrised by the atomic
|
||||||
formulas and a theory. *)
|
formulas and a theory. *)
|
||||||
|
|
|
||||||
|
|
@ -40,14 +40,18 @@ type solver_res =
|
||||||
exception Incorrect_model
|
exception Incorrect_model
|
||||||
|
|
||||||
module type BASIC_SOLVER = sig
|
module type BASIC_SOLVER = sig
|
||||||
val solve : ?assumptions:F.t list -> unit -> solver_res
|
type t
|
||||||
val assume : ?tag:int -> F.t list list -> unit
|
val create : unit -> t
|
||||||
|
val solve : t -> ?assumptions:F.t list -> unit -> solver_res
|
||||||
|
val assume : t -> ?tag:int -> F.t list list -> unit
|
||||||
end
|
end
|
||||||
|
|
||||||
let mk_solver (): (module BASIC_SOLVER) =
|
let mk_solver (): (module BASIC_SOLVER) =
|
||||||
let module S = struct
|
let module S = struct
|
||||||
include Minismt_sat.Make(struct end)
|
include Minismt_sat
|
||||||
let solve ?assumptions ()= match solve ?assumptions() with
|
let create() = create()
|
||||||
|
let solve st ?assumptions () =
|
||||||
|
match solve st ?assumptions() with
|
||||||
| Sat _ ->
|
| Sat _ ->
|
||||||
R_sat
|
R_sat
|
||||||
| Unsat us ->
|
| Unsat us ->
|
||||||
|
|
@ -86,13 +90,14 @@ module Test = struct
|
||||||
let run (t:t): result =
|
let run (t:t): result =
|
||||||
(* Interesting stuff happening *)
|
(* Interesting stuff happening *)
|
||||||
let (module S: BASIC_SOLVER) = mk_solver () in
|
let (module S: BASIC_SOLVER) = mk_solver () in
|
||||||
|
let st = S.create() in
|
||||||
try
|
try
|
||||||
List.iter
|
List.iter
|
||||||
(function
|
(function
|
||||||
| A_assume cs ->
|
| A_assume cs ->
|
||||||
S.assume cs
|
S.assume st cs
|
||||||
| A_solve (assumptions, expect) ->
|
| A_solve (assumptions, expect) ->
|
||||||
match S.solve ~assumptions (), expect with
|
match S.solve st ~assumptions (), expect with
|
||||||
| R_sat, `Expect_sat
|
| R_sat, `Expect_sat
|
||||||
| R_unsat, `Expect_unsat -> ()
|
| R_unsat, `Expect_unsat -> ()
|
||||||
| R_unsat, `Expect_sat ->
|
| R_unsat, `Expect_sat ->
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue