Require Export GeoCoq.Elements.OriginalProofs.lemma_equalanglesflip.
Require Export GeoCoq.Elements.OriginalProofs.proposition_16.
Require Export GeoCoq.Elements.OriginalProofs.lemma_angletrichotomy.
Require Export GeoCoq.Elements.OriginalProofs.lemma_collinearbetween.

Section Euclid.

Context `{Ax:euclidean_neutral_ruler_compass}.

Lemma proposition_27 :
   forall A B C D E F,
   BetS A E B -> BetS C F D -> CongA A E F E F D -> TS A E F D ->
   Par A B C D.
Proof.
intros.
assert (neq A B) by (forward_using lemma_betweennotequal).
assert (neq C D) by (forward_using lemma_betweennotequal).
rename_H H;let Tf:=fresh in
assert (Tf:exists H, (BetS A H D /\ Col E F H /\ nCol E F A)) by (conclude_def TS );destruct Tf as [H];spliter.
assert (Col A E B) by (conclude_def Col ).
assert (neq A E) by (forward_using lemma_betweennotequal).
assert (Col C F D) by (conclude_def Col ).
assert (neq F D) by (forward_using lemma_betweennotequal).
assert (CongA E F D A E F) by (conclude lemma_equalanglessymmetric).
assert (nCol E F D) by (conclude_def CongA ).
assert (neq E F) by (forward_using lemma_angledistinct).
assert (neq F E) by (conclude lemma_inequalitysymmetric).
assert (~ Meet A B C D).
 {
 intro.
 let Tf:=fresh in
 assert (Tf:exists G, (neq A B /\ neq C D /\ Col A B G /\ Col C D G)) by (conclude_def Meet );destruct Tf as [G];spliter.
 assert (Col B A G) by (forward_using lemma_collinearorder).
 assert (Col B A E) by (forward_using lemma_collinearorder).
 assert (neq B A) by (conclude lemma_inequalitysymmetric).
 assert (Col A G E) by (conclude lemma_collinear4).
 assert (Col A E G) by (forward_using lemma_collinearorder).
 assert (eq F F) by (conclude cn_equalityreflexive).
 assert (Out E F F) by (conclude lemma_ray4).
 assert (Supp A E F F B) by (conclude_def Supp ).
 assert (eq E E) by (conclude cn_equalityreflexive).
 assert (Out F E E) by (conclude lemma_ray4).
 assert (BetS D F C) by (conclude axiom_betweennesssymmetry).
 assert (Supp D F E E C) by (conclude_def Supp ).
 assert (CongA E F D D F E) by (conclude lemma_ABCequalsCBA).
 assert (CongA A E F D F E) by (conclude lemma_equalanglestransitive).
 assert (CongA F E B E F C) by (conclude lemma_supplements).
 assert (CongA B E F C F E) by (conclude lemma_equalanglesflip).
 assert (~ BetS A E G).
  {
  intro.
  assert (eq E E) by (conclude cn_equalityreflexive).
  assert (Col E F E) by (conclude_def Col ).
  assert (BetS G E A) by (conclude axiom_betweennesssymmetry).
  assert (Col C F D) by (conclude_def Col ).
  assert (Col C D F) by (forward_using lemma_collinearorder).
  assert (neq C D) by (forward_using lemma_betweennotequal).
  assert (Col D G F) by (conclude lemma_collinear4).
  assert (Col G F D) by (forward_using lemma_collinearorder).
  assert (~ eq F G).
   {
   intro.
   assert (Col A E F) by (conclude cn_equalitysub).
   assert (Col E F A) by (forward_using lemma_collinearorder).
   contradict.
   }
  assert (neq G F) by (conclude lemma_inequalitysymmetric).
  assert (~ Col E F G).
   {
   intro.
   assert (Col G F E) by (forward_using lemma_collinearorder).
   assert (Col F E D) by (conclude lemma_collinear4).
   assert (Col E F D) by (forward_using lemma_collinearorder).
   contradict.
   }
  assert (BetS D H A) by (conclude axiom_betweennesssymmetry).
  assert (OS D G E F) by (unfold OS;exists A;exists H;exists E;splits;auto).
  assert (OS G D E F) by (forward_using lemma_samesidesymmetric).
  assert (eq F F) by (conclude cn_equalityreflexive).
  assert (Col E F F) by (conclude_def Col ).
  assert (BetS D F C) by (conclude axiom_betweennesssymmetry).
  assert (TS D E F C) by (conclude_def TS ).
  assert (TS G E F C) by (conclude lemma_planeseparation).
  let Tf:=fresh in
  assert (Tf:exists R, (BetS G R C /\ Col E F R /\ nCol E F G)) by (conclude_def TS );destruct Tf as [R];spliter.
  assert (~ neq F R).
   {
   intro.
   assert (Col G R C) by (conclude_def Col ).
   assert (Col C G D) by (forward_using lemma_collinearorder).
   assert (Col C G R) by (forward_using lemma_collinearorder).
   assert (neq G C) by (forward_using lemma_betweennotequal).
   assert (neq C G) by (conclude lemma_inequalitysymmetric).
   assert (Col G C R) by (forward_using lemma_collinearorder).
   assert (Col G C D) by (forward_using lemma_collinearorder).
   assert (neq G C) by (conclude lemma_inequalitysymmetric).
   assert (neq R F) by (conclude lemma_inequalitysymmetric).
   assert (Col C G R) by (forward_using lemma_collinearorder).
   assert (Col C D F) by (forward_using lemma_collinearorder).
   assert (Col D F G) by (conclude lemma_collinear4).
   assert (Col D F C) by (forward_using lemma_collinearorder).
   assert (neq F D) by (forward_using lemma_betweennotequal).
   assert (neq D F) by (conclude lemma_inequalitysymmetric).
   assert (Col F G C) by (conclude lemma_collinear4).
   assert (Col C G F) by (forward_using lemma_collinearorder).
   assert (Col C G D) by (forward_using lemma_collinearorder).
   assert (Col R F D) by (conclude lemma_collinear5).
   assert (Col R F E) by (forward_using lemma_collinearorder).
   assert (Col F D E) by (conclude lemma_collinear4).
   assert (Col E F D) by (forward_using lemma_collinearorder).
   contradict.
   }
  assert (BetS G F C) by (conclude cn_equalitysub).
  assert (~ Col E G F).
   {
   intro.
   assert (Col E F G) by (forward_using lemma_collinearorder).
   contradict.
   }
  assert (Triangle E G F) by (conclude_def Triangle ).
  assert (LtA G E F E F C) by (conclude proposition_16).
  assert (LtA G E F F E B) by (conclude lemma_angleorderrespectscongruence).
  assert (eq F F) by (conclude cn_equalityreflexive).
  assert (Out E F F) by (conclude lemma_ray4).
  assert (Out E G B) by (conclude_def Out ).
  assert (~ Col G E F).
   {
   intro.
   assert (Col E G F) by (forward_using lemma_collinearorder).
   contradict.
   }
  assert (CongA G E F G E F) by (conclude lemma_equalanglesreflexive).
  assert (CongA G E F B E F) by (conclude lemma_equalangleshelper).
  assert (nCol B E F) by (conclude_def CongA ).
  assert (CongA B E F F E B) by (conclude lemma_ABCequalsCBA).
  assert (CongA G E F F E B) by (conclude lemma_equalanglestransitive).
  assert (CongA F E B G E F) by (conclude lemma_equalanglessymmetric).
  assert (LtA F E B F E B) by (conclude lemma_angleorderrespectscongruence2).
  assert (~ LtA F E B F E B) by (conclude lemma_angletrichotomy).
  contradict.
  }
 assert (~ Out E A G).
  {
  intro.
  assert (eq F F) by (conclude cn_equalityreflexive).
  assert (Out E F F) by (conclude lemma_ray4).
  assert (Out E G A) by (conclude lemma_ray5).
  assert (CongA E F D A E F) by (conclude lemma_equalanglessymmetric).
  assert (CongA E F D G E F) by (conclude lemma_equalangleshelper).
  assert (BetS B E A) by (conclude axiom_betweennesssymmetry).
  assert ((BetS E A G \/ eq G A \/ BetS E G A)) by (conclude lemma_ray1).
  assert (BetS B E G).
  by cases on (BetS E A G \/ eq G A \/ BetS E G A).
  {
   assert (BetS B E G) by (conclude lemma_3_7b).
   close.
   }
  {
   assert (BetS B E G) by (conclude cn_equalitysub).
   close.
   }
  {
   assert (BetS B E G) by (conclude axiom_innertransitivity).
   close.
   }
(** cases *)
  assert (BetS G E B) by (conclude axiom_betweennesssymmetry).
  assert (eq E E) by (conclude cn_equalityreflexive).
  assert (Col E F E) by (conclude_def Col ).
  assert (~ Col E F G).
   {
   intro.
   assert (Col B A G) by (forward_using lemma_collinearorder).
   assert (Col A E B) by (conclude_def Col ).
   assert (Col B A E) by (forward_using lemma_collinearorder).
   assert (Col A G E) by (conclude lemma_collinear4).
   assert (Col G E A) by (forward_using lemma_collinearorder).
   assert (Col G E F) by (forward_using lemma_collinearorder).
   assert (neq E G) by (forward_using lemma_betweennotequal).
   assert (neq G E) by (conclude lemma_inequalitysymmetric).
   assert (Col E A F) by (conclude lemma_collinear4).
   assert (Col E F A) by (forward_using lemma_collinearorder).
   contradict.
   }
  assert (OS A G E F) by (conclude_def OS ).
  assert (OS G A E F) by (forward_using lemma_samesidesymmetric).
  assert (TS G E F D) by (conclude lemma_planeseparation).
  let Tf:=fresh in
  assert (Tf:exists P, (BetS G P D /\ Col E F P /\ nCol E F G)) by (conclude_def TS );destruct Tf as [P];spliter.
  assert (Col G P D) by (conclude_def Col ).
  assert (~ neq P F).
   {
   intro.
   assert (neq G D) by (forward_using lemma_betweennotequal).
   assert (Col G D P) by (forward_using lemma_collinearorder).
   assert (Col C F D) by (conclude_def Col ).
   assert (Col C D F) by (forward_using lemma_collinearorder).
   assert (Col D G F) by (conclude lemma_collinear4).
   assert (Col G D F) by (forward_using lemma_collinearorder).
   assert (Col D P F) by (conclude lemma_collinear4).
   assert (Col P F D) by (forward_using lemma_collinearorder).
   assert (Col P F E) by (forward_using lemma_collinearorder).
   assert (Col F D E) by (conclude lemma_collinear4).
   assert (~ Col F D E).
    {
    intro.
    assert (Col E F D) by (forward_using lemma_collinearorder).
    contradict.
    }
   contradict.
   }
  assert (BetS G F D) by (conclude cn_equalitysub).
  assert (~ Col F E A).
   {
   intro.
   assert (Col E F A) by (forward_using lemma_collinearorder).
   contradict.
   }
  assert (CongA F E A F E A) by (conclude lemma_equalanglesreflexive).
  assert (CongA F E A F E G) by (conclude lemma_equalangleshelper).
  assert (CongA F E G F E A) by (conclude lemma_equalanglessymmetric).
  assert (nCol F E G) by (conclude_def CongA ).
  assert (~ Col E G F).
   {
   intro.
   assert (Col F E G) by (forward_using lemma_collinearorder).
   contradict.
   }
  assert (Triangle E G F) by (conclude_def Triangle ).
  assert (LtA G E F E F D) by (conclude proposition_16).
  assert (LtA E F D E F D) by (conclude lemma_angleorderrespectscongruence2).
  assert (~ LtA E F D E F D) by (conclude lemma_angletrichotomy).
  contradict.
  }
 assert ((eq A E \/ eq A G \/ eq E G \/ BetS E A G \/ BetS A E G \/ BetS A G E)) by (conclude_def Col ).
 assert (~ Meet A B C D).
 by cases on (eq A E \/ eq A G \/ eq E G \/ BetS E A G \/ BetS A E G \/ BetS A G E).
 {
  assert (~ Meet A B C D).
   {
   intro.
   contradict.
   }
  close.
  }
 {
  assert (~ neq H F).
   {
   intro.
   assert (Col C D F) by (forward_using lemma_collinearorder).
   assert (Col D G F) by (conclude lemma_collinear4).
   assert (Col D A F) by (conclude cn_equalitysub).
   assert (Col A H D) by (conclude_def Col ).
   assert (Col D A H) by (forward_using lemma_collinearorder).
   assert (neq A D) by (forward_using lemma_betweennotequal).
   assert (neq D A) by (conclude lemma_inequalitysymmetric).
   assert (Col A F H) by (conclude lemma_collinear4).
   assert (Col H F A) by (forward_using lemma_collinearorder).
   assert (Col H F E) by (forward_using lemma_collinearorder).
   assert (Col F A E) by (conclude lemma_collinear4).
   assert (Col E F A) by (forward_using lemma_collinearorder).
   contradict.
   }
  assert (BetS A F D) by (conclude cn_equalitysub).
  assert (~ Col E A F).
   {
   intro.
   assert (Col E F A) by (forward_using lemma_collinearorder).
   contradict.
   }
  assert (Triangle E A F) by (conclude_def Triangle ).
  assert (LtA A E F E F D) by (conclude proposition_16).
  assert (CongA E F D A E F) by (conclude lemma_equalanglessymmetric).
  assert (LtA E F D E F D) by (conclude lemma_angleorderrespectscongruence2).
  assert (~ Meet A B C D).
   {
   intro.
   assert (~ LtA E F D E F D) by (conclude lemma_angletrichotomy).
   contradict.
   }
  close.
  }
 {
  assert (Col C D E) by (conclude cn_equalitysub).
  assert (Col C D F) by (forward_using lemma_collinearorder).
  assert (Col D E F) by (conclude lemma_collinear4).
  assert (Col E F D) by (forward_using lemma_collinearorder).
  assert (~ neq E F).
   {
   intro.
   assert (Col F D H) by (conclude lemma_collinear4).
   assert (Col D H F) by (forward_using lemma_collinearorder).
   assert (Col A H D) by (conclude_def Col ).
   assert (Col D H A) by (forward_using lemma_collinearorder).
   assert (neq H D) by (forward_using lemma_betweennotequal).
   assert (neq D H) by (conclude lemma_inequalitysymmetric).
   assert (Col H F A) by (conclude lemma_collinear4).
   assert (Col H F E) by (forward_using lemma_collinearorder).
   assert (~ neq H F).
    {
    intro.
    assert (Col F A E) by (conclude lemma_collinear4).
    assert (Col E F A) by (forward_using lemma_collinearorder).
    contradict.
    }
   assert (Col A H D) by (conclude_def Col ).
   assert (Col A F D) by (conclude cn_equalitysub).
   assert (Col D F A) by (forward_using lemma_collinearorder).
   assert (Col D F C) by (forward_using lemma_collinearorder).
   assert (neq H D) by (forward_using lemma_betweennotequal).
   assert (neq D H) by (conclude lemma_inequalitysymmetric).
   assert (neq D F) by (conclude cn_equalitysub).
   assert (Col F A C) by (conclude lemma_collinear4).
   assert (Col C F A) by (forward_using lemma_collinearorder).
   assert (Col D C G) by (forward_using lemma_collinearorder).
   assert (Col C D F) by (forward_using lemma_collinearorder).
   assert (Col D C F) by (forward_using lemma_collinearorder).
   assert (neq D C) by (conclude lemma_inequalitysymmetric).
   assert (Col C G F) by (conclude lemma_collinear4).
   assert (Col C F G) by (forward_using lemma_collinearorder).
   assert (~ neq C F).
    {
    intro.
    assert (Col F A G) by (conclude lemma_collinear4).
    assert (Col F A E) by (conclude cn_equalitysub).
    assert (Col E F A) by (forward_using lemma_collinearorder).
    contradict.
    }
   assert (Col A H D) by (conclude_def Col ).
   assert (Col A C D) by (conclude cn_equalitysub).
   assert (Col C D A) by (forward_using lemma_collinearorder).
   assert (Col F D A) by (conclude cn_equalitysub).
   assert (Col C D E) by (conclude cn_equalitysub).
   assert (Col F D E) by (conclude cn_equalitysub).
   assert (Col D F E) by (forward_using lemma_collinearorder).
   assert (Col D F A) by (forward_using lemma_collinearorder).
   assert (neq D F) by (conclude cn_equalitysub).
   assert (Col F E A) by (conclude lemma_collinear4).
   assert (Col E F A) by (forward_using lemma_collinearorder).
   contradict.
   }
  assert (Col E F A) by (conclude_def Col ).
  assert (~ Meet A B C D).
   {
   intro.
   contradict.
   }
  close.
  }
 {
  assert (neq E A) by (forward_using lemma_betweennotequal).
  assert (Out E A G) by (conclude lemma_ray4).
  assert (~ Meet A B C D).
   {
   intro.
   contradict.
   }
  close.
  }
 {
  assert (~ Meet A B C D).
   {
   intro.
   contradict.
   }
  close.
  }
 {
  assert (BetS E G A) by (conclude axiom_betweennesssymmetry).
  assert (neq E A) by (forward_using lemma_betweennotequal).
  assert (Out E A G) by (conclude lemma_ray4).
  assert (~ Meet A B C D).
   {
   intro.
   contradict.
   }
  close.
  }
(** cases *)
 contradict.
 }
assert (eq A A) by (conclude cn_equalityreflexive).
assert (Col A B A) by (conclude_def Col ).
assert (Col A B E) by (conclude_def Col ).
assert (eq D D) by (conclude cn_equalityreflexive).
assert (Col C D D) by (conclude_def Col ).
assert (Col C D F) by (conclude_def Col ).
assert (neq A E) by (forward_using lemma_betweennotequal).
assert (neq F D) by (forward_using lemma_betweennotequal).
assert (BetS E H F) by (conclude lemma_collinearbetween).
assert (BetS F H E) by (conclude axiom_betweennesssymmetry).
assert (Par A B C D) by (conclude_def Par ).
close.
Qed.

End Euclid.


Require Import CoqStock.DubStep.
Require Import CoqStock.Invs.
Require Import CoqStock.List.
Require Import CoqStock.Listerine.
Require Import CoqStock.Untie.
Require Import CoqStock.WreckIt.

Require Import Brzozowski.Alphabet.
Require Import Brzozowski.ConcatLang.
Require Import Brzozowski.Decidable.
Require Import Brzozowski.Regex.
Require Import Brzozowski.Language.
Require Import Brzozowski.LogicOp.
Require Import Brzozowski.Null.

(*
  It is clear that:

  $$
  \begin{aligned}
  \nu(a) & = \emptyset\ \text{for any}\ a \in \Sigma_k, \\
  \nu(\epsilon) & = \epsilon, \text{and} \\
  \nu(\emptyset) & = \emptyset . \\
  \end{aligned}
  $$
*)

Theorem null_emptystr_is_emptystr: null emptystr emptystr.
Proof.
apply null_emptystr.
constructor.
Qed.

Theorem null_emptyset_is_emptyset: null emptyset emptyset.
Proof.
apply null_emptyset.
unfold not.
intros.
inversion H.
Qed.

Theorem null_symbol_is_emptyset: forall (a: alphabet),
    null (symbol a) emptyset.
Proof.
intros.
apply null_emptyset.
unfold not.
intros.
inversion H.
Qed.

(*
    Furthermore

    $$
    \begin{aligned}
    \nu(P* ) &= \epsilon\ \text{(by definition of * ), and} \\
    \nu(P.Q) &= \nu(P)\ \&\ \nu(Q).
    \end{aligned}
    $$
*)

(* \nu(P* ) = \epsilon\ *)
Theorem null_star_is_emptystr: forall (r: regex),
    null (star r) emptystr.
Proof.
intros.
apply null_emptystr.
constructor.
Qed.

Theorem null_concat_is_and_emptystr: forall (p q: regex),
    null p emptystr ->
    null q emptystr ->
    null (concat p q) emptystr.
Proof.
intros.
constructor.
destruct_concat_lang.
exists [].
exists [].
assert ([] ++ [] = (@nil alphabet)). cbn. reflexivity.
exists H1.
split.
- inversion H.
  exact H2.
- inversion H0.
  exact  H2.
Qed.

(* \nu(P.Q) = \nu(P)\ \&\ \nu(Q) *)
Theorem null_concat_is_and:
  forall (p q: regex)
         (dp dq: regex)
         (dc: regex)
         (null_p: null p dp)
         (null_q: null q dq),
  null (concat p q) (null_and dp dq).
Proof.
intros.
invs null_p; invs null_q; cbn; constructor; try untie.
- destruct_concat_lang.
  exists []. exists []. exists eq_refl.
  split; assumption.
- invs H1. wreckit. listerine. subst.
  apply H0. assumption.
- invs H1. wreckit. listerine. subst.
  apply H. assumption.
- invs H1. wreckit. listerine. subst.
  apply H. assumption.
Qed.

Theorem null_concat_is_and_emptyset_r: forall (p q: regex),
    null p emptyset ->
    null q emptystr ->
    null (concat p q) emptyset.
Proof.
(*TODO: Good First Issue *)
Abort.

Theorem null_concat_is_and_emptyset_l: forall (p q: regex),
    null p emptystr ->
    null q emptyset ->
    null (concat p q) emptyset.
Proof.
(* TODO: Good First Issue *)
Abort.

Theorem null_concat_is_and_emptyset: forall (p q: regex),
    null p emptyset ->
    null q emptyset ->
    null (concat p q) emptyset.
Proof.
(* TODO: Good First Issue *)
Abort.

(* \nu(P + Q) = \nu(P) + \nu(Q) *)
Theorem null_or_is_or:
  forall
    (p q: regex)
    (pn qn: regex)
    (null_p: null p pn)
    (null_q: null q qn),
    null (or p q) (null_or pn qn).
Proof.
intros.
invs null_p; invs null_q; cbn; constructor; cbn.
- constructor. auto.
- constructor. auto.
- constructor. auto.
- untie. invs H1. wreckit; contradiction.
Qed.

(* \nu(P\ \&\ Q) = \nu(P)\ \&\ \nu(Q). *)
Theorem null_and_is_and:
  forall
    (p q: regex)
    (dp dq: regex)
    (null_p: null p dp)
    (null_q: null q dq),
    null (and p q) (null_and dp dq).
Proof.
intros.
invs null_p; invs null_q; cbn; constructor; cbn;
  try constructor;
  untie.
- invs H1. destruct H2.
  + invs H1. contradiction.
  + invs H1. contradiction.
- invs H1. destruct H2.
  constructor. right. constructor. assumption.
- invs H1. destruct H2.
  constructor. left. constructor. assumption.
- invs H1. destruct H2.
  constructor. left. constructor. assumption.
Qed.

(*
\nu(P') = \epsilon\ \text{if}\ \nu(P) = \emptyset \\
\nu(P') = \emptyset\ \text{if}\ \nu(P) = \epsilon
*)
Theorem null_neg_is_neg:
  forall
    (p: regex)
    (dp: regex)
    (null_p: null p dp),
    null (neg p) (null_neg dp).
Proof.
intros.
invs null_p; cbn; constructor.
- untie.
  cbn in H0.
  invs H0.
  contradiction.
- cbn.
  constructor.
  assumption.
Qed.

Theorem null_or_emptystr: forall (p q: regex),
    null p emptystr ->
    null q emptystr ->
    null (or p q) emptystr.
Proof.
(* TODO: Good First Issue *)
Abort.

Theorem null_or_emptystr_l: forall (p q: regex),
    null p emptystr ->
    null q emptyset ->
    null (or p q) emptystr.
Proof.
(* TODO: Good First Issue *)
Abort.

Theorem null_or_emptystr_r: forall (p q: regex),
    null p emptyset ->
    null q emptystr ->
    null (or p q) emptystr.
Proof.
(* TODO: Good First Issue *)
Abort.

Theorem null_or_emptyset: forall (p q: regex),
    null p emptyset ->
    null q emptyset ->
    null (or p q) emptyset.
Proof.
(* TODO: Good First Issue *)
Abort.

Theorem null_and_emptystr: forall (p q: regex),
    null p emptystr ->
    null q emptystr ->
    null (and p q) emptystr.
Proof.
(* TODO: Good First Issue *)
Abort.

Theorem null_and_l_emptyset: forall (p q: regex),
  null p emptyset ->
  null (and p q) emptyset.
Proof.
(* TODO: Good First Issue *)
Abort.

Theorem null_and_emptyset_l: forall (p q: regex),
    null p emptyset ->
    null q emptystr ->
    null (and p q) emptyset.
Proof.
(* TODO: Good First Issue *)
Abort.

Theorem null_and_r_emptyset: forall (p q: regex),
  null q emptyset ->
  null (and p q) emptyset.
Proof.
intros.
constructor.
untie.
invs H0.
apply H1.
invs H.
constructor.
right.
cbn.
constructor.
assumption.
Qed.

Theorem null_and_emptyset_r: forall (p q: regex),
    null p emptystr ->
    null q emptyset ->
    null (and p q) emptyset.
Proof.
intros.
apply null_and_r_emptyset.
assumption.
Qed.

Theorem null_and_emptyset: forall (p q: regex),
    null p emptyset ->
    null q emptyset ->
    null (and p q) emptyset.
Proof.
intros.
apply null_and_r_emptyset.
assumption.
Qed.

Theorem null_and_emptyset_either: forall (p q: regex),
    null p emptyset \/
    null q emptyset ->
    null (and p q) emptyset.
Proof.
intros.
destruct H.
- constructor.
  untie.
  invs H0.
  apply H1.
  constructor.
  invs H.
  left.
  cbn.
  constructor.
  assumption.
- constructor.
  untie.
  invs H0.
  invs H.
  apply H1.
  constructor.
  right.
  cbn.
  constructor.
  assumption.
Qed.

Theorem null_neg_emptyset: forall (r: regex),
    null r emptystr ->
    null (neg r) emptyset.
Proof.
intros.
constructor.
invs H.
cbn.
untie.
invs H.
contradiction.
Qed.

Theorem null_neg_emptystr_emptyset:
  null (neg emptystr) emptyset.
Proof.
apply null_neg_emptyset.
apply null_emptystr_is_emptystr.
Qed.

Theorem null_neg_emptystr: forall (r: regex),
    null r emptyset ->
    null (neg r) emptystr.
Proof.
intros.
constructor.
invs H.
cbn.
constructor.
assumption.
Qed.

Theorem null_is_null_def:
  forall (r: regex),
  null r (null_def r).
Proof.
intros.
induction r.
- cbn.
  apply null_emptyset.
  untie.
- cbn.
  apply null_emptystr.
  constructor.
- cbn.
  apply null_emptyset.
  untie.
  invs H.
- cbn.
  invs IHr1; invs IHr2.
  + apply null_emptystr.
    constructor.
    auto.
  + apply null_emptystr.
    constructor.
    auto.
  + apply null_emptystr.
    constructor.
    auto.
  + apply null_emptyset.
    untie.
    invs H2.
    invs H4; contradiction.
- cbn.
  invs IHr.
  + apply null_emptyset.
    cbn.
    untie.
    invs H0.
    contradiction.
  + apply null_emptystr.
    cbn.
    constructor.
    assumption.
- cbn.
  invs IHr1;
  invs IHr2.
  + apply null_emptystr.
    destruct_concat_lang.
    exists [].
    exists [].
    exists eq_refl.
    split; assumption.
  + apply null_emptyset.
    untie.
    invs H2.
    wreckit.
    listerine.
    contradiction.
  + apply null_emptyset.
    untie.
    invs H2.
    wreckit.
    listerine.
    contradiction.
  + apply null_emptyset.
    untie.
    invs H2.
    wreckit.
    listerine.
    contradiction.
- cbn.
  apply null_emptystr.
  constructor.
Qed.

Theorem null_def_implies_null:
  forall (r s: regex),
  null_def r = s -> null r s.
Proof.
intros.
rewrite <- H.
apply null_is_null_def.
Qed.

Theorem null_def_is_emptystr_or_emptyset: forall (r: regex),
  (null_def r = emptystr) \/ (null_def r = emptyset).
Proof.
intros.
induction r.
- cbn. auto.
- cbn. auto.
- cbn. auto.
- cbn. destruct IHr1; destruct IHr2; rewrite H; (try rewrite H0); auto.
- cbn. destruct IHr; rewrite H; cbn; auto.
- cbn. destruct IHr1; destruct IHr2; rewrite H; (try rewrite H0); auto.
- cbn. auto.
Qed.

Theorem null_implies_null_def:
  forall (r s: regex),
  null r s -> null_def r = s.
Proof.
intros.
inversion_clear H.
- induction r.
  + inversion H0.
  + cbn. reflexivity.
  + inversion H0.
  + invs H0. wreckit.
    * apply IHr1 in H as B1.
      cbn.
      rewrite B1.
      reflexivity.
    * apply IHr2 in H as B1.
      cbn.
      rewrite B1.
      specialize null_def_is_emptystr_or_emptyset with (r := r1).
      intros.
      destruct H0; rewrite H0; reflexivity.
  + invs H0.
    cbn.
    specialize null_def_is_emptystr_or_emptyset with (r := r).
    intros.
    destruct H0.
    * apply null_def_implies_null in H0.
      invs H0.
      contradiction.
    * rewrite H0.
      cbn.
      reflexivity.
  + invs H0. listerine. subst.
    remember (IHr1 H1).
    remember (IHr2 H2).
    cbn.
    rewrite e.
    rewrite e0.
    reflexivity.
  + cbn. reflexivity.
- induction r.
  + cbn. reflexivity.
  + exfalso.
    apply H0.
    constructor.
  + cbn. reflexivity.
  + cbn.
    specialize null_def_is_emptystr_or_emptyset with (r := r1).
    specialize null_def_is_emptystr_or_emptyset with (r := r2).
    intros Dr1 Dr2.
    destruct Dr1, Dr2; rewrite H; (try rewrite H1);
    apply null_def_implies_null in H;
    apply null_def_implies_null in H1;
    invs H; invs H1.
    * exfalso. apply H0. cbn. constructor. auto.
    * exfalso. apply H0. cbn. constructor. auto.
    * exfalso. apply H0. cbn. constructor. auto.
    * reflexivity.
  + cbn.
    specialize null_def_is_emptystr_or_emptyset with (r := r).
    intros Dr.
    cbn in H0.
    destruct Dr; rewrite H; cbn;
    apply null_def_implies_null in H.
    * reflexivity.
    * invs H. exfalso. apply H0. constructor. assumption.
  + cbn.
    remember (null_def r1) as dr1.
    remember (null_def r2) as dr2.
    symmetry in Heqdr1.
    symmetry in Heqdr2.
    apply null_def_implies_null in Heqdr1.
    apply null_def_implies_null in Heqdr2.
    induction dr1; inversion_clear Heqdr1.
    * reflexivity.
    * induction dr2; inversion_clear Heqdr2.
      -- reflexivity.
      -- exfalso.
         apply H0.
         destruct_concat_lang.
         exists [].
         exists [].
         exists eq_refl.
         split; assumption.
  + exfalso.
    apply H0.
    constructor.
Qed.

Theorem null_iff_null_def:
  forall (r s: regex),
  null_def r = s <-> null r s.
Proof.
split.
apply null_def_implies_null.
apply null_implies_null_def.
Qed.

Theorem null_is_emptystr_or_emptyset (r: regex):
  null_def r = emptystr \/ null_def r = emptyset.
Proof.
induction r.
- right.
  cbn; reflexivity.
- left.
  cbn; reflexivity.
- right.
  cbn; reflexivity.
- wreckit; (cbn;
  try rewrite IHr0;
  try rewrite IHr3);
  auto.
- wreckit; cbn; rewrite IHr; auto.
- wreckit; (cbn;
    try rewrite IHr0;
    try rewrite IHr3);
    auto.
- left.
  cbn.
  reflexivity.
Qed.

Theorem null_only_emptyset_or_emptystr (r: regex):
  null r emptyset \/ null r emptystr.
Proof.
specialize denotation_is_decidable with (r := r) (s := []).
intros.
destruct H.
- right. constructor. assumption.
- left. constructor. assumption.
Qed.


(***************************************************************************)
(* Formalization of the Chou, Gao and Zhang's decision procedure.          *)
(* Julien Narboux (Julien@narboux.fr)                                      *)
(* LIX/INRIA FUTURS 2004-2006                                              *)
(* University of Strasbourg 2008                                           *)
(***************************************************************************)

Require Import area_method.

Lemma midpoint_elim : forall O A B,
 on_line_d O A B (1 / 2) ->
 O<>A ->
 B ** O / O ** A =1.
Proof.
intros.
unfold on_line_d in H.
use H.
assert (B**A + A**O = B**O) by auto with Geom.
rewrite <- H.
replace (O**A) with (- A**O).
rewrite H4.
uniformize_dir_seg.
field.
split;auto with Geom.
symmetry;auto with Geom.
Qed.

Lemma l6_15 : forall A B O C D r,
  is_midpoint O A B ->
  on_line_d C O A r ->
  on_line_d D O A (1/r) ->
  r <> 0 ->
  parallel A C C B ->
  parallel D A D B ->
  C<>B ->
  D<>B ->
  A<>D ->
  A<>C ->
  r+1 <> 0 ->
  harmonic A B C D.
Proof.
geoInit.
eliminate D.
replace (A ** O / O ** A) with (0-1).
eliminate C.
replace (A ** O / O ** A) with (0-1).
replace (B ** O / O ** A) with (1).
field.
repeat split;auto with field_hints.
symmetry;apply midpoint_elim;auto.
replace (A**O) with (- O**A) by (symmetry; auto with Geom).
field;auto with Geom.
intuition.
replace (A**O) with (- O**A) by (symmetry; auto with Geom).
field;auto with Geom.
intuition.
intuition.
Qed.

Lemma l_6_295 : forall A B C D F P Q R S,
on_foot F B A C ->
on_line D B F ->
is_midpoint P A B ->
is_midpoint Q B C ->
is_midpoint R C D ->
is_midpoint S D A ->
eq_distance S Q P R.
Proof.
geoInit.
eliminate S.
eliminate R.
repeat rewrite <- Fmult_Fplus_distr.
apply f_equal2.
auto.
apply f_equal2.
auto.
eliminate D.
eliminate F.
eliminate Q.
eliminate P.
basic_simpl.
unfold_Py.
uniformize_dir_seg.
field;decomp_all_non_zero_mult_div;solve_conds.
Qed.

Lemma l6_63 : forall A B C D E H,
on_foot D C A B ->
on_foot E B A C ->
inter_ll H C D B E ->
Py C H D = Py B H E.
Proof.
geoInit.
eliminate H.
smart_field_simplify_eq.
ring_simplify_eq.
eliminate D.
smart_field_simplify_eq.
eliminate E.
smart_field_simplify_eq.
uniformize_pys.
unfold_Py.
uniformize_signed_areas.
uniformize_dir_seg.
basic_simpl.
ring.
Qed.

Lemma l_6_273 : forall B C X A A1 C1,
 on_perp_d A B C 1 ->
 on_foot A1 A B X ->
 on_foot C1 C B X ->
 eq_distance A A1 B C1.
Proof.
am_before_field.
field_simplify_eq;auto.
replace (- (2 * (2 * (2 * 2))) * S B C X * S B C X) with (- (2 * (2 * (2 * 2))) * ( S B C X * S B C X) ) by ring.
rewrite (herron_qin B C X).
unfold_Py.
uniformize_dir_seg.
field_and_conclude.
solve_conds.
unfold not;intro H1; rewrite H1 in *; basic_simpl;intuition.
Qed.

Lemma l6_144 : forall A B I A1 A2 B1 B2 C,
on_foot A1 B I A ->
on_line_d A2 A1 B (0-1) ->
on_foot B1 A I B ->
on_line_d B2 B1 A (0-1) ->
inter_ll C A A2 B B2 ->
eq_angle A C I I C B.
Proof.
geoInit.
eliminate C.
smart_field_simplify_eq.
eliminate A2.
eliminate A1.
eliminate B2.
replace (1 - (0 - 1)) with 2 in * by ring.
eliminate B1.
uniformize_signed_areas.
unfold_Py;uniformize_dir_seg.
basic_simpl.
field.
solve_conds.
intro;rewrite H1 in H; basic_simpl;intuition.
intro;rewrite H1 in H0; basic_simpl;intuition.
Qed.

(* Napoleon Triangle *)

Lemma l_6_191 : forall A B C  E F G O1 O2 O3 r,
 1+2<>0 ->
 r*r = (2+1) ->
 is_midpoint E A C ->
 on_perp_d O2 E A (r / (2+1)) ->
 is_midpoint F B C ->
 on_perp_d O1 F C (r / (2+1)) ->
 is_midpoint G A B ->
 on_perp_d O3 G B (r/ (2+1)) ->
 eq_distance O1 O2 O2 O3.
Proof.
geoInit.
am_before_field.
uniformize_signed_areas.
uniformize_pys.
unfold_Py.
uniformize_dir_seg.
basic_simpl.
field_simplify_eq.
ring_simplify_eq.
assert (r * r * A ** B * A ** B = ( r * r) * A ** B * A ** B).
ring.
replace (-
(2 *
 (2 *
  (2 *
   (2 *
    (2 *
     (2 *
      (2 *
       (2 *
        (2 *
         (2 *
          (2 *
           (2 *
            (2 *
             (2 *
              (2 *
               (2 *
                (2 *
                 (2 *
                  (2 *
                   (2 *
                    (2 *
                     (2 *
                      (2 *
                       (2 *
                        (2 *
                         (2 *
                          (2 *
                           (2 *
                            (2 *
                             (2 *
                              (2 *
                               (2 *
                                (2 *
                                 (2 *
                                  (2 *
                                   (2 *
                                    (2 *
                                     (2 *
                                      (2 *
                                       (1 +
                                        2 *
                                        (1 +
                                         2 *
                                         (2 *
                                          (1 +
                                           2 *
                                           (2 *
                                            (1 +
                                             2 *
                                             (1 +
                                              2 *
                                              (2 *
                                               (2 *
                                                (1 +
                                                 2 *
                                                 (2 *
                                                  (2 *
                                                   (1 +
                                                    2 *
                                                    (1 +
                                                     2 *
                                                     (1 +
                                                      2 *
                                                      (1 +
                                                       2 *
                                                       (2 *
                                                        (1 +
                                                         2 *
                                                         (2 *
                                                          (1 +
                                                           2 *
                                                           (1 +
                                                            2 * (2 * (1 + 2)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) *
r * r * A ** B * A ** B) with (-
(2 *
 (2 *
  (2 *
   (2 *
    (2 *
     (2 *
      (2 *
       (2 *
        (2 *
         (2 *
          (2 *
           (2 *
            (2 *
             (2 *
              (2 *
               (2 *
                (2 *
                 (2 *
                  (2 *
                   (2 *
                    (2 *
                     (2 *
                      (2 *
                       (2 *
                        (2 *
                         (2 *
                          (2 *
                           (2 *
                            (2 *
                             (2 *
                              (2 *
                               (2 *
                                (2 *
                                 (2 *
                                  (2 *
                                   (2 *
                                    (2 *
                                     (2 *
                                      (2 *
                                       (1 +
                                        2 *
                                        (1 +
                                         2 *
                                         (2 *
                                          (1 +
                                           2 *
                                           (2 *
                                            (1 +
                                             2 *
                                             (1 +
                                              2 *
                                              (2 *
                                               (2 *
                                                (1 +
                                                 2 *
                                                 (2 *
                                                  (2 *
                                                   (1 +
                                                    2 *
                                                    (1 +
                                                     2 *
                                                     (1 +
                                                      2 *
                                                      (1 +
                                                       2 *
                                                       (2 *
                                                        (1 +
                                                         2 *
                                                         (2 *
                                                          (1 +
                                                           2 *
                                                           (1 +
                                                            2 * (2 * (1 + 2)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) *
(r * r) * A ** B * A ** B).
2:ring.
rewrite H0.
replace (2 *
(2 *
 (2 *
  (2 *
   (2 *
    (2 *
     (2 *
      (2 *
       (2 *
        (2 *
         (2 *
          (2 *
           (2 *
            (2 *
             (2 *
              (2 *
               (2 *
                (2 *
                 (2 *
                  (2 *
                   (2 *
                    (2 *
                     (2 *
                      (2 *
                       (2 *
                        (2 *
                         (2 *
                          (2 *
                           (2 *
                            (2 *
                             (2 *
                              (2 *
                               (2 *
                                (2 *
                                 (2 *
                                  (2 *
                                   (2 *
                                    (2 *
                                     (2 *
                                      (1 +
                                       2 *
                                       (1 +
                                        2 *
                                        (2 *
                                         (1 +
                                          2 *
                                          (2 *
                                           (1 +
                                            2 *
                                            (1 +
                                             2 *
                                             (2 *
                                              (2 *
                                               (1 +
                                                2 *
                                                (2 *
                                                 (2 *
                                                  (1 +
                                                   2 *
                                                   (1 +
                                                    2 *
                                                    (1 +
                                                     2 *
                                                     (1 +
                                                      2 *
                                                      (2 *
                                                       (1 +
                                                        2 *
                                                        (2 *
                                                         (1 +
                                                          2 *
                                                          (1 +
                                                           2 * (2 * (1 + 2))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) *
r * r * B ** C * B ** C)
with
(2 *
(2 *
 (2 *
  (2 *
   (2 *
    (2 *
     (2 *
      (2 *
       (2 *
        (2 *
         (2 *
          (2 *
           (2 *
            (2 *
             (2 *
              (2 *
               (2 *
                (2 *
                 (2 *
                  (2 *
                   (2 *
                    (2 *
                     (2 *
                      (2 *
                       (2 *
                        (2 *
                         (2 *
                          (2 *
                           (2 *
                            (2 *
                             (2 *
                              (2 *
                               (2 *
                                (2 *
                                 (2 *
                                  (2 *
                                   (2 *
                                    (2 *
                                     (2 *
                                      (1 +
                                       2 *
                                       (1 +
                                        2 *
                                        (2 *
                                         (1 +
                                          2 *
                                          (2 *
                                           (1 +
                                            2 *
                                            (1 +
                                             2 *
                                             (2 *
                                              (2 *
                                               (1 +
                                                2 *
                                                (2 *
                                                 (2 *
                                                  (1 +
                                                   2 *
                                                   (1 +
                                                    2 *
                                                    (1 +
                                                     2 *
                                                     (1 +
                                                      2 *
                                                      (2 *
                                                       (1 +
                                                        2 *
                                                        (2 *
                                                         (1 +
                                                          2 *
                                                          (1 +
                                                           2 * (2 * (1 + 2))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) *
(r * r) * B ** C * B ** C).
rewrite H0.
ring.
ring.
solve_conds.
Qed.


Require Import AutoSep Malloc.

Definition bag := W * W -> nat.

Theorem W_W_dec : forall x y : W * W, {x = y} + {x <> y}.
  decide equality; apply weq.
Qed.

Definition mem (p : W * W) (b : bag) := (b p > 0)%nat.
Infix "%in" := mem (at level 70, no associativity).

Definition empty : bag := fun _ => O.

Definition equiv (b1 b2 : bag) := forall p, b1 p = b2 p.
Infix "%=" := equiv (at level 70, no associativity).

Definition add (b : bag) (p : W * W) : bag := fun p' => if W_W_dec p' p then S (b p') else b p'.
Infix "%+" := add (at level 50, left associativity).

Definition del (b : bag) (p : W * W) : bag := fun p' => if W_W_dec p' p then pred (b p') else b p'.
Infix "%-" := del (at level 50, left associativity).

Ltac bags := subst;
  repeat match goal with
           | [ H : _ %= _ |- _ ] => generalize dependent H
           | [ H : _ %in _ |- _ ] => generalize dependent H
           | [ H : ~ _ %in _ |- _ ] => generalize dependent H
           | [ H : _ \is _ |- _ ] => generalize dependent H
           | [ H : @eq W _ _ |- _ ] => generalize dependent H
           | [ H : ~(@eq W _ _) |- _ ] => generalize dependent H
         end; clear;
  unfold equiv, empty, mem, add, del, propToWord, IF_then_else; intuition idtac;
    repeat (match goal with
              | [ H : (_, _) = (_, _) |- _ ] => injection H; clear H; intros; subst
              | [ |- context[if ?E then _ else _] ] => destruct E; subst
              | [ _ : context[if ?E then _ else _] |- _ ] => destruct E; subst
              | [ H : forall p : W * W, _ |- _ ] => rewrite H in *
            end; intuition idtac);
    try match goal with
          | [ |- _ \/ _ ] => right; intuition idtac
        end;
    repeat match goal with
             | [ H : forall p : W * W, _ |- _ ] => rewrite H in *
           end; auto; try (discriminate || omega).

Hint Extern 5 (_ %= _) => bags.
Hint Extern 5 (_ %in _) => bags.
Hint Extern 5 (~ _ %in _) => bags.
Hint Extern 5 (_ \is _) => bags.

Section adt.
  Variable P : bag -> W -> HProp.
  (* Abstract predicate for the data structure *)

  Variable res : nat.
  (* How many reserved stack slots? *)

  Definition initS : spec := SPEC reserving res
    PRE[_] mallocHeap
    POST[R] P empty R * mallocHeap.

  Definition isEmptyS : spec := SPEC("b") reserving res
    Al b,
    PRE[V] P b (V "b") * mallocHeap
    POST[R] [| (b %= empty) \is R |] * P b (V "b") * mallocHeap.

  Definition enqueueS : spec := SPEC("b", "v1", "v2") reserving res
    Al b,
    PRE[V] P b (V "b") * mallocHeap
    POST[_] P (b %+ (V "v1", V "v2")) (V "b") * mallocHeap.

  Definition dequeueS : spec := SPEC("b", "r") reserving res
    Al b,
    PRE[V] [| ~(b %= empty) |] * P b (V "b") * V "r" =?> 2 * mallocHeap
    POST[_] Ex v1, Ex v2, P (b %- (v1, v2)) (V "b") * (V "r" ==*> v1, v2) * mallocHeap.
End adt.


(*****************************************************************************)
(*****************************************************************************)
(****                                                                     ****)
(****   A demonstration (but not a proof) of why Church encodings don't   ****)
(****   support dependent elimination                                     ****)
(****                                                                     ****)
(*****************************************************************************)
(*****************************************************************************)

(*
  This file demonstrates the problems one encounters when trying to implement
  inductive types (in particular, pairs) with Church encodings. For an actual
  impossibility result, see:

    Geuvers, H. (2001). Induction Is Not Derivable in Second Order Dependent
    Type Theory. In: Abramsky, S. (eds) Typed Lambda Calculi and Applications.
    TLCA 2001. Lecture Notes in Computer Science, vol 2044. Springer, Berlin,
    Heidelberg. https://doi.org/10.1007/3-540-45413-6_16

  These encodings of pairs require an impredicative universe in order to be
  defined in the same universe as their component types, so we'll use `Prop`.
*)

Module NonDependentPairsWithNonDependentElimination.
  (*
    Just as in System F, non-dependent pairs with non-dependent elimination
    work fine, but we don't get eta equivalence.
  *)

  Definition Pair (X Y : Prop) : Prop :=
    forall (Z : Prop), (X -> Y -> Z) -> Z.

  Definition construct (X Y : Prop) : X -> Y -> Pair X Y :=
    fun x y Z f => f x y.

  Definition eliminate (X Y Z : Prop) : (X -> Y -> Z) -> Pair X Y -> Z :=
    fun f p => p Z f.

  Definition first (X Y : Prop) : Pair X Y -> X :=
    fun p => eliminate X Y X (fun x _ => x) p.

  Definition second (X Y : Prop) : Pair X Y -> Y :=
    fun p => eliminate X Y Y (fun _ y => y) p.

  Theorem betaFirst :
    forall (X Y : Prop) (x : X) (y : Y), first X Y (construct X Y x y) = x.
  Proof.
    reflexivity.
  Qed.

  Theorem betaSecond :
    forall (X Y : Prop) (x : X) (y : Y), second X Y (construct X Y x y) = y.
  Proof.
    reflexivity.
  Qed.

  Axiom eta :
    forall (X Y : Prop) (p : Pair X Y),
    construct X Y (first X Y p) (second X Y p) = p.
End NonDependentPairsWithNonDependentElimination.

Module DependentPairsWithNonDependentElimination.
  (*
    Dependent pairs with non-dependent elimination almost work, except we can't
    define the second projection in full generality. In other words, we can
    encode "weak sums" (i.e., existentials) but not "strong sums". Of course,
    without the second projection, we don't have the associated equivalences.
  *)

  Definition Pair (X : Prop) (Y : X -> Prop) : Prop :=
    forall (Z : Prop), (forall x, Y x -> Z) -> Z.

  Definition construct (X : Prop) (Y : X -> Prop) :
    forall (x : X), Y x -> Pair X Y
  :=
    fun x y Z f => f x y.

  Definition eliminate (X : Prop) (Y : X -> Prop) (Z : Prop) :
    (forall (x : X), Y x -> Z) -> Pair X Y -> Z
  :=
    fun f p => p Z f.

  Definition first (X : Prop) (Y : X -> Prop) : Pair X Y -> X :=
    fun p => eliminate X Y X (fun x _ => x) p.

  (*
    ```
    Definition second (X : Prop) (Y : X -> Prop) (p : Pair X Y) :
      Y (first X Y p)
    :=
      eliminate X Y (Y (first X Y p)) (fun _ y => y) p.
    ```
  *)

  Parameter second :
    forall (X : Prop) (Y : X -> Prop) (p : Pair X Y), Y (first X Y p).

  Theorem betaFirst :
    forall (X : Prop) (Y : X -> Prop) (x : X) (y : Y x),
    first X Y (construct X Y x y) = x.
  Proof.
    reflexivity.
  Qed.

  Axiom betaSecond :
    forall (X : Prop) (Y : X -> Prop) (x : X) (y : Y x),
    second X Y (construct X Y x y) = y.

  Axiom eta :
    forall (X : Prop) (Y : X -> Prop) (p : Pair X Y),
    construct X Y (first X Y p) (second X Y p) = p.
End DependentPairsWithNonDependentElimination.

Module NonDependentPairsWithDependentElimination.
  (*
    We can't even define the type former for non-dependent pairs with dependent
    elimination. In other words, we don't have an encoding of pairs with an
    induction principle.
  *)

  (*
    ```
    Definition Pair (X Y : Prop) : Prop :=
      forall (Z : Pair X Y -> Prop),
      (forall (x : X) (y : Y), Z (construct X Y x y)) ->
      forall (p : Pair X Y), Z p.
    ```
  *)
End NonDependentPairsWithDependentElimination.

Module DependentPairsWithDependentElimination.
  (*
    Dependent pairs with dependent elimination (i.e., sigma types) have the
    same problem.
  *)

  (*
    ```
    Definition Pair (X : Prop) (Y : X -> Prop) : Prop :=
      forall (Z : Pair X Y -> Prop),
      (forall (x : X) (y : Y x), Z (construct X Y x y)) ->
      forall (p : Pair X Y), Z p.
    ```
  *)
End DependentPairsWithDependentElimination.


Require Import Iron.Language.SystemF2.SubstTypeType.
Require Import Iron.Language.SystemF2Store.TyJudge.
Require Import Coq.Logic.FunctionalExtensionality.

Theorem subst_type_exp_ix
 :  forall ix ds ke te se x1 t1 t2 k2
 ,  get ix ke = Some k2
 -> TYPE ds ke  te se x1 t1
 -> KIND (delete ix ke)  t2 k2
 -> TYPE ds (delete ix ke)     (substTE ix t2 te)  (substTE ix t2 se)
            (substTX ix t2 x1) (substTT ix t2 t1).
Proof.
 intros. gen ix ds ke te se t1 t2 k2.
 induction x1 using exp_mutind with
  (PA := fun a => forall ix ds ke te se t1 t2 t3 k3
      ,  get ix ke = Some k3
      -> TYPEA ds ke te se a t1 t2
      -> KIND (delete ix ke) t3 k3
      -> TYPEA ds (delete ix ke)  (substTE ix t3 te) (substTE ix t3 se)
                  (substTA ix t3 a)
                  (substTT ix t3 t1) (substTT ix t3 t2));
  intros; simpl; inverts_type; eauto.

 Case "XVar".
  apply TyVar; auto.
  unfold substTE. auto.

 Case "XLoc".
  eapply TyLoc;
   unfold substTE; eauto.

 Case "XLAM".
  simpl. apply TyLAM.
  rewrite delete_rewind.
  rewrite (liftTE_substTE 0 ix).
  rewrite (liftTE_substTE 0 ix).
  eauto using kind_kienv_weaken.

 Case "XAPP".
  rewrite (substTT_substTT 0 ix).
  eauto using subst_type_type_ix.
  apply TyAPP.
   simpl. eapply (IHx1 ix) in H4; eauto.
   simpl. eapply subst_type_type_ix; eauto.

 Case "XLam".
  simpl. apply TyLam.
  eapply subst_type_type_ix; eauto.
  unfold substTE at 1. rewrite map_rewind.
  rrwrite ( map (substTT ix t2) (te :> t)
          = substTE ix t2 (te :> t)).
  eauto.

 Case "XApp".
  eapply TyApp.
   eapply IHx1_1 in H4; eauto.
    simpl in H4. burn.
   eapply IHx1_2 in H6; eauto.

 Case "XCon".
  rr. simpl.
  eapply TyCon; eauto.
   eapply subst_type_type_ix_forall2; eauto.

   eapply Forall2_map.
   eapply Forall2_map_right' in H10.
   eapply Forall2_impl_in; eauto; intros.
    rrwrite (ix = 0 + ix).
    rewrite substTTs_substTT; rr.
     nforall. eapply H; eauto.
     have (DEFOK ds (DefData dc tsFields tc)).
     have (DEFOK ds (DefType tc ks       dcs)).
     rrwrite (length ts = length ks). eauto.

 Case "XCase".
  eapply TyCase; eauto.
  eapply Forall_map.
  repeat nforall. intros. eauto.
  repeat nforall. intros.
   have (In x (map dcOfAlt aa)).
   assert ( map dcOfAlt (map (substTA ix t2) aa)
          = map dcOfAlt aa) as HDC.
    lists. f_equal.
    extensionality x0. rr. auto.
   rewrite HDC. auto.

 Case "XUpdate".
  have (DEFOK ds (DefData dc    tsFields tcObj)).
  have (DEFOK ds (DefType tcObj ks dcs)).
  eapply TyUpdate; eauto.
  eapply Forall2_map_left.
   eapply Forall2_impl; eauto; intros.
   eapply subst_type_type_ix; eauto.
  rrwrite (TCon tcObj = substTT ix t2 (TCon tcObj)).
  rewrite <- substTT_makeTApps.
  eauto.
  rrwrite (ix = 0 + ix).
  rewrite substTTs_substTT; eauto.
  nnat.
  rrwrite (length ts = length ks). eauto.

 Case "AAlt".
  have (DEFOK ds (DefData dc tsFields tc)).
  rr.
  eapply TyAlt with (tc := tc) (ks := ks) (dcs := dcs); eauto.
  eapply subst_type_type_ix_forall2; eauto.
   eapply IHx1 in H9; eauto.
   rrwrite (ix = 0 + ix).
   rewrite substTTs_substTT_map; rr.
    unfold substTE. rewrite <- map_app. auto.
    rrwrite (length tsParam = length ks).
    nforall. eauto.
Qed.

Theorem subst_type_exp
 :  forall ds ke te se x1 t1 t2 k2
 ,  TYPE ds (ke :> k2) te se x1 t1
 -> KIND ke  t2 k2
 -> TYPE ds ke (substTE 0 t2 te) (substTE 0 t2 se)
               (substTX 0 t2 x1) (substTT 0 t2 t1).
Proof.
 intros.
 rrwrite (ke = delete 0 (ke :> k2)).
 eapply subst_type_exp_ix; burn.
Qed.


Theorem hoge : forall P Q R : Prop, P \/ ~(Q \/ R) -> (P \/ ~Q) /\ (P \/ ~R).
Proof.
  refine (fun P Q R => _).
  refine (fun H => _).
  refine match H with | or_introl HP => _ | or_intror HnQR => _ end.
  - refine (conj _ _).
    + refine (or_introl _).
      refine HP.
    + refine (or_introl _).
      refine HP.
  - refine (conj _ _).
    + refine (or_intror _).
      refine (fun HQ => _).
      refine (HnQR _).
      refine (or_introl _).
      refine HQ.
    + refine (or_intror _).
      refine (fun HR => _).
      refine (HnQR _).
      refine (or_intror _).
      refine HR.
Qed.


(*
  Copyright 2022 ZhengPu Shi
  This file is part of CoqMatrix. It is distributed under the MIT
  "expat license". You should have recieved a LICENSE file with it.

  purpose   : Matrix implemented with Fin Function
  author    : ZhengPu Shi
  date      : 2021.12

  remark    :
  1. reference:
  https://math-comp.github.io/htmldoc_1_14_0/mathcomp.algebra.matrix.html#matrix
  2. change it to Functor version, which can support multiple Base Type.
  3. especially we want to use RingType as Base Type, because lots of operations
    related to Base Type could be omitted.
 *)

(** The library all_algebra contain 'matrix' formalization *)
From mathcomp Require Import all_ssreflect all_algebra.

Require Export MatrixTheory.
(* Require Export ListListExt.
Require Export FieldTypeR.
Require Import MatrixSig. *)

(* Require Export Fin.
Require Export Arith.
Require Export Lia.
Require Export List.
Export ListNotations. *)

Generalizable Variable A B C Aeq Beq Ceq Aadd Aopp Amul Ainv.

Open Scope A_scope.
Open Scope mat_scope.

Section FinFunMatrix.

  (* Note that, in the construction of _ringtype, we need the proof of "1 <> 0",
     I don't sure how to organize it, becuase in my hierarchy and in Coq's hierarchy,
     "1 <> " is a property in a field structure. So, I use limited field to instead
     ring structure *)

  (* Context `{R : Ring A Aadd A0 Aopp Amul A1 eq}. *)
  (* Add Ring ring_inst : make_ring_theory. *)

  Context `{F : Field}.
  Context `{Dec_eq : Decidable A Aeq}.

  Infix "+" := Aadd : A_scope.
  Notation "- a" := (Aopp a) : A_scope.
  Infix "*" := Amul : A_scope.
  Add Field field_inst : make_field_theory.

  (** package A to ringType structure, to enable A be used as carrier type
    of MathComp.matrix.
    We must construct the required hierarchy one by one, otherwise, the later
    structure will fail.
    For example, choiceType need a eqType canonical declaration, and so on *)
  Section carrier_of_matrix.

    (* eqType *)
    Section eqType.
      (** reflect (x1 = x2) (x1 =? x2) *)
      Let A_eqbP : Equality.axiom Aeqb.
      Proof.
        hnf. intros. destruct (decidable x y) as [H|H]; auto.
        - apply Aeqb_true in H. rewrite H. constructor.
          apply Aeqb_true. auto.
        - apply Aeqb_false in H. rewrite H. constructor.
          apply Aeqb_false. auto.
      Qed.

      Let A_eqMixin := EqMixin A_eqbP.
      Canonical A_eqType := Eval hnf in EqType A A_eqMixin.
    End eqType.

    (* choiceType *)
    Section choiceType.
      Import Countable.

      Definition pickle (x : A) := 0%nat.
      Definition unpickle (n:nat) : option A := None.
      Definition pcancel : pcancel pickle unpickle. Admitted.
      Definition A_choiceType_mixin_of : mixin_of A :=
        Mixin pcancel.

      Let A_choiceMixin := ChoiceMixin A_choiceType_mixin_of.
      Canonical A_choiceType := ChoiceType A A_choiceMixin.
    End choiceType.

    (* zmodType *)
    Section zmodType.
      Import ssrfun.

      Let Aadd_assoc : associative Aadd.
      Proof.
        hnf;intros;ring.
      Qed.

      Let Aadd_comm : commutative Aadd.
      Proof.
        hnf;intros;ring.
      Qed.

      Let Aadd_left_id : left_id A0 Aadd.
      Proof.
        hnf;intros;ring.
      Qed.

      Let Aadd_left_inv : left_inverse A0 Aopp Aadd.
      Proof.
        hnf;intros;ring.
      Qed.

      Let A_zmodMixin := ZmodMixin Aadd_assoc Aadd_comm Aadd_left_id
                           Aadd_left_inv.
      Canonical A_zmodType := Eval hnf in ZmodType _ A_zmodMixin.
    End zmodType.

    (* ringType *)
    Section ringType.
      Import ssrfun.

      Let Amul_assoc : associative Amul.
      Proof.
        hnf;intros;ring.
      Qed.

      Let Amul_left_id : left_id A1 Amul.
      Proof.
        hnf;intros;ring.
      Qed.

      Let Amul_right_id : right_id A1 Amul.
      Proof.
        hnf;intros;ring.
      Qed.

      Let Amul_left_distr : left_distributive Amul Aadd.
      Proof.
        hnf;intros;ring.
      Qed.

      Let Amul_right_distr : right_distributive Amul Aadd.
      Proof.
        hnf;intros;ring.
      Qed.

      (* 1 != 0%R *)
      Let A_1_neq_0 : negb (eq_op A1 (GRing.zero A_zmodType)).
      Proof.
        cbv. assert (H : Aeqb A1 A0 = false).
        - apply Aeqb_false. apply field_1_neq_0.
        - apply Aeqb_false in H.
          destruct Dec_eq. destruct decidable; auto.
      Qed.

      Let A_ringMixin := RingMixin Amul_assoc Amul_left_id Amul_right_id
                           Amul_left_distr Amul_right_distr A_1_neq_0.
      Canonical A_ringType := Eval hnf in RingType _ A_ringMixin.

    End ringType.

  End carrier_of_matrix.

  (** Matrix type *)

  (* details about Mathcomp.matrix is complex *)
  (*   Print matrix.       (* Inductive matrix := Matrix (_:finfun_of) *)
  Print finfun_of.    (* Inductive finfun_of := FinfunOf (_:finfun_on) *)
  Print finfun_on.    (* Inductive finfun_on := finfun_nil | finfun_cons *)
   *)
  Definition mat (r c : nat) := matrix A r c.

  (** The equality is decidable *)
  Lemma meq_dec : forall {r c} (m1 m2 : mat r c), {m1 = m2} + {m1 <> m2}.
  Proof.
    intros. apply (@eq_comparable (matrix_eqType A_eqType r c)).
  Qed.

  (** Mathcomp issue: leq (S a) b <-> Nat.ltb a b *)
  (* Two different definitions for natural number comparision:
   leq is given by Mathcomp
   Nat.ltb is given by Coq Std.Lib *)
  Fact mathcomp_leq_iff_ltb : forall a b : nat, leq (S a) b <-> Nat.ltb a b.
  Proof.
    intros.
    destruct (@leP a b), (@Nat.ltb_spec a b).
  Admitted. (* ToDo: ? *)
  (* Some idea of the proof: owing to big difference of two definitions, maybe it is
   hard to proof directly. We can proove it with the help of induction relation le.
   1. Convert Nat.ltb to le，use Nat.ltb_spec，
      Convert leq to le, use leP.
   2. Nat.ltb_spec : forall x y : nat, BoolSpec (lt x y) (le y x) (Nat.ltb x y)
      if lt x y，Nat.ltb x y = true
      then     ，Nat.ltb x y = false

      leP: forall {m n : nat}, reflect (le m n) (leq m n)
      if le m n，leq m n = true
      then     ，leq m n = false *)

  (** Get element of a matrix *)
  Definition mnth' {r c} (m : mat r c) (ri ci : nat) : A.
  Proof.
    destruct (ri <? r) eqn:H1, (ci <? c) eqn:H2.
    { apply mathcomp_leq_iff_ltb in H1,H2.  (*  <? to <  *)
      pose (ri' := @Ordinal r ri H1).
      pose (ci' := @Ordinal c ci H2).
      exact (m ri' ci'). }
    all: exact A0.  (* all other situation is A0 *)
  Defined.

  Definition mnth {r c} (m : mat r c) (ri ci : nat) : A.
  Proof.
    destruct (ri < r) eqn:H1, (ci < c) eqn:H2.
    { exact (m (@Ordinal r ri H1) (@Ordinal c ci H2)). }
    all: exact A0.
  Defined.

  Lemma meq_iff_mnth : forall {r c : nat} (m1 m2 : mat r c),
      m1 = m2 <->
        (forall ri ci (Hri : lt ri r) (Hci : lt ci c),
            mnth m1 ri ci = mnth m2 ri ci).
  Proof.
    intros. split; intros.
    { destruct (ri < r) eqn:H1, (ci < c) eqn:H2.
      { unfold mnth.
  Admitted.

  (** Create specific matrix *)
  Definition mk_mat_1_1 (a11 : A) : mat 1 1 :=
    matrix_of_fun_def
      (fun i j => match i,j with (* i : ordinal_finType 1 *)
                  | Ordinal 0 _, Ordinal 0 _ => a11
                  | _,_ => A0
                  end).
  Definition mk_mat_3_1 (a1 a2 a3 : A) : mat 3 1 :=
    matrix_of_fun_def
      (fun i j => match i,j with
                  | Ordinal 0 _, Ordinal 0 _ => a1
                  | Ordinal 1 _, Ordinal 0 _ => a2
                  | Ordinal 2 _, Ordinal 0 _ => a3
                  | _,_ => A0
                  end).
  Definition mk_mat_3_3 (a11 a12 a13 a21 a22 a23 a31 a32 a33 : A) : mat 3 3 :=
    matrix_of_fun_def
      (fun i j => match i,j with
                  | Ordinal 0 _, Ordinal 0 _ => a11
                  | Ordinal 0 _, Ordinal 1 _ => a12
                  | Ordinal 0 _, Ordinal 2 _ => a13
                  | Ordinal 1 _, Ordinal 0 _ => a21
                  | Ordinal 1 _, Ordinal 1 _ => a22
                  | Ordinal 1 _, Ordinal 2 _ => a23
                  | Ordinal 2 _, Ordinal 0 _ => a31
                  | Ordinal 2 _, Ordinal 1 _ => a32
                  | Ordinal 2 _, Ordinal 2 _ => a33
                  | _,_ => A0
                  end).
  Definition mk_mat_2_2 (a11 a12 a21 a22 : A) : mat 2 2 :=
    matrix_of_fun_def
      (fun i j => match i,j with
                  | Ordinal 0 _, Ordinal 0 _ => a11
                  | Ordinal 0 _, Ordinal 1 _ => a12
                  | Ordinal 1 _, Ordinal 0 _ => a21
                  | Ordinal 1 _, Ordinal 1 _ => a22
                  | _,_ => A0
                  end).

  (** Zero matrix *)
  Definition mat0 r c : mat r c
    := matrix_of_fun_def (fun i j => A0).

  (** A matrix is a nonzero matrix *)
  Definition matnonzero {r c} (m : mat r c) : Prop := m <> mat0 r c.

  (** Unit matrix *)
  Definition mat1 n : mat n n :=
    matrix_of_fun_def (fun i j => if (i == j) then A1 else A0).

  (** Mapping of a matrix *)
  Definition mmap {r c} (f : A -> A) (m : mat r c) : mat r c :=
    matrix_of_fun_def (fun i j => f (m i j)).

  (** Mapping of two matrices *)
  Definition mmap2 {r c} (f : A -> A -> A) (m1  m2 : mat r c) : mat r c :=
    matrix_of_fun_def (fun i j => f (m1 i j) (m2 i j)).

  Lemma mmap2_comm : forall {r c} (f : A -> A -> A)
                            (f_comm : forall a b : A, f a b = f b a)
                            (m1 m2 : mat r c),
      mmap2 f m1 m2 = mmap2 f m2 m1.
  Proof.
    intros.
  Admitted.

  Lemma mmap2_assoc : forall {r c} (f : A -> A -> A)
                             (f_assoc : forall a b c, f a (f b c) = f (f a b) c)
                             (m1 m2 m3 : mat r c),
      mmap2 f (mmap2 f m1 m2) m3 = mmap2 f m1 (mmap2 f m2 m3).
  Proof.
    intros.
  Admitted.

  (** Addition of matrix *)
  Definition madd {r c} (m1 m2 : mat r c) :=
    matrix_of_fun_def (fun i j => Aadd (m1 i j) (m2 i j)).
  Notation "m1 + m2" := (madd m1 m2) : mat_scope.

  Lemma madd_comm : forall {r c} (m1 m2 : mat r c), m1 + m2 = m2 + m1.
  Proof.
  Admitted.

  Lemma madd_assoc : forall {r c} (m1 m2 m3 : mat r c), (m1 + m2) + m3 = m1 + (m2 + m3).
  Proof.
  Admitted.

  Lemma madd_0_l : forall {r c} (m : mat r c), (mat0 r c) + m = m.
  Proof.
  Admitted.

  Lemma madd_0_r : forall {r c} (m : mat r c), m + (mat0 r c) = m.
  Proof.
  Admitted.

  (** Opposite of matrix *)
  Definition mopp {r c} (m : mat r c) : mat r c :=
    matrix_of_fun_def (fun i j => Aopp (m i j)).
  Notation "- m" := (mopp m) : mat_scope.

  Lemma mopp_opp : forall {r c} (m : mat r c), - - m = m.
  Proof.
  Admitted.

  Lemma mopp_exchange : forall {r c} (m1 m2 : mat r c), -m1 = m2 <-> m1 = -m2.
  Proof.
  Admitted.

  Lemma mopp_mat0 : forall {r c}, - (mat0 r c) = mat0 r c.
  Proof.
  Admitted.

  Lemma madd_opp : forall {r c} (m : mat r c), m + (-m) = mat0 r c.
  Proof.
  Admitted.

  Definition msub {r c} (m1 m2 : mat r c) :=
    matrix_of_fun_def (fun i j => Aadd (m1 i j) (Aopp (m2 i j))).
  Infix "-" := msub : mat_scope.

  Lemma msub_comm : forall {r c} (m1 m2 : mat r c), m1 - m2 = - (m2 - m1).
  Proof.
  Admitted.

  Lemma msub_assoc : forall {r c} (m1 m2 m3 : mat r c),
      (m1 - m2) - m3 = m1 - (m2 + m3).
  Proof.
  Admitted.

  Lemma msub_0_l : forall {r c} (m : mat r c), (mat0 r c) - m = - m.
  Proof.
  Admitted.

  Lemma msub_0_r : forall {r c} (m : mat r c), m - (mat0 r c) = m.
  Proof.
  Admitted.

  Lemma msub_self : forall {r c} (m : mat r c), m - m = (mat0 r c).
  Proof.
  Admitted.

  (** 矩阵数乘 *)
  Definition mcmul {r c} (a : A) (m : mat r c) : mat r c :=
    matrix_of_fun_def (fun i j => Amul a (m i j)).

  Notation "a c* m" := (mcmul a m) : mat_scope.

  Definition mmulc {r c} (m : mat r c) (a : A) : mat r c :=
    matrix_of_fun_def (fun i j => Amul (m i j) a).

  Notation "m *c a" := (mmulc m a) : mat_scope.

  Lemma mmulc_eq_mcmul : forall {r c} (a : A) (m : mat r c),  m *c a = a c* m.
  Proof.
  Admitted.

  Lemma mcmul_assoc : forall {r c} (a b : A) (m : mat r c), a c* (b c* m) = (a * b) c* m.
  Proof.
  Admitted.

  Lemma mcmul_perm : forall {r c} (a b : A) (m : mat r c), a c* (b c* m) = b c* (a c* m).
  Proof.
  Admitted.

  Lemma mcmul_add_distr_l : forall {r c} (a : A) (m1 m2 : mat r c),
      a c* (m1 + m2) = (a c* m1) + (a c* m2).
  Proof.
  Admitted.

  Lemma mcmul_add_distr_r : forall {r c} (a b : A) (m : mat r c),
      (a + b)%A c* m = a c* m + b c* m.
  Proof.
  Admitted.

  (* 0 c* m = mat0 *)
  Lemma mcmul_0_l : forall {r c} (m : mat r c), A0 c* m = mat0 r c.
  Proof.
  Admitted.

  (* 1 * m = m *)
  Lemma mcmul_1_l : forall {r c} (m : mat r c), A1 c* m = m.
  Proof.
  Admitted.

  (* (-a) * m = - (a * m) *)
  Lemma mcmul_neg : forall {r c} a (m : mat r c), (- a)%A c* m = - (a c* m).
  Proof.
  Admitted.

  (* (-a) * (- m) = (a * m) *)
  Lemma mcmul_neg_mopp : forall {r c} a (m : mat r c), (-a)%A c* (-m) = a c* m.
  Proof.
  Admitted.

  (* a * m = m -> a = 1 \/ m = 0 *)
  Lemma mcmul_same_imply_coef1_or_mzero : forall {r c} a (m : mat r c),
      a c* m = m -> (a = A1) \/ (m = mat0 r c).
  Proof.
  Abort.

  (* m1 <> 0 -> m2 <> 0 -> m1 = k c* m2 -> k <> 0 *)
  Lemma mat_eq_mcmul_implfy_coef_neq0 : forall {r c} (m1 m2 : mat r c) k,
      matnonzero m1 -> matnonzero m2 -> (m1 = k c* m2) -> k <> A0.
  Proof.
  Abort.

  (* m <> 0 -> k c* m = 0 -> k = 0 *)
  Lemma mcmul_mnonzero_eq0_imply_k0 : forall {r c} (m : mat r c) k,
      matnonzero m -> mat0 r c = k c* m -> k = A0.
  Proof.
  Abort.

  (** transpose *)
  Definition mtrans {r c} (m : mat r c): mat c r :=
    matrix_of_fun_def (fun i j => m j i).

  Notation "m \T" := (mtrans m) : mat_scope.

  Lemma mtrans_trans : forall {r c} (m : mat r c), m \T \T = m.
  Proof.
  Admitted.

  (** 矩阵乘法 *)
  Definition mmul {r c s} (m1 : mat r c) (m2 : mat c s) : mat r s :=
    @mulmx A_ringType r c s m1 m2.
  Infix "*" := mmul : mat_scope.

  Lemma mmul_add_distr_l : forall {r c A} (m1 : mat r c) (m2 m3 : mat c A),
      m1 * (m2 + m3) = m1 * m2 + m1 * m3.
  Proof.
  Admitted.

  Lemma mmul_add_distr_r : forall {r c s} (m1 m2 : mat r c) (m3 : mat c s),
      (m1 + m2) * m3 = (m1 * m3) + (m2 * m3).
  Proof.
  Admitted.

  Lemma mmul_assoc : forall {r c s A} (m1 : mat r c) (m2 : mat c s) (m3 : mat s A),
      (m1 * m2) * m3 = m1 * (m2 * m3).
  Proof. intros. apply Logic.eq_sym. apply mulmxA. Qed.

  Lemma mmul_0_l : forall {r c A} (m : mat c A), (mat0 r c) * m = mat0 r A.
  Proof.
  Admitted.

  Lemma mmul_0_r : forall {r c A} (m : mat r c), m * (mat0 c A) = mat0 r A.
  Proof.
  Admitted.

  Lemma mmul_1_l : forall {r c} (m : mat r c), (mat1 r) * m = m.
  Proof.
  Admitted.

  Lemma mmul_1_r : forall {r c} (m : mat r c), m * (mat1 c) = m.
  Proof.
  Admitted.

  (*   (** Vector type *)
  Definition vecr n := mat 1 n.
  Definition vecc n := mat n 1.

  (** ** Construct a matrix with a vector and a a matrix *)

  (** Construct by row *)
  Definition mconsr {r c} (v : vecr c) (m : mat r c) : mat (S r) c.
  Proof.
    destruct v,m.
    refine (mk_mat ((hd [] mat_data) :: mat_data0) _ _).
    - simpl. f_equal. auto.
    - simpl. split; auto.
      destruct mat_data; simpl in *; try lia.
  Defined.

  (** Construct by column *)
  Definition mconsc {r c} (v : vecc r) (m : mat r c) : mat r (S c).
  Proof.
    destruct v as [v], m as [m].
    refine (mk_mat (consc (hdc A0 v) m) _ _).
    - apply consc_height; auto. rewrite hdc_length; auto.
    - apply consc_width; auto. rewrite hdc_length; subst; auto.
  Defined. *)

  (** list list to matrix *)

  (* Definition l2m_old {r c} (dl : list (list A)) (H1 : length dl = r) *)
  (*   (H2 : width dl c) : mat r c := mk_mat dl H1 H2. *)

  Definition l2m {r c} (dl : list (list A)) : mat r c.
  Proof.
    (* destruct (ri <? r) eqn:H1, (ci <? c) eqn:H2. *)
    (* { apply mathcomp_leq_iff_ltb in H1,H2. *)
    (*   pose (ri' := @Ordinal r ri H1). *)
    (*   pose (ci' := @Ordinal c ci H2). *)
    (*   exact (m ri' ci'). } *)
    (*   all: exact A0. *)
    (* Defined. *)
    (* matrix_of_fun_def (fun i j => *)
    (*                      match  *)
    (*                        dlnth Amul (m i j) a). *)
    apply (matrix_of_fun_def (fun i j => A0)).
  Defined.

  (* Learn finfun_on *)
  Section check_finfun_on.
    Variable r c : nat.
    Let fin_r_c_T := prod_finType (ordinal_finType r) (ordinal_finType c).

    (* it's complex form *)
  (*     Check @finfun_on fin_r_c_T (fun _ : 'I_r * 'I_c => A)
      (@enum_mem fin_r_c_T
        (@mem ('I_r * 'I_c) (predPredType ('I_r * 'I_c))
          (@PredOfSimpl.coerce ('I_r * 'I_c) (pred_of_argType ('I_r * 'I_c))))).

    (* simple form, benefit from type inference *)
    Check finfun_on (fun _ : 'I_r * 'I_c => A)
      (enum_mem (mem (PredOfSimpl.coerce (pred_of_argType ('I_r * 'I_c))))). *)
  End check_finfun_on.

  (** convert "finfun_on" to "list (list A)" *)
  Definition finfun_on_to_dlist (r c : nat)
    (f : finfun_on (fun _ : 'I_r * 'I_c => A)
           (enum_mem (mem (PredOfSimpl.coerce (pred_of_argType ('I_r * 'I_c))))))
    : list (list A) :=
    match f with
    | finfun_nil => []
    | finfun_cons _ _ _ _ => []
    end.

  Definition m2l {r c} (m : mat r c) : list (list A).
  Proof.
    destruct m. destruct f.
    apply (finfun_on_to_dlist r c f).
  Defined.

  Lemma m2l_length : forall {r c} (m : mat r c), length (m2l m) = r.
  Proof.
  Admitted.

  Lemma m2l_width : forall {r c} (m : mat r c), width (m2l m) c.
  Proof.
  Admitted.

  Lemma m2l_l2m_id : forall {r c} (dl : list (list A)) (H1 : length dl = r)
                            (H2 : width dl c), @m2l r c (l2m dl) = dl.
  Proof.
  Admitted.

  Lemma l2m_m2l_id : forall {r c} (m : mat r c), l2m (m2l m) = m.
  Proof.
  Admitted.

  Lemma l2m_inj : forall {r c} (d1 d2 : list (list A)),
      length d1 = r -> width d1 c ->
      length d2 = r -> width d2 c ->
      d1 <> d2 -> @l2m r c d1 <> l2m d2.
  Proof.
  Admitted.

  Lemma l2m_surj : forall {r c} (m : mat r c),
      (exists d, l2m d = m).
  Proof.
  Admitted.

  Lemma m2l_inj : forall {r c} (m1 m2 : mat r c),
      m1 <> m2 -> m2l m1 <> m2l m2.
  Proof.
  Admitted.

  Lemma m2l_surj : forall {r c} (d : list (list A)),
      length d = r -> width d c ->
      (exists m, @m2l r c m = d).
  Proof.
  Admitted.

  (** ** Other OPs and PROPs *)

  (** Convert between tuples and matrix *)

  (** tuple_3x3 -> mat_3x3 *)
  Definition t2m_3x3 (t : @T_3x3 A) : mat 3 3.
  Proof.
    destruct t as ((t1,t2),t3).
    destruct t1 as ((a11,a12),a13).
    destruct t2 as ((a21,a22),a23).
    destruct t3 as ((a31,a32),a33).
    exact (mk_mat_3_3 a11 a12 a13 a21 a22 a23 a31 a32 a33).
  Defined.

  (** mat_3x3 -> tuple_3x3 *)
  Definition m2t_3x3 (m : mat 3 3) : @T_3x3 A :=
    ((mnth m 0 0, mnth m 0 1, mnth m 0 2),
      (mnth m 1 0, mnth m 1 1, mnth m 1 2),
      (mnth m 2 0, mnth m 2 1, mnth m 2 2)).
  (*
  Definition m2t_3x3 (m : mat 3 3) : @T_3x3 A.
    destruct m. rename mat_data into dl.
    remember (hd [] dl) as l1.
    remember (hd [] (tl dl)) as l2.
    remember (hd [] (tl (tl dl))) as l3.
    remember (hd A0 l1, hd A0 (tl l1), hd A0 (tl (tl l1))) as t1.
    remember (hd A0 l2, hd A0 (tl l2), hd A0 (tl (tl l2))) as t2.
    remember (hd A0 l3, hd A0 (tl l3), hd A0 (tl (tl l3))) as t3.
    exact (t1, t2, t3).
  Defined.
   *)

  Lemma m2t_t2m_id_3x3 : forall (x : @T_3x3 A), m2t_3x3 (t2m_3x3 x) = x.
  (*     Proof.
    destruct x as ((t1,t2),t3).
    destruct t1 as ((a11,a12),a13).
    destruct t2 as ((a21,a22),a23).
    destruct t3 as ((a31,a32),a33).
    simpl. auto.
  Qed. *)
  Admitted.

  (*   Lemma t2m_m2t_id_3x3 (m : mat 3 3) : t2m_3x3 (m2t_3x3 m) = m.
    Proof.
    unfold t2m_3x3, m2t_3x3. unfold mk_mat_3_3.
    intros ri ci Hi Hj.
    do 3 (destruct ri; [do 3 (destruct ci; auto); lia | idtac]). lia.
  Qed.
  Admitted. *)
  Lemma t2m_m2t_id_3x3 : forall (m : mat 3 3),
      t2m_3x3 (m2t_3x3 m) = m.
  Proof.
  Admitted.

  (** m[0,0] : mat_1x1 -> A *)
  Definition scalar_of_mat (m : mat 1 1) := mnth m 0 0.

End FinFunMatrix.