(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
(* <O___,, *       (see CREDITS file for the list of authors)           *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)
(*                                                                      *)
(* Micromega: A reflexive tactic using the Positivstellensatz           *)
(*                                                                      *)
(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
(*                                                                      *)
(************************************************************************)
Require Setoid.
(*Declare ML Module "micromega_plugin".*)
Definition Rsrt : ring_theory R0 R1 Rplus Rmult Rminus Ropp (@eq R).
Open Scope R_scope.
Notation to_nat := N.to_nat.
(* Syntactic ring coefficients. *)
Inductive Rcst :=
| C0
| C1
| CQ (r : Q)
| CZ (r : Z)
| CPlus (r1 r2 : Rcst)
| CMinus (r1  r2 : Rcst)
| CMult (r1 r2 : Rcst)
| CPow  (r1 : Rcst) (z:Z+nat)
| CInv  (r : Rcst)
| COpp  (r : Rcst).
Definition z_of_exp (z : Z + nat) :=
match z with
| inl z => z
| inr n => Z.of_nat n
end.
Fixpoint Q_of_Rcst (r : Rcst) : Q :=
match r with
| C0 => 0 # 1
| C1 => 1 # 1
| CZ z => z # 1
| CQ q => q
| CPlus r1 r2 => Qplus (Q_of_Rcst r1) (Q_of_Rcst r2)
| CMinus r1 r2 => Qminus (Q_of_Rcst r1) (Q_of_Rcst r2)
| CMult r1 r2  => Qmult (Q_of_Rcst r1) (Q_of_Rcst r2)
| CPow  r1 z   => Qpower (Q_of_Rcst r1) (z_of_exp z)
| CInv r       => Qinv (Q_of_Rcst r)
| COpp r       => Qopp (Q_of_Rcst r)
end.
Definition is_neg (z: Z+nat) :=
match z with
| inl (Zneg _) => true
|  _           => false
end.
Definition CInvR0 (r : Rcst) := Qeq_bool (Q_of_Rcst r) (0 # 1).
Definition CPowR0 (z : Z) (r : Rcst) :=
Z.ltb z Z0 && Qeq_bool (Q_of_Rcst r) (0 # 1).
Fixpoint R_of_Rcst (r : Rcst) : R :=
match r with
| C0 => R0
| C1 => R1
| CZ z => IZR z
| CQ q => Q2R q
| CPlus r1 r2  => (R_of_Rcst r1) + (R_of_Rcst r2)
| CMinus r1 r2 => (R_of_Rcst r1) - (R_of_Rcst r2)
| CMult r1 r2  => (R_of_Rcst r1) * (R_of_Rcst r2)
| CPow r1 z    =>
match z with
| inl z =>
if CPowR0 z r1
then R0
else  powerRZ (R_of_Rcst r1) z
| inr n => pow (R_of_Rcst r1) n
end
| CInv r       =>
if CInvR0 r then R0
else Rinv (R_of_Rcst r)
| COpp r       => - (R_of_Rcst r)
end.
Add Morphism Q2R with signature Qeq ==> @eq R as Q2R_m.
exact Qeq_eqR.
Qed.
Definition INZ (n:N) : R :=
match n with
| N0 => IZR 0%Z
| Npos p => IZR (Zpos p)
end.
Definition Reval_expr := eval_pexpr  Rplus Rmult Rminus Ropp R_of_Rcst N.to_nat pow.
Definition Reval_op2 (o:Op2) : R -> R -> Prop :=
match o with
| OpEq =>  @eq R
| OpNEq => fun x y  => ~ x = y
| OpLe => Rle
| OpGe => Rge
| OpLt => Rlt
| OpGt => Rgt
end.
Definition Reval_formula (e: PolEnv R) (ff : Formula Rcst) :=
let (lhs,o,rhs) := ff in Reval_op2 o (Reval_expr e lhs) (Reval_expr e rhs).
Definition Reval_formula' :=
eval_sformula  Rplus Rmult Rminus Ropp (@eq R) Rle Rlt N.to_nat pow R_of_Rcst.
Definition QReval_formula :=
eval_formula  Rplus Rmult Rminus Ropp (@eq R) Rle Rlt Q2R N.to_nat pow .
Definition Qeval_nformula :=
eval_nformula 0 Rplus Rmult  (@eq R) Rle Rlt Q2R.
Definition RWitness := Psatz Q.
Definition RWeakChecker := check_normalised_formulas 0%Q 1%Q Qplus Qmult  Qeq_bool Qle_bool.
Definition Rnormalise := @cnf_normalise Q 0%Q 1%Q Qplus Qmult Qminus Qopp Qeq_bool.
Definition Rnegate := @cnf_negate Q 0%Q 1%Q Qplus Qmult Qminus Qopp Qeq_bool.
Definition runsat := check_inconsistent 0%Q Qeq_bool Qle_bool.
Definition rdeduce := nformula_plus_nformula 0%Q Qplus Qeq_bool.
Definition RTautoChecker (f : BFormula (Formula Rcst)) (w: list RWitness)  : bool :=
@tauto_checker (Formula Q) (NFormula Q)
unit runsat rdeduce
(Rnormalise unit) (Rnegate unit)
RWitness (fun cl => RWeakChecker (List.map fst cl)) (map_bformula (map_Formula Q_of_Rcst)  f) w.

Lemma RTautoChecker_sound : forall f w, RTautoChecker f w = true -> forall env, eval_bf  (Reval_formula env)  f.