(************************************************************************)
(*         *   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-2011                             *)
(*                                                                      *)
(************************************************************************)
Require  FSetPositive FSetEqProperties.
(*Declare ML Module "micromega_plugin".*)
Ltac flatten_bool :=
repeat match goal with
[ id : (_ && _)%bool = true |- _ ] =>  destruct (andb_prop _ _ id); clear id
|  [ id : (_ || _)%bool = true |- _ ] =>  destruct (orb_prop _ _ id); clear id
end.
Ltac inv H := inversion H ; try subst ; clear H.
Open Scope Z_scope.
Fixpoint Zeval_expr (env : PolEnv Z) (e: PExpr Z) : Z :=
match e with
| PEc c => c
| PEX x => env x
| PEadd e1 e2 => Zeval_expr env e1 + Zeval_expr env e2
| PEmul e1 e2 => Zeval_expr env e1 * Zeval_expr env e2
| PEpow e1 n  => Z.pow (Zeval_expr env e1) (Z.of_N n)
| PEsub e1 e2 => (Zeval_expr env e1) - (Zeval_expr env e2)
| PEopp e   => Z.opp (Zeval_expr env e)
end.
Definition eval_expr := eval_pexpr  Z.add Z.mul Z.sub Z.opp (fun x => x) (fun x => x) (pow_N 1 Z.mul).
Fixpoint Zeval_const  (e: PExpr Z) : option Z :=
match e with
| PEc c => Some c
| PEX x => None
| PEadd e1 e2 => map_option2 (fun x y => Some (x + y))
(Zeval_const e1) (Zeval_const e2)
| PEmul e1 e2 => map_option2 (fun x y => Some (x * y))
(Zeval_const e1) (Zeval_const e2)
| PEpow e1 n  => map_option (fun x => Some (Z.pow x (Z.of_N n)))
(Zeval_const e1)
| PEsub e1 e2 => map_option2 (fun x y => Some (x - y))
(Zeval_const e1)  (Zeval_const e2)
| PEopp e   => map_option (fun x => Some (Z.opp x)) (Zeval_const e)
end.
Definition Zeval_op2 (o : Op2) : Z -> Z -> Prop :=
match o with
| OpEq =>  @eq Z
| OpNEq => fun x y  => ~ x = y
| OpLe => Z.le
| OpGe => Z.ge
| OpLt => Z.lt
| OpGt => Z.gt
end.
Definition Zeval_formula (env : PolEnv Z) (f : Formula Z):=
let (lhs, op, rhs) := f in
(Zeval_op2 op) (Zeval_expr env lhs) (Zeval_expr env rhs).
Definition Zeval_formula' :=
eval_formula  Z.add Z.mul Z.sub Z.opp (@eq Z) Z.le Z.lt (fun x => x) (fun x => x) (pow_N 1 Z.mul).
Definition eval_nformula :=
eval_nformula 0 Z.add Z.mul  (@eq Z) Z.le Z.lt (fun x => x) .
Definition Zeval_op1 (o : Op1) : Z -> Prop :=
match o with
| Equal => fun x : Z => x = 0
| NonEqual => fun x : Z => x <> 0
| Strict => fun x : Z => 0 < x
| NonStrict => fun x : Z => 0 <= x
end.
Definition ZWitness := Psatz Z.
Definition ZWeakChecker := check_normalised_formulas 0 1 Z.add Z.mul Zeq_bool Z.leb.
Definition psub  := psub Z0  Z.add Z.sub Z.opp Zeq_bool.
Declare Equivalent Keys psub RingMicromega.psub.
Definition padd  := padd Z0  Z.add Zeq_bool.
Declare Equivalent Keys padd RingMicromega.padd.
Definition pmul := pmul 0 1 Z.add Z.mul Zeq_bool.
Definition normZ  := norm 0 1 Z.add Z.mul Z.sub Z.opp Zeq_bool.
Declare Equivalent Keys normZ RingMicromega.norm.
Definition eval_pol := eval_pol Z.add Z.mul (fun x => x).
Declare Equivalent Keys eval_pol RingMicromega.eval_pol.
Definition xnormalise (t:Formula Z) : list (NFormula Z)  :=
let (lhs,o,rhs) := t in
let lhs := normZ lhs in
let rhs := normZ rhs in
match o with
| OpEq =>
((psub lhs (padd  rhs (Pc 1))),NonStrict)::((psub rhs (padd lhs (Pc 1))),NonStrict)::nil
| OpNEq => (psub lhs rhs,Equal) :: nil
| OpGt   => (psub rhs lhs,NonStrict) :: nil
| OpLt => (psub lhs rhs,NonStrict) :: nil
| OpGe => (psub rhs (padd lhs (Pc 1)),NonStrict) :: nil
| OpLe => (psub lhs (padd rhs (Pc 1)),NonStrict) :: nil
end.
Definition normalise {T : Type} (t:Formula Z) (tg:T) : cnf (NFormula Z) T :=
List.map  (fun x => (x,tg)::nil) (xnormalise t).
Definition xnegate (t:RingMicromega.Formula Z) : list (NFormula Z)  :=
let (lhs,o,rhs) := t in
let lhs := normZ lhs in
let rhs := normZ rhs in
match o with
| OpEq  => (psub lhs rhs,Equal) :: nil
| OpNEq => ((psub lhs (padd rhs (Pc 1))),NonStrict)::((psub rhs (padd lhs (Pc 1))),NonStrict)::nil
| OpGt  => (psub lhs (padd rhs (Pc 1)),NonStrict) :: nil
| OpLt  => (psub rhs (padd lhs (Pc 1)),NonStrict) :: nil
| OpGe  => (psub lhs rhs,NonStrict) :: nil
| OpLe  => (psub rhs lhs,NonStrict) :: nil
end.
Definition negate {T : Type} (t:Formula Z) (tg:T) : cnf (NFormula Z) T :=
List.map  (fun x => (x,tg)::nil) (xnegate t).
Definition Zunsat := check_inconsistent 0  Zeq_bool Z.leb.
Definition Zdeduce := nformula_plus_nformula 0 Z.add Zeq_bool.
Definition cnfZ (Annot TX AF : Type) (f : TFormula (Formula Z) Annot TX AF) :=
rxcnf Zunsat Zdeduce normalise negate true f.
Definition ZweakTautoChecker (w: list ZWitness) (f : BFormula (Formula Z)) : bool :=
@tauto_checker (Formula Z)  (NFormula Z) unit Zunsat Zdeduce normalise negate  ZWitness (fun cl => ZWeakChecker (List.map fst cl)) f w.
(* To get a complete checker, the proof format has to be enriched *)
Open Scope Z_scope.
Definition ceiling (a b:Z) : Z :=
let (q,r) := Z.div_eucl a b in
match r with
| Z0 => q
| _  => q + 1
end.
(** NB: narrow_interval_upper_bound is Zdiv.Zdiv_le_lower_bound *)
Inductive ZArithProof :=
| DoneProof
| RatProof : ZWitness -> ZArithProof -> ZArithProof
| CutProof : ZWitness -> ZArithProof -> ZArithProof
| EnumProof : ZWitness -> ZWitness -> list ZArithProof -> ZArithProof
(*| ExProof   : positive -> positive -> positive -> ZArithProof  ExProof z t x : exists z t, x = z - t /\ z >= 0 /\ t >= 0 *)
.
(*| SplitProof :   PolC Z -> ZArithProof -> ZArithProof -> ZArithProof.*)
(* n/d <= x  -> d*x - n >= 0 *)
(* In order to compute the 'cut', we need to express a polynomial P as a * Q + b. - b is the constant - a is the gcd of the other coefficient. *)
Definition isZ0 (x:Z) :=
match x with
| Z0 => true
| _  => false
end.
Definition ZgcdM (x y : Z) := Z.max (Z.gcd x y) 1.
Fixpoint Zgcd_pol (p : PolC Z) : (Z * Z) :=
match p with
| Pc c => (0,c)
| Pinj _ p => Zgcd_pol p
| PX p _ q =>
let (g1,c1) := Zgcd_pol p in
let (g2,c2) := Zgcd_pol q in
(ZgcdM (ZgcdM g1 c1) g2 , c2)
end.
(*Eval compute in (Zgcd_pol ((PX (Pc (-2)) 1 (Pc 4)))).*)
Fixpoint Zdiv_pol (p:PolC Z) (x:Z) : PolC Z :=
match p with
| Pc c => Pc (Z.div c x)
| Pinj j p => Pinj j (Zdiv_pol p x)
| PX p j q => PX (Zdiv_pol p x) j (Zdiv_pol q x)
end.
Inductive Zdivide_pol (x:Z): PolC Z -> Prop :=
| Zdiv_Pc : forall c, (x | c) -> Zdivide_pol x (Pc c)
| Zdiv_Pinj : forall p, Zdivide_pol x p ->  forall j, Zdivide_pol x (Pinj j p)
| Zdiv_PX   : forall p q, Zdivide_pol x p -> Zdivide_pol x q -> forall j, Zdivide_pol x (PX p j q).
Definition makeCuttingPlane (p : PolC Z) : PolC  Z * Z :=
let (g,c) := Zgcd_pol p in
if Z.gtb g Z0
then (Zdiv_pol (PsubC Z.sub p c) g , Z.opp (ceiling (Z.opp c) g))
else (p,Z0).
Definition genCuttingPlane (f : NFormula Z) : option (PolC Z * Z * Op1) :=
let (e,op) := f in
match op with
| Equal => let (g,c) := Zgcd_pol e in
if andb (Z.gtb g Z0) (andb (negb (Zeq_bool c Z0)) (negb (Zeq_bool (Z.gcd g c) g)))
then None (* inconsistent *)
else (* Could be optimised Zgcd_pol is recomputed *)
let (p,c) := makeCuttingPlane e  in
Some (p,c,Equal)
| NonEqual => Some (e,Z0,op)
| Strict   =>  let (p,c) := makeCuttingPlane (PsubC Z.sub e 1) in
Some (p,c,NonStrict)
| NonStrict => let (p,c) := makeCuttingPlane e  in
Some (p,c,NonStrict)
end.
Definition nformula_of_cutting_plane (t : PolC Z * Z * Op1) : NFormula Z :=
let (e_z, o) := t in
let (e,z) := e_z in
(padd e (Pc z) , o).
Definition is_pol_Z0 (p : PolC Z) : bool :=
match p with
| Pc Z0 => true
|   _   => false
end.

Lemma is_pol_Z0_eval_pol : forall p, is_pol_Z0 p = true -> forall env, eval_pol env p = 0.