Fixpoint natc (m n : nat) :=
match m, n with 0, 0 => Eq | 0, _ => Lt | _, 0 => Gt | S m1, S n1 => natc m1 n1 end.
rewrite tvcompare_def.
generalize (natc_correct (tvarn v) (tvarn v)); case natc; auto.
intros H; contradict H; auto with arith.
intros H; contradict H; auto with arith.
Qed.
(* Proof *)
Variable interv : tvar -> point K.
Notation "{v[ x ]}" := (interv x).
(* Implementation of variable *)
Variable var : Type.
(* Implementation of coef *)
Variable coef : Type.
Variable cadd : coef -> coef -> coef.
Variable czerop : coef -> bool.
Variable czero : coef.
Variable conep : coef -> bool.
Variable cone : coef.
Variable copp : coef -> coef.
Variable cscale : var -> coef -> coef.
Variable interk : var -> K.
Notation "{k[ x ]}" := (interk x).
Variable interc : coef -> K.
Notation "{c[ x ]}" := (interc x).
Hypothesis cadd_c : forall x y, {c[cadd x y]} = ({c[x]} + {c[y]})%f.
Hypothesis cone_c : {c[cone]} = (1)%f.
Hypothesis conep_c : forall x,
if conep x then {c[x]} = (1)%f else True.
Hypothesis czero_c : {c[czero]} = (0)%f.
Hypothesis cscale_c : forall k x,
{c[cscale k x]} = ({k[k]} * {c[x]})%f.
Hypothesis czerop_c : forall x,
if czerop x then {c[x]} = (0)%f else True.
Hypothesis copp_c : forall x, {c[copp x]} = (- {c[x]})%f.
(* We want to reduce expression *)
Inductive tuple := Tuple (_ _ _: tvar).
Let  line := list tuple.
Let  expr := list (coef * line).
Definition intert (t : tuple) :=
let (p1,p2,p3) := t in '[{v[p1]},{v[p2]},{v[p3]}].
Notation "{t[ x ]}" := (intert x).
Fixpoint interl (l :line) :=
match l with nil => 1%f | t ::l1 => ({t[t]} * interl l1)%f end.
Notation "{l[ x ]}" := (interl x).
Fixpoint intere (e :expr) :=
match e with nil => 0%f | (c,l)::e1 =>
({c[c]} * {l[l]} + intere e1)%f
end.
Notation "{e[ x ]}" := (intere x).
Fixpoint intere1 (e :expr) :=
match e with nil => 0%f | (c,t ::nil)::nil =>
if conep c then {t[t]} else intere e
| _ => intere e end.
Notation "{e1[ x ]}" := (intere1 x).
(* Sign *)
Inductive sign := Sm1 | S0 | S1.
Definition sopp s := match s with Sm1 => S1 | S0 => S0 | S1 => Sm1 end.
Definition smult s1 s2 :=
match s1 with S0 => S0 | S1 => s2 | Sm1 => sopp s2 end.
Definition smult3 s1 s2 s3 :=
match s1 with S0 => S0
| S1 => smult s2 s3
| Sm1 => sopp (smult s2 s3) end.
(* Membership *)
Definition tin i (t : tuple) :=
let (j1,j2,j3) := t in
match tvcompare i j1 with Eq => true
| _ =>   match tvcompare i j2 with Eq => true
| _ =>   match tvcompare i j3 with Eq => true
| _ =>  false end end end.
(* Substitution *)
Definition tsubst i j (t : tuple) :=
let (i1,i2,i3) := t in
match tvcompare i i1 with
| Eq => Tuple j i2 i3
| _ =>
match tvcompare i i2 with
| Eq => Tuple i1 j i3
| _ =>
match tvcompare i i3 with
| Eq => Tuple i1 i2 j
| _ => t
end
end
end.
Definition s2k (s: sign) : K :=
match s with S0 => 0%f | S1 => 1%f | Sm1 => (-(1))%f end.
(* Add an element in a tuple  i1 [? i2 i3] *)
Definition mk_tuplel i1 i2 i3 :=
match tvcompare i1 i2 with
| Eq => (S0, Tuple i1 i2 i3)
| Lt => (S1, Tuple i1 i2 i3)
| Gt =>
match tvcompare i1 i3 with
| Eq => ( S0, Tuple i1 i2 i3)
| Lt => (Sm1, Tuple i2 i1 i3)
| Gt => ( S1, Tuple i2 i3 i1)
end
end.
(* Add an element in a tuple  [i1 i2 ?] i3 *)
Definition mk_tupler i1 i2 i3 :=
match tvcompare i2 i3 with
| Eq => (S0, Tuple i1 i2 i3)
| Lt => (S1, Tuple i1 i2 i3)
| Gt =>
match tvcompare i1 i3 with
| Eq => ( S0, Tuple i1 i2 i3)
| Lt => (Sm1, Tuple i1 i3 i2)
| Gt => ( S1, Tuple i3 i1 i2)
end
end.

Lemma mk_tupler_c i1 i2 i3 :
let (s,t1) := mk_tupler i1 i2 i3 in
{t[Tuple i1 i2 i3]} = (s2k s * {t[t1]})%f.