(** Normalisation of formulae **)
Inductive Op2 : Set := (* binary relations *)
| OpEq
| OpNEq
| OpLe
| OpGe
| OpLt
| OpGt.
Register OpEq  as micromega.Op2.OpEq.
Register OpNEq as micromega.Op2.OpNEq.
Register OpLe  as micromega.Op2.OpLe.
Register OpGe  as micromega.Op2.OpGe.
Register OpLt  as micromega.Op2.OpLt.
Register OpGt  as micromega.Op2.OpGt.
Definition eval_op2 (o : Op2) : R -> R -> Prop :=
match o with
| OpEq => req
| OpNEq => fun x y : R => x ~= y
| OpLe => rle
| OpGe => fun x y : R => y <= x
| OpLt => fun x y : R => x < y
| OpGt => fun x y : R => y < x
end.
Definition  eval_pexpr : PolEnv -> PExpr C -> R :=
PEeval rplus rtimes rminus ropp phi pow_phi rpow.
#[universes(template)]
Record Formula (T:Type) : Type := Build_Formula{
Flhs : PExpr T;
Fop : Op2;
Frhs : PExpr T
}.
Register Formula as micromega.Formula.type.
Register Build_Formula as micromega.Formula.Build_Formula.
Definition eval_formula (env : PolEnv) (f : Formula C) : Prop :=
let (lhs, op, rhs) := f in
(eval_op2 op) (eval_pexpr env lhs) (eval_pexpr env rhs).
(* We normalize Formulas by moving terms to one side *)
Definition norm := norm_aux cO cI cplus ctimes cminus copp ceqb.
Definition psub := Psub cO  cplus cminus copp ceqb.
Definition padd  := Padd cO  cplus ceqb.
Definition pmul := Pmul cO cI cplus ctimes ceqb.
Definition popp := Popp copp.
Definition normalise (f : Formula C) : NFormula :=
let (lhs, op, rhs) := f in
let lhs := norm lhs in
let rhs := norm rhs in
match op with
| OpEq =>  (psub  lhs rhs, Equal)
| OpNEq => (psub lhs rhs, NonEqual)
| OpLe =>  (psub rhs lhs, NonStrict)
| OpGe =>  (psub lhs rhs, NonStrict)
| OpGt => (psub  lhs rhs, Strict)
| OpLt => (psub  rhs lhs, Strict)
end.
Definition negate (f : Formula C) : NFormula :=
let (lhs, op, rhs) := f in
let lhs := norm lhs in
let rhs := norm rhs in
match op with
| OpEq => (psub rhs lhs, NonEqual)
| OpNEq => (psub rhs lhs, Equal)
| OpLe => (psub lhs rhs, Strict) (* e <= e' == ~ e > e' *)
| OpGe => (psub rhs lhs, Strict)
| OpGt => (psub rhs lhs, NonStrict)
| OpLt => (psub lhs rhs, NonStrict)
end.

(* Specifications: *)
Lemma eval_pol_sub : forall env lhs rhs, eval_pol env (psub  lhs rhs) == eval_pol env lhs - eval_pol env rhs.
Lemma eval_pol_add : forall env lhs rhs, eval_pol env (padd  lhs rhs) == eval_pol env lhs + eval_pol env rhs.
Lemma eval_pol_mul : forall env lhs rhs, eval_pol env (pmul  lhs rhs) == eval_pol env lhs * eval_pol env rhs.
Lemma eval_pol_opp : forall env e, eval_pol env (popp e) ==  - eval_pol env e.
Lemma eval_pol_norm : forall env lhs, eval_pexpr env lhs == eval_pol env  (norm lhs).
Theorem normalise_sound :
forall (env : PolEnv) (f : Formula C),
eval_formula env f <-> eval_nformula env (normalise f).
Theorem negate_correct :
forall (env : PolEnv) (f : Formula C),
eval_formula env f <-> ~ (eval_nformula env (negate f)).