Require Export Coercion_Defs.
Require Import Classical.

(* ******************************************************************************** *)
(* Lemmas about opening *)
(* ******************************************************************************** *)

Lemma open_idempotent : forall x e n,
  (open_exp n (exp_fvar x) (open_exp n (exp_fvar x) e)) = (open_exp n (exp_fvar x) e).
Proof.
intros.
generalize dependent n. generalize dependent x.
induction e.
Case "base". intros. simpl. eauto.
Case "bvar". intros. simpl.
  destruct (n0===n). simpl. eauto.
  simpl. destruct (n0===n); try contradiction || subst; eauto.
Case "fvar". intros. simpl. eauto.
Case "cast". intros. simpl. rewrite (IHe x n). eauto.
Case "abs". intros. simpl. rewrite (IHe x (S n)). eauto.
Case "app". intros. simpl. rewrite (IHe1 x n). rewrite (IHe2 x n). eauto.
Case "pair". intros. simpl. rewrite (IHe1 x n). rewrite (IHe2 x n). eauto.
Case "proj". intros. simpl. rewrite (IHe x n). eauto.
Qed.

Inductive lc : nat -> exp -> Prop :=
| lc_bvar : forall n m, m < n -> lc n (exp_bvar m)
| lc_var : forall a n, lc n (exp_fvar a)
| lc_base : forall a n, lc n (exp_base a)
| lc_cast : forall e n t, lc n e -> lc n (exp_cast e t)
| lc_app : forall e1 e2 n, lc n e1 -> lc n e2 -> lc n (exp_app e1 e2)
| lc_pair :  forall e1 e2 n, lc n e1 -> lc n e2 -> lc n (exp_pair e1 e2)
| lc_proj : forall e n a, lc n e -> lc n (exp_proj a e)
| lc_abs : forall e n t, lc (S n) e -> lc n (exp_lam t e).

Lemma open_inverse_lc : forall e x n,
  (lc n e) ->
  exists e', e = (open_exp n (exp_fvar x) e') /\
    (forall f, freevars e' f -> x `notin` f).
Proof.
intros. rename H into lcn.
generalize dependent n.
induction e.
Case "base".
exists (exp_base a).
split.
  simpl; eauto.
  intros. inversion H. eauto.
Case "bvar".
intros.
inversion lcn. subst.
exists (exp_bvar n). simpl.
   split.
   destruct (n0 === n).
      SCase "n0 = n".
       simpl. eauto.  subst.  assert False. omega. destruct H.
      SCase "n0 <> n". eauto.
   intros. inversion H. eauto.
Case "fvar".
intros.
destruct (classic (a=x)).
  SCase "a=x".
   subst.
   exists (exp_bvar n).
   split.  simpl.  destruct (n===n). eauto. destruct n0.  eauto.
   intros. inversion H. subst. fsetdec.
  SCase "a<>x".
    exists (exp_fvar a).
    simpl. intuition. inversion H0. subst.
    fsetdec.
Case "cast".
intros.
inversion lcn. subst.
destruct (IHe _ H1) as [e' [e'_eq fvs]].
subst. exists (exp_cast e' t). simpl.
split. eauto.
intros. eapply fvs. inversion H. eauto.
Case "lam".
intros.
inversion lcn. subst.
destruct (IHe _ H1) as [e_body [e_body_eq fvs]].
(* destruct (increase_bvar_index e_body' x 0) as [e_body [e_body_eq fvs]]. *)
exists (exp_lam t e_body).
split.
simpl. simpl in e_body_eq. subst. simpl. f_equal.
intros. inversion H. subst. eapply fvs; eauto.
Case "app".
intros.
inversion lcn. subst.
destruct (IHe1 _ H2) as [e1' [e1'_eq fvs1]].
destruct (IHe2 _ H3) as [e2' [e2'_eq fvs2]].
subst. exists (exp_app e1' e2'). simpl.
split. eauto.
intros. inversion H. subst.
assert (x `notin` fvs0). eapply fvs1; eauto.
assert (x `notin` fvs3). eapply fvs2; eauto.
fsetdec.
Case "pair".
intros.
inversion lcn. subst.
destruct (IHe1 _ H2) as [e1' [e1'_eq fvs1]].
destruct (IHe2 _ H3) as [e2' [e2'_eq fvs2]].
subst. exists (exp_pair e1' e2'). simpl.
split. eauto.
intros. inversion H. subst.
assert (x `notin` fvs0). eapply fvs1; eauto.
assert (x `notin` fvs3). eapply fvs2; eauto.
fsetdec.
Case "proj".
intros.
inversion lcn. subst.
destruct (IHe _ H1) as [e1' [e1'_eq fvs1]].
subst. exists (exp_proj i e1'). simpl.
split. eauto.
intros. inversion H. subst. eapply fvs1; eauto.
Qed.

Hint Constructors lc.

Lemma open_lc : forall n e x,
  lc n (open_exp n (exp_fvar x) e) ->
  lc (S n) e.
intros. generalize dependent n.
induction e;  try solve [intros; inversion H; subst; simpl; firstorder || eauto].
Case "bvar". intros.
simpl in H. destruct (n0===n). subst. eauto.
  inversion H. subst.
  constructor. omega.
Qed.

Lemma coercion_lc : forall sigma pi a t d t' m,
  (coercion sigma pi a t d t' m) -> forall n, lc n m.
Proof.
intros. generalize dependent n.
induction H.
 try repeat  (constructor; omega || firstorder).
 unfold compose. try repeat  (constructor; omega || firstorder).
 intros.  unfold compose.  unfold funcompose. try repeat  (constructor; omega || firstorder).
 intros.  unfold compose.  unfold paircompose. try repeat  (constructor; omega || firstorder).
Qed.

Lemma coerce_disjunct : forall m e,
  (coerce m e) = e \/ (coerce m e) = (exp_app m e).
Proof.
intros m e.
case_eq m; unfold coerce; simpl; intuition.
case_eq e0; simpl; intuition.
case_eq n; simpl; intuition.
Qed.

Lemma coerce_non_identity : forall m e,
  (forall t, m <> (id t)) -> (coerce m e) = (exp_app m e).
Proof.
intros m e m_neq_id.
case_eq m; unfold coerce; simpl; intuition.
case_eq e0; simpl; intuition.
case_eq n; simpl; intuition.
subst. unfold id in m_neq_id. destruct (m_neq_id t (refl_equal _)).
Qed.

Lemma lc_coerce: forall m e n,
  (lc n m) -> (lc n e) -> (lc n (coerce m e)).
Proof.
intros.
destruct (coerce_disjunct m e); rewrite H1; eauto || constructor.
Qed.

Lemma typing_lc: forall sigma gamma e e' t d d',
  nd_typing sigma gamma d d' e e' t ->
  (lc 0 e').
Proof.
intros. rename H into T.
induction T; try solve [intros; try unfold coerciongen in *; try constructor; eauto using coercion_lc, lc_coerce || discriminate].
Case "lam".
constructor. simpl. pick fresh x. assert (x `notin` L). fsetdec.
pose proof (H0 _  H1).
eauto using open_lc.
Qed.

Lemma open_inverse_nd : forall sigma gamma e x tx e' t d d',
  ok sigma -> ok ([(x,tx)]++gamma) ->
  nd_typing sigma ([(x,tx)]++gamma) d d' e e' t ->
  (exists e0, (e' = (open_exp 0 (exp_fvar x) e0)) /\ (forall f, freevars e0 f -> x `notin` f)).
Proof.
intros. eauto using typing_lc, open_inverse_lc.
Qed.

Lemma open_exp_injection : forall e1 e2 y n fv1 fv2,
  (freevars e1 fv1) ->
  (freevars e2 fv2) ->
  (y `notin` fv1) ->
  (y `notin` fv2) ->
  (open_exp n (exp_fvar y) e1) = (open_exp n (exp_fvar y) e2) ->
  e1 = e2.
Proof.
intros e1 e2 y n fv1 fv2 freevars1 freevars2 y_notin_1 y_notin_2 eq.
generalize dependent n.
generalize dependent e2.
generalize dependent fv1.
generalize dependent fv2.
induction e1.
Case "base".
intros.
simpl in eq.
induction e2; simpl in eq; subst; try eauto || discriminate || (destruct (n===n0); subst; discriminate).
Case "bvar".
intros. simpl in eq.
induction e2.
 SCase "e2 base".
 destruct (n0===n); subst; discriminate.
 SCase "e2 bvar".
 simpl in eq.
  destruct (n0===n1) as [n0_eq_n1 | n0_neq_n1].
     SSCase "n0_eq_n1".
       subst.
       destruct (n1===n) as [n1_eq_n | n1_neq_n].
         subst. eauto.
         discriminate.
     SSCase "n0_neq_n1".
        destruct (n0===n); subst; eauto || discriminate.
 SCase "e2 fvar".
   simpl in eq.
   destruct (n0===n).
      subst. assert (y=a). injection eq; intuition.
   subst. inversion freevars2. subst. fsetdec. eauto.
 destruct (n0===n); subst; discriminate.
 destruct (n0===n); subst; discriminate.
 destruct (n0===n); subst; discriminate.
 destruct (n0===n); subst; discriminate.
 destruct (n0===n); subst; discriminate.
Case "fvar".
 intros.
 simpl in eq.
 induction e2; simpl in eq; try eauto || destruct (n===n0); subst; try discriminate || eauto.
 assert (y=a). injection eq; intuition.
  subst. inversion freevars1. subst. fsetdec. eauto.
Case "Cast".
 intros.
 simpl in eq.
 induction e2; simpl in eq; try eauto || destruct (n===n0); subst; try discriminate || eauto.
 inversion freevars1. subst.
 injection eq;  intros. subst.
 inversion freevars2. subst.
 assert (e1 = e2). eapply (IHe1 fv2); eauto. subst; auto.
Case "Abs".
 intros.
 simpl in eq.
 induction e2; simpl in eq; try eauto || destruct (n===n0); subst; try discriminate || eauto.
 inversion freevars1. subst.
 firstorder.
 injection eq. intros. subst.
 inversion freevars2. subst.
 assert (e1 = e2). eapply (IHe1 fv2); eauto. subst; eauto.
Case "App".
 intros.
 simpl in eq.
 induction e2; simpl in eq; try eauto || destruct (n===n0); subst; try discriminate || eauto.
 inversion freevars1. subst.
 injection eq. intros. subst.
 inversion freevars2. subst.
 assert (e1_1 = e2_1). eapply (IHe1_1 fvs0); try fsetdec || eauto.
 assert (e1_2 = e2_2). eapply (IHe1_2 fvs3); try fsetdec || eauto.
 subst. eauto.
Case "Pair".
 intros.
 simpl in eq.
 induction e2; simpl in eq; try eauto || destruct (n===n0); subst; try discriminate || eauto.
 inversion freevars1. subst.
 injection eq. intros. subst.
 inversion freevars2. subst.
 assert (e1_1 = e2_1). eapply (IHe1_1 fvs0); try fsetdec || eauto.
 assert (e1_2 = e2_2). eapply (IHe1_2 fvs3); try fsetdec || eauto.
 subst. eauto.
Case "Proj".
 intros.
 simpl in eq.
 induction e2; simpl in eq; try eauto || destruct (n===n0); subst; try discriminate || eauto.
 inversion freevars1. subst.
 injection eq. intros. subst.
 inversion freevars2. subst.
 assert (e1 = e2). eapply (IHe1 fv2); try fsetdec || eauto.
 subst. eauto.
Qed.

Lemma freevars_totality : forall e, exists fvs, freevars e fvs.
Proof.
intros.
induction e.
Case "base".
exists AtomSet.F.empty. constructor.
Case "bvar".
exists AtomSet.F.empty. constructor.
Case "fvar".
exists (singleton a). constructor.
Case "cast".
destruct IHe as [fvse].
exists fvse; constructor; eauto.
Case "lam".
destruct IHe as [fvse].
exists fvse; constructor; eauto.
Case "app".
destruct IHe1 as [fvse1].
destruct IHe2 as [fvse2].
exists (fvse1 `union` fvse2); constructor; eauto.
Case "pair".
destruct IHe1 as [fvse1].
destruct IHe2 as [fvse2].
exists (fvse1 `union` fvse2); constructor; eauto.
Case "proj".
destruct IHe as [fvse].
exists fvse; constructor; eauto.
Qed.

Lemma binds_id : forall x (t1:typ) t2 G,
  ok G ->
  binds x t1 G ->
  binds x t2 G ->
  (t1 = t2).
Proof.
intros.
induction G.
Case "G is nil".
inversion H0.
Case "G is cons".
rewrite_env ([a] ++ G) in H0.
destruct (binds_concat_inv _ _ _ _ _ H0) as [[xNotinA xinG] | xinA].
SCase "xinG".
rewrite_env ([a] ++ G) in H1.
destruct (binds_concat_inv _ _ _ _ _ H1) as [[xNotinA' xinG'] | xinA'].
SSCase "xinG'".
eapply IHG; try inversion H; eauto.
SSCase "xinA'".
pose proof (binds_In _ _ _ _ xinA'). contradiction.
SCase "xinA".
rewrite_env ([a] ++ G) in H1.
destruct (binds_concat_inv _ _ _ _ _ H1) as [[xNotinA' xinG'] | xinA'].
SSCase "xinG'".
pose proof (binds_In _ _ _ _ xinA). contradiction.
SSCase "xinA".
induction a.
destruct (binds_singleton_inv _ _ _ _ _ xinA) as [ A B].
destruct (binds_singleton_inv _ _ _ _ _ xinA') as [ C D].
subst. auto.
Qed.

Lemma opening_preserves_identity : forall x i e1 e2 fvs1 fvs2,
  (freevars e1 fvs1) ->
  (freevars e2 fvs2) ->
  (x `notin` fvs1) -> (x `notin` fvs2) ->
  ((open_exp i (exp_fvar x) e1) = (open_exp i (exp_fvar x) e2)) -> e1 = e2.
Proof.
Lemma freevar_neq : forall x e fvs,
  (freevars e fvs) ->
  (x `notin` fvs) ->
  (exp_fvar x) <> e.
Proof.
intros.
induction e;
  try discriminate ||
    inversion H. subst fvs. assert (x <> a); [fsetdec | injection; auto].
Qed.
intros.
generalize dependent e2.
generalize dependent i.
generalize dependent fvs1.
generalize dependent fvs2.
induction e1.
Case "exp_base".
  intros.
  assert ((exp_fvar x) <> e2) as Neq2. eauto using freevar_neq.
  induction e2; simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
Case "exp_bvar".
  intros.
  induction e2.
  SCase "exp_base".
  simpl open_exp in H3.
  destruct (i===n). subst. discriminate. auto.
  SCase "exp_bvar".
  simpl open_exp in H3.
  destruct (i===n). destruct (i===n0). subst. subst. auto.
  discriminate.
  destruct (i===n0);
  auto. discriminate.
  SCase "exp_fvar".
  simpl open_exp in H3.
  destruct (i===n).
  assert ((exp_fvar x) <> (exp_fvar a)) as Neq2. eauto using freevar_neq.
  destruct Neq2. auto. auto.
  SCase "exp_cast".
  simpl open_exp in H3.
  destruct (i===n); discriminate H3.
  SCase "exp_lam".
  simpl open_exp in H3.
  destruct (i===n); discriminate H3.
  SCase "exp_app".
  simpl open_exp in H3.
  destruct (i===n); discriminate H3.
  SCase "exp_pair".
  simpl open_exp in H3.
  destruct (i===n); discriminate H3.
  SCase "exp_proj".
  simpl open_exp in H3.
  destruct (i===n); discriminate H3.
Case "exp_fvar".
  intros.
  assert ((exp_fvar x) <> (exp_fvar a)) as Neq1. eauto using freevar_neq.
  induction e2; simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; destruct Neq1; auto | auto])).
Case "exp_cast".
  induction e2.
  SCase "exp_base".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
  SCase "exp_bvar".
  intros.
  simpl open_exp in H3.
  destruct (i===n); discriminate H3.
  SCase "exp_fvar".
  intros.
  assert ((exp_fvar x) <> (exp_fvar a)) as Neq1. eauto using freevar_neq.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; destruct Neq1; auto | auto])).
  SCase "exp_cast".
  intros.
  simpl open_exp in H3.
  injection H3. intros bodyEq tEq.
  inversion H. inversion H0.
  assert (e1=e2) as fromIH.
  eapply (IHe1 fvs2); eauto || fsetdec.
  subst. auto.
  SCase "exp_lam".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
  SCase "exp_app".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
  SCase "exp_pair".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
  SCase "exp_proj".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
Case "exp_lam".
  induction e2.
  SCase "exp_base".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
  SCase "exp_bvar".
  intros.
  simpl open_exp in H3.
  destruct (i===n); discriminate H3.
  SCase "exp_fvar".
  intros.
  assert ((exp_fvar x) <> (exp_fvar a)) as Neq1. eauto using freevar_neq.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; destruct Neq1; auto | auto])).
  SCase "exp_case".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
  SCase "exp_lam".
  intros.
  simpl open_exp in H3.
  injection H3. intros bodyEq tEq.
  inversion H. inversion H0.
  assert (e1=e2) as fromIH.
  eapply (IHe1 fvs2); eauto || fsetdec.
  subst. auto.
  SCase "exp_app".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
  SCase "exp_pair".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
  SCase "exp_proj".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
Case "exp_app".
  induction e2.
   SCase "exp_base".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_bvar".
   intros.
   simpl open_exp in H3.
   destruct (i===n); discriminate H3.
   SCase "exp_fvar".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_case".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_lam".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_app".
   intros.
   simpl open_exp in H3. injection H3. intros Eq2 Eq1.
   assert (e1_1 = e2_1) as fromIH1.
   inversion H. inversion H0. eapply (IHe1_1 fvs4);  eauto || fsetdec.
   assert (e1_2 = e2_2) as fromIH2.
   inversion H. inversion H0. eapply (IHe1_2 fvs5);  eauto || fsetdec.
   subst. auto.
   SCase "exp_pair".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_proj".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
Case "exp_pair".
  induction e2.
   SCase "exp_base".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_bvar".
   intros.
   simpl open_exp in H3.
   destruct (i===n); discriminate H3.
   SCase "exp_fvar".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_case".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_lam".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_app".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_pair".
   intros.
   simpl open_exp in H3. injection H3. intros Eq2 Eq1.
   assert (e1_1 = e2_1) as fromIH1.
   inversion H. inversion H0. eapply (IHe1_1 fvs4);  eauto || fsetdec.
   assert (e1_2 = e2_2) as fromIH2.
   inversion H. inversion H0. eapply (IHe1_2 fvs5);  eauto || fsetdec.
   subst. auto.
   SCase "exp_proj".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
Case "exp_proj".
  induction e2.
   SCase "exp_base".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_bvar".
   intros.
   simpl open_exp in H3.
   destruct (i0===n); discriminate H3.
   SCase "exp_fvar".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_case".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_lam".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_app".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_pair".
   intros.
   simpl open_exp in H3; (auto || discriminate ||  (destruct (i===n); [subst; discriminate | auto])).
   SCase "exp_proj".
   intros.
   simpl open_exp in H3. injection H3. intros Eq2 Eq1.
   assert (e1 = e2) as fromIH1.
   inversion H. inversion H0. eapply (IHe1 fvs2);  eauto || fsetdec.
   subst. auto.
Qed.

(* ******************************************************************************** *)
(* Common structural properties about coercion generation *)
(* ******************************************************************************** *)

Lemma coercion_pi_strengthening: forall sigma pi pi' t t' C a r,
  coercion sigma pi a t r t' C ->
  (forall b, In b pi' -> In b pi) ->
    coercion sigma pi' a t r t' C.
Proof.
intros until 1. rename H into D1. intro subset.
generalize dependent pi'.
induction D1.
Case "coercion_Id".
intros; eapply coercion_Id; eauto.
Case "coercion_PrimTrans".
intros.
eapply coercion_PrimTrans.
eauto. unfold not; intro contra.
pose proof (subset _ contra). contradiction.
eapply IHD1.
intros b inCons.
destruct (in_inv inCons) as [head | tail].
subst. eauto using in_eq.
eapply in_cons. eauto using subset.
Case "coercion_FunTrans".
intros.
eapply coercion_FunTrans.
unfold not; intro contra.
(* weird ... Coq doesn't like this *)
(* pose proof (subset (typ_fun t1' t2') contra).  *)
assert (In (typ_fun t1' t2') pi).
eauto. contradiction.
auto. auto.
eapply IHD1_3.
intros b inCons.
destruct (in_inv inCons) as [head | tail].
subst. eauto using in_eq.
eapply in_cons. eauto using subset.
Case "coercion_PairTrans".
intros.
eapply coercion_PairTrans.
unfold not; intro contra.
(* weird ... Coq doesn't like this *)
(* pose proof (subset (typ_fun t1' t2') contra).  *)
assert (In (typ_pair t1' t2') pi).
eauto. contradiction.
auto. auto.
eapply IHD1_3.
intros b inCons.
destruct (in_inv inCons) as [head | tail].
subst. eauto using in_eq.
eapply in_cons. eauto using subset.
Qed.

Hint Constructors coercion.
Hint Resolve Permutation_in Permutation_sym Permutation_refl Permutation_trans.

Lemma perm_cons : forall A (t:A) pi pi',
  Permutation pi pi' ->
  Permutation (t::pi) (t::pi').
Proof.
intros.
  change (Permutation ([t]++pi) ([t]++pi')). eauto using Permutation_app_head.
Qed.

Lemma coercion_pi_perm: forall sigma pi pi' a t r t' m,
  (coercion sigma pi a t r t' m) ->
  (Permutation pi pi') ->
  (coercion sigma pi' a t r t' m).
Proof with eauto*.
intros. rename H into C. rename H0 into P.
generalize dependent pi'.
induction C.
Case "id".
intros. eauto.
Case "prim trans".
intros.
eapply coercion_PrimTrans.
  eauto.
  try unfold not; eauto.
  assert (Permutation (t2::pi) (t2::pi')). eauto using perm_cons.
  firstorder.
Case "fun trans".
  intros.
eapply coercion_FunTrans. unfold not; eauto. eauto. eauto.
  assert (Permutation ((typ_fun t1' t2')::pi) ((typ_fun t1' t2')::pi')). eauto using perm_cons.
  firstorder.
Case "pair trans".
  intros.
eapply coercion_PairTrans. unfold not; eauto. eauto. eauto.
  assert (Permutation ((typ_pair t1' t2')::pi) ((typ_pair t1' t2')::pi')). eauto using perm_cons.
  firstorder.
Qed.

(* ******************************************************************************** *)
(* Lemmas about lists *)
(* ******************************************************************************** *)
Lemma in_inv_nodup : forall (A:Type) (a:A) (b:A) (l:list A),
  (In b (a::l)) ->
  (NoDup (a::l)) ->
  ((a=b /\ ~In b l) \/ (a<>b /\ In b l)).
Proof.
intros A a b l Inb_al Nodup.
inversion Nodup. subst x. subst l0.
destruct (in_inv Inb_al) as [aEqb | inTl].
  Case "a=b".
  left. subst b.
  eauto.
  Case "In tl".
  right.
  split.
  unfold not. intro. subst b. contradiction.
  auto.
Qed.

Lemma in_singleton_eq :
forall (A:Type) (a:A) (l:list A) (b:A),
  (In b l) ->
  (NoDup l) ->
  (forall c, In c l -> In c [a]) ->
  l = [a].
Proof.
intros A a l.
induction l.
Case "l nil".
intros.
  contradiction.
Case "l cons".
intros.
assert (a=a0).
 pose proof (H1 a0 (in_eq _ _)).
 inversion H2. auto. destruct H3.
 subst a0.
cut (l=nil). intros. subst l. eauto.
SCase "cut l=nil".
destruct (in_inv_nodup _ _ _ l H H0) as [ [aEqb xx] | [aNeqb  bInl]].
  SSCase "a = b".
   subst b.
   induction l. auto.
   clear IHl0.
   inversion H0. subst x. subst l0.
   assert (forall c:A, In c (a0::l) -> In c [a]).
     intros.
      eapply H1. eapply in_cons. eauto.
   pose proof (IHl a0 (in_eq _ _) H5 H2).
   injection H3. intros. subst a0.
   unfold not in H4. destruct (H4 (in_eq _ _)).
  SSCase "a <> b AND b in L".
  pose proof (H1 b (in_cons _ _ _ bInl)).
  destruct H2. contradiction. destruct H2.
Qed.

Lemma in_singleton_pair : forall (A:Type) (B:Type) (a:A) (b:B) c d,
  In (a,b) [(c,d)] -> a = c /\ b = d.
Proof.
intros.
destruct (in_inv H).
      SSSSCase "in head".
         injection H0. intros. subst a b. auto.
      SSSSCase "silly in nil". contradiction.
Qed.

Lemma in_sing_eq_l : forall (x:exp) (y:typ) a b,
  In (x,y) [(a,b)] ->
  x = a.
Proof.
intros.
destruct (in_inv H).
  injection H0. intros. subst. intuition.
contradiction.
Qed.

Lemma in_sing_eq_r : forall (x:exp) (y:typ) a b,
  In (x,y) [(a,b)] ->
  y = b.
Proof.
intros.
destruct (in_inv H).
  injection H0. intros. subst. intuition.
contradiction.
Qed.

Lemma insingleton : forall (A:Type) (a:A) theta,
  In a theta -> (forall b:A, In b [a] -> In b theta).
  intros. assert (a = b).
  destruct (in_inv H0). subst a. auto. contradiction. subst. auto.
  Qed.

Lemma in_ext : forall (A:Type) (x:A) l l',
  In x l -> In x (l ++ l').
Proof.
intros.
eauto using in_or_app.
Qed.

Lemma in_not_in : forall (A:Type) (x:A) (y:A) l,
  In x l -> ~ In y l -> x <> y.
Proof.
intros. unfold not. intros. subst. contradiction.
Qed.

Lemma not_in_singleton : forall (A:Type) (x:A) y,
  x <> y -> ~In x [y].
intros.
unfold not. intros.
destruct (in_inv H0). subst. destruct H. reflexivity. contradiction.
Qed.


(* -*- coding: utf-8 -*- *)
(************************************************************************)
(*         *   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)         *)
(************************************************************************)

(** Binary Integers : results about order predicates *)
(** Initial author : Pierre Crégut (CNET, Lannion, France) *)

(** THIS FILE IS DEPRECATED.
    It is now almost entirely made of compatibility formulations
    for results already present in BinInt.Z. *)

Require Import BinPos BinInt Decidable Zcompare.
Require Import Arith_base. (* Useless now, for compatibility only *)

Local Open Scope Z_scope.

(*********************************************************)
(** Properties of the order relations on binary integers *)

(** * Trichotomy *)

Theorem Ztrichotomy_inf n m : {n < m} + {n = m} + {n > m}.
Proof.
  unfold ">", "<". generalize (Z.compare_eq n m).
  destruct (n ?= m); [ left; right | left; left | right]; auto.
Defined.

Theorem Ztrichotomy n m : n < m \/ n = m \/ n > m.
Proof.
  Z.swap_greater. apply Z.lt_trichotomy.
Qed.

(**********************************************************************)
(** * Decidability of equality and order on Z *)

Notation dec_eq := Z.eq_decidable (only parsing).
Notation dec_Zle := Z.le_decidable (only parsing).
Notation dec_Zlt := Z.lt_decidable (only parsing).

Theorem dec_Zne n m : decidable (Zne n m).
Proof.
  destruct (Z.eq_decidable n m); [right|left]; subst; auto.
Qed.

Theorem dec_Zgt n m : decidable (n > m).
Proof.
  destruct (Z.lt_decidable m n); [left|right]; Z.swap_greater; auto.
Qed.

Theorem dec_Zge n m : decidable (n >= m).
Proof.
  destruct (Z.le_decidable m n); [left|right]; Z.swap_greater; auto.
Qed.

Theorem not_Zeq n m : n <> m -> n < m \/ m < n.
Proof.
  apply Z.lt_gt_cases.
Qed.

(** * Relating strict and large orders *)

Notation Zgt_lt := Z.gt_lt (compat "8.6").
Notation Zlt_gt := Z.lt_gt (compat "8.6").
Notation Zge_le := Z.ge_le (compat "8.6").
Notation Zle_ge := Z.le_ge (compat "8.6").
Notation Zgt_iff_lt := Z.gt_lt_iff (only parsing).
Notation Zge_iff_le := Z.ge_le_iff (only parsing).

Lemma Zle_not_lt n m : n <= m -> ~ m < n.
Proof.
 apply Z.le_ngt.
Qed.

Lemma Zlt_not_le n m : n < m -> ~ m <= n.
Proof.
 apply Z.lt_nge.
Qed.

Lemma Zle_not_gt n m : n <= m -> ~ n > m.
Proof.
  trivial.
Qed.

Lemma Zgt_not_le n m : n > m -> ~ n <= m.
Proof.
  Z.swap_greater. apply Z.lt_nge.
Qed.

Lemma Znot_ge_lt n m : ~ n >= m -> n < m.
Proof.
  Z.swap_greater. apply Z.nle_gt.
Qed.

Lemma Znot_lt_ge n m : ~ n < m -> n >= m.
Proof.
  trivial.
Qed.

Lemma Znot_gt_le n m: ~ n > m -> n <= m.
Proof.
  trivial.
Qed.

Lemma Znot_le_gt n m : ~ n <= m -> n > m.
Proof.
  Z.swap_greater. apply Z.nle_gt.
Qed.

Lemma not_Zne n m : ~ Zne n m -> n = m.
Proof.
  intros H.
  destruct (Z.eq_decidable n m); [assumption|now elim H].
Qed.

(** * Equivalence and order properties *)

(** Reflexivity *)

Notation Zle_refl := Z.le_refl (compat "8.6").
Notation Zeq_le := Z.eq_le_incl (only parsing).

Hint Resolve Z.le_refl: zarith.

(** Antisymmetry *)

Notation Zle_antisym := Z.le_antisymm (only parsing).

(** Asymmetry *)

Notation Zlt_asym := Z.lt_asymm (only parsing).

Lemma Zgt_asym n m : n > m -> ~ m > n.
Proof.
  Z.swap_greater. apply Z.lt_asymm.
Qed.

(** Irreflexivity *)

Notation Zlt_irrefl := Z.lt_irrefl (compat "8.6").
Notation Zlt_not_eq := Z.lt_neq (only parsing).

Lemma Zgt_irrefl n : ~ n > n.
Proof.
  Z.swap_greater. apply Z.lt_irrefl.
Qed.

(** Large = strict or equal *)

Notation Zlt_le_weak := Z.lt_le_incl (only parsing).
Notation Zle_lt_or_eq_iff := Z.lt_eq_cases (only parsing).

Lemma Zle_lt_or_eq n m : n <= m -> n < m \/ n = m.
Proof.
  apply Z.lt_eq_cases.
Qed.

(** Dichotomy *)

Notation Zle_or_lt := Z.le_gt_cases (only parsing).

(** Transitivity of strict orders *)

Notation Zlt_trans := Z.lt_trans (compat "8.6").

Lemma Zgt_trans n m p : n > m -> m > p -> n > p.
Proof.
  Z.swap_greater. intros; now transitivity m.
Qed.

(** Mixed transitivity *)

Notation Zlt_le_trans := Z.lt_le_trans (compat "8.6").
Notation Zle_lt_trans := Z.le_lt_trans (compat "8.6").

Lemma Zle_gt_trans n m p : m <= n -> m > p -> n > p.
Proof.
  Z.swap_greater. Z.order.
Qed.

Lemma Zgt_le_trans n m p : n > m -> p <= m -> n > p.
Proof.
  Z.swap_greater. Z.order.
Qed.

(** Transitivity of large orders *)

Notation Zle_trans := Z.le_trans (compat "8.6").

Lemma Zge_trans n m p : n >= m -> m >= p -> n >= p.
Proof.
  Z.swap_greater. Z.order.
Qed.

Hint Resolve Z.le_trans: zarith.

(** * Compatibility of order and operations on Z *)

(** ** Successor *)

(** Compatibility of successor wrt to order *)

Lemma Zsucc_le_compat n m : m <= n -> Z.succ m <= Z.succ n.
Proof.
  apply Z.succ_le_mono.
Qed.

Lemma Zsucc_lt_compat n m : n < m -> Z.succ n < Z.succ m.
Proof.
  apply Z.succ_lt_mono.
Qed.

Lemma Zsucc_gt_compat n m : m > n -> Z.succ m > Z.succ n.
Proof.
  Z.swap_greater. apply Z.succ_lt_mono.
Qed.

Hint Resolve Zsucc_le_compat: zarith.

(** Simplification of successor wrt to order *)

Lemma Zsucc_gt_reg n m : Z.succ m > Z.succ n -> m > n.
Proof.
  Z.swap_greater. apply Z.succ_lt_mono.
Qed.

Lemma Zsucc_le_reg n m : Z.succ m <= Z.succ n -> m <= n.
Proof.
  apply Z.succ_le_mono.
Qed.

Lemma Zsucc_lt_reg n m : Z.succ n < Z.succ m -> n < m.
Proof.
  apply Z.succ_lt_mono.
Qed.

(** Special base instances of order *)

Notation Zlt_succ := Z.lt_succ_diag_r (only parsing).
Notation Zlt_pred := Z.lt_pred_l (only parsing).

Lemma Zgt_succ n : Z.succ n > n.
Proof.
  Z.swap_greater. apply Z.lt_succ_diag_r.
Qed.

Lemma Znot_le_succ n : ~ Z.succ n <= n.
Proof.
  apply Z.lt_nge, Z.lt_succ_diag_r.
Qed.

(** Relating strict and large order using successor or predecessor *)

Notation Zlt_succ_r := Z.lt_succ_r (compat "8.6").
Notation Zle_succ_l := Z.le_succ_l (compat "8.6").

Lemma Zgt_le_succ n m : m > n -> Z.succ n <= m.
Proof.
  Z.swap_greater. apply Z.le_succ_l.
Qed.

Lemma Zle_gt_succ n m : n <= m -> Z.succ m > n.
Proof.
  Z.swap_greater. apply Z.lt_succ_r.
Qed.

Lemma Zle_lt_succ n m : n <= m -> n < Z.succ m.
Proof.
  apply Z.lt_succ_r.
Qed.

Lemma Zlt_le_succ n m : n < m -> Z.succ n <= m.
Proof.
  apply Z.le_succ_l.
Qed.

Lemma Zgt_succ_le n m : Z.succ m > n -> n <= m.
Proof.
  Z.swap_greater. apply Z.lt_succ_r.
Qed.

Lemma Zlt_succ_le n m : n < Z.succ m -> n <= m.
Proof.
  apply Z.lt_succ_r.
Qed.

Lemma Zle_succ_gt n m : Z.succ n <= m -> m > n.
Proof.
  Z.swap_greater. apply Z.le_succ_l.
Qed.

(** Weakening order *)

Notation Zle_succ := Z.le_succ_diag_r (only parsing).
Notation Zle_pred := Z.le_pred_l (only parsing).
Notation Zlt_lt_succ := Z.lt_lt_succ_r (only parsing).
Notation Zle_le_succ := Z.le_le_succ_r (only parsing).

Lemma Zle_succ_le n m : Z.succ n <= m -> n <= m.
Proof.
  intros. now apply Z.lt_le_incl, Z.le_succ_l.
Qed.

Hint Resolve Z.le_succ_diag_r: zarith.
Hint Resolve Z.le_le_succ_r: zarith.

(** Relating order wrt successor and order wrt predecessor *)

Lemma Zgt_succ_pred n m : m > Z.succ n -> Z.pred m > n.
Proof.
  Z.swap_greater. apply Z.lt_succ_lt_pred.
Qed.

Lemma Zlt_succ_pred n m : Z.succ n < m -> n < Z.pred m.
Proof.
  apply Z.lt_succ_lt_pred.
Qed.

(** Relating strict order and large order on positive *)

Lemma Zlt_0_le_0_pred n : 0 < n -> 0 <= Z.pred n.
Proof.
  apply Z.lt_le_pred.
Qed.

Lemma Zgt_0_le_0_pred n : n > 0 -> 0 <= Z.pred n.
Proof.
  Z.swap_greater. apply Z.lt_le_pred.
Qed.

(** Special cases of ordered integers *)

Notation Zlt_0_1 := Z.lt_0_1 (compat "8.6").
Notation Zle_0_1 := Z.le_0_1 (compat "8.6").

Lemma Zle_neg_pos : forall p q:positive, Zneg p <= Zpos q.
Proof.
  exact Pos2Z.neg_le_pos.
Qed.

Lemma Zgt_pos_0 : forall p:positive, Zpos p > 0.
Proof.
  easy.
Qed.

(* weaker but useful (in [Z.pow] for instance) *)
Lemma Zle_0_pos : forall p:positive, 0 <= Zpos p.
Proof.
  exact Pos2Z.pos_is_nonneg.
Qed.

Lemma Zlt_neg_0 : forall p:positive, Zneg p < 0.
Proof.
  exact Pos2Z.neg_is_neg.
Qed.

Lemma Zle_0_nat : forall n:nat, 0 <= Z.of_nat n.
Proof.
  induction n; simpl; intros. apply Z.le_refl. easy.
Qed.

Hint Immediate Z.eq_le_incl: zarith.

(** Derived lemma *)

Lemma Zgt_succ_gt_or_eq n m : Z.succ n > m -> n > m \/ m = n.
Proof.
  Z.swap_greater. intros. now apply Z.lt_eq_cases, Z.lt_succ_r.
Qed.

(** ** Addition *)
(** Compatibility of addition wrt to order *)

Notation Zplus_lt_le_compat := Z.add_lt_le_mono (only parsing).
Notation Zplus_le_lt_compat := Z.add_le_lt_mono (only parsing).
Notation Zplus_le_compat := Z.add_le_mono (only parsing).
Notation Zplus_lt_compat := Z.add_lt_mono (only parsing).

Lemma Zplus_gt_compat_l n m p : n > m -> p + n > p + m.
Proof.
  Z.swap_greater. apply Z.add_lt_mono_l.
Qed.

Lemma Zplus_gt_compat_r n m p : n > m -> n + p > m + p.
Proof.
  Z.swap_greater. apply Z.add_lt_mono_r.
Qed.

Lemma Zplus_le_compat_l n m p : n <= m -> p + n <= p + m.
Proof.
  apply Z.add_le_mono_l.
Qed.

Lemma Zplus_le_compat_r n m p : n <= m -> n + p <= m + p.
Proof.
  apply Z.add_le_mono_r.
Qed.

Lemma Zplus_lt_compat_l n m p : n < m -> p + n < p + m.
Proof.
  apply Z.add_lt_mono_l.
Qed.

Lemma Zplus_lt_compat_r n m p : n < m -> n + p < m + p.
Proof.
  apply Z.add_lt_mono_r.
Qed.

(** Compatibility of addition wrt to being positive *)

Notation Zplus_le_0_compat := Z.add_nonneg_nonneg (only parsing).

(** Simplification of addition wrt to order *)

Lemma Zplus_le_reg_l n m p : p + n <= p + m -> n <= m.
Proof.
 apply Z.add_le_mono_l.
Qed.

Lemma Zplus_le_reg_r n m p : n + p <= m + p -> n <= m.
Proof.
 apply Z.add_le_mono_r.
Qed.

Lemma Zplus_lt_reg_l n m p : p + n < p + m -> n < m.
Proof.
 apply Z.add_lt_mono_l.
Qed.

Lemma Zplus_lt_reg_r n m p : n + p < m + p -> n < m.
Proof.
 apply Z.add_lt_mono_r.
Qed.

Lemma Zplus_gt_reg_l n m p : p + n > p + m -> n > m.
Proof.
 Z.swap_greater. apply Z.add_lt_mono_l.
Qed.

Lemma Zplus_gt_reg_r n m p : n + p > m + p -> n > m.
Proof.
 Z.swap_greater. apply Z.add_lt_mono_r.
Qed.

(** ** Multiplication *)
(** Compatibility of multiplication by a positive wrt to order *)

Lemma Zmult_le_compat_r n m p : n <= m -> 0 <= p -> n * p <= m * p.
Proof.
 intros. now apply Z.mul_le_mono_nonneg_r.
Qed.

Lemma Zmult_le_compat_l n m p : n <= m -> 0 <= p -> p * n <= p * m.
Proof.
 intros. now apply Z.mul_le_mono_nonneg_l.
Qed.

Lemma Zmult_lt_compat_r n m p : 0 < p -> n < m -> n * p < m * p.
Proof.
 apply Z.mul_lt_mono_pos_r.
Qed.

Lemma Zmult_gt_compat_r n m p : p > 0 -> n > m -> n * p > m * p.
Proof.
 Z.swap_greater. apply Z.mul_lt_mono_pos_r.
Qed.

Lemma Zmult_gt_0_lt_compat_r n m p : p > 0 -> n < m -> n * p < m * p.
Proof.
 Z.swap_greater. apply Z.mul_lt_mono_pos_r.
Qed.

Lemma Zmult_gt_0_le_compat_r n m p : p > 0 -> n <= m -> n * p <= m * p.
Proof.
 Z.swap_greater. apply Z.mul_le_mono_pos_r.
Qed.

Lemma Zmult_lt_0_le_compat_r n m p : 0 < p -> n <= m -> n * p <= m * p.
Proof.
 apply Z.mul_le_mono_pos_r.
Qed.

Lemma Zmult_gt_0_lt_compat_l n m p : p > 0 -> n < m -> p * n < p * m.
Proof.
 Z.swap_greater. apply Z.mul_lt_mono_pos_l.
Qed.

Lemma Zmult_lt_compat_l n m p : 0 < p -> n < m -> p * n < p * m.
Proof.
 apply Z.mul_lt_mono_pos_l.
Qed.

Lemma Zmult_gt_compat_l n m p : p > 0 -> n > m -> p * n > p * m.
Proof.
 Z.swap_greater. apply Z.mul_lt_mono_pos_l.
Qed.

Lemma Zmult_ge_compat_r n m p : n >= m -> p >= 0 -> n * p >= m * p.
Proof.
 Z.swap_greater. intros. now apply Z.mul_le_mono_nonneg_r.
Qed.

Lemma Zmult_ge_compat_l n m p : n >= m -> p >= 0 -> p * n >= p * m.
Proof.
 Z.swap_greater. intros. now apply Z.mul_le_mono_nonneg_l.
Qed.

Lemma Zmult_ge_compat n m p q :
  n >= p -> m >= q -> p >= 0 -> q >= 0 -> n * m >= p * q.
Proof.
 Z.swap_greater. intros. now apply Z.mul_le_mono_nonneg.
Qed.

Lemma Zmult_le_compat n m p q :
  n <= p -> m <= q -> 0 <= n -> 0 <= m -> n * m <= p * q.
Proof.
 intros. now apply Z.mul_le_mono_nonneg.
Qed.

(** Simplification of multiplication by a positive wrt to being positive *)

Lemma Zmult_gt_0_lt_reg_r n m p : p > 0 -> n * p < m * p -> n < m.
Proof.
 Z.swap_greater. apply Z.mul_lt_mono_pos_r.
Qed.

Lemma Zmult_lt_reg_r n m p : 0 < p -> n * p < m * p -> n < m.
Proof.
 apply Z.mul_lt_mono_pos_r.
Qed.

Lemma Zmult_le_reg_r n m p : p > 0 -> n * p <= m * p -> n <= m.
Proof.
 Z.swap_greater. apply Z.mul_le_mono_pos_r.
Qed.

Lemma Zmult_lt_0_le_reg_r n m p : 0 < p -> n * p <= m * p -> n <= m.
Proof.
 apply Z.mul_le_mono_pos_r.
Qed.

Lemma Zmult_ge_reg_r n m p : p > 0 -> n * p >= m * p -> n >= m.
Proof.
 Z.swap_greater. apply Z.mul_le_mono_pos_r.
Qed.

Lemma Zmult_gt_reg_r n m p : p > 0 -> n * p > m * p -> n > m.
Proof.
 Z.swap_greater. apply Z.mul_lt_mono_pos_r.
Qed.

Lemma Zmult_lt_compat n m p q :
  0 <= n < p -> 0 <= m < q -> n * m < p * q.
Proof.
 intros (Hn,Hnp) (Hm,Hmq). now apply Z.mul_lt_mono_nonneg.
Qed.

Lemma Zmult_lt_compat2 n m p q :
  0 < n <= p -> 0 < m < q -> n * m < p * q.
Proof.
  intros (Hn, Hnp) (Hm,Hmq).
  apply Z.le_lt_trans with (p * m).
   apply Z.mul_le_mono_pos_r; trivial.
   apply Z.mul_lt_mono_pos_l; Z.order.
Qed.

(** Compatibility of multiplication by a positive wrt to being positive *)

Notation Zmult_le_0_compat := Z.mul_nonneg_nonneg (only parsing).
Notation Zmult_lt_0_compat := Z.mul_pos_pos (only parsing).
Notation Zmult_lt_O_compat := Z.mul_pos_pos (only parsing).

Lemma Zmult_gt_0_compat n m : n > 0 -> m > 0 -> n * m > 0.
Proof.
 Z.swap_greater. apply Z.mul_pos_pos.
Qed.

(* To remove someday ... *)

Lemma Zmult_gt_0_le_0_compat n m : n > 0 -> 0 <= m -> 0 <= m * n.
Proof.
 Z.swap_greater. intros. apply Z.mul_nonneg_nonneg. trivial.
  now apply Z.lt_le_incl.
Qed.

(** Simplification of multiplication by a positive wrt to being positive *)

Lemma Zmult_le_0_reg_r n m : n > 0 -> 0 <= m * n -> 0 <= m.
Proof.
 Z.swap_greater. apply Z.mul_nonneg_cancel_r.
Qed.

Lemma Zmult_lt_0_reg_r n m : 0 < n -> 0 < m * n -> 0 < m.
Proof.
 apply Z.mul_pos_cancel_r.
Qed.

Lemma Zmult_gt_0_lt_0_reg_r n m : n > 0 -> 0 < m * n -> 0 < m.
Proof.
 Z.swap_greater. apply Z.mul_pos_cancel_r.
Qed.

Lemma Zmult_gt_0_reg_l n m : n > 0 -> n * m > 0 -> m > 0.
Proof.
 Z.swap_greater. apply Z.mul_pos_cancel_l.
Qed.

(** ** Square *)
(** Simplification of square wrt order *)

Lemma Zlt_square_simpl n m : 0 <= n -> m * m < n * n -> m < n.
Proof.
 apply Z.square_lt_simpl_nonneg.
Qed.

Lemma Zgt_square_simpl n m : n >= 0 -> n * n > m * m -> n > m.
Proof.
 Z.swap_greater. apply Z.square_lt_simpl_nonneg.
Qed.

(** * Equivalence between inequalities *)

Notation Zle_plus_swap := Z.le_add_le_sub_r (only parsing).
Notation Zlt_plus_swap := Z.lt_add_lt_sub_r (only parsing).
Notation Zlt_minus_simpl_swap := Z.lt_sub_pos (only parsing).

Lemma Zeq_plus_swap n m p : n + p = m <-> n = m - p.
Proof.
 apply Z.add_move_r.
Qed.

Lemma Zlt_0_minus_lt n m : 0 < n - m -> m < n.
Proof.
 apply Z.lt_0_sub.
Qed.

Lemma Zle_0_minus_le n m : 0 <= n - m -> m <= n.
Proof.
 apply Z.le_0_sub.
Qed.

Lemma Zle_minus_le_0 n m : m <= n -> 0 <= n - m.
Proof.
 apply Z.le_0_sub.
Qed.

(** For compatibility *)
Notation Zlt_O_minus_lt := Zlt_0_minus_lt (only parsing).


(** Additional results about [CPermutation] *)

From Coq Require Export CPermutation.
From OLlibs Require Import List_more funtheory.

Set Implicit Arguments.

Lemma CPermutation_app_app_inv A (l1 l2 l3 l4 : list A) :
  CPermutation (l1 ++ l2) (l3 ++ l4) ->
     (exists l3' l3'' l4' l4'',
        CPermutation l1 (l3' ++ l4')  /\ CPermutation l2 (l3'' ++ l4'')
     /\
        CPermutation l3 (l3' ++ l3'') /\ CPermutation l4 (l4' ++ l4''))
  \/ (exists l l',
        CPermutation l1 (l4 ++ l) /\ CPermutation l3 (l2 ++ l')
          /\ CPermutation l l')
  \/ (exists l l',
        CPermutation l2 (l4 ++ l) /\ CPermutation l3 (l1 ++ l')
          /\ CPermutation l l')
  \/ (exists l l',
        CPermutation l1 (l3 ++ l) /\ CPermutation l4 (l2 ++ l')
          /\ CPermutation l l')
  \/ (exists l l',
        CPermutation l2 (l3 ++ l) /\ CPermutation l4 (l1 ++ l')
          /\ CPermutation l l').
Proof.
intros HC; inversion HC as [lx ly Hx Hy].
dichot_app_exec Hx; dichot_app_exec Hy; subst.
- right; left.
  exists (l ++ l0), (l0 ++ l).
  repeat split; rewrite <- ? app_assoc; apply CPermutation_app_rot.
- dichot_app_exec Hy0; subst.
  + now left; exists l, l0, lx, l5; repeat split.
  + right; right; right; left; exists (l1 ++ lx), (lx ++ l1).
    repeat split; rewrite <- ? app_assoc; apply CPermutation_app_rot.
- dichot_app_exec Hy1; subst.
  + right; right; left; exists (ly ++ l2), (l2 ++ ly).
    repeat split; rewrite <- ? app_assoc; apply CPermutation_app_rot.
  + now left; exists l, ly, l3, l0; repeat split.
- right; right; right; right; exists (l5 ++ l0), (l0 ++ l5).
  repeat split; rewrite <- ? app_assoc; apply CPermutation_app_rot.
Qed.

Lemma CPermutation_vs_elt_subst A (a : A) l l1 l2 :
  CPermutation l (l1 ++ a :: l2) -> exists l3 l4,
    (forall l0, CPermutation (l1 ++ l0 ++ l2) (l3 ++ l0 ++ l4)) /\ l = l3 ++ a :: l4.
Proof.
intros HP.
destruct (CPermutation_vs_elt_inv _ _ _ HP) as [l' [l'' [Heq ->]]].
exists l', l''; split; [ | reflexivity ].
intros l0.
etransitivity; [ apply CPermutation_app_comm | ].
list_simpl; rewrite Heq, app_assoc.
constructor.
Qed.

Lemma CPermutation_map_inv_inj A B (f : A -> B) : injective f ->
  forall l1 l2, CPermutation (map f l1) (map f l2) -> CPermutation l1 l2.
Proof.
intros Hi l1 l2 HP; inversion HP as [l3 l4 Heq1 Heq2].
symmetry in Heq1; symmetry in Heq2.
decomp_map Heq1; decomp_map Heq2; subst.
apply map_injective in Heq5; auto.
apply map_injective in Heq6; auto.
subst; constructor.
Qed.

Lemma CPermutation_map_inv_inj_local A B (f : A -> B) l1 l2 :
  (forall x y, In x l1 -> In y l2 -> f x = f y -> x = y) ->
    CPermutation (map f l1) (map f l2) -> CPermutation l1 l2.
Proof.
intros Hi HP; inversion HP as [l3 l4 Heq1 Heq2].
symmetry in Heq1; symmetry in Heq2.
decomp_map Heq1; decomp_map Heq2; subst.
symmetry in Heq5; symmetry in Heq6.
apply map_injective_in in Heq5.
2:{ intros x y Hin1 Hin2 Heq; apply Hi; auto; apply in_or_app; auto. }
apply map_injective_in in Heq6.
2:{ intros x y Hin1 Hin2 Heq; apply Hi; auto; apply in_or_app; auto. }
subst; constructor.
Qed.


Definition remove_by_value(M: map K V)(v: V): map K V :=
  remove_keys M (preimage M (singleton_set v)).


(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)

(************************************************************************)
(*                                                                      *)
(*                           Nat.v                                      *)
(*                                                                      *)
(*    Laurent.Thery @sophia.inria.fr        March 2002                  *)
(************************************************************************)
(** Some extra properties of natural numbers *)
Require Import Arith.
Require Import ZArith.
Require Import ZArithRing.
Require Import sTactic.
Require Import Max.

Theorem le_ind2 :
 forall P : nat -> nat -> Prop,
 (forall m : nat, 0 <= m -> P 0 m) ->
 (forall m n : nat, n <= m -> P n m -> P (S n) (S m)) ->
 forall m n : nat, n <= m -> P n m.
intros P H H0 m n; generalize m; elim n; clear n m; auto with arith.
intros n H1 m; case m; auto with arith.
intros H2; Contradict H2; auto with arith.
Qed.

Theorem minus_O : forall n m : nat, n <= m -> n - m = 0.
intros n m H; elim H using le_ind2; auto.
Qed.

Theorem minus_O_le : forall n m : nat, n - m = 0 -> n <= m.
intros n; elim n; simpl in |- *; auto with arith.
intros n1 Rec m; case m; simpl in |- *; try (intros H; rewrite H);
 auto with arith.
Qed.

(** Check if [i] is strictly less than [o] *)
Fixpoint ltdec (i o : nat) {struct o} : bool :=
  match i, o with
  | O, O => false
  | O, S o1 => true
  | S i1, S o1 => ltdec i1 o1
  | S i1, O => false
  end.

Theorem ltdec_correct :
 forall i o : nat, match ltdec i o with
                   | true => i < o
                   | false => o <= i
                   end.
intros i; elim i; simpl in |- *; auto.
intros o; case o; simpl in |- *; auto with arith.
intros i1 H o; case o; simpl in |- *; auto with arith.
intros o1; generalize (H o1); case (ltdec i1 o1); auto with arith.
Qed.

Theorem pred_le : forall a b, a <= b -> pred a <= pred b.
intros a b; case a; case b; simpl in |- *; auto with arith.
Qed.
Hint Resolve pred_le: arith.

Fixpoint minus2 (m1 m2 : nat) {struct m2} : nat * nat :=
  match m1, m2 with
  | S m3, S m4 => minus2 m3 m4
  | _, _ => (m1, m2)
  end.

Theorem minus2_correct :
 forall m1 m2 : nat,
 match minus2 m1 m2 with
 | (m3, m4) => m3 = m1 - m2 /\ m4 = m2 - m1
 end.
intros m1 m2; generalize m1; elim m2; clear m1 m2; simpl in |- *;
 auto with arith.
intros m1; case m1; simpl in |- *; auto.
intros m2 Rec m1; case m1; simpl in |- *; auto.
Qed.

(** Definition of the gcd of two numbers *)
Fixpoint gcd1 (m1 m2 n : nat) {struct n} : nat :=
  match minus2 m1 m2 with
  | (O, O) => m1
  | (O, m3) => match n with
               | O => m3
               | S n1 => gcd1 m1 m3 n1
               end
  | (m3, _) => match n with
               | O => m3
               | S n1 => gcd1 m3 m2 n1
               end
  end.

Definition gcd m1 m2 := gcd1 m1 m2 (m1 + m2).

Theorem gcd1_bezout0 : forall n m : nat, gcd1 m 0 n = m.
intros n; elim n; simpl in |- *.
intros m; case m; simpl in |- *; auto.
intros n1 Rec m; case m; simpl in |- *; auto.
Qed.

Theorem gcd1_bezout1 : forall n m : nat, gcd1 0 m n = m.
intros n; elim n; simpl in |- *.
intros m; case m; simpl in |- *; auto.
intros n1 Rec m; case m; simpl in |- *; auto.
Qed.

Theorem gcd1_bezout :
 forall n m1 m2 : nat,
 m1 <= n ->
 m2 <= n ->
 exists x1 : Z,
   (exists x2 : Z,
      (Z_of_nat m1 * x1 + Z_of_nat m2 * x2)%Z = Z_of_nat (gcd1 m1 m2 n)).
intros n; elim n; simpl in |- *.
intros m1 m2 H1 H2; inversion H1; inversion H2; simpl in |- *; exists 0%Z;
 exists 0%Z; auto.
intros n0 H m1 m2 H0 H1; generalize (minus2_correct m1 m2);
 case (minus2 m1 m2).
intros n1 n2; case n1; case n2; auto.
intros H2; exists 1%Z; exists 0%Z; ring.
intros m3 (H2, H3).
cut (m1 < m2); [ intros H4 | idtac ].
generalize H0 H3 H4; case m1; clear H2 H0 H3 H4 m1.
intros H0 H3 H4; exists 0%Z; exists 1%Z; rewrite gcd1_bezout1.
replace (S m3) with m2; [ ring | rewrite H3; case m2; simpl in |- *; auto ].
intros n3 H0 H3 H4.
case (H (S n3) (S m3)); auto.
apply gt_S_le; red in |- *.
apply lt_le_trans with m2; auto with arith.
rewrite H3; auto.
generalize H1 H4; case m2; simpl in |- *; auto with arith.
intros n4 H2 H5; apply le_trans with n4; auto with arith.
generalize n3; elim n4; auto with arith; intros n5 Rec n6; case n6;
  simpl in |- *; auto.
intros x (y, H2).
exists (x - y)%Z; exists y; rewrite <- H2; rewrite H3.
rewrite Znat.inj_minus1; try ring.
apply lt_le_weak; auto.
apply lt_O_minus_lt; rewrite <- H3; auto with arith.
intros m3 (H2, H3).
cut (m2 < m1); [ intros H4 | idtac ].
generalize H1 H2 H4; case m2; clear H1 H2 H3 H4 m2.
intros H1 H3 H4; exists 1%Z; exists 0%Z; rewrite gcd1_bezout0.
replace (S m3) with m1; [ ring | rewrite H3; case m1; simpl in |- *; auto ].
intros n3 H1 H3 H4.
case (H (S m3) (S n3)); auto.
apply gt_S_le; red in |- *.
apply lt_le_trans with m1; auto with arith.
rewrite H3; generalize H4; case m1; simpl in |- *; auto with arith.
intros H2; Contradict H2; auto with arith.
intros n4 H2; apply le_lt_trans with n4; auto with arith.
generalize n3; elim n4; auto with arith; intros n5 Rec n6; case n6;
  simpl in |- *; auto.
apply gt_S_le; red in |- *.
apply lt_le_trans with m1; auto with arith.
intros x (y, H2).
exists x; exists (y - x)%Z; rewrite <- H2; rewrite H3.
rewrite Znat.inj_minus1; try ring.
apply lt_le_weak; auto.
apply lt_O_minus_lt; rewrite <- H2; auto with arith.
intros n3 n4 (H2, H3).
case (le_or_lt m1 m2); intros H4.
Contradict H2; rewrite minus_O; auto.
Contradict H3; rewrite minus_O; auto with arith.
Qed.

Theorem gcd1_O : forall n m, gcd1 0 m n = m /\ gcd1 m 0 n = m.
intros n; elim n.
intros m; case m; simpl in |- *; auto.
intros n1 Rec m; case m; simpl in |- *; auto.
Qed.

Theorem gcd_O1 : forall m, gcd 0 m = m.
intros m; case (gcd1_O m m); simpl in |- *; auto.
Qed.

Theorem gcd_O2 : forall m, gcd m 0 = m.
intros m; case (gcd1_O (m + 0) m); simpl in |- *; auto.
Qed.

(** Bezout equality *)
Theorem gcd_bezout :
 forall m1 m2 : nat,
 exists x1 : Z,
   (exists x2 : Z,
      (Z_of_nat m1 * x1 + Z_of_nat m2 * x2)%Z = Z_of_nat (gcd m1 m2)).
intros m1 m2; unfold gcd in |- *; apply gcd1_bezout; auto with arith.
Qed.

(** Division of two numbers *)
Fixpoint div1 (m1 m2 n : nat) {struct n} : nat :=
  match minus2 m1 m2 with
  | (O, O) => 1
  | (O, _) => 0
  | (m3, _) => match n with
               | O => 0
               | S n1 => S (div1 m3 m2 n1)
               end
  end.

Definition div m1 m2 := div1 m1 m2 m1.

Theorem div1_correct :
 forall n m1 m2 : nat,
 m1 <= n -> 0 < m2 -> m2 * div1 m1 m2 n <= m1 /\ m1 < m2 * S (div1 m1 m2 n).
intros n; elim n; simpl in |- *; auto.
intros m1 m2 H H0; inversion H; auto.
generalize H0; case m2; simpl in |- *; auto with arith.
intros; rewrite mult_comm; simpl in |- *; auto with arith.
intros n0 H m1 m2 H0 H1; generalize (minus2_correct m1 m2);
 case (minus2 m1 m2).
intros n1 n2; case n1; case n2; simpl in |- *.
intros (H2, H3); replace m1 with m2; auto with arith.
rewrite mult_1_r; split; auto with arith.
rewrite mult_comm; simpl in |- *; apply le_lt_trans with (m2 + 0);
 auto with arith.
apply le_antisym; apply minus_O_le; auto.
intros n3 (H2, H3); rewrite <- mult_n_O; rewrite mult_1_r; simpl in |- *;
 split; auto with arith.
apply lt_O_minus_lt; rewrite <- H3; auto with arith.
intros n3 (H2, H3); case (H (S n3) m2); auto with arith.
apply gt_S_le; red in |- *.
apply lt_le_trans with m1; auto with arith.
rewrite H2; apply lt_minus; auto.
apply minus_O_le; auto.
intros H4 H5; split; auto.
rewrite <- mult_n_Sm.
apply le_trans with (S n3 + m2); auto with arith.
rewrite H2.
rewrite plus_comm; rewrite <- le_plus_minus; auto with arith.
apply minus_O_le; auto with arith.
rewrite <- mult_n_Sm.
apply le_lt_trans with (S n3 + m2); auto with arith.
rewrite H2.
rewrite plus_comm; rewrite <- le_plus_minus; auto with arith.
apply minus_O_le; auto with arith.
intros n3 n4 (H2, H3).
case (le_or_lt m1 m2); intros H4.
Contradict H2; rewrite minus_O; auto.
Contradict H3; rewrite minus_O; auto with arith.
Qed.

Theorem div_correct :
 forall m1 m2 : nat,
 0 < m2 -> m2 * div m1 m2 <= m1 /\ m1 < m2 * S (div m1 m2).
intros m1 m2 H; unfold div in |- *; apply div1_correct; auto.
Qed.

Definition divides m1 m2 := exists m3 : _, m2 = m1 * m3.

Theorem divides_refl : forall m, divides m m.
intros; exists 1; simpl in |- *; auto; ring.
Qed.

Theorem divides_trans :
 forall m1 m2 m3, divides m1 m2 -> divides m2 m3 -> divides m1 m3.
intros m1 m2 m3 (m1', H1) (m2', H2); exists (m1' * m2'); rewrite H2;
 rewrite H1; ring.
Qed.

Theorem divides_add :
 forall m1 m2 m3, divides m1 m2 -> divides m1 m3 -> divides m1 (m2 + m3).
intros m1 m2 m3 (m1', H1) (m2', H2); exists (m1' + m2'); rewrite H2;
 rewrite H1; ring.
Qed.

Theorem divides_minus :
 forall m1 m2 m3, divides m1 m2 -> divides m1 m3 -> divides m1 (m2 - m3).
intros m1 m2 m3 (m1', H1) (m2', H2); exists (m1' - m2'); rewrite H2;
 rewrite H1. auto with arith.
Qed.
Hint Resolve divides_refl divides_add divides_minus.

Theorem divides_gcd_aux :
 forall n m1 m2,
 0 < m1 ->
 m1 <= n ->
 0 < m2 -> m2 <= n -> divides (gcd1 m1 m2 n) m2 /\ divides (gcd1 m1 m2 n) m1.
intros n; elim n; simpl in |- *.
intros m1 m2 H H0; Contradict H0; auto with arith.
intros n' Rec; intros m1 m2 H1 H2 H3 H4; generalize (minus2_correct m1 m2);
 case (minus2 m1 m2).
intros n0; case n0; clear n0.
intros n1; case n1; clear n1.
intros (H5, H6); replace m1 with m2; auto.
apply le_antisym; apply minus_O_le; auto.
intros n1 (H5, H6); case (Rec m1 (S n1)); auto with arith.
apply lt_n_Sm_le; apply lt_le_trans with m2; auto.
apply lt_O_minus_lt; rewrite <- H6; auto with arith.
apply lt_n_Sm_le; apply lt_le_trans with m2; auto.
rewrite H6.
apply lt_minus; auto.
apply minus_O_le; auto.
intros H7 H8; split; auto.
replace m2 with (m1 + S n1); auto with arith.
rewrite H6.
apply sym_equal; apply le_plus_minus.
apply minus_O_le; auto.
intros n1 n2; case n2; clear n2.
intros (H5, H6); case (Rec (S n1) m2); auto with arith.
apply lt_n_Sm_le; apply lt_le_trans with m1; auto.
rewrite H5.
apply lt_minus; auto.
apply minus_O_le; auto.
apply lt_n_Sm_le; apply lt_le_trans with m1; auto.
apply lt_O_minus_lt; rewrite <- H5; auto with arith.
intros H7 H8; split; auto.
replace m1 with (m2 + S n1); auto with arith.
rewrite H5.
apply sym_equal; apply le_plus_minus.
apply minus_O_le; auto.
intros n2 (H5, H6).
case (le_or_lt m1 m2); intros H7.
Contradict H5; rewrite minus_O; auto.
Contradict H6; rewrite minus_O; auto with arith.
Qed.

Theorem divides_gcd1 : forall m1 m2, divides (gcd m1 m2) m1.
intros m1 m2; case m1.
rewrite gcd_O1; exists 0; simpl in |- *; auto.
intros m1'; case m2; simpl in |- *.
rewrite gcd_O2; exists 1; ring.
intros m2'; case (divides_gcd_aux (S m1' + S m2') (S m1') (S m2'));
 auto with arith.
Qed.

Theorem divides_gcd2 : forall m1 m2, divides (gcd m1 m2) m2.
intros m1 m2; case m1.
rewrite gcd_O1; exists 1; ring.
intros m1'; case m2; simpl in |- *.
rewrite gcd_O2; exists 0; ring.
intros m2'; case (divides_gcd_aux (S m1' + S m2') (S m1') (S m2'));
 auto with arith.
Qed.

Theorem divides_gcd1_aux :
 forall n m1 m2 m3,
 0 < m1 ->
 m1 <= n ->
 0 < m2 ->
 m2 <= n -> divides m3 m1 -> divides m3 m2 -> divides m3 (gcd1 m1 m2 n).
intros n; elim n; simpl in |- *.
intros m1 m2 m3 H H0; Contradict H0; auto with arith.
intros n' Rec m1 m2 m3 H1 H2 H3 H4 H5 H6.
generalize (minus2_correct m1 m2); case (minus2 m1 m2).
intros n0; case n0; clear n0; auto.
intros n1; case n1; clear n1; auto.
intros n1 (H7, H8); apply Rec; auto with arith.
apply lt_n_Sm_le; apply lt_le_trans with m2; auto.
apply lt_O_minus_lt; rewrite <- H8; auto with arith.
apply lt_n_Sm_le; apply lt_le_trans with m2; auto.
rewrite H8.
apply lt_minus; auto.
apply minus_O_le; auto.
rewrite H8; auto.
intros n1 n2; case n2; clear n2; auto.
intros (H7, H8); apply Rec; auto with arith.
apply lt_n_Sm_le; apply lt_le_trans with m1; auto.
rewrite H7.
apply lt_minus; auto.
apply minus_O_le; auto.
apply lt_n_Sm_le; apply lt_le_trans with m1; auto.
apply lt_O_minus_lt; rewrite <- H7; auto with arith.
rewrite H7; auto.
intros n2 (H7, H8).
case (le_or_lt m1 m2); intros H9.
Contradict H7; rewrite minus_O; auto.
Contradict H8; rewrite minus_O; auto with arith.
Qed.

Theorem divides_gcd3 :
 forall m1 m2 m3, divides m3 m1 -> divides m3 m2 -> divides m3 (gcd m1 m2).
intros m1 m2 m3; case m1.
rewrite gcd_O1; auto.
intros m1'; case m2; simpl in |- *.
rewrite gcd_O2; auto.
intros m2' H; apply (divides_gcd1_aux (S m1' + S m2') (S m1') (S m2'));
 auto with arith.
Qed.

Theorem mult_inv : forall m1 m2 m3, S m1 * m2 = S m1 * m3 -> m2 = m3.
intros m1 m2 m3 H; apply le_antisym; apply mult_S_le_reg_l with (n := m1);
 rewrite H; auto with arith.
Qed.

Theorem divides_id : forall m1 m2, divides m1 m2 -> divides m2 m1 -> m2 = m1.
intros m1 m2 (m3, H) (m4, H0).
generalize H H0; clear H H0; case m1; clear m1.
case m2; simpl in |- *; auto; intros; discriminate.
intros m1 H H0.
cut (m3 * m4 = 1); [ intros H1 | idtac ].
cut (m3 = 1); [ intros H2 | idtac ].
rewrite H; rewrite H2; ring.
generalize H1; case m3; case m4; simpl in |- *; auto.
intros n1; rewrite mult_comm; simpl in |- *; intros H2; discriminate.
intros n n0; case n0; simpl in |- *; auto.
intros n1; rewrite <- plus_n_Sm; simpl in |- *; intros; discriminate.
apply mult_inv with (m1 := m1).
pattern (S m1) at 2 in |- *; rewrite H0; rewrite H; ring.
Qed.

Theorem gcd_sym : forall m1 m2, gcd m1 m2 = gcd m2 m1.
intros m1 m2; apply divides_id; auto.
apply divides_gcd3; auto.
apply divides_gcd2; auto.
apply divides_gcd1; auto.
apply divides_gcd3; auto.
apply divides_gcd2; auto.
apply divides_gcd1; auto.
Qed.

(** Definition of the lcm of two numbers *)
Definition lcm m1 m2 := div (m1 * m2) (gcd m1 m2).

Theorem divides_div :
 forall m1 m2, 0 < m1 -> divides m1 m2 -> m2 = m1 * div m2 m1.
intros m1 m2 H0 (m3, H).
case (div_correct m2 m1); auto.
intros H1 H2; auto.
apply le_antisym; auto.
case (le_or_lt m3 (div m2 m1)); intros H3.
pattern m2 at 1 in |- *; rewrite H; auto with arith.
Contradict H2; auto with arith.
apply le_not_lt.
pattern m2 at 2 in |- *; rewrite H; auto with arith.
Qed.

Theorem gcd_lt_zero : forall m1 m2, 0 < m1 -> 0 < m2 -> 0 < gcd m1 m2.
intros m1 m2 H H0.
generalize (divides_gcd1 m1 m2).
case (gcd m1 m2); simpl in |- *; auto with arith.
intros (m3, H1).
Contradict H; rewrite H1; simpl in |- *; auto with arith.
Qed.

Theorem mult_inv1 :
 forall m1 m2 m3 : nat, 0 < m1 -> m1 * m2 = m1 * m3 -> m2 = m3.
intros m1 m2 m3; case m1.
intros H; Contradict H; auto with arith.
intros n H H0; apply mult_inv with (m1 := n); auto.
Qed.

Theorem divides_lcm1 :
 forall m1 m2, 0 < m1 -> 0 < m2 -> divides m1 (lcm m1 m2).
intros m1 m2 H H0.
generalize (divides_gcd1 m1 m2); intros (m3, H1).
generalize (divides_gcd2 m1 m2); intros (m4, H2).
exists m4.
apply mult_inv1 with (m1 := gcd m1 m2).
apply gcd_lt_zero; auto.
unfold lcm in |- *; simpl in |- *.
rewrite <- divides_div.
pattern m2 at 1 in |- *; rewrite H2; ring.
apply gcd_lt_zero; auto.
apply divides_trans with (m2 := m1); auto.
apply divides_gcd1.
exists m2; ring.
Qed.

Theorem lcm_sym : forall a b, lcm a b = lcm b a.
intros a b; unfold lcm in |- *.
rewrite (mult_comm a); rewrite gcd_sym; auto.
Qed.

Theorem divides_lcm2 :
 forall m1 m2, 0 < m1 -> 0 < m2 -> divides m2 (lcm m1 m2).
intros m1 m2 H H0; rewrite lcm_sym; apply divides_lcm1; auto.
Qed.

Theorem divides_lcm3 :
 forall m1 m2 m3,
 0 < m1 -> 0 < m2 -> divides m1 m3 -> divides m2 m3 -> divides (lcm m1 m2) m3.
intros m1 m2 m3; case m3.
intros H H0 H1 H2; exists 0; ring.
clear m3; intros m3 H1 H2 H3 H4.
generalize (divides_gcd1 m1 m2); intros (m6, H5).
generalize (divides_gcd2 m1 m2); intros (m7, H6).
apply divides_trans with (gcd (lcm m1 m2) (S m3)); auto.
2: apply divides_gcd2.
generalize (divides_gcd1 (lcm m1 m2) (S m3)); intros (m8, H7).
pattern (lcm m1 m2) at 1 in |- *; rewrite H7.
replace m8 with 1; [ exists 1; ring | idtac ].
cut (divides (gcd m1 m2 * m8) (gcd m1 m2)); [ intros (m9, H8) | idtac ].
cut (1 = m8 * m9).
case m9.
rewrite mult_comm; simpl in |- *; intros; discriminate.
intros n1; case m8; simpl in |- *; auto.
intros n2; case n2; simpl in |- *; auto.
intros n3; rewrite <- plus_n_Sm; simpl in |- *; intros; discriminate.
apply mult_inv1 with (m1 := gcd m1 m2).
apply gcd_lt_zero; auto.
pattern (gcd m1 m2) at 1 in |- *; rewrite H8; ring.
apply divides_gcd3.
cut (divides m2 (gcd (lcm m1 m2) (S m3))); [ intros (m9, H8) | idtac ].
exists m9.
apply mult_inv1 with (m1 := m2); auto.
apply trans_equal with (gcd m1 m2 * (m2 * m9 * m8)); [ idtac | ring ].
rewrite <- H8; rewrite <- H7.
rewrite (mult_comm m2); unfold lcm in |- *; apply divides_div; auto.
apply gcd_lt_zero; auto.
apply divides_trans with m1; auto.
apply divides_gcd1.
exists m2; ring.
apply divides_gcd3; auto.
apply divides_lcm2; auto.
cut (divides m1 (gcd (lcm m1 m2) (S m3))); [ intros (m9, H8) | idtac ].
exists m9.
apply mult_inv1 with (m1 := m1); auto.
apply trans_equal with (gcd m1 m2 * (m1 * m9 * m8)); [ idtac | ring ].
rewrite <- H8; rewrite <- H7.
unfold lcm in |- *; apply divides_div; auto.
apply gcd_lt_zero; auto.
apply divides_trans with m1; auto.
apply divides_gcd1.
exists m2; ring.
apply divides_gcd3; auto.
apply divides_lcm1; auto.
Qed.

Theorem lcm_lt_O : forall a b, 0 < a -> 0 < b -> 0 < lcm a b.
intros a b H H1; case (le_or_lt (lcm a b) 0); auto; intros H2.
cut (lcm a b = 0); [ intros H3 | inversion H2; auto ].
absurd (0 < a * b); auto with arith.
rewrite (divides_div (gcd a b) (a * b)); auto.
change (~ 0 < gcd a b * lcm a b) in |- *.
rewrite H3; rewrite mult_comm; simpl in |- *; auto with arith.
apply gcd_lt_zero; auto.
apply divides_trans with a; auto.
apply divides_gcd1; auto.
exists b; ring; auto.
generalize H H1; case a; simpl in |- *.
intros H6; Contradict H6; auto with arith.
intros n; case n; simpl in |- *; auto with arith.
Qed.

Theorem mult_lt_ZERO : forall a b, 0 < a -> 0 < b -> 0 < a * b.
intros a; case a.
intros b H; Contradict H; auto with arith.
intros a1 b H; case b; simpl in |- *; auto with arith.
intros H1; Contradict H1; auto with arith.
Qed.

Theorem div_lt_ZERO :
 forall a b, 0 < a -> 0 < b -> a = div a b * b -> 0 < div a b.
intros a b H H0; case (div a b); simpl in |- *; auto with arith.
intros H1; Contradict H; rewrite H1; auto with arith.
Qed.

Theorem max_Or : forall a b, max a b = a \/ max a b = b.
intros a; elim a; simpl in |- *; auto.
intros n H b; case b; simpl in |- *; auto.
intros n0; case (H n0); intros H1; rewrite H1; auto.
Qed.


Require Import XR_Rabs.
Require Import XR_Rcase_abs.
Require Import XR_Rle_antisym.
Require Import XR_Rle_trans.
Require Import XR_Ropp_0.
Require Import XR_Ropp_le_contravar.

Local Open Scope R_scope.

Lemma Rabs_pos_eq : forall x:R, R0 <= x -> Rabs x = x.
Proof.
  intros x h.
  unfold Rabs.
  destruct (Rcase_abs x) as [ hl | hr ].
  {
    apply Rle_antisym.
    {
      apply Rle_trans with R0.
      {
        rewrite <- Ropp_0.
        apply Ropp_le_contravar.
        exact h.
      }
      { exact h. }
    }
    {
      apply Rle_trans with R0.
      {
        left.
        exact hl.
      }
      {
        rewrite <- Ropp_0.
        apply Ropp_le_contravar.
        left.
        exact hl.
      }
    }
  }
  { reflexivity. }
Qed.


Require Import List.

(* tag definition *)
Inductive tag_ter_normal :=
(* Integer arithmetic *)
| ADD : tag_ter_normal
| SUB : tag_ter_normal
| MUL : tag_ter_normal
| DIV : tag_ter_normal
(* unsigned arithmetic *)
| ADDU : tag_ter_normal
| SUBU : tag_ter_normal
| MULU : tag_ter_normal
| DIVU : tag_ter_normal
(* compare instructions *)
| CMP : tag_ter_normal
| CMPU : tag_ter_normal
(* floating point arithmetic *)
| FADD : tag_ter_normal
| FSUB : tag_ter_normal
| FMUL : tag_ter_normal
| FDIV : tag_ter_normal
| FREM : tag_ter_normal
| FSQRT : tag_ter_normal
| FINT : tag_ter_normal
(* comparing float number *)
| FCMP : tag_ter_normal
| FEQL : tag_ter_normal
| FUN : tag_ter_normal
| FCMPE : tag_ter_normal
| FEQLE : tag_ter_normal
| FUNE : tag_ter_normal
(* Bits and Bytes *)
| AND : tag_ter_normal
| OR : tag_ter_normal
| XOR : tag_ter_normal
| ANDN : tag_ter_normal
| ORN : tag_ter_normal
| NAND : tag_ter_normal
| NOR : tag_ter_normal
| NXOR : tag_ter_normal
(* shifting bit patterns *)
| SL : tag_ter_normal
| SLU : tag_ter_normal
| SR : tag_ter_normal
| SRU : tag_ter_normal
(* mix and match *)
| MOR : tag_ter_normal
| MXOR : tag_ter_normal
(* bytewise operation *)
| BDIF : tag_ter_normal
| WDIF : tag_ter_normal
| TDIF : tag_ter_normal
| ODIF : tag_ter_normal
(* the sadd instruction *)
| SADD : tag_ter_normal
(* the mux instruction *)
| MUX : tag_ter_normal
(* 2ADDU ,  4ADDU , 8ADDU , 16ADDU *)
| ADDU2 : tag_ter_normal
| ADDU4 : tag_ter_normal
| ADDU8 : tag_ter_normal
| ADDU16 : tag_ter_normal
(* load and store *)
| LDB : tag_ter_normal
| LDW : tag_ter_normal
| LDT : tag_ter_normal
| LDO : tag_ter_normal
          (* storing signd integers *)
| STB : tag_ter_normal
| STW : tag_ter_normal
| STT : tag_ter_normal
| STO : tag_ter_normal
           (* loading unsigned data *)
| LDBU : tag_ter_normal
| LDWU : tag_ter_normal
| LDTU : tag_ter_normal
| LDOU : tag_ter_normal
(* storing  unsigned data *)
| STBU : tag_ter_normal
| STWU : tag_ter_normal
| STTU : tag_ter_normal
| STOU : tag_ter_normal
           (* LDTH instruction *)
| LDTH : tag_ter_normal
(* STHT instruction *)
| STHT : tag_ter_normal
           (* loading and storing short float *)
| LDSF : tag_ter_normal
| STSF : tag_ter_normal
(* jump with absolute adress *)
| GO : tag_ter_normal
         (* Conditional assigments *)
| CSZ : tag_ter_normal
| CSNZ : tag_ter_normal
| CSN : tag_ter_normal
| CSNN : tag_ter_normal
| CSP : tag_ter_normal
| CSNP : tag_ter_normal
| CSOD : tag_ter_normal
| CSEV : tag_ter_normal
| ZSZ : tag_ter_normal
| ZSNZ : tag_ter_normal
| ZSN : tag_ter_normal
| ZSNN : tag_ter_normal
| ZSP : tag_ter_normal
| ZSNP : tag_ter_normal
| ZSOD : tag_ter_normal
| ZSEV : tag_ter_normal
           (* CSWAP *)
| CSWAP : tag_ter_normal
            (* ldunc and stunc *)
| LDUNC : tag_ter_normal
| STUNC : tag_ter_normal
            (* preld prest prego *)
| PREST : tag_ter_normal
            (* LDTVS *)
| LDTVS : tag_ter_normal.

(* this is tag for instructions with the form (tag reg reg imm) *)
Inductive tag_ter_immediate :=
(* Integer arithmetic *)
| ADD_I : tag_ter_immediate
| SUB_I : tag_ter_immediate
| MUL_I : tag_ter_immediate
| DIV_I : tag_ter_immediate
(* Unsigned arithmetic *)
| ADDU_I : tag_ter_immediate
| SUBU_I : tag_ter_immediate
| MULU_I : tag_ter_immediate
| DIVU_I : tag_ter_immediate
(* compare instructions *)
| CMP_I : tag_ter_immediate
| CMPU_I : tag_ter_immediate
(* Bits and Bytes *)
| AND_I : tag_ter_immediate
| OR_I : tag_ter_immediate
| XOR_I : tag_ter_immediate
| ANDN_I : tag_ter_immediate
| ORN_I : tag_ter_immediate
| NAND_I : tag_ter_immediate
| NOR_I : tag_ter_immediate
| NXOR_I : tag_ter_immediate
(* shifting bit patterns *)
| SL_I : tag_ter_immediate
| SLU_I : tag_ter_immediate
| SR_I : tag_ter_immediate
| SRU_I : tag_ter_immediate
(* bytewise operation *)
| BDIF_I : tag_ter_immediate
| WDIF_I : tag_ter_immediate
| TDIF_I : tag_ter_immediate
| ODIF_I : tag_ter_immediate
             (* adress computation *)
| LDA_I : tag_ter_immediate
          (* get adress *)
| GETA_I : tag_ter_immediate
           (* 2ADDU ,  4ADDU , 8ADDU , 16ADDU *)
| ADDU2_I : tag_ter_immediate
| ADDU4_I : tag_ter_immediate
| ADDU8_I : tag_ter_immediate
| ADDU16_I : tag_ter_immediate
             (* load and store *)
| LDB_I : tag_ter_immediate
| LDW_I : tag_ter_immediate
| LDT_I : tag_ter_immediate
| LDO_I : tag_ter_immediate
          (* storing signd integers *)
| STB_I : tag_ter_immediate
| STW_I : tag_ter_immediate
| STT_I : tag_ter_immediate
| STO_I : tag_ter_immediate
           (* loading unsigned data *)
| LDBU_I : tag_ter_immediate
| LDWU_I : tag_ter_immediate
| LDTU_I : tag_ter_immediate
| LDOU_I : tag_ter_immediate
           (* storing unsigned data *)
| STBU_I : tag_ter_immediate
| STWU_I : tag_ter_immediate
| STTU_I : tag_ter_immediate
| STOU_I : tag_ter_immediate
           (* LDTH instruction *)
| LDTH_I : tag_ter_immediate
(* STHT instruction *)
| STHT_I : tag_ter_immediate
           (* loading and storing short float *)
| LDSF_I : tag_ter_immediate
| STSF_I : tag_ter_immediate
(* jump with absolute adress *)
| GO_I : tag_ter_immediate
         (* Conditional assigments *)
| CSZ_I : tag_ter_immediate
| CSNZ_I : tag_ter_immediate
| CSN_I : tag_ter_immediate
| CSNN_I : tag_ter_immediate
| CSP_I : tag_ter_immediate
| CSNP_I : tag_ter_immediate
| CSOD_I : tag_ter_immediate
| CSEV_I : tag_ter_immediate
| ZSZ_I : tag_ter_immediate
| ZSNZ_I : tag_ter_immediate
| ZSN_I : tag_ter_immediate
| ZSNN_I : tag_ter_immediate
| ZSP_I : tag_ter_immediate
| ZSNP_I : tag_ter_immediate
| ZSOD_I : tag_ter_immediate
| ZSEV_I : tag_ter_immediate
(*push_j and pushgo *)
| PUSHJ_I : tag_ter_immediate
| PUSHGO_I : tag_ter_immediate
            (* LDTVS *)
| LDTVS_I : tag_ter_immediate.

(* this is tag for instructions with the form (tag reg imm reg) *)
Inductive tag_ter_immediate2 :=
(* NEG and NEGU *)
| NEG : tag_ter_immediate2
| NEGU : tag_ter_immediate2.

(* this is tag for instructions with the form (tag imm reg reg) *)
Inductive tag_ter_immediate3 :=
(* preld prest prego *)
| PRELD : tag_ter_immediate3
| PREGO : tag_ter_immediate3
(* syncid *)
| SYNCID : tag_ter_immediate3
(* syncd *)
| SYNCD : tag_ter_immediate3
(* stco instructions *)
| STCO : tag_ter_immediate3.

(* this is tag for instructions with the form (tag reg imm imm) *)
Inductive tag_ter_immediate4 :=
(* NEG and NEGU *)
| NEG_I : tag_ter_immediate4
| NEGU_I : tag_ter_immediate4.

(* this is tag for instructions with the form (tag imm imm imm) *)
Inductive tag_ter_immediate5 :=
  (* trip *)
| TRIP : tag_ter_immediate5
(* trap *)
| TRAP : tag_ter_immediate5
(* swym *)
| SWYM : tag_ter_immediate5.

(* this is tag for instructions with the form (tag imm reg imm) *)
Inductive tag_ter_immediate6 :=
(* stco *)
| STCO_I2 : tag_ter_immediate6
| STCO_I : tag_ter_immediate6.

(* this is tag for instructions with the form (tag reg imm) *)
Inductive tag_duo_immediate :=
(* floating point arithmetic *)
| FLOT_I : tag_duo_immediate
| FLOTU_I : tag_duo_immediate
(* Converstion of short float *)
| SFLOT_I : tag_duo_immediate
| SFLOTU_I : tag_duo_immediate
(* bitwise operation with 16 bit immediates value *)
| ORH_I : tag_duo_immediate
| ORMH_I : tag_duo_immediate
| ORML_I : tag_duo_immediate
| ORL_I : tag_duo_immediate
| ANDNH_I : tag_duo_immediate
| ANDNMH_I : tag_duo_immediate
| ANDNML_I : tag_duo_immediate
| ANDNL_I : tag_duo_immediate
(* SET ect... *)
| SETH_i : tag_duo_immediate
| SETMH_i : tag_duo_immediate
| SETML_i : tag_duo_immediate
| SETL_i : tag_duo_immediate
(* INCH ect.. *)
| INCH_i : tag_duo_immediate
| INCMH_i : tag_duo_immediate
| INCML_i : tag_duo_immediate
| INCL_i : tag_duo_immediate
(* BRANCHES *)
| BZ_i : tag_duo_immediate
| BNZ_i : tag_duo_immediate
| BN_i : tag_duo_immediate
| BNN_i : tag_duo_immediate
| BP_i : tag_duo_immediate
| BNP_i : tag_duo_immediate
| BOD_i : tag_duo_immediate
| BEV_i : tag_duo_immediate
| PBZ_i : tag_duo_immediate
| PBNZ_i : tag_duo_immediate
| PBN_i : tag_duo_immediate
| PBNN_i : tag_duo_immediate
| PBP_i : tag_duo_immediate
| PBNP_i : tag_duo_immediate
| PBOD_i : tag_duo_immediate
| PBEV_i : tag_duo_immediate
(* put and get *)
| GET_i : tag_duo_immediate.

(* this is tag for instructions with the form (tag imm reg) *)
(* TODO :: delete theese duplicate stuffs just for the scheme equality *)
Inductive tag_duo_immediate2 :=
(* put and get *)
| PUT_I : tag_duo_immediate2
| PUT_I2 : tag_duo_immediate2.

(* this is tag for instructions with the form (tag imm imm) *)
Inductive tag_duo_immediate3 :=
| POP : tag_duo_immediate3
          (* put and get *)
| PUT_II : tag_duo_immediate3.

(* this is tag for instructions with the form (tag reg reg) *)
Inductive tag_duo_normal :=
(* floating point arithmetic *)
| FLOT : tag_duo_normal
| FLOTU : tag_duo_normal
| FIX : tag_duo_normal
| FIXU : tag_duo_normal
(* Converstion of short float *)
| SFLOT : tag_duo_normal
| SFLOTU : tag_duo_normal.

Inductive tag_uno :=
  (* jumps with relative adress *)
| JMP : tag_uno
          (* save unsave *)
| SAVE : tag_uno
| UNSAVE : tag_uno
             (* resume *)
| RESUME : tag_uno
(* sync *)
| SYNC : tag_uno.

Inductive tag :=
| tag_t_n : tag_ter_normal -> tag
| tag_t_i : tag_ter_immediate -> tag
| tag_t_i2 : tag_ter_immediate2 -> tag
| tag_t_i3 : tag_ter_immediate3 -> tag
| tag_t_i4 : tag_ter_immediate4 -> tag
| tag_t_i5 : tag_ter_immediate5 -> tag
| tag_t_i6 : tag_ter_immediate6 -> tag
| tag_d_i : tag_duo_immediate -> tag
| tag_d_i2 : tag_duo_immediate2 -> tag
| tag_d_i3 : tag_duo_immediate3 -> tag
| tag_d_n : tag_duo_normal -> tag
| tag_u : tag_uno -> tag.

Scheme Equality for tag.

Lemma tag_beq_reflexivity : forall (t :tag), tag_beq t t = true.
Proof.
  destruct t ; destruct t ; reflexivity.
Qed.

Lemma tag_beq_different : forall (t1 t2 : tag), tag_beq t1 t2 = true -> t1 = t2.
Proof.
Admitted.

(* maybe it's not usefull to distinguish the special register than the
other because the specification says that you have different numbers for them *)

Inductive  imediate :=
  imm : nat -> imediate.
Inductive register :=
  reg : nat -> register.

Inductive operande :=
  | imm_o : imediate -> operande
  | reg_o : register -> operande.

(* instruction definition *)
Record instruction_tern_n :=
  mk_instr_t_n { instr_opcode_t_n : tag_ter_normal;
             instr_operande1_t_n : register ;
             instr_operande2_t_n : register ;
             instr_operande3_t_n : register }.

Record instruction_tern_i :=
  mk_instr_t_i { instr_opcode_t_i : tag_ter_immediate;
             instr_operande1_t_i : register ;
             instr_operande2_t_i : register ;
             instr_operande3_t_i : imediate }.

Record instruction_tern_i2 :=
  mk_instr_t_i2 { instr_opcode_t_i2 : tag_ter_immediate2;
             instr_operande1_t_i2 : register ;
             instr_operande2_t_i2 : imediate ;
             instr_operande3_t_i2 : register }.

Record instruction_tern_i3 :=
  mk_instr_t_i3 { instr_opcode_t_i3 : tag_ter_immediate3;
             instr_operande1_t_i3 : imediate ;
             instr_operande2_t_i3 : register ;
             instr_operande3_t_i3 : register }.

Record instruction_tern_i4 :=
  mk_instr_t_i4 { instr_opcode_t_i4 : tag_ter_immediate4;
             instr_operande1_t_i4 : register ;
             instr_operande2_t_i4 : imediate ;
             instr_operande3_t_i4 : imediate }.

Record instruction_tern_i5 :=
  mk_instr_t_i5 { instr_opcode_t_i5 : tag_ter_immediate5;
             instr_operande1_t_i5 : imediate ;
             instr_operande2_t_i5 : imediate ;
             instr_operande3_t_i5 : imediate }.

Record instruction_tern_i6 :=
  mk_instr_t_i6 { instr_opcode_t_i6 : tag_ter_immediate6;
             instr_operande1_t_i6 : imediate ;
             instr_operande2_t_i6 : register ;
             instr_operande3_t_i6 : imediate }.

Record instruction_duo_n :=
  mk_instr_d_n { instr_opcode_d_n : tag_duo_normal;
             instr_operande1_d_n : register ;
             instr_operande2_d_n : register }.

Record instruction_duo_i :=
  mk_instr_d_i { instr_opcode_d_i : tag_duo_immediate;
             instr_operande1_d_i : register ;
             instr_operande2_d_i : imediate }.

Record instruction_duo_i2 :=
  mk_instr_d_i2 { instr_opcode_d_i2 : tag_duo_immediate2;
             instr_operande1_d_i2 : imediate ;
             instr_operande2_d_i2 : register }.

Record instruction_duo_i3 :=
  mk_instr_d_i3 { instr_opcode_d_i3 : tag_duo_immediate3;
             instr_operande1_d_i3 : imediate ;
             instr_operande2_d_i3 : imediate }.

Record instruction_uno :=
  mk_instr_uno { instr_opcode_s : tag_uno;
                 instr_operande : imediate }.

Inductive instruction :=
| instr_t_n : instruction_tern_n -> instruction
| instr_t_i : instruction_tern_i -> instruction
| instr_t_i2 : instruction_tern_i2 -> instruction
| instr_t_i3 : instruction_tern_i3 -> instruction
| instr_t_i4 : instruction_tern_i4 -> instruction
| instr_t_i5 : instruction_tern_i5 -> instruction
| instr_t_i6 : instruction_tern_i6 -> instruction
| instr_d_n : instruction_duo_n -> instruction
| instr_d_i : instruction_duo_i -> instruction
| instr_d_n2 : instruction_duo_i2 -> instruction
| instr_d_n3 : instruction_duo_i3 -> instruction
| instr_u : instruction_uno -> instruction.
(* binary instruction definition *)
Definition binary_instruction := list bool.

(* some example to test the record structure *)
(* Example my_instr := mk_instr_t_i (tag_t_i ADD_I) (reg 10) (reg 11) (imm 12). *)

(* Example first_field_instr := my_instr.(instr_opcode_t_i).  *)