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

refactor: move Lit inside the solver, as output, not input

Browse source
This commit is contained in:
Simon Cruanes 2019-06-07 17:31:11 -05:00
parent 81e7953261
commit 38f001b0e7
8 changed files with 120 additions and 162 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

83
src/base-term/Base_types.ml
View file

@ -18,12 +18,6 @@ and 'a term_view =
| Eq of 'a * 'a
| Not of 'a
(* boolean literal *)
and lit = {
lit_term: term;
lit_sign: bool;
}
and fun_ = {
fun_id: ID.t;
fun_view: fun_view;
@ -101,17 +95,8 @@ let[@inline] term_equal_ (a:term) b = a==b
let[@inline] term_hash_ a = a.term_id
let[@inline] term_cmp_ a b = CCInt.compare a.term_id b.term_id
let cmp_lit a b =
let c = CCBool.compare a.lit_sign b.lit_sign in
if c<>0 then c
else term_cmp_ a.lit_term b.lit_term
let fun_compare a b = ID.compare a.fun_id b.fun_id
let hash_lit a =
let sign = a.lit_sign in
Hash.combine3 2 (Hash.bool sign) (term_hash_ a.lit_term)
let pp_fun out a = ID.pp out a.fun_id
let id_of_fun a = a.fun_id
@ -167,10 +152,6 @@ let pp_term_top ~ids out t =
let pp_term = pp_term_top ~ids:false
let pp_term_view = pp_term_view_gen ~pp_id:ID.pp_name ~pp_t:pp_term
let pp_lit out l =
if l.lit_sign then pp_term out l.lit_term
else Format.fprintf out "(@[@<1>¬@ %a@])" pp_term l.lit_term
module Ty_card : sig
type t = ty_card = Finite | Infinite
@ -756,63 +737,6 @@ end = struct
| Eq (a,b) -> eq tst (f a) (f b)
end
module Lit : sig
type t = lit = {
lit_term: term;
lit_sign : bool
}
val neg : t -> t
val abs : t -> t
val sign : t -> bool
val term : t -> term
val as_atom : t -> term * bool
val atom : Term.state -> ?sign:bool -> term -> t
val hash : t -> int
val compare : t -> t -> int
val equal : t -> t -> bool
val print : t Fmt.printer
val pp : t Fmt.printer
val apply_sign : t -> bool -> t
val norm_sign : t -> t * bool
val norm : t -> t * Msat.negated
module Set : CCSet.S with type elt = t
module Tbl : CCHashtbl.S with type key = t
end = struct
type t = lit = {
lit_term: term;
lit_sign : bool
}
let[@inline] neg l = {l with lit_sign=not l.lit_sign}
let[@inline] sign t = t.lit_sign
let[@inline] term (t:t): term = t.lit_term
let[@inline] abs t: t = {t with lit_sign=true}
let make ~sign t = {lit_sign=sign; lit_term=t}
let atom tst ?(sign=true) (t:term) : t =
let t, sign' = Term.abs tst t in
let sign = if not sign' then not sign else sign in
make ~sign t
let[@inline] as_atom (lit:t) = lit.lit_term, lit.lit_sign
let hash = hash_lit
let compare = cmp_lit
let[@inline] equal a b = compare a b = 0
let pp = pp_lit
let print = pp
let apply_sign t s = if s then t else neg t
let norm_sign l = if l.lit_sign then l, true else neg l, false
let norm l = let l, sign = norm_sign l in l, if sign then Msat.Same_sign else Msat.Negated
module Set = CCSet.Make(struct type t = lit let compare=compare end)
module Tbl = CCHashtbl.Make(struct type t = lit let equal=equal let hash=hash end)
end
module Value : sig
type t = value =
| V_bool of bool
@ -872,10 +796,3 @@ module Proof = struct
type t = Default
let default = Default
end
module type CC_ACTIONS = sig
val raise_conflict : Lit.t list -> Proof.t -> 'a
val propagate : Lit.t -> reason:(unit -> Lit.t list) -> Proof.t -> unit
end
type cc_actions = (module CC_ACTIONS)

5
src/base-term/Sidekick_base_term.ml
View file

@ -8,17 +8,14 @@ module Term = Base_types.Term
module Value = Base_types.Value
module Term_cell = Base_types.Term_cell
module Ty = Base_types.Ty
module Lit = Base_types.Lit
module Arg
: Sidekick_core.TERM_LIT
: Sidekick_core.TERM
with type Term.t = Term.t
and type Lit.t = Lit.t
and type Fun.t = Fun.t
and type Ty.t = Ty.t
= struct
module Term = Term
module Lit = Lit
module Fun = Fun
module Ty = Ty
end

4
src/cc/Sidekick_cc.ml
View file

@ -17,14 +17,14 @@ module Make(CC_A: ARG) = struct
module A = CC_A.A
type term = A.Term.t
type term_state = A.Term.state
type lit = A.Lit.t
type lit = CC_A.Lit.t
type fun_ = A.Fun.t
type proof = A.Proof.t
type actions = CC_A.Actions.t
module T = A.Term
module Fun = A.Fun
module Lit = A.Lit
module Lit = CC_A.Lit
module Bits = CCBitField.Make()
(* TODO: give theories the possibility to allocate new bits in nodes *)

83
src/core/Sidekick_core.ml
View file

@ -78,6 +78,8 @@ module type TERM = sig
val bool : state -> bool -> t (* build true/false *)
val as_bool : t -> bool option
val abs : state -> t -> t * bool
val map_shallow : state -> (t -> t) -> t -> t
(** Map function on immediate subterms *)
@ -87,56 +89,37 @@ module type TERM = sig
end
end
module type TERM_LIT = sig
module type TERM_PROOF = sig
include TERM
module Lit : sig
type t
val neg : t -> t
val equal : t -> t -> bool
val compare : t -> t -> int
val hash : t -> int
val pp : t Fmt.printer
val term : t -> Term.t
val sign : t -> bool
val abs : t -> t
val apply_sign : t -> bool -> t
val norm_sign : t -> t * bool
(** Invariant: if [u, sign = norm_sign t] then [apply_sign u sign = t] *)
val atom : Term.state -> ?sign:bool -> Term.t -> t
end
end
module type TERM_LIT_PROOF = sig
include TERM_LIT
module Proof : sig
type t
val pp : t Fmt.printer
val default : t
(* TODO: to give more details? or make this extensible?
or have a generative function for new proof cstors?
val cc_lemma : unit -> t
*)
end
end
module type CC_ARG = sig
module A : TERM_LIT_PROOF
module A : TERM_PROOF
val cc_view : A.Term.t -> (A.Fun.t, A.Term.t, A.Term.t Iter.t) CC_view.t
(** View the term through the lens of the congruence closure *)
module Lit : sig
type t
val term : t -> A.Term.t
val sign : t -> bool
val neg : t -> t
val pp : t Fmt.printer
end
module Actions : sig
type t
val raise_conflict : t -> A.Lit.t list -> A.Proof.t -> 'a
val raise_conflict : t -> Lit.t list -> A.Proof.t -> 'a
val propagate : t -> A.Lit.t -> reason:(unit -> A.Lit.t list) -> A.Proof.t -> unit
val propagate : t -> Lit.t -> reason:(unit -> Lit.t list) -> A.Proof.t -> unit
end
end
@ -146,7 +129,7 @@ module type CC_S = sig
type term_state = A.Term.state
type term = A.Term.t
type fun_ = A.Fun.t
type lit = A.Lit.t
type lit = CC_A.Lit.t
type proof = A.Proof.t
type actions = CC_A.Actions.t
@ -302,12 +285,11 @@ end
(** A view of the solver from a theory's point of view *)
module type SOLVER_INTERNAL = sig
module A : TERM_LIT_PROOF
module A : TERM_PROOF
module CC_A : CC_ARG with module A = A
module CC : CC_S with module CC_A = CC_A
type ty = A.Ty.t
type lit = A.Lit.t
type term = A.Term.t
type term_state = A.Term.state
type proof = A.Proof.t
@ -324,6 +306,23 @@ module type SOLVER_INTERNAL = sig
val cc : t -> CC.t
(** Congruence closure for this solver *)
(** {3 Literals}
A literal is a (preprocessed) term along with its sign.
It is directly manipulated by the SAT solver.
*)
module Lit : sig
type t
val term : t -> term
val sign : t -> bool
val neg : t -> t
val equal : t -> t -> bool
val hash : t -> int
val pp : t Fmt.printer
end
type lit = Lit.t
(** {3 Simplifiers} *)
module Simplify : sig
@ -440,7 +439,11 @@ module type SOLVER_INTERNAL = sig
literals suitable for reasoning.
Typically some clauses are also added to the solver. *)
type preprocess_hook = t -> add_clause:(lit list -> unit) -> term -> term option
type preprocess_hook =
t ->
mk_lit:(term -> lit) ->
add_clause:(lit list -> unit) ->
term -> term option
(** Given a term, try to preprocess it. Return [None] if it didn't change.
Can also add clauses to define new terms. *)
@ -449,16 +452,18 @@ end
(** Public view of the solver *)
module type SOLVER = sig
module A : TERM_LIT_PROOF
module A : TERM_PROOF
module CC_A : CC_ARG with module A = A
module Solver_internal : SOLVER_INTERNAL with module A = A and module CC_A = CC_A
(** Internal solver, available to theories. *)
module Lit = Solver_internal.Lit
type t
type solver = t
type term = A.Term.t
type ty = A.Ty.t
type lit = A.Lit.t
type lit = Solver_internal.Lit.t
type lemma = A.Proof.t
(** {3 A theory}
@ -583,10 +588,6 @@ module type SOLVER = sig
val mk_atom_t : t -> ?sign:bool -> term -> Atom.t
val add_clause_lits : t -> lit IArray.t -> unit
val add_clause_lits_l : t -> lit list -> unit
val add_clause : t -> Atom.t IArray.t -> unit
val add_clause_l : t -> Atom.t list -> unit

79
src/msat-solver/Sidekick_msat_solver.ml
View file

@ -5,30 +5,71 @@ module Log = Msat.Log
module IM = Util.Int_map
module type ARG = sig
include Sidekick_core.TERM_LIT_PROOF
include Sidekick_core.TERM_PROOF
val cc_view : Term.t -> (Fun.t, Term.t, Term.t Iter.t) Sidekick_core.CC_view.t
end
module type S = Sidekick_core.SOLVER
module Make(A : ARG)
: S with module A = A
(* : S with module A = A *)
= struct
module A = A
module T = A.Term
module Lit = A.Lit
module Ty = A.Ty
type lit = Lit.t
type term = T.t
type ty = Ty.t
type lemma = A.Proof.t
module Lit = struct
type t = {
lit_term: term;
lit_sign : bool
}
let[@inline] neg l = {l with lit_sign=not l.lit_sign}
let[@inline] sign t = t.lit_sign
let[@inline] term (t:t): term = t.lit_term
let[@inline] abs t: t = {t with lit_sign=true}
let make ~sign t = {lit_sign=sign; lit_term=t}
let atom tst ?(sign=true) (t:term) : t =
let t, sign' = T.abs tst t in
let sign = if not sign' then not sign else sign in
make ~sign t
let[@inline] as_atom (lit:t) = lit.lit_term, lit.lit_sign
let equal a b =
a.lit_sign = b.lit_sign &&
T.equal a.lit_term b.lit_term
let hash a =
let sign = a.lit_sign in
CCHash.combine3 2 (CCHash.bool sign) (T.hash a.lit_term)
let pp out l =
if l.lit_sign then T.pp out l.lit_term
else Format.fprintf out "(@[@<1>¬@ %a@])" T.pp l.lit_term
let print = pp
let apply_sign t s = if s then t else neg t
let norm_sign l = if l.lit_sign then l, true else neg l, false
let norm l = let l, sign = norm_sign l in l, if sign then Msat.Same_sign else Msat.Negated
end
type lit = Lit.t
(* actions from msat *)
type msat_acts = (Msat.void, Lit.t, Msat.void, A.Proof.t) Msat.acts
(* the full argument to the congruence closure *)
module CC_A = struct
module A = A
module Lit = Lit
let cc_view = A.cc_view
module Actions = struct
@ -49,6 +90,7 @@ module Make(A : ARG)
module Solver_internal = struct
module A = A
module CC_A = CC_A
module Lit = Lit
module CC = CC
module N = CC.N
type term = T.t
@ -119,7 +161,12 @@ module Make(A : ARG)
mutable on_partial_check: (t -> actions -> lit Iter.t -> unit) list;
mutable on_final_check: (t -> actions -> lit Iter.t -> unit) list;
}
and preprocess_hook = t -> add_clause:(lit list -> unit) -> term -> term option
and preprocess_hook =
t ->
mk_lit:(term -> lit) ->
add_clause:(lit list -> unit) ->
term -> term option
type solver = t
@ -159,6 +206,7 @@ module Make(A : ARG)
acts.Msat.acts_add_clause ~keep lits A.Proof.default
let preprocess_lit_ (self:t) ~add_clause (lit:lit) : lit =
let mk_lit t = Lit.atom self.tst t in
(* compute and cache normal form of [t] *)
let rec aux t =
match T.Tbl.find self.preprocess_cache t with
@ -174,7 +222,7 @@ module Make(A : ARG)
and aux_rec t hooks = match hooks with
| [] -> t
| h :: hooks_tl ->
match h self ~add_clause t with
match h self ~mk_lit ~add_clause t with
| None -> aux_rec t hooks_tl
| Some u ->
Log.debugf 30
@ -188,7 +236,7 @@ module Make(A : ARG)
(fun k->k "(@[msat-solver.preprocess@ :lit %a@ :into %a@])" Lit.pp lit Lit.pp lit');
lit'
let[@inline] mk_lit self acts ?sign t =
let mk_lit self acts ?sign t =
let add_clause lits =
Stat.incr self.count_preprocess_clause;
add_sat_clause_ self acts ~keep:true lits
@ -423,16 +471,18 @@ module Make(A : ARG)
ignore (mk_atom_t_ self sub : Sat_solver.atom))
let rec mk_atom_lit self lit : Atom.t =
let lit =
let lit = preprocess_lit_ self lit in
add_bool_subterms_ self (Lit.term lit);
Sat_solver.make_atom self.solver lit
and preprocess_lit_ self lit : Lit.t =
Solver_internal.preprocess_lit_
~add_clause:(fun lits ->
(* recursively add these sub-literals, so they're also properly processed *)
Stat.incr self.si.count_preprocess_clause;
let atoms = List.map (mk_atom_lit self) lits in
Sat_solver.add_clause self.solver atoms A.Proof.default)
self.si lit in
add_bool_subterms_ self (Lit.term lit);
Sat_solver.make_atom self.solver lit
self.si lit
let[@inline] mk_atom_t self ?sign t : Atom.t =
let lit = Lit.atom (tst self) ?sign t in
@ -500,13 +550,6 @@ module Make(A : ARG)
let add_clause_l self c = add_clause self (IArray.of_list c)
let add_clause_lits (self:t) (c:Lit.t IArray.t) : unit =
let c = IArray.map (mk_atom_lit self) c in
add_clause self c
let add_clause_lits_l (self:t) (c:Lit.t list) : unit =
add_clause self (IArray.of_list_map (mk_atom_lit self) c)
(* TODO: remove? use a special constant + micro theory instead?
let[@inline] assume_distinct self l ~neq lit : unit =
CC.assert_distinct (cc self) l lit ~neq

5
src/smtlib/Process.ml
View file

@ -406,6 +406,7 @@ end
module Solver = Sidekick_msat_solver.Make(Solver_arg)
module Check_cc = struct
module Lit = Solver.Lit
module SI = Solver.Solver_internal
module CC = Solver.Solver_internal.CC
module MCC = Sidekick_mini_cc.Make(Solver_arg)
@ -604,9 +605,9 @@ let process_stmt
if pp_cnf then (
Format.printf "(@[<hv1>assert@ %a@])@." Term.pp t
);
let atom = Lit.atom tst t in
let atom = Solver.mk_atom_t solver t in
CCOpt.iter (fun h -> Vec.push h [atom]) hyps;
Solver.add_clause_lits solver (IArray.singleton atom);
Solver.add_clause solver (IArray.singleton atom);
E.return()
| A.Goal (_, _) ->
Error.errorf "cannot deal with goals yet"

3
src/smtlib/Process.mli
View file

@ -5,7 +5,6 @@ open Sidekick_base_term
module Solver
: Sidekick_msat_solver.S with type A.Term.t = Term.t
and type A.Term.state = Term.state
and type A.Lit.t = Lit.t
and type A.Ty.t = Ty.t
val th_bool : Solver.theory
@ -24,7 +23,7 @@ module Check_cc : sig
end
val process_stmt :
?hyps:Lit.t list Vec.t ->
?hyps:Solver.Atom.t list Vec.t ->
?gc:bool ->
?restarts:bool ->
?pp_cnf:bool ->

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

@ -54,7 +54,7 @@ module Make(A : ARG) : S with module A = A = struct
module A = A
module Ty = A.S.A.Ty
module T = A.S.A.Term
module Lit = A.S.A.Lit
module Lit = A.S.Lit
module SI = A.S.Solver_internal
type state = {
@ -122,28 +122,28 @@ module Make(A : ARG) : S with module A = A = struct
| B_atom _ -> None
let fresh_term self ~pre ty = A.Gensym.fresh_term self.gensym ~pre ty
let fresh_lit (self:state) ~pre : Lit.t =
let fresh_lit (self:state) ~mk_lit ~pre : Lit.t =
let t = fresh_term ~pre self Ty.bool in
Lit.atom self.tst t
mk_lit t
(* TODO: polarity? *)
let cnf (self:state) (_solver:SI.t) ~add_clause (t:T.t) : T.t option =
let cnf (self:state) (_si:SI.t) ~mk_lit ~add_clause (t:T.t) : T.t option =
let rec get_lit (t:T.t) : Lit.t =
match A.view_as_bool t with
| B_bool b -> Lit.atom self.tst ~sign:b (T.bool self.tst true)
| B_bool b -> mk_lit (T.bool self.tst b)
| B_not u ->
let lit = get_lit u in
Lit.neg lit
| B_and l ->
let subs = IArray.to_list_map get_lit l in
let proxy = fresh_lit ~pre:"and_" self in
let proxy = fresh_lit ~mk_lit ~pre:"and_" self in
(* add clauses *)
List.iter (fun u -> add_clause [Lit.neg proxy; u]) subs;
add_clause (proxy :: List.map Lit.neg subs);
proxy
| B_or l ->
let subs = IArray.to_list_map get_lit l in
let proxy = fresh_lit ~pre:"or_" self in
let proxy = fresh_lit ~mk_lit ~pre:"or_" self in
(* add clauses *)
List.iter (fun u -> add_clause [Lit.neg u; proxy]) subs;
add_clause (Lit.neg proxy :: subs);
@ -154,11 +154,11 @@ module Make(A : ARG) : S with module A = A = struct
IArray.append (IArray.map (not_ self.tst) args) (IArray.singleton u) in
get_lit t'
| B_ite _ | B_eq _ ->
Lit.atom self.tst t
mk_lit t
| B_equiv (a,b) ->
let a = get_lit a in
let b = get_lit b in
let proxy = fresh_lit ~pre:"equiv_" self in
let proxy = fresh_lit ~mk_lit ~pre:"equiv_" self in
(* proxy => a<=> b,
¬proxy => a xor b *)
add_clause [Lit.neg proxy; Lit.neg a; b];
@ -166,7 +166,7 @@ module Make(A : ARG) : S with module A = A = struct
add_clause [proxy; a; b];
add_clause [proxy; Lit.neg a; Lit.neg b];
proxy
| B_atom u -> Lit.atom self.tst u
| B_atom u -> mk_lit u
in
let lit = get_lit t in
let u = Lit.term lit in