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

Correct indentation.

Browse source
This commit is contained in:
Guillaume Bury 2014-11-01 17:17:50 +01:00
parent 4ce4cb79be
commit 8d95cecba4
7 changed files with 134 additions and 134 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
common/vec.ml
View file

@ -114,9 +114,9 @@ let sort t f =
t.data <- sub_arr t.data <- sub_arr
let iter f t = let iter f t =
for i = 0 to size t - 1 do for i = 0 to size t - 1 do
f (get t i) f (get t i)
done done
(* (*
template<class V, class T> template<class V, class T>

140
sat/sat.ml
View file

@ -1,51 +1,51 @@
(* Copyright 2014 Guillaume Bury *) (* Copyright 2014 Guillaume Bury *)
module Fsat = struct module Fsat = struct
exception Out_of_int exception Out_of_int
(* Until the constant true_ and false_ are not needed anymore, (* Until the constant true_ and false_ are not needed anymore,
* wa can't simply use sigend integers to represent literals *) * wa can't simply use sigend integers to represent literals *)
type t = { type t = {
(* Invariant : var >= 0 *) (* Invariant : var >= 0 *)
var : int; var : int;
pos : bool; pos : bool;
} }
let max_index = ref 0 let max_index = ref 0
let true_ = { var = 0; pos = true } let true_ = { var = 0; pos = true }
let false_ = { var = 0; pos = false } let false_ = { var = 0; pos = false }
let dummy = { var = -1; pos = true } let dummy = { var = -1; pos = true }
let unsafe_make i = { var = i; pos = true } let unsafe_make i = { var = i; pos = true }
let make i = if i > 0 then unsafe_make i else dummy let make i = if i > 0 then unsafe_make i else dummy
let neg a = { a with pos = not a.pos } let neg a = { a with pos = not a.pos }
let norm a = unsafe_make a.var, not a.pos let norm a = unsafe_make a.var, not a.pos
let hash = Hashtbl.hash let hash = Hashtbl.hash
let equal = (=) let equal = (=)
let compare = Pervasives.compare let compare = Pervasives.compare
let label a = Hstring.make "" let label a = Hstring.make ""
let add_label _ _ = () let add_label _ _ = ()
let create, iter = let create, iter =
let create () = let create () =
if !max_index <> max_int then if !max_index <> max_int then
(incr max_index; unsafe_make !max_index) (incr max_index; unsafe_make !max_index)
else else
raise Out_of_int raise Out_of_int
in in
let iter: (t -> unit) -> unit = fun f -> let iter: (t -> unit) -> unit = fun f ->
for j = 1 to !max_index do for j = 1 to !max_index do
f (unsafe_make j) f (unsafe_make j)
done done
in in
create, iter create, iter
let print fmt a = let print fmt a =
Format.fprintf fmt "%s%d" (if not a.pos then "~" else "") a.var Format.fprintf fmt "%s%d" (if not a.pos then "~" else "") a.var
end end
@ -54,53 +54,53 @@ module Stypes = Solver_types.Make(Fsat)
module Exp = Explanation.Make(Stypes) module Exp = Explanation.Make(Stypes)
module Tsat = struct module Tsat = struct
(* We don't have anything to do since the SAT Solver already (* We don't have anything to do since the SAT Solver already
* does propagation and conflict detection *) * does propagation and conflict detection *)
type t = int type t = int
type formula = Fsat.t type formula = Fsat.t
type explanation = Exp.t type explanation = Exp.t
exception Inconsistent of explanation exception Inconsistent of explanation
let dummy = -1 let dummy = -1
let empty () = 0 let empty () = 0
let assume ~cs:_ _ _ _ = 0 let assume ~cs:_ _ _ _ = 0
end end
module Make(Dummy : sig end) = struct module Make(Dummy : sig end) = struct
module SatSolver = Solver.Make(Fsat)(Stypes)(Exp)(Tsat) module SatSolver = Solver.Make(Fsat)(Stypes)(Exp)(Tsat)
type res = type res =
| Sat | Sat
| Unsat | Unsat
let _i = ref 0 let _i = ref 0
type atom = Fsat.t type atom = Fsat.t
type state = SatSolver.t type state = SatSolver.t
let neg = Fsat.neg let neg = Fsat.neg
let new_atom = Fsat.create let new_atom = Fsat.create
let hash = Fsat.hash let hash = Fsat.hash
let equal = Fsat.equal let equal = Fsat.equal
let compare = Fsat.compare let compare = Fsat.compare
let print_atom = Fsat.print let print_atom = Fsat.print
let iter_atoms = Fsat.iter let iter_atoms = Fsat.iter
let solve () = let solve () =
try try
SatSolver.solve (); SatSolver.solve ();
assert false assert false
with with
| SatSolver.Sat -> Sat | SatSolver.Sat -> Sat
| SatSolver.Unsat _ -> Unsat | SatSolver.Unsat _ -> Unsat
let assume l = let assume l =
incr _i; incr _i;
SatSolver.assume l !_i SatSolver.assume l !_i
let eval = SatSolver.eval let eval = SatSolver.eval
end end

46
sat/sat.mli
View file

@ -1,39 +1,39 @@
(* Copyright 2014 Guillaume Bury *) (* Copyright 2014 Guillaume Bury *)
module Make(Dummy: sig end) : sig module Make(Dummy: sig end) : sig
(** Fonctor to make a pure SAT Solver module with built-in literals. *) (** Fonctor to make a pure SAT Solver module with built-in literals. *)
type atom type atom
(** Abstract type for atoms, i.e boolean literals. *) (** Abstract type for atoms, i.e boolean literals. *)
type res = Sat | Unsat type res = Sat | Unsat
(** Type of results returned by the solve function. *) (** Type of results returned by the solve function. *)
val new_atom : unit -> atom val new_atom : unit -> atom
(** [new_atom ()] returns a fresh literal. *) (** [new_atom ()] returns a fresh literal. *)
val neg : atom -> atom val neg : atom -> atom
(** [neg a] returns the negation of a literal. Involutive, i.e [neg (neg a) = a]. *) (** [neg a] returns the negation of a literal. Involutive, i.e [neg (neg a) = a]. *)
val hash : atom -> int val hash : atom -> int
val equal : atom -> atom -> bool val equal : atom -> atom -> bool
val compare : atom -> atom -> int val compare : atom -> atom -> int
(** Usual hash and comparison functions. For now, directly uses Pervasives and Hashtbl builtins. *) (** Usual hash and comparison functions. For now, directly uses Pervasives and Hashtbl builtins. *)
val print_atom : Format.formatter -> atom -> unit val print_atom : Format.formatter -> atom -> unit
(** Print the atom on the given formatter. *) (** Print the atom on the given formatter. *)
val iter_atoms : (atom -> unit) -> unit val iter_atoms : (atom -> unit) -> unit
(** Allows iteration over all atoms created (even if unused). *) (** Allows iteration over all atoms created (even if unused). *)
val solve : unit -> res val solve : unit -> res
(** Returns the satisfiability status of the current set of assumptions. *) (** Returns the satisfiability status of the current set of assumptions. *)
val eval : atom -> bool val eval : atom -> bool
(** Return the current assignement of the literals. *) (** Return the current assignement of the literals. *)
val assume : atom list list -> unit val assume : atom list list -> unit
(** Add a list of clauses to the set of assumptions. *) (** Add a list of clauses to the set of assumptions. *)
end end

4
sat/solver.ml
View file

@ -189,7 +189,7 @@ module Make (F : Formula_intf.S)
Vec.push env.trail_lim (Vec.size env.trail); Vec.push env.trail_lim (Vec.size env.trail);
Vec.push env.tenv_queue env.tenv; (* save the current tenv *) Vec.push env.tenv_queue env.tenv; (* save the current tenv *)
Log.debug 5 "New decision level : %d (%d in env queue)(%d in trail)" Log.debug 5 "New decision level : %d (%d in env queue)(%d in trail)"
(Vec.size env.trail_lim) (Vec.size env.tenv_queue) (Vec.size env.trail); (Vec.size env.trail_lim) (Vec.size env.tenv_queue) (Vec.size env.trail);
() ()
let attach_clause c = let attach_clause c =
@ -253,7 +253,7 @@ module Make (F : Formula_intf.S)
assert (v.pa.is_true || v.na.is_true); assert (v.pa.is_true || v.na.is_true);
pick_branch_lit () pick_branch_lit ()
end else end else
v v
let enqueue a lvl reason = let enqueue a lvl reason =
assert (not a.is_true && not a.neg.is_true && assert (not a.is_true && not a.neg.is_true &&

20
util/log.ml
View file

@ -50,14 +50,14 @@ let need_cleanup = ref false
let debug l format = let debug l format =
let b = Buffer.create 15 in let b = Buffer.create 15 in
if l <= !debug_level_ if l <= !debug_level_
then ( then (
(if !need_cleanup then clear_line ()); (if !need_cleanup then clear_line ());
Printf.bprintf b "%% [%.3f] " (get_total_time ()); Printf.bprintf b "%% [%.3f] " (get_total_time ());
Printf.kbprintf Printf.kbprintf
(fun b -> print_endline (Buffer.contents b)) (fun b -> print_endline (Buffer.contents b))
b format) b format)
else else
Printf.ifprintf b format Printf.ifprintf b format
let pp_pos pos = let pp_pos pos =
let open Lexing in let open Lexing in
@ -76,8 +76,8 @@ let fprintf oc format =
let buffer = Buffer.create 64 in let buffer = Buffer.create 64 in
Printf.kbprintf Printf.kbprintf
(fun fmt -> Buffer.output_buffer oc buffer) (fun fmt -> Buffer.output_buffer oc buffer)
buffer buffer
format format
let printf format = fprintf stdout format let printf format = fprintf stdout format
let eprintf format = fprintf stderr format let eprintf format = fprintf stderr format

10
util/log.mli
View file

@ -40,7 +40,7 @@ val get_debug : unit -> int (** Current debug level *)
val need_cleanup : bool ref (** Cleanup line before printing? *) val need_cleanup : bool ref (** Cleanup line before printing? *)
val debug : int -> ('a, Buffer.t, unit, unit) format4 -> 'a val debug : int -> ('a, Buffer.t, unit, unit) format4 -> 'a
(** debug message *) (** debug message *)
val pp_pos : Lexing.position -> string val pp_pos : Lexing.position -> string
@ -57,18 +57,18 @@ val on_fmt : (Format.formatter -> 'a -> 'b) -> 'a -> string
val on_buffer : (Buffer.t -> 'a -> unit) -> 'a -> string val on_buffer : (Buffer.t -> 'a -> unit) -> 'a -> string
val pp_pair: ?sep:string -> (Buffer.t -> 'a -> unit) -> val pp_pair: ?sep:string -> (Buffer.t -> 'a -> unit) ->
(Buffer.t -> 'b -> unit) -> Buffer.t -> ('a * 'b) -> unit (Buffer.t -> 'b -> unit) -> Buffer.t -> ('a * 'b) -> unit
val pp_opt : (Buffer.t -> 'a -> unit) -> Buffer.t -> 'a option -> unit val pp_opt : (Buffer.t -> 'a -> unit) -> Buffer.t -> 'a option -> unit
(** print a list of items using the printing function *) (** print a list of items using the printing function *)
val pp_list: ?sep:string -> (Buffer.t -> 'a -> unit) val pp_list: ?sep:string -> (Buffer.t -> 'a -> unit)
-> Buffer.t -> 'a list -> unit -> Buffer.t -> 'a list -> unit
(** print an array of items with printing function *) (** print an array of items with printing function *)
val pp_array: ?sep:string -> (Buffer.t -> 'a -> unit) val pp_array: ?sep:string -> (Buffer.t -> 'a -> unit)
-> Buffer.t -> 'a array -> unit -> Buffer.t -> 'a array -> unit
(** print an array, giving the printing function both index and item *) (** print an array, giving the printing function both index and item *)
val pp_arrayi: ?sep:string -> (Buffer.t -> int -> 'a -> unit) val pp_arrayi: ?sep:string -> (Buffer.t -> int -> 'a -> unit)
-> Buffer.t -> 'a array -> unit -> Buffer.t -> 'a array -> unit

42
util/test.ml
View file

@ -2,36 +2,36 @@
module S = Sat.Make(struct end) module S = Sat.Make(struct end)
let init () = let init () =
let v = Array.init 5 (fun _ -> S.new_atom ()) in let v = Array.init 5 (fun _ -> S.new_atom ()) in
[ [ [ [
[v.(0); v.(1)]; [v.(0); v.(1)];
[S.neg v.(0); v.(2)]; [S.neg v.(0); v.(2)];
[S.neg v.(1); v.(2)]; [S.neg v.(1); v.(2)];
]; ];
[ [
[v.(3); v.(4)]; [v.(3); v.(4)];
[S.neg v.(3); S.neg v.(2)]; [S.neg v.(3); S.neg v.(2)];
[S.neg v.(4); S.neg v.(2)]; [S.neg v.(4); S.neg v.(2)];
]
] ]
]
let print_assign fmt () = let print_assign fmt () =
S.iter_atoms (fun a -> S.iter_atoms (fun a ->
Format.fprintf fmt "%a -> %s,@ " Format.fprintf fmt "%a -> %s,@ "
S.print_atom a S.print_atom a
(if S.eval a then "true" else "false") (if S.eval a then "true" else "false")
) )
let main () = let main () =
Log.set_debug 10; Log.set_debug 10;
Format.printf "Hello World !@."; Format.printf "Hello World !@.";
List.iter (fun l -> List.iter (fun l ->
List.iter (fun c -> Format.printf "Adding : %a@." List.iter (fun c -> Format.printf "Adding : %a@."
(fun _ -> List.iter (fun a -> Format.printf "%a " S.print_atom a)) c) l; (fun _ -> List.iter (fun a -> Format.printf "%a " S.print_atom a)) c) l;
S.assume l; S.assume l;
match S.solve () with match S.solve () with
| S.Sat -> Format.printf "Sat@\n%a@." print_assign () | S.Sat -> Format.printf "Sat@\n%a@." print_assign ()
| S.Unsat -> Format.printf "Unsat@.") (init ()); | S.Unsat -> Format.printf "Unsat@.") (init ());
;; ;;
main () main ()