Require Import GL4ip_PSGL4ip_calcs.
Require Import List.
Export ListNotations.

Require Import genT gen.
Require Import ddT.
Require Import gen_tacs.
Require Import gen_seq.
Require Import List_lemmasT.
Require Import existsT.
Require Import univ_gen_ext.
Require Import GL4ip_PSGL4ip_list_lems.
Require Import dd_fc.
Require Import PeanoNat.
Require Import strong_inductionT.
Require Import GL4ip_exch.
Require Import GL4ip_wkn.
Require Import GL4ip_PSGL4ip_remove_list.
Require Import GL4ip_PSGL4ip_dec.
Require Import Lia.

Theorem ImpR_hpinv : forall (k : nat) concl
        (D0 : derrec GL4ip_rules (fun _ => False) concl),
        k = (derrec_height D0) ->
          ((forall prem, ((ImpRRule [prem] concl) ->
          existsT2 (D1 : derrec GL4ip_rules (fun _ => False) prem),
          derrec_height D1 <= k))).
Proof.
assert (DersNilF: dersrec GL4ip_rules (fun _ : (list (MPropF V)) *(MPropF V)  => False) []).
apply dersrec_nil.
(* Setting up the strong induction on the height. *)
pose (strong_inductionT (fun (x:nat) => forall (concl : (list (MPropF V)) *(MPropF V))
  (D0 : derrec GL4ip_rules (fun _ : (list (MPropF V)) *(MPropF V) => False) concl),
x = derrec_height D0 ->
((forall prem, ((ImpRRule [prem] concl) ->
          existsT2 (D1 : derrec GL4ip_rules (fun _ => False) prem),
          derrec_height D1 <= x))))).
apply s. intros n IH. clear s.
(* Now we do the actual proof-theoretical work. *)
intros s D0. remember D0 as D0'. destruct D0.
(* D0 is a leaf *)
- destruct f.
(* D0 is ends with an application of rule *)
- intros hei. intros prem RA. inversion RA. subst.
  inversion g ; subst.
  (* IdP *)
  * inversion H.
  (* BotL *)
  * inversion H. subst. assert (InT (Bot V) (Γ0 ++ A :: Γ1)). assert (InT (Bot V) (Γ0 ++ Γ1)).
    rewrite <- H2. apply InT_or_app. right. apply InT_eq.
    apply InT_app_or in H0. destruct H0. apply InT_or_app. auto. apply InT_or_app. right.
    apply InT_cons. auto. apply InT_split in H0. destruct H0. destruct s. rewrite e.
    assert (BotLRule [] (x ++ Bot V :: x0, B)). apply BotLRule_I. apply BotL in H0.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
    (ps:=[]) (x ++ Bot V :: x0, B) H0 DersNilF). exists d0.
    simpl. rewrite dersrec_height_nil. lia. reflexivity.
   (* AndR *)
  * inversion H.
  (* AndL *)
  * inversion H. subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
   + simpl. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
      assert (AndLRule  [((Γ2 ++ [A]) ++ A0 :: B0 :: Γ3, B)]
      ((Γ2 ++ [A]) ++ And A0 B0 :: Γ3, B)). apply AndLRule_I. apply AndL in H0.
      assert (J4: ImpRRule [(Γ2 ++ A :: A0 :: B0 :: Γ3, B)]
      (Γ2 ++ A0 :: B0 :: Γ3, Imp A B)). apply ImpRRule_I.
      repeat rewrite <- app_assoc in H0. simpl in H0.
      assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
      pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
      pose (dlCons x1 DersNilF).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
      (ps:=[(Γ2 ++ A :: A0 :: B0 :: Γ3, B)])
      (Γ2 ++ A :: And A0 B0 :: Γ3, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
      lia. reflexivity.
   + destruct x.
      { simpl in e0. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
        assert (AndLRule  [(Γ2 ++ A :: A0 :: B0 :: Γ3, B)]
        ((Γ2 ++ []) ++ A :: And A0 B0 :: Γ3, B)).
        assert (Γ2 ++ A :: A0 :: B0 :: Γ3 = (Γ2 ++ [A]) ++ A0 :: B0 :: Γ3). repeat rewrite <- app_assoc ; auto.
        assert ((Γ2 ++ []) ++ A :: And A0 B0 :: Γ3 = (Γ2 ++ [A]) ++ And A0 B0 :: Γ3). repeat rewrite <- app_assoc ; auto.
        rewrite H0. clear H0. rewrite H1. clear H1. apply AndLRule_I. apply AndL in H0.
        assert (J4: ImpRRule [(Γ2 ++ A :: A0 :: B0 :: Γ3, B)]
        (Γ2 ++ A0 :: B0 :: Γ3, Imp A B)). apply ImpRRule_I.
        assert (J5: derrec_height x < S (dersrec_height d)). lia.
        assert (J6: derrec_height x = derrec_height x). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
        pose (dlCons x0 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[(Γ2 ++ A :: A0 :: B0 :: Γ3, B)])
       ((Γ2 ++ []) ++ A :: And A0 B0 :: Γ3, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
      { inversion e0.  subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
         pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
         assert (AndLRule  [(Γ2 ++ A0 :: B0 :: x ++ A :: Γ1, B)]
       ((Γ2 ++ And A0 B0 :: x) ++ A :: Γ1, B)). repeat rewrite <- app_assoc. apply AndLRule_I. apply AndL in H0.
        assert (J4: ImpRRule [((Γ2 ++ A0 :: B0 :: x) ++ A :: Γ1, B)]
        ((Γ2 ++ A0 :: B0 :: x) ++ Γ1, Imp A B)). apply ImpRRule_I. repeat rewrite <- app_assoc in J4. simpl in J4.
        assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
        assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
        pose (dlCons x1 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[(Γ2 ++ A0 :: B0 :: x ++ A :: Γ1, B)])
        ((Γ2 ++ And A0 B0 :: x) ++ A :: Γ1, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
    + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (AndLRule  [((Γ0 ++ A :: x) ++ A0 :: B0 :: Γ3, B)]
      ((Γ0 ++ A :: x) ++ And A0 B0 :: Γ3, B)). apply AndLRule_I. apply AndL in H0. repeat rewrite <- app_assoc in H0.
      simpl in H0.
      assert (J4: ImpRRule [(Γ0 ++ A :: x ++ A0 :: B0 :: Γ3, B)]
      ((Γ0 ++ x) ++ A0 :: B0 :: Γ3, Imp A B)). repeat rewrite <- app_assoc. apply ImpRRule_I.
      assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
      pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
      pose (dlCons x1 DersNilF).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
      (ps:=[(Γ0 ++ A :: x ++ A0 :: B0 :: Γ3, B)])
      (Γ0 ++ A :: x ++ And A0 B0 :: Γ3, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
      lia. reflexivity.
  (* OrR1 *)
  * inversion H.
  (* OrR2 *)
  * inversion H.
  (* OrL *)
  * inversion H. subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
   + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
      repeat rewrite <- app_assoc. simpl.
      assert (OrLRule [((Γ2 ++ [A]) ++ A0:: Γ3, B);((Γ2 ++ [A]) ++ B0 :: Γ3, B)]
      ((Γ2 ++ [A]) ++ Or A0 B0 :: Γ3, B)). apply OrLRule_I. apply OrL in H0.
      repeat rewrite <- app_assoc in H0. simpl in H0.
      assert (J4: ImpRRule [(Γ2 ++ A :: A0 :: Γ3, B)]
      (Γ2 ++ A0 :: Γ3, Imp A B)). apply ImpRRule_I.
      assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
      pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
      assert (J7: ImpRRule [(Γ2 ++ A :: B0 :: Γ3, B)]
      (Γ2 ++ B0 :: Γ3, Imp A B)). apply ImpRRule_I.
      assert (J8: derrec_height x1 < S (dersrec_height d)). lia.
      assert (J9: derrec_height x1 = derrec_height x1). reflexivity.
      pose (IH _ J8 _ _ J9). pose (s _ J7). destruct s0. clear s.
      pose (dlCons x3 DersNilF). pose (dlCons x2 d0).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
      (ps:=[(Γ2 ++ A :: A0 :: Γ3, B); (Γ2 ++ A :: B0 :: Γ3, B)])
      (Γ2 ++ A :: Or A0 B0 :: Γ3, B) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
      lia. reflexivity.
   + destruct x.
      { simpl in e0. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
        repeat rewrite <- app_assoc. simpl.
        assert (OrLRule [((Γ2 ++ [A]) ++ A0:: Γ3, B);((Γ2 ++ [A]) ++ B0 :: Γ3, B)]
        ((Γ2 ++ [A]) ++ Or A0 B0 :: Γ3, B)). apply OrLRule_I. apply OrL in H0.
        repeat rewrite <- app_assoc in H0. simpl in H0.
        assert (J4: ImpRRule [(Γ2 ++ A :: A0 :: Γ3, B)]
        (Γ2 ++ A0 :: Γ3, Imp A B)). apply ImpRRule_I.
        assert (J5: derrec_height x < S (dersrec_height d)). lia.
        assert (J6: derrec_height x = derrec_height x). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
        assert (J7: ImpRRule [(Γ2 ++ A :: B0 :: Γ3, B)]
        (Γ2 ++ B0 :: Γ3, Imp A B)). apply ImpRRule_I.
        assert (J8: derrec_height x0 < S (dersrec_height d)). lia.
        assert (J9: derrec_height x0 = derrec_height x0). reflexivity.
        pose (IH _ J8 _ _ J9). pose (s _ J7). destruct s0. clear s.
        pose (dlCons x2 DersNilF). pose (dlCons x1 d0).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[(Γ2 ++ A :: A0 :: Γ3, B); (Γ2 ++ A :: B0 :: Γ3, B)])
        (Γ2 ++ A :: Or A0 B0 :: Γ3, B) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
      { inversion e0. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
        repeat rewrite <- app_assoc. simpl.
        assert (OrLRule [(Γ2 ++ A0 :: x ++ A :: Γ1, B);(Γ2 ++ B0 :: x ++ A :: Γ1, B)]
        (Γ2 ++ Or A0 B0 :: x ++ A :: Γ1, B)). apply OrLRule_I. apply OrL in H0.
        assert (J4: ImpRRule [((Γ2 ++ A0 :: x) ++ A :: Γ1, B)]
        ((Γ2 ++ A0 :: x) ++ Γ1, Imp A B)). apply ImpRRule_I.
        repeat rewrite <- app_assoc in J4. simpl in J4.
        assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
        assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
        assert (J7: ImpRRule [((Γ2 ++ B0 :: x) ++ A :: Γ1, B)]
        ((Γ2 ++ B0 :: x) ++ Γ1, Imp A B)). apply ImpRRule_I.
        repeat rewrite <- app_assoc in J7. simpl in J7.
        assert (J8: derrec_height x1 < S (dersrec_height d)). lia.
        assert (J9: derrec_height x1 = derrec_height x1). reflexivity.
        pose (IH _ J8 _ _ J9). pose (s _ J7). destruct s0. clear s.
        pose (dlCons x3 DersNilF). pose (dlCons x2 d0).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[(Γ2 ++ A0 :: x ++ A :: Γ1, B); (Γ2 ++ B0 :: x ++ A :: Γ1, B)])
        (Γ2 ++ Or A0 B0 :: x ++ A :: Γ1, B) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
    +  assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
        assert (OrLRule [((Γ0 ++ A :: x) ++ A0 :: Γ3, B);((Γ0 ++ A :: x) ++ B0 :: Γ3, B)]
        ((Γ0 ++ A :: x) ++ Or A0 B0 :: Γ3, B)). apply OrLRule_I. apply OrL in H0.
        repeat rewrite <- app_assoc in H0. simpl in H0.
        assert (J4: ImpRRule [(Γ0 ++ A :: x ++ A0 :: Γ3, B)]
        ((Γ0 ++ x) ++ A0 :: Γ3, Imp A B)). repeat rewrite <- app_assoc. apply ImpRRule_I.
        assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
        assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
        assert (J7: ImpRRule [(Γ0 ++ A :: x ++ B0 :: Γ3, B)]
        ((Γ0 ++ x) ++ B0 :: Γ3, Imp A B)). repeat rewrite <- app_assoc. apply ImpRRule_I.
        assert (J8: derrec_height x1 < S (dersrec_height d)). lia.
        assert (J9: derrec_height x1 = derrec_height x1). reflexivity.
        pose (IH _ J8 _ _ J9). pose (s _ J7). destruct s0. clear s.
        pose (dlCons x3 DersNilF). pose (dlCons x2 d0).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[(Γ0 ++ A :: x ++ A0 :: Γ3, B); (Γ0 ++ A :: x ++ B0 :: Γ3, B)])
        (Γ0 ++ A :: x ++ Or A0 B0 :: Γ3, B) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
        lia. reflexivity.
  (* ImpR *)
  * inversion H. subst. simpl. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
    assert (J1: derrec_height x = derrec_height x). auto.
    assert (J2: list_exch_L (Γ2 ++ A :: Γ3, B) (A :: Γ0 ++ Γ1, B)).
    rewrite <- H2. assert (A :: Γ2 ++ Γ3 = [] ++ [A] ++ Γ2 ++ [] ++ Γ3). auto. rewrite H0.
    assert (Γ2 ++ A :: Γ3 = [] ++ [] ++ Γ2 ++ [A] ++ Γ3). auto. rewrite H1. apply list_exch_LI.
    pose (GL4ip_hpadm_list_exch_L (derrec_height x) (Γ2 ++ A :: Γ3, B) x J1 (A :: Γ0 ++ Γ1, B) J2).
    destruct s.
    assert (J3: derrec_height x0 = derrec_height x0). auto.
    assert (J4: list_exch_L (A :: Γ0 ++ Γ1, B) (Γ0 ++ A :: Γ1, B)).
    assert (A :: Γ0 ++ Γ1 = [] ++ [A] ++ Γ0 ++ [] ++ Γ1). auto. rewrite H0.
    assert (Γ0 ++ A :: Γ1 = [] ++ [] ++ Γ0 ++ [A] ++ Γ1). auto. rewrite H1. apply list_exch_LI.
    pose (GL4ip_hpadm_list_exch_L (derrec_height x0) (A :: Γ0 ++ Γ1, B) x0 J3 (Γ0 ++ A :: Γ1, B) J4).
    destruct s. exists x1. lia.
  (* AtomImpL1 *)
  * inversion H. subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
 + simpl. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
      assert (AtomImpL1Rule  [((Γ2 ++ [A]) ++ # P :: Γ3 ++ A0 :: Γ4, B)]
      ((Γ2 ++ [A]) ++ # P :: Γ3 ++ Imp # P A0 :: Γ4, B)). apply AtomImpL1Rule_I. apply AtomImpL1 in H0.
      repeat rewrite <- app_assoc in H0. simpl in H0.
      assert (J4: ImpRRule [(Γ2 ++ A :: # P :: Γ3 ++ A0 :: Γ4, B)]
      (Γ2 ++ # P :: Γ3 ++ A0 :: Γ4, Imp A B)). apply ImpRRule_I.
      assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
      pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
      pose (dlCons x1 DersNilF).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
      (ps:=[(Γ2 ++ A :: # P :: Γ3 ++ A0 :: Γ4, B)])
      (Γ2 ++ A :: # P :: Γ3 ++ Imp # P A0 :: Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
      lia. reflexivity.
   + destruct x.
      { simpl in e0. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
        assert (AtomImpL1Rule  [(Γ2 ++ A :: # P :: Γ3 ++ A0 :: Γ4, B)]
        ((Γ2 ++ []) ++ A :: # P :: Γ3 ++ Imp # P A0 :: Γ4, B)).
        assert (Γ2 ++ A ::# P :: Γ3 ++ A0 :: Γ4 = (Γ2 ++ [A]) ++ # P :: Γ3 ++ A0 :: Γ4). repeat rewrite <- app_assoc ; auto.
        assert ((Γ2 ++ []) ++ A :: # P :: Γ3 ++ Imp # P A0 :: Γ4 = (Γ2 ++ [A]) ++ # P :: Γ3 ++ Imp # P A0 :: Γ4). repeat rewrite <- app_assoc ; auto.
        rewrite H0. clear H0. rewrite H1. clear H1. apply AtomImpL1Rule_I. apply AtomImpL1 in H0.
        assert (J4: ImpRRule [(Γ2 ++ A :: # P :: Γ3 ++ A0 :: Γ4, B)]
        (Γ2 ++ # P :: Γ3 ++ A0 :: Γ4, Imp A B)). apply ImpRRule_I.
        assert (J5: derrec_height x < S (dersrec_height d)). lia.
        assert (J6: derrec_height x = derrec_height x). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
        pose (dlCons x0 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[(Γ2 ++ A :: # P :: Γ3 ++ A0 :: Γ4, B)])
        ((Γ2 ++ []) ++ A :: # P :: Γ3 ++ Imp # P A0 :: Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
      { inversion e0.  subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
        - assert (J30: dersrec_height d = dersrec_height d). reflexivity.
          pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
          assert (AtomImpL1Rule  [(Γ2 ++ # P :: (Γ3 ++ [A]) ++ A0 :: Γ4, B)]
          ((Γ2 ++ # P :: Γ3) ++ A :: Imp # P A0 :: Γ4, B)).
          assert ((Γ2 ++ # P :: Γ3) ++ A :: Imp # P A0 :: Γ4 =Γ2 ++ # P :: (Γ3 ++ [A]) ++ Imp # P A0 :: Γ4). repeat rewrite <- app_assoc ; auto.
          rewrite H0. clear H0. apply AtomImpL1Rule_I. apply AtomImpL1 in H0.
          assert (J4: ImpRRule [(Γ2 ++ # P :: (Γ3 ++ [A]) ++ A0 :: Γ4, B)]
          (Γ2 ++ # P :: Γ3 ++ A0 :: Γ4, Imp A B)).
          assert (Γ2 ++ # P :: (Γ3 ++ [A]) ++ A0 :: Γ4 = (Γ2 ++ # P :: Γ3) ++ A :: A0 :: Γ4). repeat rewrite <- app_assoc ; auto.
          assert (Γ2 ++ # P :: Γ3 ++ A0 :: Γ4 = (Γ2 ++ # P :: Γ3) ++ A0 :: Γ4). repeat rewrite <- app_assoc ; auto.
          rewrite H1. rewrite H2. apply ImpRRule_I.
          assert (J5: derrec_height x < S (dersrec_height d)). lia.
          assert (J6: derrec_height x = derrec_height x). reflexivity.
          pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
          pose (dlCons x1 DersNilF).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
          (ps:=[(Γ2 ++ # P :: (Γ3 ++ [A]) ++ A0 :: Γ4, B)])
          ((Γ2 ++ # P :: Γ3) ++ A :: Imp # P A0 :: Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
          lia. reflexivity.
        - destruct x0 ; simpl in e1 ; subst.
          * assert (J30: dersrec_height d = dersrec_height d). reflexivity.
            pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
            assert (AtomImpL1Rule  [(Γ2 ++ # P :: (Γ3 ++ [A]) ++ A0 :: Γ4, B)]
            ((Γ2 ++ # P :: Γ3 ++ []) ++ A :: Imp # P A0 :: Γ4, B)).
            assert ((Γ2 ++ # P :: Γ3 ++ []) ++ A :: Imp # P A0 :: Γ4 =Γ2 ++ # P :: (Γ3 ++ [A]) ++ Imp # P A0 :: Γ4).
            repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto.
            rewrite H0. clear H0. apply AtomImpL1Rule_I. apply AtomImpL1 in H0.
            assert (J4: ImpRRule [(Γ2 ++ # P :: (Γ3 ++ [A]) ++ A0 :: Γ4, B)]
            (Γ2 ++ # P :: Γ3 ++ A0 :: Γ4, Imp A B)).
            assert (Γ2 ++ # P :: (Γ3 ++ [A]) ++ A0 :: Γ4 = (Γ2 ++ # P :: Γ3) ++ A :: A0 :: Γ4). repeat rewrite <- app_assoc ; auto.
            assert (Γ2 ++ # P :: Γ3 ++ A0 :: Γ4 = (Γ2 ++ # P :: Γ3) ++ A0 :: Γ4). repeat rewrite <- app_assoc ; auto.
            rewrite H1. rewrite H2. apply ImpRRule_I.
            assert (J5: derrec_height x < S (dersrec_height d)). lia.
            assert (J6: derrec_height x = derrec_height x). reflexivity.
            pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
            pose (dlCons x0 DersNilF).
            pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
            (ps:=[(Γ2 ++ # P :: (Γ3 ++ [A]) ++ A0 :: Γ4, B)])
            ((Γ2 ++ # P :: Γ3 ++ []) ++ A :: Imp # P A0 :: Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
            lia. reflexivity.
          * inversion e1. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
            pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
            assert (AtomImpL1Rule  [((Γ2 ++ # P :: Γ3 ++ A0 :: x0) ++ A :: Γ1, B)]
            ((Γ2 ++ # P :: Γ3 ++ Imp # P A0 :: x0) ++ A :: Γ1, B)). repeat rewrite <- app_assoc. simpl.
            repeat rewrite <- app_assoc. apply AtomImpL1Rule_I. apply AtomImpL1 in H0.
            assert (J4: ImpRRule [((Γ2 ++ # P :: Γ3 ++ A0 :: x0) ++ A :: Γ1, B)]
            ((Γ2 ++ # P :: Γ3 ++ A0 :: x0) ++ Γ1, Imp A B)). apply ImpRRule_I.
            repeat rewrite <- app_assoc in J4. simpl in J4. repeat rewrite <- app_assoc in J4. simpl in J4.
            assert (J5: derrec_height x < S (dersrec_height d)). lia.
            assert (J6: derrec_height x = derrec_height x). reflexivity.
            pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
            pose (dlCons x1 DersNilF). rewrite <- app_assoc in H0. simpl in H0. rewrite <- app_assoc in H0.
            pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
            (ps:=[(Γ2 ++ # P :: Γ3 ++ A0 :: x0 ++ A :: Γ1, B)])
            ((Γ2 ++ # P :: Γ3 ++ Imp # P A0 :: x0) ++ A :: Γ1, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
            lia. reflexivity.
        - assert (J30: dersrec_height d = dersrec_height d). reflexivity.
          pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
          assert (AtomImpL1Rule  [(Γ2 ++ # P :: (x ++ A :: x0) ++ A0 :: Γ4, B)]
          ((Γ2 ++ # P :: x) ++ A :: x0 ++ Imp # P A0 :: Γ4, B)).
          assert ((Γ2 ++ # P :: x) ++ A :: x0 ++ Imp # P A0 :: Γ4 = Γ2 ++ # P :: (x ++ A :: x0) ++ Imp # P A0 :: Γ4). repeat rewrite <- app_assoc ; auto.
          rewrite H0. clear H0. apply AtomImpL1Rule_I. apply AtomImpL1 in H0.
          assert (J4: ImpRRule [(Γ2 ++ # P :: (x ++ A :: x0) ++ A0 :: Γ4, B)]
          (Γ2 ++ # P :: (x ++ x0) ++ A0 :: Γ4, Imp A B)).
          assert (Γ2 ++ # P :: (x ++ x0) ++ A0 :: Γ4 = (Γ2 ++ # P :: x) ++ x0 ++ A0 :: Γ4). repeat rewrite <- app_assoc ; auto.
          assert (Γ2 ++ # P :: (x ++ A :: x0) ++ A0 :: Γ4 = (Γ2 ++ # P :: x) ++ A :: x0 ++ A0 :: Γ4). repeat rewrite <- app_assoc ; auto.
          rewrite H1. rewrite H2. apply ImpRRule_I.
          assert (J5: derrec_height x1 < S (dersrec_height d)). lia.
          assert (J6: derrec_height x1 = derrec_height x1). reflexivity.
          pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
          pose (dlCons x2 DersNilF).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
          (ps:=[(Γ2 ++ # P :: (x ++ A :: x0) ++ A0 :: Γ4, B)])
          ((Γ2 ++ # P :: x) ++ A :: x0 ++ Imp # P A0 :: Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
          lia. reflexivity. }
    + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (AtomImpL1Rule  [(Γ0 ++ A :: x ++ # P :: Γ3 ++ A0 :: Γ4, B)]
       (Γ0 ++ A :: x ++ # P :: Γ3 ++ Imp # P A0 :: Γ4, B)).
       assert (Γ0 ++ A :: x ++ # P :: Γ3 ++ Imp # P A0 :: Γ4 = (Γ0 ++ A :: x) ++ # P :: Γ3 ++ Imp # P A0 :: Γ4). repeat rewrite <- app_assoc ; auto.
       assert (Γ0 ++ A :: x ++ # P :: Γ3 ++ A0 :: Γ4 = (Γ0 ++ A :: x) ++ # P :: Γ3 ++ A0 :: Γ4). repeat rewrite <- app_assoc ; auto.
       rewrite H0. rewrite H1. apply AtomImpL1Rule_I. apply AtomImpL1 in H0.
       assert (J4: ImpRRule [(Γ0 ++ A :: x ++ # P :: Γ3 ++ A0 :: Γ4, B)]
       ((Γ0 ++ x) ++ # P :: Γ3 ++ A0 :: Γ4, Imp A B)). repeat rewrite <- app_assoc. apply ImpRRule_I.
       assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
       assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
       pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
       pose (dlCons x1 DersNilF).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
       (ps:= [(Γ0 ++ A :: x ++ # P :: Γ3 ++ A0 :: Γ4, B)])
       (Γ0 ++ A :: x ++ # P :: Γ3 ++ Imp # P A0 :: Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
       lia. reflexivity.
  (* AtomImpL2 *)
  * inversion H. subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
 + simpl. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
      assert (AtomImpL2Rule  [((Γ2 ++ [A]) ++ A0 :: Γ3 ++ # P :: Γ4, B)]
      ((Γ2 ++ [A]) ++ Imp # P A0 :: Γ3 ++ # P :: Γ4, B)). apply AtomImpL2Rule_I. apply AtomImpL2 in H0.
      repeat rewrite <- app_assoc in H0. simpl in H0.
      assert (J4: ImpRRule [(Γ2 ++ A :: A0 :: Γ3 ++ # P :: Γ4, B)]
      (Γ2 ++ A0 :: Γ3 ++ # P :: Γ4, Imp A B)). apply ImpRRule_I.
      assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
      pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
      pose (dlCons x1 DersNilF).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
      (ps:=[(Γ2 ++ A ::A0 :: Γ3 ++  # P :: Γ4, B)])
      (Γ2 ++ A :: Imp # P A0 :: Γ3 ++ # P :: Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
      lia. reflexivity.
   + destruct x.
      { simpl in e0. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
        assert (AtomImpL2Rule  [(Γ2 ++ A ::A0  :: Γ3 ++ # P :: Γ4, B)]
        ((Γ2 ++ []) ++ A ::  Imp # P A0 :: Γ3 ++# P :: Γ4, B)).
        assert (Γ2 ++ A :: A0 :: Γ3 ++ # P :: Γ4 = (Γ2 ++ [A]) ++ A0 :: Γ3 ++ # P :: Γ4). repeat rewrite <- app_assoc ; auto.
        assert ((Γ2 ++ []) ++ A :: Imp # P A0 :: Γ3 ++ # P :: Γ4 = (Γ2 ++ [A]) ++ Imp # P A0 :: Γ3 ++ # P :: Γ4). repeat rewrite <- app_assoc ; auto.
        rewrite H0. clear H0. rewrite H1. clear H1. apply AtomImpL2Rule_I. apply AtomImpL2 in H0.
        assert (J4: ImpRRule [(Γ2 ++ A :: A0 :: Γ3 ++ # P :: Γ4, B)]
        (Γ2 ++ A0  :: Γ3 ++ # P :: Γ4, Imp A B)). apply ImpRRule_I.
        assert (J5: derrec_height x < S (dersrec_height d)). lia.
        assert (J6: derrec_height x = derrec_height x). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
        pose (dlCons x0 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[(Γ2 ++ A :: A0 :: Γ3 ++ # P :: Γ4, B)])
        ((Γ2 ++ []) ++ A ::Imp # P A0  :: Γ3 ++ # P :: Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
      { inversion e0.  subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
        - assert (J30: dersrec_height d = dersrec_height d). reflexivity.
          pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
          assert (AtomImpL2Rule  [(Γ2 ++ A0 :: (Γ3 ++ [A]) ++ # P :: Γ4, B)]
          ((Γ2 ++ Imp # P A0 :: Γ3) ++ A ::# P  :: Γ4, B)).
          assert ((Γ2 ++ Imp # P A0 :: Γ3) ++ A :: # P :: Γ4 =Γ2 ++ Imp # P A0 :: (Γ3 ++ [A]) ++ # P :: Γ4). repeat rewrite <- app_assoc ; auto.
          rewrite H0. clear H0. apply AtomImpL2Rule_I. apply AtomImpL2 in H0.
          assert (J4: ImpRRule [(Γ2 ++ A0 :: (Γ3 ++ [A]) ++ # P :: Γ4, B)]
          (Γ2 ++A0 :: Γ3 ++ # P :: Γ4, Imp A B)).
          assert (Γ2 ++A0  :: (Γ3 ++ [A]) ++ # P :: Γ4 = (Γ2 ++ A0 :: Γ3) ++ A :: # P :: Γ4). repeat rewrite <- app_assoc ; auto.
          assert (Γ2 ++A0  :: Γ3 ++ # P :: Γ4 = (Γ2 ++ A0:: Γ3) ++ # P  :: Γ4). repeat rewrite <- app_assoc ; auto.
          rewrite H1. rewrite H2. apply ImpRRule_I.
          assert (J5: derrec_height x < S (dersrec_height d)). lia.
          assert (J6: derrec_height x = derrec_height x). reflexivity.
          pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
          pose (dlCons x1 DersNilF).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
          (ps:=[(Γ2 ++ A0 :: (Γ3 ++ [A]) ++ # P :: Γ4, B)])
          ((Γ2 ++ Imp # P A0 :: Γ3) ++ A :: # P :: Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
          lia. reflexivity.
        - destruct x0 ; simpl in e1 ; subst.
          * assert (J30: dersrec_height d = dersrec_height d). reflexivity.
            pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
            assert (AtomImpL2Rule  [(Γ2 ++ A0 :: (Γ3 ++ [A]) ++ # P :: Γ4, B)]
            ((Γ2 ++ Imp # P A0 :: Γ3 ++ []) ++ A :: # P :: Γ4, B)).
            assert ((Γ2 ++ Imp # P A0 :: Γ3 ++ []) ++ A :: # P :: Γ4 =Γ2 ++ Imp # P A0 :: (Γ3 ++ [A]) ++ # P :: Γ4).
            repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto.
            rewrite H0. clear H0. apply AtomImpL2Rule_I. apply AtomImpL2 in H0.
            assert (J4: ImpRRule [(Γ2 ++A0  :: (Γ3 ++ [A]) ++ # P :: Γ4, B)]
            (Γ2 ++ A0 :: Γ3 ++ # P :: Γ4, Imp A B)).
            assert (Γ2 ++ A0 :: (Γ3 ++ [A]) ++ # P :: Γ4 = (Γ2 ++ A0 :: Γ3) ++ A :: # P :: Γ4). repeat rewrite <- app_assoc ; auto.
            assert (Γ2 ++ A0 :: Γ3 ++ # P :: Γ4 = (Γ2 ++ A0 :: Γ3) ++ # P :: Γ4). repeat rewrite <- app_assoc ; auto.
            rewrite H1. rewrite H2. apply ImpRRule_I.
            assert (J5: derrec_height x < S (dersrec_height d)). lia.
            assert (J6: derrec_height x = derrec_height x). reflexivity.
            pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
            pose (dlCons x0 DersNilF).
            pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
            (ps:=[(Γ2 ++ A0 :: (Γ3 ++ [A]) ++ # P :: Γ4, B)])
            ((Γ2 ++ Imp # P A0 :: Γ3 ++ []) ++ A :: # P :: Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
            lia. reflexivity.
          * inversion e1. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
            pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
            assert (AtomImpL2Rule  [((Γ2 ++ A0 :: Γ3 ++ # P :: x0) ++ A :: Γ1, B)]
            ((Γ2 ++ Imp # P A0 :: Γ3 ++ # P :: x0) ++ A :: Γ1, B)). repeat rewrite <- app_assoc. simpl.
            repeat rewrite <- app_assoc. apply AtomImpL2Rule_I. apply AtomImpL2 in H0.
            assert (J4: ImpRRule [((Γ2 ++  A0 :: Γ3 ++ # P :: x0) ++ A :: Γ1, B)]
            ((Γ2 ++ A0 :: Γ3 ++ # P :: x0) ++ Γ1, Imp A B)). apply ImpRRule_I.
            repeat rewrite <- app_assoc in J4. simpl in J4. repeat rewrite <- app_assoc in J4. simpl in J4.
            assert (J5: derrec_height x < S (dersrec_height d)). lia.
            assert (J6: derrec_height x = derrec_height x). reflexivity.
            pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
            pose (dlCons x1 DersNilF). rewrite <- app_assoc in H0. simpl in H0. rewrite <- app_assoc in H0.
            pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
            (ps:=[(Γ2 ++ A0 :: Γ3 ++ # P :: x0 ++ A :: Γ1, B)])
            ((Γ2 ++ Imp # P A0 :: Γ3 ++ # P :: x0) ++ A :: Γ1, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
            lia. reflexivity.
        - assert (J30: dersrec_height d = dersrec_height d). reflexivity.
          pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
          assert (AtomImpL2Rule  [(Γ2 ++ A0 :: (x ++ A :: x0) ++ # P :: Γ4, B)]
          ((Γ2 ++ Imp # P A0 :: x) ++ A :: x0 ++ # P :: Γ4, B)).
          assert ((Γ2 ++ Imp # P A0 :: x) ++ A :: x0 ++ # P :: Γ4 = Γ2 ++ Imp # P A0 :: (x ++ A :: x0) ++ # P :: Γ4). repeat rewrite <- app_assoc ; auto.
          rewrite H0. clear H0. apply AtomImpL2Rule_I. apply AtomImpL2 in H0.
          assert (J4: ImpRRule [(Γ2 ++A0  :: (x ++ A :: x0) ++ # P :: Γ4, B)]
          (Γ2 ++ A0 :: (x ++ x0) ++ # P :: Γ4, Imp A B)).
          assert (Γ2 ++  A0:: (x ++ x0) ++ # P :: Γ4 = (Γ2 ++A0  :: x) ++ x0 ++ # P :: Γ4). repeat rewrite <- app_assoc ; auto.
          assert (Γ2 ++ A0 :: (x ++ A :: x0) ++ # P :: Γ4 = (Γ2 ++ A0 :: x) ++ A :: x0 ++ # P :: Γ4). repeat rewrite <- app_assoc ; auto.
          rewrite H1. rewrite H2. apply ImpRRule_I.
          assert (J5: derrec_height x1 < S (dersrec_height d)). lia.
          assert (J6: derrec_height x1 = derrec_height x1). reflexivity.
          pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
          pose (dlCons x2 DersNilF).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
          (ps:=[(Γ2 ++A0  :: (x ++ A :: x0) ++ # P :: Γ4, B)])
          ((Γ2 ++  Imp # P A0 :: x) ++ A :: x0 ++ # P :: Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
          lia. reflexivity. }
    + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (AtomImpL2Rule  [(Γ0 ++ A :: x ++ A0 :: Γ3 ++ # P :: Γ4, B)]
       (Γ0 ++ A :: x ++ Imp # P A0 :: Γ3 ++ # P :: Γ4, B)).
       assert (Γ0 ++ A :: x ++ Imp # P A0 :: Γ3 ++ # P :: Γ4 = (Γ0 ++ A :: x) ++ Imp # P A0 :: Γ3 ++ # P :: Γ4). repeat rewrite <- app_assoc ; auto.
       assert (Γ0 ++ A :: x ++ A0 :: Γ3 ++ # P :: Γ4 = (Γ0 ++ A :: x) ++ A0 :: Γ3 ++ # P :: Γ4). repeat rewrite <- app_assoc ; auto.
       rewrite H0. rewrite H1. apply AtomImpL2Rule_I. apply AtomImpL2 in H0.
       assert (J4: ImpRRule [(Γ0 ++ A :: x ++ A0  :: Γ3 ++ # P:: Γ4, B)]
       ((Γ0 ++ x) ++ A0 :: Γ3 ++ # P :: Γ4, Imp A B)). repeat rewrite <- app_assoc. apply ImpRRule_I.
       assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
       assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
       pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
       pose (dlCons x1 DersNilF).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
       (ps:= [(Γ0 ++ A :: x ++ A0 :: Γ3 ++ # P :: Γ4, B)])
       (Γ0 ++ A :: x ++Imp # P A0 :: Γ3 ++ # P :: Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
       lia. reflexivity.
 (* AndImpL *)
  * inversion H. subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
   + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (AndImpLRule  [((Γ2 ++ [A]) ++ Imp A0 (Imp B0 C) :: Γ3, B)]
       ((Γ2 ++ [A]) ++ Imp (And A0 B0) C :: Γ3, B)). apply AndImpLRule_I. apply AndImpL in H0.
       repeat rewrite <- app_assoc in H0. simpl in H0.
       assert (J4: ImpRRule [(Γ2 ++ A :: Imp A0 (Imp B0 C) :: Γ3, B)]
       (Γ2 ++ Imp A0 (Imp B0 C) :: Γ3, Imp A B)). apply ImpRRule_I.
       assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
       assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
       pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
       pose (dlCons x1 DersNilF).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
       (ps:=[(Γ2 ++ A :: Imp A0 (Imp B0 C) :: Γ3, B)])
       (Γ2 ++ A :: Imp (And A0 B0) C :: Γ3, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
       lia. reflexivity.
   + destruct x.
      { simpl in e0. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
         pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
         assert (AndImpLRule  [((Γ2 ++ [A]) ++ Imp A0 (Imp B0 C) :: Γ3, B)]
         ((Γ2 ++ []) ++ A :: Imp (And A0 B0) C :: Γ3, B)).
         assert ((Γ2 ++ []) ++ A :: Imp (And A0 B0) C :: Γ3 = (Γ2 ++ [A]) ++ Imp (And A0 B0) C :: Γ3).
         repeat rewrite <- app_assoc. reflexivity. rewrite H0. apply AndImpLRule_I. apply AndImpL in H0.
         assert (J4: ImpRRule [((Γ2 ++ [A]) ++ Imp A0 (Imp B0 C) :: Γ3, B)]
        (Γ2 ++ Imp A0 (Imp B0 C) :: Γ3, Imp A B)). repeat rewrite <- app_assoc. apply ImpRRule_I.
         assert (J5: derrec_height x < S (dersrec_height d)). lia.
         assert (J6: derrec_height x = derrec_height x). reflexivity.
         pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
         pose (dlCons x0 DersNilF).
         pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
         (ps:=[((Γ2 ++ [A]) ++ Imp A0 (Imp B0 C) :: Γ3, B)])
         ((Γ2 ++ []) ++ A :: Imp (And A0 B0) C :: Γ3, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
         lia. reflexivity. }
      { inversion e0.  subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
         pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
         assert (AndImpLRule  [(Γ2 ++ Imp A0 (Imp B0 C) :: x ++ A :: Γ1, B)]
         ((Γ2 ++ Imp (And A0 B0) C :: x) ++ A :: Γ1, B)). repeat rewrite <- app_assoc. apply AndImpLRule_I.
         apply AndImpL in H0.
         assert (J4: ImpRRule [((Γ2 ++ Imp A0 (Imp B0 C) :: x) ++ A :: Γ1, B)]
         ((Γ2 ++ Imp A0 (Imp B0 C) :: x) ++ Γ1, Imp A B)). apply ImpRRule_I. repeat rewrite <- app_assoc in J4.
         simpl in J4.
         assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
         assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
         pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
         pose (dlCons x1 DersNilF).
         pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
         (ps:=[(Γ2 ++ Imp A0 (Imp B0 C) :: x ++ A :: Γ1, B)])
         ((Γ2 ++ Imp (And A0 B0) C :: x) ++ A :: Γ1, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
         lia. reflexivity. }
    + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (AndImpLRule [((Γ0 ++ A :: x) ++ Imp A0 (Imp B0 C) :: Γ3, B)]
       ((Γ0 ++ A :: x) ++ Imp (And A0 B0) C :: Γ3, B)). apply AndImpLRule_I. repeat rewrite <- app_assoc in H0. simpl in H0.
       assert (J4: ImpRRule [(Γ0 ++ A :: x ++ Imp A0 (Imp B0 C) :: Γ3, B)]
       ((Γ0 ++ x) ++ Imp A0 (Imp B0 C) :: Γ3, Imp A B)). repeat rewrite <- app_assoc. apply ImpRRule_I.
       assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
       assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
       pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
       pose (dlCons x1 DersNilF). apply AndImpL in H0.
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
       (ps:=[(Γ0 ++ A :: x ++ Imp A0 (Imp B0 C) :: Γ3, B)])
       (Γ0 ++ A :: x ++ Imp (And A0 B0) C :: Γ3, B) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil. lia. reflexivity.
  (* OrImpL *)
  * inversion H. subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
   + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (OrImpLRule  [((Γ2 ++ [A]) ++ Imp A0 C :: Γ3 ++ Imp B0 C :: Γ4, B)]
       ((Γ2 ++ [A]) ++ Imp (Or A0 B0) C :: Γ3 ++ Γ4, B)). apply OrImpLRule_I. apply OrImpL in H0.
       repeat rewrite <- app_assoc in H0. simpl in H0.
       assert (J4: ImpRRule [(Γ2 ++ A :: Imp A0 C :: Γ3 ++ Imp B0 C :: Γ4, B)]
       (Γ2 ++ Imp A0 C :: Γ3 ++ Imp B0 C :: Γ4, Imp A B)). apply ImpRRule_I.
       assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
       assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
       pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
       pose (dlCons x1 DersNilF).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
       (ps:=[(Γ2 ++ A :: Imp A0 C :: Γ3 ++ Imp B0 C :: Γ4, B)])
       (Γ2 ++ A :: Imp (Or A0 B0) C :: Γ3 ++ Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
       lia. reflexivity.
   + destruct x.
      { simpl in e0. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (OrImpLRule  [((Γ2 ++ [A]) ++ Imp A0 C :: Γ3 ++ Imp B0 C :: Γ4, B)]
       ((Γ2 ++ []) ++ A :: Imp (Or A0 B0) C :: Γ3 ++ Γ4, B)).
       assert ((Γ2 ++ []) ++ A :: Imp (Or A0 B0) C :: Γ3 ++ Γ4 = (Γ2 ++ [A]) ++ Imp (Or A0 B0) C :: Γ3 ++ Γ4).
       repeat rewrite <- app_assoc. auto. rewrite H0. apply OrImpLRule_I. apply OrImpL in H0.
       assert (J4: ImpRRule [((Γ2 ++ [A]) ++ Imp A0 C :: Γ3 ++ Imp B0 C :: Γ4, B)]
       (Γ2 ++ Imp A0 C :: Γ3 ++ Imp B0 C :: Γ4, Imp A B)). repeat rewrite <- app_assoc. apply ImpRRule_I.
       assert (J5: derrec_height x < S (dersrec_height d)). lia.
       assert (J6: derrec_height x = derrec_height x). reflexivity.
       pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
       pose (dlCons x0 DersNilF).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
       (ps:=[((Γ2 ++ [A]) ++ Imp A0 C :: Γ3 ++ Imp B0 C :: Γ4, B)])
       ((Γ2 ++ []) ++ A :: Imp (Or A0 B0) C :: Γ3 ++ Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
       lia. reflexivity. }
      { inversion e0.  subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
         pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s. simpl.
         apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
         - assert (OrImpLRule  [(Γ2 ++ Imp A0 C :: Γ3 ++  Imp B0 C :: A :: Γ4, B)]
           ((Γ2 ++ Imp (Or A0 B0) C :: Γ3) ++ A :: Γ4, B)). repeat rewrite <- app_assoc. apply OrImpLRule_I.
           apply OrImpL in H0.
           assert (J4: ImpRRule [((Γ2 ++ Imp A0 C :: Γ3 ++ [Imp B0 C]) ++ A :: Γ4, B)]
           ((Γ2 ++ Imp A0 C :: Γ3 ++ [Imp B0 C]) ++ Γ4, Imp A B)). apply ImpRRule_I.
           repeat rewrite <- app_assoc in J4. simpl in J4. repeat rewrite <- app_assoc in J4. simpl in J4.
           assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
           assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
           pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
           pose (dlCons x DersNilF).
           pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
           (ps:=[(Γ2 ++ Imp A0 C :: Γ3 ++ Imp B0 C :: A :: Γ4, B)])
           ((Γ2 ++ Imp (Or A0 B0) C :: Γ3) ++ A :: Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
           lia. reflexivity.
         - assert (OrImpLRule  [(Γ2 ++ Imp A0 C :: Γ3 ++ Imp B0 C :: x1 ++ A :: Γ1, B)]
           ((Γ2 ++ Imp (Or A0 B0) C :: Γ3 ++ x1) ++ A :: Γ1, B)). repeat rewrite <- app_assoc.
           simpl. repeat rewrite <- app_assoc. apply OrImpLRule_I. apply OrImpL in H0.
           assert (J4: ImpRRule [(Γ2 ++ Imp A0 C :: Γ3 ++ Imp B0 C :: x1 ++ A :: Γ1, B)]
           (Γ2 ++ Imp A0 C :: Γ3 ++ Imp B0 C :: x1 ++ Γ1, Imp A B)).
           assert (Γ2 ++ Imp A0 C :: Γ3 ++ Imp B0 C :: x1 ++ A :: Γ1 = (Γ2 ++ Imp A0 C :: Γ3 ++ Imp B0 C :: x1) ++ A :: Γ1).
           repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. auto. rewrite H1.
           assert (Γ2 ++ Imp A0 C :: Γ3 ++ Imp B0 C :: x1 ++ Γ1 = (Γ2 ++ Imp A0 C :: Γ3 ++ Imp B0 C :: x1) ++ Γ1).
           repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. auto. rewrite H2.
           apply ImpRRule_I.
           assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
           assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
           pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
           pose (dlCons x DersNilF).
           pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
           (ps:=[(Γ2 ++ Imp A0 C :: Γ3 ++ Imp B0 C :: x1 ++ A :: Γ1, B)])
           ((Γ2 ++ Imp (Or A0 B0) C :: Γ3 ++ x1) ++ A :: Γ1, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
           lia. reflexivity.
         - assert (OrImpLRule  [((Γ2 ++ Imp A0 C :: x) ++ A :: x1 ++ Imp B0 C :: Γ4, B)]
           ((Γ2 ++ Imp (Or A0 B0) C :: x) ++ A :: x1 ++ Γ4, B)).
           assert ((Γ2 ++ Imp A0 C :: x) ++ A :: x1 ++ Imp B0 C :: Γ4 = Γ2 ++ Imp A0 C :: (x ++ A :: x1) ++ Imp B0 C :: Γ4).
           repeat rewrite <- app_assoc. auto. rewrite H0.
           assert ((Γ2 ++ Imp (Or A0 B0) C :: x) ++ A :: x1 ++ Γ4 = Γ2 ++ Imp (Or A0 B0) C :: (x ++ A :: x1) ++ Γ4).
           repeat rewrite <- app_assoc. auto. rewrite H1.
           apply OrImpLRule_I. apply OrImpL in H0.
           assert (J4: ImpRRule [((Γ2 ++ Imp A0 C :: x) ++ A :: x1 ++ Imp B0 C :: Γ4, B)]
           (Γ2 ++ Imp A0 C :: (x ++ x1) ++ Imp B0 C :: Γ4, Imp A B)).
           assert (Γ2 ++ Imp A0 C :: (x ++ x1) ++ Imp B0 C :: Γ4 = (Γ2 ++ Imp A0 C :: x) ++ x1 ++ Imp B0 C :: Γ4).
           repeat rewrite <- app_assoc. auto. rewrite H1. apply ImpRRule_I.
           assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
           assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
           pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
           pose (dlCons x2 DersNilF).
           pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
           (ps:=[((Γ2 ++ Imp A0 C :: x) ++ A :: x1 ++ Imp B0 C :: Γ4, B)])
           ((Γ2 ++ Imp (Or A0 B0) C :: x) ++ A :: x1 ++ Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
           lia. reflexivity. }
    + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (OrImpLRule  [((Γ0 ++ A :: x) ++ Imp A0 C :: Γ3 ++ Imp B0 C :: Γ4, B)]
       (Γ0 ++ A :: x ++ Imp (Or A0 B0) C :: Γ3 ++ Γ4, B)).
       assert (Γ0 ++ A :: x ++ Imp (Or A0 B0) C :: Γ3 ++ Γ4 = (Γ0 ++ A :: x) ++ Imp (Or A0 B0) C :: Γ3 ++ Γ4).
       repeat rewrite <- app_assoc. auto. rewrite H0.
       apply OrImpLRule_I. apply OrImpL in H0.
       assert (J4: ImpRRule [((Γ0 ++ A :: x) ++ Imp A0 C :: Γ3 ++ Imp B0 C :: Γ4, B)]
       ((Γ0 ++ x) ++ Imp A0 C :: Γ3 ++ Imp B0 C :: Γ4, Imp A B)). repeat rewrite <- app_assoc. apply ImpRRule_I.
       assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
       assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
       pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
       pose (dlCons x1 DersNilF).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
       (ps:=[((Γ0 ++ A :: x) ++ Imp A0 C :: Γ3 ++ Imp B0 C :: Γ4, B)])
       (Γ0 ++ A :: x ++ Imp (Or A0 B0) C :: Γ3 ++ Γ4, B) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
       lia. reflexivity.
  (* ImpImpL *)
 * inversion H. subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
   + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
      assert (ImpImpLRule [(Γ2 ++ A :: Imp B0 C :: Γ3, Imp A0 B0); (Γ2 ++ A :: C :: Γ3, B)]
      (Γ2 ++ A :: Imp (Imp A0 B0) C :: Γ3, B)).
      assert (Γ2 ++ A :: Imp B0 C :: Γ3 = (Γ2 ++ [A]) ++ Imp B0 C :: Γ3). repeat rewrite <- app_assoc ; auto.
      rewrite H0. assert (Γ2 ++ A :: C :: Γ3 = (Γ2 ++ [A]) ++ C :: Γ3). repeat rewrite <- app_assoc ; auto.
      rewrite H1. assert (Γ2 ++ A :: Imp (Imp A0 B0) C :: Γ3 = (Γ2 ++ [A]) ++ Imp (Imp A0 B0) C :: Γ3). repeat rewrite <- app_assoc ; auto.
      rewrite H2. apply ImpImpLRule_I. apply ImpImpL in H0.
      assert (J4: ImpRRule [(Γ2 ++ A :: C :: Γ3, B)] (Γ2 ++ C :: Γ3, Imp A B)). apply ImpRRule_I.
      assert (J5: derrec_height x1 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x1 = derrec_height x1). reflexivity.
      pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
      assert (J1: derrec_height x0 = derrec_height x0). auto.
      assert (J2: wkn_L A (Γ2 ++ Imp B0 C :: Γ3, Imp A0 B0) (Γ2 ++ A :: Imp B0 C :: Γ3, Imp A0 B0)).
      apply wkn_LI.
      pose (@GL4ip_wkn_L (derrec_height x0) _ x0 J1 (Γ2 ++ A :: Imp B0 C :: Γ3, Imp A0 B0) A J2). destruct s.
      pose (dlCons x2 DersNilF). pose (dlCons x3 d0).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
      (ps:=[(Γ2 ++ A :: Imp B0 C :: Γ3, Imp A0 B0); (Γ2 ++ A :: C :: Γ3, B)])
      (Γ2 ++ A :: Imp (Imp A0 B0) C :: Γ3, B) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
      lia. reflexivity.
   + destruct x.
      { simpl in e0. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
        assert (ImpImpLRule [(Γ2 ++ A :: Imp B0 C :: Γ3, Imp A0 B0); (Γ2 ++ A :: C :: Γ3, B)]
        ((Γ2 ++ []) ++ A :: Imp (Imp A0 B0) C :: Γ3, B)).
        assert (Γ2 ++ A :: Imp B0 C :: Γ3 = (Γ2 ++ [A]) ++ Imp B0 C :: Γ3). repeat rewrite <- app_assoc ; auto.
        rewrite H0. assert (Γ2 ++ A :: C :: Γ3 = (Γ2 ++ [A]) ++ C :: Γ3). repeat rewrite <- app_assoc ; auto.
        rewrite H1. assert ((Γ2 ++ []) ++ A :: Imp (Imp A0 B0) C :: Γ3 = (Γ2 ++ [A]) ++ Imp (Imp A0 B0) C :: Γ3). repeat rewrite <- app_assoc ; auto.
        rewrite H2. apply ImpImpLRule_I. apply ImpImpL in H0.
        assert (J4: ImpRRule [(Γ2 ++ A :: C :: Γ3, B)] (Γ2 ++ C :: Γ3, Imp A B)). apply ImpRRule_I.
        assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
        assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
        assert (J1: derrec_height x = derrec_height x). auto.
        assert (J2: wkn_L A (Γ2 ++ Imp B0 C :: Γ3, Imp A0 B0) (Γ2 ++ A :: Imp B0 C :: Γ3, Imp A0 B0)).
        apply wkn_LI.
        pose (@GL4ip_wkn_L (derrec_height x) _ x J1 (Γ2 ++ A :: Imp B0 C :: Γ3, Imp A0 B0) A J2). destruct s.
        pose (dlCons x1 DersNilF). pose (dlCons x2 d0).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[(Γ2 ++ A :: Imp B0 C :: Γ3, Imp A0 B0); (Γ2 ++ A :: C :: Γ3, B)])
        ((Γ2 ++ []) ++ A :: Imp (Imp A0 B0) C :: Γ3, B) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
      { inversion e0. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
        repeat rewrite <- app_assoc. simpl.
        assert (ImpImpLRule [(Γ2 ++ Imp B0 C :: x ++ A :: Γ1, Imp A0 B0); (Γ2 ++ C :: x ++ A :: Γ1, B)]
        (Γ2 ++ Imp (Imp A0 B0) C :: x ++ A :: Γ1, B)). apply ImpImpLRule_I. apply ImpImpL in H0.
        assert (J4: ImpRRule [(Γ2 ++ C :: x ++ A :: Γ1, B)] (Γ2 ++ C :: x ++ Γ1, Imp A B)).
        assert (Γ2 ++ C :: x ++ A :: Γ1 = (Γ2 ++ C :: x) ++ A :: Γ1). repeat rewrite <- app_assoc ; auto.
        rewrite H1. assert (Γ2 ++ C :: x ++ Γ1 = (Γ2 ++ C :: x) ++ Γ1). repeat rewrite <- app_assoc ; auto.
        rewrite H2. apply ImpRRule_I.
        assert (J5: derrec_height x1 < S (dersrec_height d)). lia.
        assert (J6: derrec_height x1 = derrec_height x1). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
        assert (J1: derrec_height x0 = derrec_height x0). auto.
        assert (J2: wkn_L A (Γ2 ++ Imp B0 C :: x ++ Γ1, Imp A0 B0) (Γ2 ++ Imp B0 C :: x ++ A :: Γ1, Imp A0 B0)).
        assert (Γ2 ++ Imp B0 C :: x ++ Γ1 = (Γ2 ++ Imp B0 C :: x) ++ Γ1). repeat rewrite <- app_assoc ; auto.
        rewrite H1. assert (Γ2 ++ Imp B0 C :: x ++ A :: Γ1 = (Γ2 ++ Imp B0 C :: x) ++ A :: Γ1). repeat rewrite <- app_assoc ; auto.
        rewrite H2. apply wkn_LI.
        pose (@GL4ip_wkn_L (derrec_height x0) _ x0 J1 _ A J2). destruct s.
        pose (dlCons x2 DersNilF). pose (dlCons x3 d0).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[(Γ2 ++ Imp B0 C :: x ++ A :: Γ1, Imp A0 B0); (Γ2 ++ C :: x ++ A :: Γ1, B)])
       (Γ2 ++ Imp (Imp A0 B0) C :: x ++ A :: Γ1, B) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
    + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
        repeat rewrite <- app_assoc. simpl.
        assert (ImpImpLRule [((Γ0 ++ A :: x) ++ Imp B0 C :: Γ3, Imp A0 B0); ((Γ0 ++ A :: x) ++ C :: Γ3, B)]
        (Γ0 ++ A :: x ++ Imp (Imp A0 B0) C :: Γ3, B)).
        assert (Γ0 ++ A :: x ++ Imp (Imp A0 B0) C :: Γ3 =  (Γ0 ++ A :: x) ++ Imp (Imp A0 B0) C :: Γ3).
        repeat rewrite <- app_assoc ; auto. rewrite H0. apply ImpImpLRule_I. apply ImpImpL in H0.
        assert (J4: ImpRRule [((Γ0 ++ A :: x) ++ C :: Γ3, B)] ((Γ0 ++ x) ++ C :: Γ3, Imp A B)).
        repeat rewrite <- app_assoc. apply ImpRRule_I.
        assert (J5: derrec_height x1 < S (dersrec_height d)). lia.
        assert (J6: derrec_height x1 = derrec_height x1). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s.
        assert (J1: derrec_height x0 = derrec_height x0). auto.
        assert (J2: wkn_L A ((Γ0 ++ x) ++ Imp B0 C :: Γ3, Imp A0 B0) ((Γ0 ++ A :: x) ++ Imp B0 C :: Γ3, Imp A0 B0)).
        repeat rewrite <- app_assoc. apply wkn_LI.
        pose (@GL4ip_wkn_L (derrec_height x0) _ x0 J1 _ A J2). destruct s.
        pose (dlCons x2 DersNilF). pose (dlCons x3 d0).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[((Γ0 ++ A :: x) ++ Imp B0 C :: Γ3, Imp A0 B0); ((Γ0 ++ A :: x) ++ C :: Γ3, B)])
        (Γ0 ++ A :: x ++ Imp (Imp A0 B0) C :: Γ3, B) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
        lia. reflexivity.
  (* BoxImpL *)
 * inversion X. subst. apply app2_find_hole in H. destruct H. repeat destruct s ; destruct p ; subst.
   + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
      apply univ_gen_ext_splitR in X0. destruct X0. destruct s. repeat destruct p. subst.
      assert (J4: ImpRRule [(Γ2 ++ A :: B0 :: Γ3, B)] (Γ2 ++ B0 :: Γ3, Imp A B)). apply ImpRRule_I.
      assert (J5: derrec_height x1 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x1 = derrec_height x1). reflexivity.
      pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s. destruct (dec_is_boxedT A).
      { assert (BoxImpLRule [(XBoxed_list (x2 ++ A :: x3) ++ [Box A0], A0); (Γ2 ++ A :: B0 :: Γ3, B)]
        (Γ2 ++ A :: Imp (Box A0) B0 :: Γ3, B)).
        assert (Γ2 ++ A :: Imp (Box A0) B0 :: Γ3 =  (Γ2 ++ [A]) ++ Imp (Box A0) B0 :: Γ3).
        repeat rewrite <- app_assoc ; auto. rewrite H.
        assert (Γ2 ++ A :: B0 :: Γ3 =  (Γ2 ++ [A]) ++ B0 :: Γ3).
        repeat rewrite <- app_assoc ; auto. rewrite H0. apply BoxImpLRule_I ; auto. intro.
        intros. apply in_app_or in H2. destruct H2. apply H1. apply in_or_app ; auto. inversion H2 ; subst. auto.
        apply H1 ; apply in_or_app ; auto. repeat rewrite <- app_assoc. simpl. apply univ_gen_ext_combine.
        auto. apply univ_gen_ext_cons ; auto. apply BoxImpL in X0.
        assert (J1: derrec_height x0 = derrec_height x0). auto.
        assert (J2: wkn_L A (XBoxed_list (x2 ++ x3) ++ [Box A0], A0) ((XBoxed_list x2) ++ A :: (XBoxed_list x3) ++ [Box A0], A0)).
        repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. apply wkn_LI.
        pose (@GL4ip_wkn_L (derrec_height x0) _ x0 J1 _ A J2). destruct s.
        assert (J3: derrec_height x5 = derrec_height x5). auto.
        assert (J31: wkn_L (unBox_formula A) ((XBoxed_list x2) ++ A :: (XBoxed_list x3) ++ [Box A0], A0) (XBoxed_list (x2 ++ A :: x3) ++ [Box A0], A0)).
        repeat rewrite XBox_app_distrib. simpl. repeat rewrite <- app_assoc. apply wkn_LI.
        pose (@GL4ip_wkn_L (derrec_height x5) _ x5 J3 _ (unBox_formula A) J31). destruct s.
        pose (dlCons x4 DersNilF). pose (dlCons x6 d0).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[(XBoxed_list (x2 ++ A :: x3) ++ [Box A0], A0); (Γ2 ++ A :: B0 :: Γ3, B)])
        (Γ2 ++ A :: Imp (Box A0) B0 :: Γ3, B) X0 d1). exists d2. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
      { assert (BoxImpLRule [(XBoxed_list (x2 ++ x3) ++ [Box A0], A0); (Γ2 ++ A :: B0 :: Γ3, B)]
        (Γ2 ++ A :: Imp (Box A0) B0 :: Γ3, B)).
        assert (Γ2 ++ A :: Imp (Box A0) B0 :: Γ3 =  (Γ2 ++ [A]) ++ Imp (Box A0) B0 :: Γ3).
        repeat rewrite <- app_assoc ; auto. rewrite H.
        assert (Γ2 ++ A :: B0 :: Γ3 =  (Γ2 ++ [A]) ++ B0 :: Γ3).
        repeat rewrite <- app_assoc ; auto. rewrite H0. apply BoxImpLRule_I ; auto. repeat rewrite <- app_assoc. simpl.
        apply univ_gen_ext_combine ; auto. apply univ_gen_ext_extra ; auto. apply BoxImpL in X0.
        pose (dlCons x4 DersNilF). pose (dlCons x0 d0).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[(XBoxed_list (x2 ++ x3) ++ [Box A0], A0); (Γ2 ++ A :: B0 :: Γ3, B)])
        (Γ2 ++ A :: Imp (Box A0) B0 :: Γ3, B) X0 d1). exists d2. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
   + destruct x.
      { simpl in e0. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
        apply univ_gen_ext_splitR in X0. destruct X0. destruct s. repeat destruct p. subst.
        assert (J4: ImpRRule [(Γ2 ++ A :: B0 :: Γ3, B)] (Γ2 ++ B0 :: Γ3, Imp A B)). apply ImpRRule_I.
        assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
        assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s. destruct (dec_is_boxedT A).
        - assert (BoxImpLRule [(XBoxed_list (x1 ++ A :: x2) ++ [Box A0], A0); (Γ2 ++ A :: B0 :: Γ3, B)]
          ((Γ2 ++ []) ++ A :: Imp (Box A0) B0 :: Γ3, B)).
          assert ((Γ2 ++ []) ++ A :: Imp (Box A0) B0 :: Γ3 =  (Γ2 ++ [A]) ++ Imp (Box A0) B0 :: Γ3).
          repeat rewrite <- app_assoc ; auto. rewrite H.
          assert (Γ2 ++ A :: B0 :: Γ3 =  (Γ2 ++ [A]) ++ B0 :: Γ3).
          repeat rewrite <- app_assoc ; auto. rewrite H0. apply BoxImpLRule_I ; auto. intro.
          intros. apply in_app_or in H2. destruct H2. apply H1. apply in_or_app ; auto. inversion H2 ; subst. auto.
          apply H1 ; apply in_or_app ; auto. repeat rewrite <- app_assoc. simpl. apply univ_gen_ext_combine.
          auto. apply univ_gen_ext_cons ; auto. apply BoxImpL in X0.
          assert (J1: derrec_height x = derrec_height x). auto.
          assert (J2: wkn_L A (XBoxed_list (x1 ++ x2) ++ [Box A0], A0) ((XBoxed_list x1) ++ A :: (XBoxed_list x2) ++ [Box A0], A0)).
          repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. apply wkn_LI.
          pose (@GL4ip_wkn_L (derrec_height x) _ x J1 _ A J2). destruct s.
          assert (J3: derrec_height x4 = derrec_height x4). auto.
          assert (J31: wkn_L (unBox_formula A) ((XBoxed_list x1) ++ A :: (XBoxed_list x2) ++ [Box A0], A0) (XBoxed_list (x1 ++ A :: x2) ++ [Box A0], A0)).
          repeat rewrite XBox_app_distrib. simpl. repeat rewrite <- app_assoc. apply wkn_LI.
          pose (@GL4ip_wkn_L (derrec_height x4) _ x4 J3 _ (unBox_formula A) J31). destruct s.
          pose (dlCons x3 DersNilF). pose (dlCons x5 d0).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
          (ps:=[(XBoxed_list (x1 ++ A :: x2) ++ [Box A0], A0); (Γ2 ++ A :: B0 :: Γ3, B)])
          ((Γ2 ++ []) ++ A :: Imp (Box A0) B0 :: Γ3, B) X0 d1). exists d2. simpl. rewrite dersrec_height_nil.
          lia. reflexivity.
        - assert (BoxImpLRule [(XBoxed_list (x1 ++ x2) ++ [Box A0], A0); (Γ2 ++ A :: B0 :: Γ3, B)]
          ((Γ2 ++ []) ++ A :: Imp (Box A0) B0 :: Γ3, B)).
          assert ((Γ2 ++ []) ++ A :: Imp (Box A0) B0 :: Γ3 =  (Γ2 ++ [A]) ++ Imp (Box A0) B0 :: Γ3).
          repeat rewrite <- app_assoc ; auto. rewrite H.
          assert (Γ2 ++ A :: B0 :: Γ3 =  (Γ2 ++ [A]) ++ B0 :: Γ3).
          repeat rewrite <- app_assoc ; auto. rewrite H0. apply BoxImpLRule_I ; auto. repeat rewrite <- app_assoc. simpl.
          apply univ_gen_ext_combine ; auto. apply univ_gen_ext_extra ; auto. apply BoxImpL in X0.
          pose (dlCons x3 DersNilF). pose (dlCons x d0).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
          (ps:=[(XBoxed_list (x1 ++ x2) ++ [Box A0], A0); (Γ2 ++ A :: B0 :: Γ3, B)])
          ((Γ2 ++ []) ++ A :: Imp (Box A0) B0 :: Γ3, B) X0 d1). exists d2. simpl. rewrite dersrec_height_nil.
          lia. reflexivity. }
      { inversion e0. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
        apply univ_gen_ext_splitR in X0. destruct X0. destruct s. repeat destruct p. subst. apply univ_gen_ext_splitR in u0.
        destruct u0. destruct s. repeat destruct p ; subst.
        assert (J4: ImpRRule [((Γ2 ++ B0 :: x) ++ A :: Γ1, B)] ((Γ2 ++ B0 :: x) ++ Γ1, Imp A B)). apply ImpRRule_I.
        repeat rewrite <- app_assoc in J4. simpl in J4.
        assert (J5: derrec_height x1 < S (dersrec_height d)). lia.
        assert (J6: derrec_height x1 = derrec_height x1). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s. destruct (dec_is_boxedT A).
        - assert (BoxImpLRule [(XBoxed_list (x2 ++ x4 ++ A :: x5) ++ [Box A0], A0); (Γ2 ++ B0 :: x ++ A :: Γ1, B)]
          ((Γ2 ++ Imp (Box A0) B0 :: x) ++ A :: Γ1, B)). repeat rewrite <- app_assoc. apply BoxImpLRule_I ; auto.
          intro. intros. apply in_app_or in H. destruct H. apply H1. apply in_or_app ; auto. apply in_app_or in H. destruct H.
          apply H1. apply in_or_app ; right ; apply in_or_app;  auto. inversion H ; subst. auto.
          apply H1 ; apply in_or_app ; right ; apply in_or_app ; auto. apply univ_gen_ext_combine.
          auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_cons ; auto. apply BoxImpL in X0.
          assert (J1: derrec_height x0 = derrec_height x0). auto.
          assert (J2: wkn_L A (XBoxed_list (x2 ++ x4 ++ x5) ++ [Box A0], A0) ((XBoxed_list (x2 ++ x4)) ++ A :: (XBoxed_list x5) ++ [Box A0], A0)).
          assert (XBoxed_list (x2 ++ x4 ++ x5) ++ [Box A0] = (XBoxed_list (x2 ++ x4)) ++ (XBoxed_list x5) ++ [Box A0]).
          repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. auto. rewrite H. apply wkn_LI.
          pose (@GL4ip_wkn_L (derrec_height x0) _ x0 J1 _ A J2). destruct s.
          assert (J3: derrec_height x6 = derrec_height x6). auto.
          assert (J31: wkn_L (unBox_formula A)  (XBoxed_list (x2 ++ x4) ++ A :: XBoxed_list x5 ++ [Box A0], A0)
          (XBoxed_list (x2 ++ x4 ++ A :: x5) ++ [Box A0], A0)).
          assert (XBoxed_list (x2 ++ x4 ++ A :: x5) ++ [Box A0] = (XBoxed_list (x2 ++ x4)) ++ unBox_formula A :: A :: (XBoxed_list x5) ++ [Box A0]).
          repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. auto. rewrite H. apply wkn_LI.
          pose (@GL4ip_wkn_L (derrec_height x6) _ x6 J3 _ (unBox_formula A) J31). destruct s.
          pose (dlCons x3 DersNilF). pose (dlCons x7 d0).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
          (ps:=[(XBoxed_list (x2 ++ x4 ++ A :: x5) ++ [Box A0], A0); (Γ2 ++ B0 :: x ++ A :: Γ1, B)])
          ((Γ2 ++ Imp (Box A0) B0 :: x) ++ A :: Γ1, B) X0 d1). exists d2. simpl. rewrite dersrec_height_nil.
          lia. reflexivity.
        - assert (BoxImpLRule [(XBoxed_list (x2 ++ x4 ++ x5) ++ [Box A0], A0); (Γ2 ++ B0 :: x ++ A :: Γ1, B)]
          ((Γ2 ++ Imp (Box A0) B0 :: x) ++ A :: Γ1, B)). repeat rewrite <- app_assoc. apply BoxImpLRule_I ; auto.
          apply univ_gen_ext_combine ; auto.  apply univ_gen_ext_combine ; auto. apply univ_gen_ext_extra ; auto. apply BoxImpL in X0.
          pose (dlCons x3 DersNilF). pose (dlCons x0 d0).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
          (ps:=[(XBoxed_list (x2 ++ x4 ++ x5) ++ [Box A0], A0); (Γ2 ++ B0 :: x ++ A :: Γ1, B)])
          ((Γ2 ++ Imp (Box A0) B0 :: x) ++ A :: Γ1, B) X0 d1). exists d2. simpl. rewrite dersrec_height_nil.
          lia. reflexivity. }
    + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
      apply univ_gen_ext_splitR in X0. destruct X0. destruct s. repeat destruct p. subst. apply univ_gen_ext_splitR in u.
      destruct u. destruct s. repeat destruct p ; subst.
      assert (J4: ImpRRule [(Γ0 ++ A :: x ++ B0 :: Γ3, B)] ((Γ0 ++ x) ++ B0 :: Γ3, Imp A B)).
      repeat rewrite <- app_assoc. apply ImpRRule_I.
      assert (J5: derrec_height x1 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x1 = derrec_height x1). reflexivity.
      pose (IH _ J5 _ _ J6). pose (s _ J4). destruct s0. clear s. destruct (dec_is_boxedT A).
      { assert (BoxImpLRule [(XBoxed_list (x4 ++ A :: x5 ++ x3) ++ [Box A0], A0); (Γ0 ++ A :: x ++ B0 :: Γ3, B)]
        (Γ0 ++ A :: x ++ Imp (Box A0) B0 :: Γ3, B)).
        assert (Γ0 ++ A :: x ++ B0 :: Γ3 = (Γ0 ++ A :: x) ++ B0 :: Γ3). repeat rewrite <- app_assoc. auto.
        rewrite H. assert (Γ0 ++ A :: x ++ Imp (Box A0) B0 :: Γ3 = (Γ0 ++ A :: x) ++ Imp (Box A0) B0 :: Γ3). repeat rewrite <- app_assoc. auto.
        rewrite H0. apply BoxImpLRule_I ; auto. clear H. clear H0.
        intro. intros. apply in_app_or in H. destruct H. apply H1. apply in_or_app ; left. apply in_or_app ; auto.
        inversion H. subst ; auto. apply in_app_or in H0. destruct H0.
        apply H1. apply in_or_app ; left ; apply in_or_app;  auto.
        apply H1 ; apply in_or_app ; auto. repeat rewrite <- app_assoc. simpl. apply univ_gen_ext_combine ; auto.
        apply univ_gen_ext_cons ; auto. apply univ_gen_ext_combine ; auto. apply BoxImpL in X0.
        assert (J1: derrec_height x0 = derrec_height x0). auto.
        assert (J2: wkn_L A (XBoxed_list ((x4 ++ x5) ++ x3) ++ [Box A0], A0) ((XBoxed_list x4) ++ A :: (XBoxed_list (x5 ++ x3)) ++ [Box A0], A0)).
        repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. apply wkn_LI.
        pose (@GL4ip_wkn_L (derrec_height x0) _ x0 J1 _ A J2). destruct s.
        assert (J3: derrec_height x6 = derrec_height x6). auto.
        assert (J31: wkn_L (unBox_formula A)  (XBoxed_list x4 ++ A :: XBoxed_list (x5 ++ x3) ++ [Box A0], A0)
        (XBoxed_list (x4 ++ A :: x5 ++ x3) ++ [Box A0], A0)).
        repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. simpl.
        repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. apply wkn_LI.
        pose (@GL4ip_wkn_L (derrec_height x6) _ x6 J3 _ (unBox_formula A) J31). destruct s.
        pose (dlCons x2 DersNilF). pose (dlCons x7 d0).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[(XBoxed_list (x4 ++ A :: x5 ++ x3) ++ [Box A0], A0); (Γ0 ++ A :: x ++ B0 :: Γ3, B)])
        (Γ0 ++ A :: x ++ Imp (Box A0) B0 :: Γ3, B) X0 d1). exists d2. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
      { assert (BoxImpLRule [(XBoxed_list ((x4 ++ x5) ++ x3) ++ [Box A0], A0); (Γ0 ++ A :: x ++ B0 :: Γ3, B)]
        (Γ0 ++ A :: x ++ Imp (Box A0) B0 :: Γ3, B)).
        assert (Γ0 ++ A :: x ++ B0 :: Γ3 = (Γ0 ++ A :: x) ++ B0 :: Γ3). repeat rewrite <- app_assoc ; auto.
        rewrite H. assert (Γ0 ++ A :: x ++ Imp (Box A0) B0 :: Γ3 = (Γ0 ++ A :: x) ++ Imp (Box A0) B0 :: Γ3). repeat rewrite <- app_assoc ; auto.
        rewrite H0. apply BoxImpLRule_I ; auto. repeat rewrite <- app_assoc.
        apply univ_gen_ext_combine ; auto. simpl. apply univ_gen_ext_extra ; auto. apply univ_gen_ext_combine ; auto. apply BoxImpL in X0.
        pose (dlCons x2 DersNilF). pose (dlCons x0 d0).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
        (ps:=[(XBoxed_list ((x4 ++ x5) ++ x3) ++ [Box A0], A0); (Γ0 ++ A :: x ++ B0 :: Γ3, B)])
        (Γ0 ++ A :: x ++ Imp (Box A0) B0 :: Γ3, B) X0 d1). exists d2. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
  (* GLR *)
  * inversion X.
Qed.

Theorem ImpR_inv : forall concl prem, (derrec GL4ip_rules (fun _ => False) concl) ->
                                      (ImpRRule [prem] concl) ->
                                      (derrec GL4ip_rules (fun _ => False) prem).
Proof.
intros.
assert (J1: derrec_height X = derrec_height X). reflexivity.
pose (ImpR_hpinv _  _ X J1). pose (s _ H). destruct s0. assumption.
Qed.


(* 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                                                     *)

(************************************************************************)
(*                                                                      *)
(*                      ReduceEq.v                                      *)
(*                                                                      *)
(*    Laurent.Thery @sophia.inria.fr        March 2002                  *)
(************************************************************************)
(** Reduce with an equality *)
Require Import List.
Require Import Normal.
Require Import Nat.
Require Import ZArithRing.
Require Import sTactic.
Require Import GroundN.

(** Reduce an equality with an equality
    - [a1=b1+m1.x /\ a2=b2+m2.x] gives [a1=b1+m1.x /\ n2.a2+n1.b1=n2.b2+n1.a1]
*)
Fixpoint reduceEqEq (m1 : nat) (a1 b1 : exp) (l : list (nat * form))
 {struct l} : list form :=
  match l with
  | (m2, Form.Eq a2 b2) :: l1 =>
      match lcm m1 m2 with
      | m3 =>
          match div m3 m1 with
          | n1 =>
              match div m3 m2 with
              | n2 =>
                  Form.Eq (Plus (scal n1 b1) (scal n2 a2))
                    (Plus (scal n1 a1) (scal n2 b2))
                  :: reduceEqEq m1 a1 b1 l1
              end
          end
      end
  | _ => nil
  end.

Theorem reduceEqEq_correct :
 forall m1 a b l l1,
 0 < m1 ->
 listEqP l1 ->
 (exp2Z (tail l) a = (nth 0 l 0 * Z_of_nat m1 + exp2Z (tail l) b)%Z /\
  formL2Prop (nth 0 l 0%Z) (tail l) l1 <->
  exp2Z (tail l) a = (nth 0 l 0 * Z_of_nat m1 + exp2Z (tail l) b)%Z /\
  form2Prop (tail l) (buildConj (reduceEqEq m1 a b l1))) /\
 Cnf1 (buildConj (reduceEqEq m1 a b l1)).
intros m1 a b l l1 H H0; elim H0; clear H0 l1; simpl in |- *; auto.
intuition.
intros n a0 b0 l0 H0 H1; case (reduceEqEq m1 a b l0).
simpl in |- *; repeat rewrite scal_correct.
intros (H2, H2'); split; auto; split.
intros (H3, (H4, H5)); split; auto.
rewrite H3; rewrite H4.
apply
 trans_equal
  with
    (Z_of_nat (div (lcm m1 n) m1) * exp2Z (tail l) b +
     (Z_of_nat (div (lcm m1 n) n) * (nth 0 l 0 * Z_of_nat n) +
      Z_of_nat (div (lcm m1 n) n) * exp2Z (tail l) b0))%Z.
ring; auto.
replace (Z_of_nat (div (lcm m1 n) n) * (nth 0 l 0 * Z_of_nat n))%Z with
 (Z_of_nat (div (lcm m1 n) m1) * (nth 0 l 0 * Z_of_nat m1))%Z.
ring; auto.
cut (forall a b c, (a * (b * c))%Z = (a * c * b)%Z);
 [ intros H6; repeat rewrite H6 | intros; ring ].
repeat rewrite <- Znat.inj_mult;
 repeat rewrite (fun y z => mult_comm (div y z));
 repeat rewrite <- divides_div; auto.
apply divides_lcm2; auto.
apply divides_lcm1; auto.
intros (H3, H4); split; [ idtac | split ]; auto.
apply Zeq_mult_simpl with (c := Z_of_nat (div (lcm m1 n) n)).
apply Compare.not_eq_sym; apply Zorder.Zlt_not_eq.
replace 0%Z with (Z_of_nat 0); [ apply Znat.inj_lt | simpl in |- *; auto ].
cut (lcm m1 n = n * div (lcm m1 n) n :>nat).
case (div (lcm m1 n) n); auto with arith.
rewrite mult_comm; simpl in |- *; intros H5; Contradict H5.
apply Compare.not_eq_sym; apply lt_O_neq; apply lcm_lt_O; auto.
apply divides_div; auto.
apply divides_lcm2; auto.
rewrite (fun a l => Zmult_comm (exp2Z l a)).
apply
 Zplus_reg_l with (n := (Z_of_nat (div (lcm m1 n) m1) * exp2Z (tail l) b)%Z).
rewrite H4.
rewrite H3.
replace
 ((nth 0 l 0 * Z_of_nat n + exp2Z (tail l) b0) * Z_of_nat (div (lcm m1 n) n))%Z
 with
 (exp2Z (tail l) b0 * Z_of_nat (div (lcm m1 n) n) +
  Z_of_nat n * Z_of_nat (div (lcm m1 n) n) * nth 0 l 0)%Z;
 [ rewrite <- Znat.inj_mult; rewrite <- divides_div; auto | ring ].
replace
 (Z_of_nat (div (lcm m1 n) m1) * (nth 0 l 0 * Z_of_nat m1 + exp2Z (tail l) b))%Z
 with
 (exp2Z (tail l) b * Z_of_nat (div (lcm m1 n) m1) +
  Z_of_nat m1 * Z_of_nat (div (lcm m1 n) m1) * nth 0 l 0)%Z;
 [ rewrite <- Znat.inj_mult; rewrite <- divides_div; auto | ring ].
ring.
apply divides_lcm1; auto.
apply divides_lcm2; auto.
intuition.
intros f l1 (H2, H2'); split; auto.
split.
intros (H3, (H4, H5)); split; auto.
change
  (form2Prop (tail l)
     (Form.Eq
        (Plus (scal (div (lcm m1 n) m1) b) (scal (div (lcm m1 n) n) a0))
        (Plus (scal (div (lcm m1 n) m1) a) (scal (div (lcm m1 n) n) b0))) /\
   form2Prop (tail l) (buildConj (f :: l1))) in |- *.
split; [ idtac | intuition ].
simpl in |- *; repeat rewrite scal_correct.
rewrite H3; rewrite H4.
replace
 (Z_of_nat (div (lcm m1 n) n) * (nth 0 l 0 * Z_of_nat n + exp2Z (tail l) b0))%Z
 with
 (Z_of_nat n * Z_of_nat (div (lcm m1 n) n) * nth 0 l 0 +
  Z_of_nat (div (lcm m1 n) n) * exp2Z (tail l) b0)%Z;
 [ rewrite <- Znat.inj_mult; rewrite <- divides_div; auto | ring ].
replace
 (Z_of_nat (div (lcm m1 n) m1) * (nth 0 l 0 * Z_of_nat m1 + exp2Z (tail l) b))%Z
 with
 (Z_of_nat m1 * Z_of_nat (div (lcm m1 n) m1) * nth 0 l 0 +
  Z_of_nat (div (lcm m1 n) m1) * exp2Z (tail l) b)%Z;
 [ rewrite <- Znat.inj_mult; rewrite <- divides_div; auto | ring ].
ring; auto.
apply divides_lcm1; auto.
apply divides_lcm2; auto.
intros (H3, H4); split; auto; split.
cut
 (form2Prop (tail l)
    (Form.Eq (Plus (scal (div (lcm m1 n) m1) b) (scal (div (lcm m1 n) n) a0))
       (Plus (scal (div (lcm m1 n) m1) a) (scal (div (lcm m1 n) n) b0))));
 [ simpl in |- *; repeat rewrite scal_correct; intros H5
 | generalize H4; simpl in |- *; intros (H5, H6); auto ].
apply Zeq_mult_simpl with (c := Z_of_nat (div (lcm m1 n) n)).
apply Compare.not_eq_sym; apply Zorder.Zlt_not_eq.
replace 0%Z with (Z_of_nat 0); [ apply Znat.inj_lt | simpl in |- *; auto ].
cut (lcm m1 n = n * div (lcm m1 n) n :>nat).
case (div (lcm m1 n) n); auto with arith.
rewrite mult_comm; simpl in |- *; intros H6; Contradict H6.
apply Compare.not_eq_sym; apply lt_O_neq; apply lcm_lt_O; auto.
apply divides_div; auto.
apply divides_lcm2; auto.
rewrite (fun a l => Zmult_comm (exp2Z l a)).
apply
 Zplus_reg_l with (n := (Z_of_nat (div (lcm m1 n) m1) * exp2Z (tail l) b)%Z).
rewrite H5.
rewrite H3.
replace
 ((nth 0 l 0 * Z_of_nat n + exp2Z (tail l) b0) * Z_of_nat (div (lcm m1 n) n))%Z
 with
 (exp2Z (tail l) b0 * Z_of_nat (div (lcm m1 n) n) +
  Z_of_nat n * Z_of_nat (div (lcm m1 n) n) * nth 0 l 0)%Z;
 [ rewrite <- Znat.inj_mult; rewrite <- divides_div; auto | ring ].
replace
 (Z_of_nat (div (lcm m1 n) m1) * (nth 0 l 0 * Z_of_nat m1 + exp2Z (tail l) b))%Z
 with
 (exp2Z (tail l) b * Z_of_nat (div (lcm m1 n) m1) +
  Z_of_nat m1 * Z_of_nat (div (lcm m1 n) m1) * nth 0 l 0)%Z;
 [ rewrite <- Znat.inj_mult; rewrite <- divides_div; auto | ring ].
ring.
apply divides_lcm1; auto.
apply divides_lcm2; auto.
cut (form2Prop (tail l) (buildConj (f :: l1)));
 [ intuition | generalize H4; simpl in |- *; intros (H5, H6); auto ].
Qed.

Theorem reduceEqEq_groundN :
 forall n m1 a b l,
 listEqP l ->
 groundNL2 n l ->
 groundNExp n a -> groundNExp n b -> groundNL n (reduceEqEq m1 a b l).
intros n m1 a b l H; generalize n m1 a b; elim H; clear H n m1 a b;
 simpl in |- *; auto.
intros n a b l0 H H0 H1 n0 m1 a0 b0 H2 H3 H4.
apply GNVCons; auto.
inversion H2.
inversion H8.
apply GNEq with (n := n0) (m := n0); auto.
apply GNPlus with (n := n0) (m := n2); auto.
apply scal_groundN; auto.
apply scal_groundN; auto.
apply GNPlus with (n := n0) (m := m0); auto.
apply scal_groundN; auto.
apply scal_groundN; auto.
apply H1 with (n := n0); auto.
inversion H2; auto.
Qed.

(** Reduce an inequality with an equality
    - [a1=b1+m1.x /\ ~(a2=b2+m2.x)] gives [a1=b1+m1.x /\ ~(n2.a2+n1.b1=n2.b2+n1.a1)]
*)
Fixpoint reduceEqNEq (m1 : nat) (a1 b1 : exp) (l : list (nat * form))
 {struct l} : list form :=
  match l with
  | (m2, Neg (Form.Eq a2 b2)) :: l1 =>
      match lcm m1 m2 with
      | m3 =>
          match div m3 m1 with
          | n1 =>
              match div m3 m2 with
              | n2 =>
                  Neg
                    (Form.Eq (Plus (scal n1 b1) (scal n2 a2))
                       (Plus (scal n1 a1) (scal n2 b2)))
                  :: reduceEqNEq m1 a1 b1 l1
              end
          end
      end
  | _ => nil
  end.

Theorem reduceEqNEq_correct :
 forall m1 a b l l1,
 0 < m1 ->
 listNEqP l1 ->
 (exp2Z (tail l) a = (nth 0 l 0 * Z_of_nat m1 + exp2Z (tail l) b)%Z /\
  formL2Prop (nth 0 l 0%Z) (tail l) l1 <->
  exp2Z (tail l) a = (nth 0 l 0 * Z_of_nat m1 + exp2Z (tail l) b)%Z /\
  form2Prop (tail l) (buildConj (reduceEqNEq m1 a b l1))) /\
 Cnf1 (buildConj (reduceEqNEq m1 a b l1)).
intros m1 a b l l1 H H0; elim H0; clear H0 l1; simpl in |- *; auto.
intuition.
intros n a0 b0 l0 H0 H1; case (reduceEqNEq m1 a b l0).
simpl in |- *; repeat rewrite scal_correct.
intros (H2, H2'); split; auto; split.
intros (H3, (H4, H5)); split; auto.
rewrite H3; Contradict H4.
apply Zeq_mult_simpl with (c := Z_of_nat (div (lcm m1 n) n)).
apply Compare.not_eq_sym; apply Zorder.Zlt_not_eq.
replace 0%Z with (Z_of_nat 0); [ apply Znat.inj_lt | simpl in |- *; auto ].
cut (lcm m1 n = n * div (lcm m1 n) n :>nat).
case (div (lcm m1 n) n); auto with arith.
rewrite mult_comm; simpl in |- *; intros H6; Contradict H6.
apply Compare.not_eq_sym; apply lt_O_neq; apply lcm_lt_O; auto.
apply divides_div; auto.
apply divides_lcm2; auto.
rewrite (fun a l => Zmult_comm (exp2Z l a)).
apply
 Zplus_reg_l with (n := (Z_of_nat (div (lcm m1 n) m1) * exp2Z (tail l) b)%Z).
rewrite H4.
replace
 (Z_of_nat (div (lcm m1 n) m1) * (nth 0 l 0 * Z_of_nat m1 + exp2Z (tail l) b))%Z
 with
 (Z_of_nat m1 * Z_of_nat (div (lcm m1 n) m1) * nth 0 l 0 +
  Z_of_nat (div (lcm m1 n) m1) * exp2Z (tail l) b)%Z;
 [ rewrite <- Znat.inj_mult; rewrite <- divides_div; auto | ring ].
replace
 ((nth 0 l 0 * Z_of_nat n + exp2Z (tail l) b0) * Z_of_nat (div (lcm m1 n) n))%Z
 with
 (Z_of_nat n * Z_of_nat (div (lcm m1 n) n) * nth 0 l 0 +
  Z_of_nat (div (lcm m1 n) n) * exp2Z (tail l) b0)%Z;
 [ rewrite <- Znat.inj_mult; rewrite <- divides_div; auto | ring ].
ring; auto.
apply divides_lcm2; auto.
apply divides_lcm1; auto.
intros (H3, H4); split; [ idtac | split ]; auto; [ idtac | intuition ].
Contradict H4.
rewrite H3; rewrite H4.
cut (forall a b c d, (a * (b * c + d))%Z = (a * c * b + a * d)%Z);
 [ intros H6; repeat rewrite H6 | intros; ring ].
repeat rewrite <- Znat.inj_mult;
 repeat rewrite (fun y z => mult_comm (div y z));
 repeat rewrite <- divides_div; auto.
ring.
apply divides_lcm1; auto.
apply divides_lcm2; auto.
intros f l1 (H2, H2'); split; auto; split.
intros (H3, (H4, H5)); split; auto.
change
  (form2Prop (tail l)
     (Neg
        (Form.Eq
           (Plus (scal (div (lcm m1 n) m1) b) (scal (div (lcm m1 n) n) a0))
           (Plus (scal (div (lcm m1 n) m1) a) (scal (div (lcm m1 n) n) b0)))) /\
   form2Prop (tail l) (buildConj (f :: l1))) in |- *;
 split; try (intuition; fail).
simpl in |- *; repeat rewrite scal_correct; rewrite H3; red in |- *;
 Contradict H4.
apply Zeq_mult_simpl with (c := Z_of_nat (div (lcm m1 n) n)).
apply Compare.not_eq_sym; apply Zorder.Zlt_not_eq.
replace 0%Z with (Z_of_nat 0); [ apply Znat.inj_lt | simpl in |- *; auto ].
cut (lcm m1 n = n * div (lcm m1 n) n :>nat).
case (div (lcm m1 n) n); auto with arith.
rewrite mult_comm; simpl in |- *; intros H6; Contradict H6.
apply Compare.not_eq_sym; apply lt_O_neq; apply lcm_lt_O; auto.
apply divides_div; auto.
apply divides_lcm2; auto.
rewrite (fun a l => Zmult_comm (exp2Z l a)).
apply
 Zplus_reg_l with (n := (Z_of_nat (div (lcm m1 n) m1) * exp2Z (tail l) b)%Z).
rewrite H4.
replace
 (Z_of_nat (div (lcm m1 n) m1) * (nth 0 l 0 * Z_of_nat m1 + exp2Z (tail l) b))%Z
 with
 (Z_of_nat m1 * Z_of_nat (div (lcm m1 n) m1) * nth 0 l 0 +
  Z_of_nat (div (lcm m1 n) m1) * exp2Z (tail l) b)%Z;
 [ rewrite <- Znat.inj_mult; rewrite <- divides_div; auto | ring ].
replace
 ((nth 0 l 0 * Z_of_nat n + exp2Z (tail l) b0) * Z_of_nat (div (lcm m1 n) n))%Z
 with
 (Z_of_nat n * Z_of_nat (div (lcm m1 n) n) * nth 0 l 0 +
  Z_of_nat (div (lcm m1 n) n) * exp2Z (tail l) b0)%Z;
 [ rewrite <- Znat.inj_mult; rewrite <- divides_div; auto | ring ].
ring; auto.
apply divides_lcm2; auto.
apply divides_lcm1; auto.
intros (H3, H4); split; [ idtac | split ]; auto; [ idtac | intuition ].
cut
 (form2Prop (tail l)
    (Neg
       (Form.Eq
          (Plus (scal (div (lcm m1 n) m1) b) (scal (div (lcm m1 n) n) a0))
          (Plus (scal (div (lcm m1 n) m1) a) (scal (div (lcm m1 n) n) b0)))));
 [ simpl in |- *; repeat rewrite scal_correct; intros H5
 | generalize H4; simpl in |- *; intros (H5, H6); auto ].
Contradict H5.
rewrite H5; rewrite H3.
cut (forall a b c d, (a * (b * c + d))%Z = (a * c * b + a * d)%Z);
 [ intros H6; repeat rewrite H6 | intros; ring ].
repeat rewrite <- Znat.inj_mult;
 repeat rewrite (fun y z => mult_comm (div y z));
 repeat rewrite <- divides_div; auto.
ring.
apply divides_lcm1; auto.
apply divides_lcm2; auto.
cut (form2Prop (tail l) (buildConj (f :: l1)));
 [ intuition | generalize H4; simpl in |- *; intros (H7, H8); auto ].
Qed.

Theorem reduceEqNEq_groundN :
 forall n m1 a b l,
 listNEqP l ->
 groundNL2 n l ->
 groundNExp n a -> groundNExp n b -> groundNL n (reduceEqNEq m1 a b l).
intros n m1 a b l H; generalize n m1 a b; elim H; clear H n m1 a b;
 simpl in |- *; auto.
intros n a b l0 H H0 H1 n0 m1 a0 b0 H2 H3 H4.
apply GNVCons; auto.
apply GNNeg.
inversion H2.
inversion H8.
inversion H13.
apply GNEq with (n := n0) (m := n0); auto.
apply GNPlus with (n := n0) (m := n3); auto.
apply scal_groundN; auto.
apply scal_groundN; auto.
apply GNPlus with (n := n0) (m := m0); auto.
apply scal_groundN; auto.
apply scal_groundN; auto.
apply H1 with (n := n0); auto.
inversion H2; auto.
Qed.

(** Reduce a congruence with an equality
    - [a1=b1+m1.x /\ a2=b2+m2.x [i2]] gives [a1=b1+m1.x /\ n2.a2+n1.b1=n2.b2+n1.a1 [n2*n]]
*)

Fixpoint reduceEqCong (m1 : nat) (a1 b1 : exp) (l : list (nat * form))
 {struct l} : list form :=
  match l with
  | (m2, Cong n a2 b2) :: l1 =>
      match lcm m1 m2 with
      | m3 =>
          match div m3 m1 with
          | n1 =>
              match div m3 m2 with
              | n2 =>
                  Cong (n2 * n) (Plus (scal n1 b1) (scal n2 a2))
                    (Plus (scal n1 a1) (scal n2 b2))
                  :: reduceEqCong m1 a1 b1 l1
              end
          end
      end
  | _ => nil
  end.

Theorem reduceEqCong_correct :
 forall m1 a b l l1,
 0 < m1 ->
 listCongP l1 ->
 (exp2Z (tail l) a = (nth 0 l 0 * Z_of_nat m1 + exp2Z (tail l) b)%Z /\
  formL2Prop (nth 0 l 0%Z) (tail l) l1 <->
  exp2Z (tail l) a = (nth 0 l 0 * Z_of_nat m1 + exp2Z (tail l) b)%Z /\
  form2Prop (tail l) (buildConj (reduceEqCong m1 a b l1))) /\
 Cnf1 (buildConj (reduceEqCong m1 a b l1)).
intros m1 a b l l1 H H0; elim H0; clear H0 l1; simpl in |- *; auto.
intuition.
intros n i a0 b0 l0 HH H0 H1; case (reduceEqCong m1 a b l0).
simpl in |- *; repeat rewrite scal_correct.
intros (H2, H2'); split; auto; split.
intros (H3, ((m2, H4), H5)); split; auto.
rewrite H3; rewrite H4.
exists m2.
cut (forall a b c d, (a * (b * c + d))%Z = (a * c * b + a * d)%Z);
 [ intros H6; repeat rewrite H6 | intros; ring ].
cut (forall a b c d e, (a * (b * c + d + e))%Z = (a * c * b + a * (d + e))%Z);
 [ intros H7; repeat rewrite H7 | intros; ring ].
repeat rewrite <- Znat.inj_mult;
 repeat rewrite (fun y z => mult_comm (div y z));
 repeat rewrite <- divides_div; auto.
rewrite Znat.inj_mult.
ring; auto.
apply divides_lcm1; auto.
apply divides_lcm2; auto.
intros (H3, (m4, H4)); split; auto; split; auto.
exists m4.
apply Zeq_mult_simpl with (c := Z_of_nat (div (lcm m1 n) n)).
apply Compare.not_eq_sym; apply Zorder.Zlt_not_eq.
replace 0%Z with (Z_of_nat 0); [ apply Znat.inj_lt | simpl in |- *; auto ].
cut (lcm m1 n = n * div (lcm m1 n) n :>nat).
case (div (lcm m1 n) n); auto with arith.
rewrite mult_comm; simpl in |- *; intros H6; Contradict H6.
apply Compare.not_eq_sym; apply lt_O_neq; apply lcm_lt_O; auto.
apply divides_div; auto.
apply divides_lcm2; auto.
rewrite (fun a l => Zmult_comm (exp2Z (tail l) a)).
apply
 Zplus_reg_l with (n := (Z_of_nat (div (lcm m1 n) m1) * exp2Z (tail l) b)%Z).
rewrite H4.
rewrite H3.
rewrite Znat.inj_mult.
cut (forall a b c d, (a * (b * c + d))%Z = (a * c * b + a * d)%Z);
 [ intros H6; repeat rewrite H6 | intros; ring ].
cut (forall a b c d e, ((b * c + d + e) * a)%Z = (a * c * b + a * (d + e))%Z);
 [ intros H7; repeat rewrite H7 | intros; ring ].
repeat rewrite <- Znat.inj_mult;
 repeat rewrite (fun y z => mult_comm (div y z));
 repeat rewrite <- divides_div; auto.
rewrite Znat.inj_mult.
ring; auto.
apply divides_lcm2; auto.
apply divides_lcm1; auto.
intuition.
intros f l1 (H2, H2'); split; auto; split.
intros (H3, ((m4, H4), H5)); split; auto.
change
  (form2Prop (tail l)
     (Cong (div (lcm m1 n) n * i)
        (Plus (scal (div (lcm m1 n) m1) b) (scal (div (lcm m1 n) n) a0))
        (Plus (scal (div (lcm m1 n) m1) a) (scal (div (lcm m1 n) n) b0))) /\
   form2Prop (tail l) (buildConj (f :: l1))) in |- *;
 split; try (intuition; fail).
simpl in |- *; repeat rewrite scal_correct; rewrite H3.
exists m4.
rewrite H4.
cut (forall a b c d, (a * (b * c + d))%Z = (a * c * b + a * d)%Z);
 [ intros H6; repeat rewrite H6 | intros; ring ].
cut (forall a b c d e, (a * (b * c + d + e))%Z = (a * c * b + a * (d + e))%Z);
 [ intros H7; repeat rewrite H7 | intros; ring ].
repeat rewrite <- Znat.inj_mult;
 repeat rewrite (fun y z => mult_comm (div y z));
 repeat rewrite <- divides_div; auto.
rewrite Znat.inj_mult.
ring; auto.
apply divides_lcm1; auto.
apply divides_lcm2; auto.
intros (H3, H4); split; [ idtac | split ]; auto; [ idtac | intuition ].
cut
 (form2Prop (tail l)
    (Cong (div (lcm m1 n) n * i)
       (Plus (scal (div (lcm m1 n) m1) b) (scal (div (lcm m1 n) n) a0))
       (Plus (scal (div (lcm m1 n) m1) a) (scal (div (lcm m1 n) n) b0))));
 [ simpl in |- *; repeat rewrite scal_correct; intros (m5, H5)
 | generalize H4; simpl in |- *; intros (H5, H6); auto ].
exists m5.
apply Zeq_mult_simpl with (c := Z_of_nat (div (lcm m1 n) n)).
apply Compare.not_eq_sym; apply Zorder.Zlt_not_eq.
replace 0%Z with (Z_of_nat 0); [ apply Znat.inj_lt | simpl in |- *; auto ].
cut (lcm m1 n = n * div (lcm m1 n) n :>nat).
case (div (lcm m1 n) n); auto with arith.
rewrite mult_comm; simpl in |- *; intros H6; Contradict H6.
apply Compare.not_eq_sym; apply lt_O_neq; apply lcm_lt_O; auto.
apply divides_div; auto.
apply divides_lcm2; auto.
rewrite (fun a l => Zmult_comm (exp2Z (tail l) a)).
apply
 Zplus_reg_l with (n := (Z_of_nat (div (lcm m1 n) m1) * exp2Z (tail l) b)%Z).
rewrite H5; rewrite H3.
cut (forall a b c d, (a * (b * c + d))%Z = (a * c * b + a * d)%Z);
 [ intros H6; repeat rewrite H6 | intros; ring ].
cut (forall a b c d e, ((b * c + d + e) * a)%Z = (a * c * b + a * (d + e))%Z);
 [ intros H7; repeat rewrite H7 | intros; ring ].
repeat rewrite <- Znat.inj_mult;
 repeat rewrite (fun y z => mult_comm (div y z));
 repeat rewrite <- divides_div; auto.
rewrite Znat.inj_mult.
ring; auto.
apply divides_lcm2; auto.
apply divides_lcm1; auto.
simpl in H4.
intuition.
Qed.

Theorem reduceEqCong_groundN :
 forall n m1 a b l,
 listCongP l ->
 groundNL2 n l ->
 groundNExp n a -> groundNExp n b -> groundNL n (reduceEqCong m1 a b l).
intros n m1 a b l H; generalize n m1 a b; elim H; clear H n m1 a b;
 simpl in |- *; auto.
intros n i a b l0 H H0 H1 H2 n0 m1 a0 b0 H3 H4 H5.
apply GNVCons; auto.
inversion H3.
inversion H9.
apply GNCong with (n := n0) (m := n0); auto.
apply GNPlus with (n := n0) (m := n2); auto.
apply scal_groundN; auto.
apply scal_groundN; auto.
apply GNPlus with (n := n0) (m := m0); auto.
apply scal_groundN; auto.
apply scal_groundN; auto.
apply H2 with (n := n0); auto.
inversion H3; auto.
Qed.


Require Import Setoid.

Inductive NonEmpty (A: Type) : Prop := intro : A -> NonEmpty A.

Axiom axiom_of_prop_ext : forall P Q: Prop, (P <-> Q) <-> (P = Q).
Axiom axiom_of_choise : forall A: Type, NonEmpty A -> A.

Lemma nonempty_equiv (A: Type) : NonEmpty A <-> exists x: A, True.
Proof.
  split; intros H.
  - destruct H. exists X. auto.
  - admit.
Admitted.

Definition choose (A: Type) (P : A -> Prop) (h : exists x, P x) : A.
Proof.
  apply axiom_of_choise. constructor. admit.
Admitted.

Theorem em (P: Prop) : P \/ ~P.
  assert (exists x, x = (True \/ P)) by (exists (True \/ P); auto).
  assert (exists x, x = (False \/ P)) by (exists (False \/ P); auto).
Abort.

Axiom Quot : forall {A: Type}, (A -> A -> Prop) -> Type.

Axiom Quot_mk : forall {A:  Type} (r: A -> A -> Prop),
  A -> Quot r.

Axiom Quot_ind :
  forall (A:  Type) (r: A -> A -> Prop) (P: Quot r -> Prop),
    (forall a: A, P (Quot_mk r a)) -> forall q: Quot r, P q.

Axiom Quot_lift :
  forall {A:  Type} {r: A -> A -> Prop} {B: Type} (f: A -> B),
    (forall a b: A, r a b -> f a = f b) -> Quot r -> B.

Axiom Quot_sound :
  forall (A: Type) (r: A -> A -> Prop) (a b: A),
    r a b -> Quot_mk r a = Quot_mk r b.

Theorem exists_base {A: Type} (r: A -> A -> Prop) (q: Quot r) :
  exists x, q = Quot_mk r x.
Proof.
  induction q using Quot_ind. exists a; auto.
Qed.

Axiom Quot_lift' : forall {A:  Type} {r: A -> A -> Prop} {B: Type}
  (f: A -> B) (P: forall a b: A, r a b -> f a = f b) (x: A),
    f x = Quot_lift f P (Quot_mk r x).

Definition fun_ext_eq (A B: Type) (f g: A -> B) := forall x: A, f x = g x.

Definition ExtFun (A B: Type) := Quot (fun_ext_eq A B).

Definition id {A: Type} (x: A) := x.

Definition fun_app {A B: Type} (f: Quot (fun_ext_eq A B)) : A -> B.
Proof.
  intro x. apply (Quot_lift (fun f: A -> B => f x) (r := fun_ext_eq A B)); auto.
Defined.

Theorem fun_ext (A B: Type) (f g: A -> B): (forall x, f x = g x) -> f = g.
Proof.
  intros H.
  assert (fun_app (Quot_mk (fun_ext_eq A B) f) = fun_app (Quot_mk (fun_ext_eq A B) g)).
  { f_equal. apply Quot_sound. auto. }
  unfold fun_app in *. rewrite <- (Quot_lift' (fun f : A -> B => f x)) in H0.
  assert (forall a b: A, (fun_ext_eq A B) a b -> a = b
  rewrite id_is_id, (id_is_id (Quot_mk (fun_ext_eq A B) f)) in H0.
  rewrite Quot_lift in H0.
  assert (forall y, y = id y).

Axiom Quot : forall A: Type, (A -> A -> Prop) -> Type.

Axiom Quot.mk : forall (A:  Type) (r: A -> A -> Prop),
  A -> Quot r.

Axiom Quot.ind :
  forall (A:  Type) (r: A -> A -> Prop) (P: Quot r -> Prop),
      (forall a: A, P (Quot.mk r a)) -> forall q: Quot r, P q.

Axiom Quot.lift :
  forall (A:  Type) (r: A -> A -> Prop) (B: Type) (f: A -> B),
    (forall a b: A, r a b -> f a = f b) -> Quot r -> B.

Axiom Quot.sound :
  forall (A: Type) (r: A -> A -> Prop) (a b: A),
    r a b -> Quot.mk r a = Quot.mk r b.


(* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines *)
Require Coq.Setoids.Setoid.
Import Coq.Setoids.Setoid.
Generalizable All Variables.
Axiom admit : forall {T}, T.
Class Equiv (A : Type) := equiv : relation A.
Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv.
Class ILogicOps Frm := { lentails: relation Frm;
                         ltrue: Frm;
                         land: Frm -> Frm -> Frm;
                         lor: Frm -> Frm -> Frm }.
Infix "|--"  := lentails (at level 79, no associativity).
Class ILogic Frm {ILOps: ILogicOps Frm} := { lentailsPre:> PreOrder lentails }.
Definition lequiv `{ILogic Frm} P Q := P |-- Q /\ Q |-- P.
Infix "-|-"  := lequiv (at level 85, no associativity).
Instance lequiv_inverse_lentails `{ILogic Frm} : subrelation lequiv (inverse lentails) := admit.
Record ILFunFrm (T : Type) `{e : Equiv T} `{ILOps : ILogicOps Frm} := mkILFunFrm { ILFunFrm_pred :> T -> Frm }.
Section ILogic_Fun.
  Context (T: Type) `{TType: type T}.
  Context `{IL: ILogic Frm}.
  Local Instance ILFun_Ops : ILogicOps (@ILFunFrm T _ Frm _) := admit.
  Definition ILFun_ILogic : ILogic (@ILFunFrm T _ Frm _) := admit.
End ILogic_Fun.
Arguments ILFunFrm _ {e} _ {ILOps}.
Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| lentails P Q := (P : Prop) -> Q;
                                                   ltrue        := True;
                                                   land     P Q := P /\ Q;
                                                   lor      P Q := P \/ Q |}.
Axiom Action : Set.
Definition Actions := list Action.
Instance ActionsEquiv : Equiv Actions := { equiv a1 a2 := a1 = a2 }.
Definition OPred := ILFunFrm Actions Prop.
Local Existing Instance ILFun_Ops.
Local Existing Instance ILFun_ILogic.
Definition catOP (P Q: OPred) : OPred := admit.
Add Parametric Morphism : catOP with signature lentails ==> lentails ==> lentails as catOP_entails_m.
apply admit.
Defined.
Definition catOPA (P Q R : OPred) : catOP (catOP P Q) R -|- catOP P (catOP Q R) := admit.
Class IsPointed (T : Type) := point : T.
Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)).
Record PointedOPred := mkPointedOPred {
                           OPred_pred :> OPred;
                           OPred_inhabited: IsPointed_OPred OPred_pred
                         }.
Existing Instance OPred_inhabited.
Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred
  := {| OPred_pred := O ; OPred_inhabited := _ |}.
Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q) := admit.
Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred)
            (tr : T -> T) (O2 : PointedOPred) (x : T)
            (H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0),
     exists e1 e2,
       catOP (O0 e1) (OPred_pred e2) |-- catOP (O1 x) O2.
  intros; do 2 esplit.
  rewrite <- catOPA.
  lazymatch goal with
  | |- ?R (?f ?a ?b) (?f ?a' ?b') =>
    let P := constr:(fun H H' => @Morphisms.proper_prf (OPred -> OPred -> OPred)
         (@Morphisms.respectful OPred (OPred -> OPred)
            (@lentails OPred
               (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop))
            (@lentails OPred
               (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop) ==>
             @lentails OPred
               (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop))) catOP
         catOP_entails_m_Proper a a' H b b' H') in
    pose P;
    refine (P _ _)
  end; unfold Basics.flip.
  Focus 2.
  (* As in 8.5, allow a shelved subgoal to remain *)
  apply reflexivity.


From Coqprime Require Import PocklingtonRefl.
Local Open Scope positive_scope.
Require Import  p1_0.
Require Import  p1_1.
Require Import  p1_2.
Require Import  p1_3.
Require Import  p1_4.
Require Import  p1_5.
Require Import  p1_6.
Require Import  p1_7.
Require Import  p1_8.
Require Import  p1_9.
Require Import  p1_10.
Require Import  p1_11.
Require Import  p1_12.
Require Import  p1_13.
Require Import  p1_14.
Require Import  p1_15.
Require Import  p1_16.
Require Import  p1_17.
Require Import  p1_18.
Require Import  p1_19.
Require Import  p1_20.
Require Import  p1_21.
Require Import  p1_22.
Require Import  p1_23.
Require Import  p1_24.
Require Import  p1_25.
Require Import  p1_26.
Require Import  p1_27.
Require Import  p1_28.
Require Import  p1_29.
Require Import  p1_30.
Require Import  p1_31.
Require Import  p1_32.
Require Import  p1_33.
Require Import  p1_34.
Require Import  p1_35.
Require Import  p1_36.
Require Import  p1_37.
Require Import  p1_38.
Require Import  p1_39.
Require Import  p1_40.
Require Import  p1_41.
Require Import  p1_42.

Lemma  primo: prime 179330471940057344458208069448729662884428461685778228345943220850055556923630938130677971906631303873391468287456028748831893026119855801594209813373836864456979934293572148321890413946410351595934990947200401918133129279392351267492947092870322592188229234074251511129610279036108571098721810242296920157719.
Proof.
exact
(primo0 (primo1 (primo2 (primo3 (primo4 (primo5 (primo6 (primo7 (primo8 (primo9 (primo10 (primo11 (primo12 (primo13 (primo14 (primo15 (primo16 (primo17 (primo18 (primo19 (primo20 (primo21 (primo22 (primo23 (primo24 (primo25 (primo26 (primo27 (primo28 (primo29 (primo30 (primo31 (primo32 (primo33 (primo34 (primo35 (primo36 (primo37 (primo38 (primo39 (primo40 (primo41 primo42)))))))))))))))))))))))))))))))))))))))))).
Qed.


Require Import Crypto.Specific.Framework.RawCurveParameters.
Require Import Crypto.Util.LetIn.

(***
Modulus : 2^291 - 19
Base: 24.25
***)

Definition curve : CurveParameters :=
  {|
    sz := 12%nat;
    base := 24 + 1/4;
    bitwidth := 32;
    s := 2^291;
    c := [(1, 19)];
    carry_chains := Some [seq 0 (pred 12); [0; 1]]%nat;

    a24 := None;
    coef_div_modulus := Some 2%nat;

    goldilocks := None;
    karatsuba := None;
    montgomery := false;
    freeze := Some true;
    ladderstep := false;

    mul_code := None;

    square_code := None;

    upper_bound_of_exponent_loose := None;
    upper_bound_of_exponent_tight := None;
    allowable_bit_widths := None;
    freeze_extra_allowable_bit_widths := None;
    modinv_fuel := None
  |}.

Ltac extra_prove_mul_eq _ := idtac.
Ltac extra_prove_square_eq _ := idtac.