fix more warnings

This commit is contained in:
Simon Cruanes 2021-08-27 09:28:59 -04:00
parent b33f5fa5b1
commit e7e8873295
No known key found for this signature in database
GPG key ID: 4AC01D0849AA62B6
18 changed files with 49 additions and 61 deletions

View file

@ -5,7 +5,7 @@
from {!Sidekick_core}, using data structures from from {!Sidekick_core}, using data structures from
{!Sidekick_base}. *) {!Sidekick_base}. *)
open Sidekick_base open! Sidekick_base
(** Argument to the SMT solver *) (** Argument to the SMT solver *)
module Solver_arg = struct module Solver_arg = struct
@ -24,8 +24,8 @@ module Solver = Sidekick_smt_solver.Make(Solver_arg)
(** Theory of datatypes *) (** Theory of datatypes *)
module Th_data = Sidekick_th_data.Make(struct module Th_data = Sidekick_th_data.Make(struct
module S = Solver module S = Solver
open Base_types open! Base_types
open Sidekick_th_data open! Sidekick_th_data
module Proof = Proof_stub module Proof = Proof_stub
module Cstor = Cstor module Cstor = Cstor
@ -89,7 +89,8 @@ module Th_lra = Sidekick_arith_lra.Make(struct
let mk_bool = T.bool let mk_bool = T.bool
let view_as_lra t = match T.view t with let view_as_lra t = match T.view t with
| T.LRA l -> l | T.LRA l -> l
| T.Eq (a,b) when Ty.equal (T.ty a) (Ty.real()) -> LRA_pred (Eq, a, b) | T.Eq (a,b) when Ty.equal (T.ty a) (Ty.real()) ->
LRA_pred (Eq, a, b)
| _ -> LRA_other t | _ -> LRA_other t
let ty_lra _st = Ty.real() let ty_lra _st = Ty.real()

View file

@ -769,12 +769,6 @@ end = struct
| Eq (a,b) -> Eq (f a, f b) | Eq (a,b) -> Eq (f a, f b)
| Ite (a,b,c) -> Ite (f a, f b, f c) | Ite (a,b,c) -> Ite (f a, f b, f c)
| LRA l -> LRA (Sidekick_arith_lra.map_view f l) | LRA l -> LRA (Sidekick_arith_lra.map_view f l)
module Tbl = CCHashtbl.Make(struct
type t = term view
let equal = equal
let hash = hash
end)
end end
(** Term creation and manipulation *) (** Term creation and manipulation *)

View file

@ -1,6 +1,6 @@
(* This file is free software. See file "license" for more details. *) (* This file is free software. See file "license" for more details. *)
open Base_types open! Base_types
module Val_map = struct module Val_map = struct
module M = CCMap.Make(CCInt) module M = CCMap.Make(CCInt)

View file

@ -1,5 +1,5 @@
open Base_types open! Base_types
module Term = Term module Term = Term
module Fun = Fun module Fun = Fun

View file

@ -56,7 +56,7 @@ end = struct
let dump oc self : unit = let dump oc self : unit =
let fpf = Printf.fprintf in let fpf = Printf.fprintf in
let pp_c out c = Clause.iter c ~f:(fun a -> fpf oc "%d " (a:atom:>int)); in let pp_c out c = Clause.iter c ~f:(fun a -> fpf out "%d " (a:atom:>int)); in
Vec.iter Vec.iter
(function (function
| Input c -> fpf oc "i %a0\n" pp_c c; | Input c -> fpf oc "i %a0\n" pp_c c;
@ -82,8 +82,6 @@ module Fwd_check : sig
indexes in the trace of the steps that failed. *) indexes in the trace of the steps that failed. *)
val check : Trace.t -> (unit, error) result val check : Trace.t -> (unit, error) result
end = struct end = struct
module ISet = CCSet.Make(CCInt)
type t = { type t = {
checker: Checker.t; checker: Checker.t;
errors: VecI32.t; errors: VecI32.t;

View file

@ -259,7 +259,7 @@ module type LIT = sig
val signed_term : t -> T.Term.t * bool val signed_term : t -> T.Term.t * bool
(** Return the atom and the sign *) (** Return the atom and the sign *)
val atom : T.Term.store -> ?sign:bool -> T.Term.t -> t val atom : ?sign:bool -> T.Term.store -> T.Term.t -> t
(** [atom store t] makes a literal out of a term, possibly normalizing (** [atom store t] makes a literal out of a term, possibly normalizing
its sign in the process. its sign in the process.
@param sign if provided, and [sign=false], negate the resulting lit. *) @param sign if provided, and [sign=false], negate the resulting lit. *)

View file

@ -228,7 +228,7 @@ module Make() : S = struct
exception Conflict exception Conflict
let raise_conflict_ self a = let raise_conflict_ _self a =
Log.debugf 5 (fun k->k"conflict on atom %a" Atom.pp a); Log.debugf 5 (fun k->k"conflict on atom %a" Atom.pp a);
raise Conflict raise Conflict
@ -245,7 +245,6 @@ module Make() : S = struct
let pp_trail_ out self = let pp_trail_ out self =
Fmt.fprintf out "(@[%a@])" (Fmt.iter Atom.pp) (Atom.Stack.to_iter self.trail) Fmt.fprintf out "(@[%a@])" (Fmt.iter Atom.pp) (Atom.Stack.to_iter self.trail)
exception Found_watch of atom
exception Is_sat exception Is_sat
exception Is_undecided exception Is_undecided

View file

@ -1,5 +1,7 @@
(env (env
(_ (_
(flags :standard -warn-error -3-32 -color always -safe-string -short-paths) (flags :standard -warn-error
-a+8+9 -w +a-4-32-40-41-42-44-48
-color always -safe-string -short-paths)
(ocamlopt_flags :standard -O3 -color always -unbox-closures -unbox-closures-factor 20))) (ocamlopt_flags :standard -O3 -color always -unbox-closures -unbox-closures-factor 20)))

View file

@ -19,7 +19,7 @@ module Make(T : Sidekick_core.TERM)
let make ~sign t = {lit_sign=sign; lit_term=t} let make ~sign t = {lit_sign=sign; lit_term=t}
let atom tst ?(sign=true) (t:term) : t = let atom ?(sign=true) tst (t:term) : t =
let t, sign' = T.Term.abs tst t in let t, sign' = T.Term.abs tst t in
let sign = if not sign' then not sign else sign in let sign = if not sign' then not sign else sign in
make ~sign t make ~sign t

View file

@ -133,7 +133,6 @@ module Make(A : ARG) : S with module A = A = struct
module LE_ = Linear_expr.Make(A.Q)(SimpVar) module LE_ = Linear_expr.Make(A.Q)(SimpVar)
module LE = LE_.Expr module LE = LE_.Expr
module SimpSolver = Simplex2.Make(A.Q)(SimpVar) module SimpSolver = Simplex2.Make(A.Q)(SimpVar)
module LConstr = SimpSolver.Constraint
module Subst = SimpSolver.Subst module Subst = SimpSolver.Subst
module Comb_map = CCMap.Make(LE_.Comb) module Comb_map = CCMap.Make(LE_.Comb)

View file

@ -111,6 +111,7 @@ let main_smt () : _ result =
in in
Process.Solver.create ~proof ~theories tst () () Process.Solver.create ~proof ~theories tst () ()
in in
(* FIXME: emit an actual proof *)
let proof_file = if !proof_file ="" then None else Some !proof_file in let proof_file = if !proof_file ="" then None else Some !proof_file in
if !check then ( if !check then (
(* might have to check conflicts *) (* might have to check conflicts *)
@ -126,7 +127,7 @@ let main_smt () : _ result =
E.fold_l E.fold_l
(fun () -> (fun () ->
Process.process_stmt Process.process_stmt
~gc:!gc ~restarts:!restarts ~pp_cnf:!p_cnf ?proof_file ~gc:!gc ~restarts:!restarts ~pp_cnf:!p_cnf
~time:!time_limit ~memory:!size_limit ~time:!time_limit ~memory:!size_limit
~pp_model:!p_model ~pp_model:!p_model
~check:!check ~progress:!p_progress ~check:!check ~progress:!p_progress

View file

@ -192,7 +192,7 @@ let solve ?(check=false) ?in_memory_proof (solver:SAT.t) : (unit, string) result
| SAT.Sat _ -> | SAT.Sat _ ->
let t3 = Sys.time () -. t2 in let t3 = Sys.time () -. t2 in
Format.printf "Sat (%.3f/%.3f)@." t2 t3; Format.printf "Sat (%.3f/%.3f)@." t2 t3;
| SAT.Unsat (module US) -> | SAT.Unsat _ ->
if check then ( if check then (
match in_memory_proof with match in_memory_proof with

View file

@ -1,4 +1,4 @@
open Sidekick_base open! Sidekick_base
module A = Alcotest module A = Alcotest
module CC = Sidekick_mini_cc.Make(struct module CC = Sidekick_mini_cc.Make(struct

View file

@ -75,7 +75,6 @@ module Make(A : ARG)
end end
module CC = Sidekick_cc.Make(CC_actions) module CC = Sidekick_cc.Make(CC_actions)
module Expl = CC.Expl
module N = CC.N module N = CC.N
(** Internal solver, given to theories and to Msat *) (** Internal solver, given to theories and to Msat *)
@ -85,7 +84,6 @@ module Make(A : ARG)
module Lit = Lit module Lit = Lit
module CC = CC module CC = CC
module N = CC.N module N = CC.N
type formula = Lit.t
type nonrec proof = proof type nonrec proof = proof
type dproof = proof -> unit type dproof = proof -> unit
type term = Term.t type term = Term.t
@ -199,8 +197,6 @@ module Make(A : ARG)
type solver = t type solver = t
module Eq_class = CC.N
module Expl = CC.Expl
module Proof = P module Proof = P
let[@inline] cc (t:t) = Lazy.force t.cc let[@inline] cc (t:t) = Lazy.force t.cc
@ -244,7 +240,7 @@ module Make(A : ARG)
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_lit self ?default_pol (acts:theory_actions) (lit:Lit.t) : unit = let add_sat_lit _self ?default_pol (acts:theory_actions) (lit:Lit.t) : unit =
let (module A) = acts in let (module A) = acts in
A.add_lit ?default_pol lit A.add_lit ?default_pol lit
@ -337,7 +333,7 @@ module Make(A : ARG)
(module struct (module struct
let add_lit ?default_pol lit = let add_lit ?default_pol lit =
let lit = preprocess_lit lit in let lit = preprocess_lit lit in
A0.add_lit lit A0.add_lit ?default_pol lit
let add_clause c pr = let add_clause c pr =
Stat.incr self.count_preprocess_clause; Stat.incr self.count_preprocess_clause;
let c = CCList.map preprocess_lit c in let c = CCList.map preprocess_lit c in
@ -772,8 +768,12 @@ module Make(A : ARG)
let _lits f = SAT.iter_trail f in let _lits f = SAT.iter_trail f in
(* TODO: theory combination *) (* TODO: theory combination *)
let m = mk_model self _lits in let m = mk_model self _lits in
(* TODO: check model *)
let _ = check in
do_on_exit (); do_on_exit ();
Sat m Sat m
| Sat_solver.Unsat (module UNSAT) -> | Sat_solver.Unsat (module UNSAT) ->
let unsat_core () = UNSAT.unsat_assumptions () in let unsat_core () = UNSAT.unsat_assumptions () in
do_on_exit (); do_on_exit ();

View file

@ -1,8 +1,7 @@
(** {2 Conversion into {!Term.t}} *) (** {2 Conversion into {!Term.t}} *)
module BT = Sidekick_base
module Profile = Sidekick_util.Profile module Profile = Sidekick_util.Profile
open Sidekick_base open! Sidekick_base
module SBS = Sidekick_base_solver module SBS = Sidekick_base_solver
[@@@ocaml.warning "-32"] [@@@ocaml.warning "-32"]
@ -17,7 +16,6 @@ module Solver = SBS.Solver
module Check_cc = struct module Check_cc = struct
module Lit = Solver.Solver_internal.Lit module Lit = Solver.Solver_internal.Lit
module SI = Solver.Solver_internal module SI = Solver.Solver_internal
module CC = Solver.Solver_internal.CC
module MCC = Sidekick_mini_cc.Make(SBS.Solver_arg) module MCC = Sidekick_mini_cc.Make(SBS.Solver_arg)
let pp_c out c = Fmt.fprintf out "(@[%a@])" (Util.pp_list ~sep:" " Lit.pp) c let pp_c out c = Fmt.fprintf out "(@[%a@])" (Util.pp_list ~sep:" " Lit.pp) c
@ -136,7 +134,6 @@ let solve
?gc:_ ?gc:_
?restarts:_ ?restarts:_
?(pp_model=false) ?(pp_model=false)
?proof_file
?(check=false) ?(check=false)
?time:_ ?memory:_ ?(progress=false) ?time:_ ?memory:_ ?(progress=false)
~assumptions ~assumptions
@ -199,7 +196,7 @@ let solve
(* process a single statement *) (* process a single statement *)
let process_stmt let process_stmt
?gc ?restarts ?(pp_cnf=false) ?gc ?restarts ?(pp_cnf=false)
?proof_file ?pp_model ?(check=false) ?pp_model ?(check=false)
?time ?memory ?progress ?time ?memory ?progress
(solver:Solver.t) (solver:Solver.t)
(stmt:Statement.t) : unit or_error = (stmt:Statement.t) : unit or_error =
@ -237,7 +234,7 @@ let process_stmt
l l
in in
solve solve
?gc ?restarts ~check ?proof_file ?pp_model ?gc ?restarts ~check ?pp_model
?time ?memory ?progress ?time ?memory ?progress
~assumptions ~assumptions
solver; solver;

View file

@ -24,7 +24,6 @@ val process_stmt :
?gc:bool -> ?gc:bool ->
?restarts:bool -> ?restarts:bool ->
?pp_cnf:bool -> ?pp_cnf:bool ->
?proof_file:string ->
?pp_model:bool -> ?pp_model:bool ->
?check:bool -> ?check:bool ->
?time:float -> ?time:float ->

View file

@ -1,7 +1,5 @@
(** {1 Process Statements} *) (** {1 Process Statements} *)
module ID = Sidekick_base.ID
module E = CCResult
module Loc = Smtlib_utils.V_2_6.Loc module Loc = Smtlib_utils.V_2_6.Loc
module Parse_ast = Smtlib_utils.V_2_6.Ast module Parse_ast = Smtlib_utils.V_2_6.Ast
module Process = Process module Process = Process

View file

@ -2,9 +2,8 @@
(** {1 Preprocessing AST} *) (** {1 Preprocessing AST} *)
open Sidekick_base open! Sidekick_base
module Loc = Smtlib_utils.V_2_6.Loc module Loc = Smtlib_utils.V_2_6.Loc
module Fmt = CCFormat
module PA = Smtlib_utils.V_2_6.Ast module PA = Smtlib_utils.V_2_6.Ast
module BT = Sidekick_base module BT = Sidekick_base
@ -111,7 +110,7 @@ let string_as_q (s:string) : Q.t option =
with _ -> None with _ -> None
let t_as_q t = match Term.view t with let t_as_q t = match Term.view t with
| T.LRA (LRA_const n) -> Some n | T.LRA (Base_types.LRA_const n) -> Some n
| _ -> None | _ -> None
(* conversion of terms *) (* conversion of terms *)
@ -141,7 +140,7 @@ let rec conv_term (ctx:Ctx.t) (t:PA.term) : T.t =
| PA.App ("xor", [a;b]) -> | PA.App ("xor", [a;b]) ->
let a = conv_term ctx a in let a = conv_term ctx a in
let b = conv_term ctx b in let b = conv_term ctx b in
Form.xor ctx.tst a b Form.xor ctx.Ctx.tst a b
| PA.App (f, args) -> | PA.App (f, args) ->
let args = List.map (conv_term ctx) args in let args = List.map (conv_term ctx) args in
begin match find_id_ ctx f with begin match find_id_ ctx f with
@ -188,7 +187,7 @@ let rec conv_term (ctx:Ctx.t) (t:PA.term) : T.t =
| PA.Is_a (s, u) -> | PA.Is_a (s, u) ->
let u = conv_term ctx u in let u = conv_term ctx u in
begin match find_id_ ctx s with begin match find_id_ ctx s with
| _, Ctx.K_fun {Fun.fun_view=Fun_cstor c; _} -> | _, Ctx.K_fun {Fun.fun_view=Base_types.Fun_cstor c; _} ->
Term.is_a tst c u Term.is_a tst c u
| _ -> errorf_ctx ctx "expected `%s` to be a constructor" s | _ -> errorf_ctx ctx "expected `%s` to be a constructor" s
end end
@ -270,35 +269,36 @@ let rec conv_term (ctx:Ctx.t) (t:PA.term) : T.t =
| PA.Arith (op, l) -> | PA.Arith (op, l) ->
let l = List.map (conv_term ctx) l in let l = List.map (conv_term ctx) l in
let open Base_types in let open Base_types in
let tst = ctx.Ctx.tst in
begin match op, l with begin match op, l with
| PA.Leq, [a;b] -> T.lra ctx.tst (LRA_pred (Leq, a, b)) | PA.Leq, [a;b] -> T.lra tst (LRA_pred (Leq, a, b))
| PA.Lt, [a;b] -> T.lra ctx.tst (LRA_pred (Lt, a, b)) | PA.Lt, [a;b] -> T.lra tst (LRA_pred (Lt, a, b))
| PA.Geq, [a;b] -> T.lra ctx.tst (LRA_pred (Geq, a, b)) | PA.Geq, [a;b] -> T.lra tst (LRA_pred (Geq, a, b))
| PA.Gt, [a;b] -> T.lra ctx.tst (LRA_pred (Gt, a, b)) | PA.Gt, [a;b] -> T.lra tst (LRA_pred (Gt, a, b))
| PA.Add, [a;b] -> T.lra ctx.tst (LRA_op (Plus, a, b)) | PA.Add, [a;b] -> T.lra tst (LRA_op (Plus, a, b))
| PA.Add, (a::l) -> | PA.Add, (a::l) ->
List.fold_left (fun a b -> T.lra ctx.tst (LRA_op (Plus,a,b))) a l List.fold_left (fun a b -> T.lra tst (LRA_op (Plus,a,b))) a l
| PA.Minus, [a] -> | PA.Minus, [a] ->
begin match t_as_q a with begin match t_as_q a with
| Some a -> T.lra ctx.tst (LRA_const (Q.neg a)) | Some a -> T.lra tst (LRA_const (Q.neg a))
| None -> | None ->
T.lra ctx.tst (LRA_op (Minus, T.lra ctx.tst (LRA_const Q.zero), a)) T.lra tst (LRA_op (Minus, T.lra tst (LRA_const Q.zero), a))
end end
| PA.Minus, [a;b] -> T.lra ctx.tst (LRA_op (Minus, a, b)) | PA.Minus, [a;b] -> T.lra tst (LRA_op (Minus, a, b))
| PA.Minus, (a::l) -> | PA.Minus, (a::l) ->
List.fold_left (fun a b -> T.lra ctx.tst (LRA_op (Minus,a,b))) a l List.fold_left (fun a b -> T.lra tst (LRA_op (Minus,a,b))) a l
| PA.Mult, [a;b] -> | PA.Mult, [a;b] ->
begin match t_as_q a, t_as_q b with begin match t_as_q a, t_as_q b with
| Some a, Some b -> T.lra ctx.tst (LRA_const (Q.mul a b)) | Some a, Some b -> T.lra tst (LRA_const (Q.mul a b))
| Some a, _ -> T.lra ctx.tst (LRA_mult (a, b)) | Some a, _ -> T.lra tst (LRA_mult (a, b))
| _, Some b -> T.lra ctx.tst (LRA_mult (b, a)) | _, Some b -> T.lra tst (LRA_mult (b, a))
| None, None -> | None, None ->
errorf_ctx ctx "cannot handle non-linear mult %a" PA.pp_term t errorf_ctx ctx "cannot handle non-linear mult %a" PA.pp_term t
end end
| PA.Div, [a;b] -> | PA.Div, [a;b] ->
begin match t_as_q a, t_as_q b with begin match t_as_q a, t_as_q b with
| Some a, Some b -> T.lra ctx.tst (LRA_const (Q.div a b)) | Some a, Some b -> T.lra tst (LRA_const (Q.div a b))
| _, Some b -> T.lra ctx.tst (LRA_mult (Q.inv b, a)) | _, Some b -> T.lra tst (LRA_mult (Q.inv b, a))
| _, None -> | _, None ->
errorf_ctx ctx "cannot handle non-linear div %a" PA.pp_term t errorf_ctx ctx "cannot handle non-linear div %a" PA.pp_term t
end end
@ -440,7 +440,7 @@ and conv_statement_aux ctx (stmt:PA.statement) : Stmt.t list =
cstor_args=lazy (mk_selectors cstor); cstor_args=lazy (mk_selectors cstor);
cstor_arity=0; cstor_arity=0;
cstor_ty_as_data=data; cstor_ty_as_data=data;
cstor_ty=data.data_as_ty; cstor_ty=data.Base_types.data_as_ty;
} in } in
(* declare cstor *) (* declare cstor *)
Ctx.add_id_ ctx cstor_name cstor_id (Ctx.K_fun (Fun.cstor cstor)); Ctx.add_id_ ctx cstor_name cstor_id (Ctx.K_fun (Fun.cstor cstor));
@ -475,7 +475,7 @@ and conv_statement_aux ctx (stmt:PA.statement) : Stmt.t list =
(* now force definitions *) (* now force definitions *)
List.iter List.iter
(fun {Data.data_cstors=lazy m;data_as_ty=lazy _;_} -> (fun {Data.data_cstors=lazy m;data_as_ty=lazy _;_} ->
ID.Map.iter (fun _ ({Cstor.cstor_args=lazy l;_} as r) -> r.cstor_arity <- List.length l) m; ID.Map.iter (fun _ ({Cstor.cstor_args=lazy l;_} as r) -> r.Base_types.cstor_arity <- List.length l) m;
()) ())
l; l;
[Stmt.Stmt_data l] [Stmt.Stmt_data l]