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 AndR_AndL_hpinv : forall (k : nat) concl
        (D0 : derrec GL4ip_rules (fun _ => False) concl),
        k = (derrec_height D0) ->
          ((forall prem, ((AndLRule [prem] concl) ->
          existsT2 (D1 : derrec GL4ip_rules (fun _ => False) prem),
          derrec_height D1 <= k))) *
          ((forall prem1 prem2, ((AndRRule [prem1; prem2] concl) ->
          existsT2 (D1 : derrec GL4ip_rules (fun _ => False) prem1)
                   (D2 : derrec GL4ip_rules (fun _ => False) prem2),
          (derrec_height D1 <= k) * (derrec_height D2 <= k)))).
Proof.
assert (DersNilF: dersrec GL4ip_rules (fun _ : Seq  => False) []).
apply dersrec_nil.
(* Setting up the strong induction on the height. *)
pose (strong_inductionT (fun (x:nat) => forall (concl : Seq)
  (D0 : derrec GL4ip_rules (fun _ : Seq => False) concl),
x = derrec_height D0 ->
((forall prem, ((AndLRule [prem] concl) ->
          existsT2 (D1 : derrec GL4ip_rules (fun _ => False) prem),
          derrec_height D1 <= x))) *
          ((forall prem1 prem2, ((AndRRule [prem1; prem2] concl) ->
          existsT2 (D1 : derrec GL4ip_rules (fun _ => False) prem1)
                   (D2 : derrec GL4ip_rules (fun _ => False) prem2),
          (derrec_height D1 <= x) * (derrec_height D2 <= x)))))).
apply p. intros n IH. clear p.
(* 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. split.

(* Invertibility AndL *)
{ intros prem RA. inversion RA. subst.
  inversion g ; subst.
  (* IdP *)
  * inversion H. subst. assert (InT # P (Γ0 ++ And A B :: Γ1)).
    rewrite <- H2. apply InT_or_app. right. apply InT_eq. assert (InT # P (Γ0 ++ A :: B :: Γ1)).
    apply InT_app_or in H0. destruct H0. apply InT_or_app. auto. apply InT_or_app. right.
    apply InT_cons. inversion i. subst. inversion H1. apply InT_cons. assumption.
    apply InT_split in H1. destruct H1. destruct s. rewrite e. assert (IdPRule [] (x ++ # P :: x0, # P)).
    apply IdPRule_I. apply IdP in H1.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[]) (x ++ # P :: x0, # P) H1 DersNilF). exists d0.
    simpl. rewrite dersrec_height_nil. lia. reflexivity.
  (* BotL *)
  * inversion H. subst. assert (InT (Bot) (Γ0 ++ And A B :: Γ1)).
    rewrite <- H2. apply InT_or_app. right. apply InT_eq. assert (InT (Bot) (Γ0 ++ A :: B :: Γ1)).
    apply InT_app_or in H0. destruct H0. apply InT_or_app. auto. apply InT_or_app. right.
    apply InT_cons. inversion i. subst. inversion H1. apply InT_cons. auto. apply InT_split in H1. destruct H1. destruct s. rewrite e.
    assert (BotLRule [] (x ++ Bot :: x0, C)). apply BotLRule_I. apply BotL in H1.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[]) (x ++ Bot :: x0, C) H1 DersNilF). exists d0.
    simpl. rewrite dersrec_height_nil. lia. reflexivity.
   (* AndR *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
    assert (J1: AndLRule [(Γ0 ++ A :: B :: Γ1, B0)] (Γ0 ++ And A B :: Γ1, B0)). apply AndLRule_I. simpl in IH.
    assert (J2: derrec_height x0 < S (dersrec_height d)). lia.
    assert (J3: derrec_height x0 = derrec_height x0). reflexivity.
    pose (IH _ J2 _ _ J3). destruct p. clear s0. pose (s _ J1). destruct s0. clear s.
    assert (J4: AndLRule [(Γ0 ++ A :: B :: Γ1, A0)] (Γ0 ++ And A B :: Γ1, A0)). apply AndLRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
    assert (AndRRule [(Γ0 ++ A :: B :: Γ1, A0); (Γ0 ++ A :: B :: Γ1, B0)]
   (Γ0 ++ A :: B :: Γ1, And A0 B0)). apply AndRRule_I. pose (dlCons x1 DersNilF). pose (dlCons x2 d0).
    apply AndR in H0.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ A :: B :: Γ1, A0); (Γ0 ++ A :: B :: Γ1, B0)])
    (Γ0 ++ A :: B :: Γ1, And A0 B0) H0 d1). exists d2. simpl. rewrite dersrec_height_nil. lia. reflexivity.
  (* AndL *)
  * inversion H. subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
   + inversion e0. subst. simpl. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s. exists x0. lia.
   + destruct x.
      { inversion e0. subst. simpl. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s. repeat rewrite <- app_assoc. simpl.
      exists x. lia. }
      { inversion e0.  subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
        assert (J4: AndLRule [((Γ2 ++ A0 :: B0 :: x) ++ A :: B :: Γ1, C)]
        ((Γ2 ++ A0 :: B0 :: x) ++ And A B :: Γ1, C)). apply AndLRule_I.
        repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc in J4. simpl in J4.
        assert (AndLRule [(Γ2 ++ A0 :: B0 :: x ++ A :: B :: Γ1, C)]
        (Γ2 ++ And A0 B0 :: x ++ A :: B :: Γ1, C)).
        apply AndLRule_I.
        assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
        assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
        pose (IH _ J5 _ _ J6). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
        pose (dlCons x1 DersNilF). apply AndL in H0.
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ2 ++ A0 :: B0 :: x ++ A :: B :: Γ1, C)])
        (Γ2 ++ And A0 B0 :: x ++ A :: B :: Γ1, C) H0 d0). exists d1. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
    + destruct x.
       { simpl in e0. inversion e0. subst. clear e0. simpl.
         assert (J30: dersrec_height d = dersrec_height d). reflexivity.
         pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
         assert (Γ0 ++ A0 :: B0 :: Γ3 = (Γ0 ++ []) ++ A0 :: B0 :: Γ3). repeat rewrite <- app_assoc. auto.
         rewrite H0. exists x. lia. }
       { inversion e0. subst. clear e0.
         assert (J30: dersrec_height d = dersrec_height d). reflexivity. simpl.
         pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
         assert (AndLRule [((Γ0 ++ A :: B :: x) ++ A0 :: B0 :: Γ3, C)]
         ((Γ0 ++ A :: B :: x) ++ And A0 B0 :: Γ3, C)). apply AndLRule_I. repeat rewrite <- app_assoc in H0. simpl in H0.
         assert (J4: AndLRule [(Γ0 ++ A :: B :: x ++ A0 :: B0 :: Γ3, C)]
         (Γ0 ++ And A B :: x ++ A0 :: B0 :: Γ3, C)). apply AndLRule_I.
         assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
         assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
         pose (IH _ J5 _ _ J6). destruct p. clear s0. pose (s ((Γ0 ++ A :: B :: x) ++ A0 :: B0 :: Γ3, C)).
         assert (AndLRule [((Γ0 ++ A :: B :: x) ++ A0 :: B0 :: Γ3, C)] ((Γ0 ++ And A B :: x) ++ A0 :: B0 :: Γ3, C)).
         repeat rewrite <- app_assoc. apply AndLRule_I. apply s0 in H1. destruct H1.
         pose (dlCons x1 DersNilF). apply AndL in H0.
         assert (Γ0 ++ A :: B :: x ++ A0 :: B0 :: Γ3 =(Γ0 ++ A :: B :: x) ++ A0 :: B0 :: Γ3).
         repeat rewrite <- app_assoc. auto. rewrite H1 in H0.
         pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
         (ps:=[((Γ0 ++ A :: B :: x) ++ A0 :: B0 :: Γ3, C)])
         (Γ0 ++ A :: B :: x ++ And A0 B0 :: Γ3, C) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl.
         rewrite dersrec_height_nil. lia. reflexivity. }
  (* OrR1 *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). repeat destruct s. simpl.
    assert (J4: AndLRule [(Γ0 ++ A :: B :: Γ1, A0)] (Γ0 ++ And A B :: Γ1, A0)). apply AndLRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
    assert (OrR1Rule [(Γ0 ++ A :: B :: Γ1, A0)]
    (Γ0 ++ A :: B :: Γ1, Or A0 B0)). apply OrR1Rule_I. pose (dlCons x0 DersNilF).
    apply OrR1 in H0.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ A :: B :: Γ1, A0)])
    (Γ0 ++ A :: B :: Γ1, Or A0 B0) H0 d0). exists d1. simpl. rewrite dersrec_height_nil. lia. reflexivity.
  (* OrR2 *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). repeat destruct s. simpl.
    assert (J4: AndLRule [(Γ0 ++ A :: B :: Γ1, B0)] (Γ0 ++ And A B :: Γ1, B0)). apply AndLRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
    assert (OrR2Rule [(Γ0 ++ A :: B :: Γ1, B0)]
    (Γ0 ++ A :: B :: Γ1, Or A0 B0)). apply OrR2Rule_I. pose (dlCons x0 DersNilF).
    apply OrR2 in H0.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ A :: B :: Γ1, B0)])
    (Γ0 ++ A :: B :: Γ1, Or A0 B0) H0 d0). exists d1. simpl. rewrite dersrec_height_nil. lia. reflexivity.
  (* OrL *)
  * inversion H. subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
   + inversion e0.
   + destruct x.
      { inversion e0. }
      { 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 :: B :: Γ1, C);(Γ2 ++ B0 :: x ++ A :: B :: Γ1, C)]
        (Γ2 ++ Or A0 B0 :: x ++ A :: B :: Γ1, C)). apply OrLRule_I. apply OrL in H0.
        assert (J4: AndLRule [((Γ2 ++ A0 :: x) ++ A :: B :: Γ1, C)]
        ((Γ2 ++ A0 :: x) ++ And A B :: Γ1, C)). apply AndLRule_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). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
        assert (J7: AndLRule [((Γ2 ++ B0 :: x) ++ A :: B :: Γ1, C)]
        ((Γ2 ++ B0 :: x) ++ And A B :: Γ1, C)). apply AndLRule_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). destruct p. clear s0. pose (s _ J7). destruct s0. clear s.
        pose (dlCons x3 DersNilF). pose (dlCons x2 d0).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ2 ++ A0 :: x ++ A :: B :: Γ1, C); (Γ2 ++ B0 :: x ++ A :: B :: Γ1, C)])
        (Γ2 ++ Or A0 B0 :: x ++ A :: B :: Γ1, C) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
    + destruct x.
       { simpl in e0. inversion e0. }
       { inversion e0. subst. clear e0. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
          pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
          assert (OrLRule [((Γ0 ++ A :: B :: x) ++ A0 :: Γ3, C);((Γ0 ++ A :: B :: x) ++ B0 :: Γ3, C)]
          ((Γ0 ++ A :: B :: x) ++ Or A0 B0 :: Γ3, C)). apply OrLRule_I. apply OrL in H0.
          repeat rewrite <- app_assoc in H0. simpl in H0.
          assert (J4: AndLRule [(Γ0 ++ A :: B :: x ++ A0 :: Γ3, C)]
          ((Γ0 ++ And A B :: x) ++ A0 :: Γ3, C)). repeat rewrite <- app_assoc. apply AndLRule_I.
          assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
          assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
          pose (IH _ J5 _ _ J6). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
          assert (J7: AndLRule [(Γ0 ++ A :: B :: x ++ B0 :: Γ3, C)]
          ((Γ0 ++ And A B :: x) ++ B0 :: Γ3, C)). repeat rewrite <- app_assoc. apply AndLRule_I.
          assert (J8: derrec_height x1 < S (dersrec_height d)). lia.
          assert (J9: derrec_height x1 = derrec_height x1). reflexivity.
          pose (IH _ J8 _ _ J9). destruct p. clear s0. pose (s _ J7). destruct s0. clear s.
          pose (dlCons x3 DersNilF). pose (dlCons x2 d0).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(Γ0 ++ A :: B :: x ++ A0 :: Γ3, C); (Γ0 ++ A :: B :: x ++ B0 :: Γ3, C)])
          (Γ0 ++ A :: B :: x ++ Or A0 B0 :: Γ3, C) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
          lia. reflexivity. }
  (* ImpR *)
  * 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 (ImpRRule [(Γ2 ++ A0 :: A :: B :: Γ1, B0)] (Γ2 ++ A :: B :: Γ1, Imp A0 B0)). apply ImpRRule_I.
      assert (J4: AndLRule [((Γ2 ++ [A0]) ++ A :: B :: Γ1, B0)] ((Γ2 ++ [A0]) ++ And A B :: Γ1, B0)). apply AndLRule_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). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
      pose (dlCons x1 DersNilF). apply ImpR in H0.
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:=[(Γ2 ++ A0 :: A :: B :: Γ1, B0)])
      (Γ2 ++ A :: B :: Γ1, Imp A0 B0) 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 (ImpRRule [(Γ2 ++ A0 :: x ++ A :: B :: Γ1, B0)] (Γ2 ++ x ++ A :: B :: Γ1, Imp A0 B0)). apply ImpRRule_I.
      assert (J4: AndLRule [((Γ2 ++ A0 :: x) ++ A :: B :: Γ1, B0)] ((Γ2 ++ A0 :: x) ++ And A B :: Γ1, B0)). apply AndLRule_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). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
      pose (dlCons x1 DersNilF). apply ImpR in H0.
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:=[(Γ2 ++ A0 :: x ++ A :: B :: Γ1, B0)])
      (Γ2 ++ x ++ A :: B :: Γ1, Imp A0 B0) H0 d0). repeat rewrite <- app_assoc. 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 (ImpRRule [ (Γ0 ++ A0 :: A :: B :: Γ1, B0)]  (Γ0 ++ A :: B :: Γ1, Imp A0 B0)). apply ImpRRule_I.
        assert (J4: AndLRule [((Γ0 ++ [A0]) ++ A :: B :: Γ1, B0)] ((Γ0 ++ [A0]) ++ And A B :: Γ1, B0)). apply AndLRule_I.
        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). destruct p. clear s0. pose (s (Γ0 ++ A0 :: A :: B :: Γ1, B0)).
        assert (AndLRule [(Γ0 ++ A0 :: A :: B :: Γ1, B0)] ((Γ0 ++ []) ++ A0 :: And A B :: Γ1, B0)). repeat rewrite <- app_assoc. simpl ; auto.
        apply s0 in H1. destruct H1.
        pose (dlCons x0 DersNilF). apply ImpR in H0.
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ0 ++ A0 :: A :: B :: Γ1, B0)])
        (Γ0 ++ A :: B :: Γ1, Imp A0 B0) H0 d0). repeat rewrite <- app_assoc. 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.
        assert (ImpRRule [((Γ0 ++ A :: B :: x) ++ A0 :: Γ3, B0)]  ((Γ0 ++ A :: B :: x) ++ Γ3, Imp A0 B0)). apply ImpRRule_I.
        assert (J4: AndLRule [(Γ0 ++ A :: B :: x ++ A0 :: Γ3, B0)] (Γ0 ++ And A B :: x ++ A0 :: Γ3, B0)). apply AndLRule_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). destruct p. clear s0. pose (s ((Γ0 ++ A :: B :: x) ++ A0 :: Γ3, B0)).
        assert (AndLRule [((Γ0 ++ A :: B :: x) ++ A0 :: Γ3, B0)] ((Γ0 ++ And A B :: x) ++ A0 :: Γ3, B0)). repeat rewrite <- app_assoc. simpl ; auto.
        apply s0 in H1. destruct H1.
        pose (dlCons x1 DersNilF). assert ((Γ0 ++ A :: B :: x) ++ Γ3 = Γ0 ++ A :: B :: x ++ Γ3). repeat rewrite <- app_assoc.
        auto. rewrite H1 in H0. apply ImpR in H0.
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[((Γ0 ++ A :: B :: x) ++ A0 :: Γ3, B0)])
        (Γ0 ++ A :: B :: x ++ Γ3, Imp A0 B0) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil. lia. reflexivity. }
  (* AtomImpL1 *)
  * inversion H. subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
   + inversion e0.
   + destruct x.
      { inversion e0. }
      { inversion e0.  subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
        - inversion e1.
        - destruct x0. simpl in e1. inversion e1. inversion e1. subst. clear e1. clear e0.
          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 :: B :: Γ1, C)]
          (Γ2 ++ # P :: Γ3 ++ Imp # P A0 :: x0 ++ A :: B :: Γ1, C)). apply AtomImpL1Rule_I.
          assert (J4: AndLRule [((Γ2 ++ # P :: Γ3 ++ A0 :: x0) ++ A :: B :: Γ1, C)] ((Γ2 ++ # P :: Γ3 ++ A0 :: x0) ++ And A B :: Γ1, C)).
          apply AndLRule_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). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
          pose (dlCons x1 DersNilF). apply AtomImpL1 in H0. repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. simpl.
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(Γ2 ++ # P :: Γ3 ++ A0 :: x0 ++ A :: B :: Γ1, C)])
          (Γ2 ++ # P :: Γ3 ++ Imp (# P) A0 :: x0 ++ A :: B :: Γ1, C) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil.
          lia. reflexivity.
        - destruct x0. simpl in e1. inversion e1. inversion e1. subst. simpl.
          assert (J30: dersrec_height d = dersrec_height d). reflexivity.
          pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s. clear e0. clear e1.
          assert (AtomImpL1Rule [(Γ2 ++ # P :: (x ++ A :: B :: x0) ++ A0 :: Γ4, C)]
          (Γ2 ++ # P :: (x ++ A :: B :: x0) ++ Imp # P A0 :: Γ4, C)). apply AtomImpL1Rule_I.
          assert (J4: AndLRule [((Γ2 ++ # P :: x) ++ A :: B :: x0 ++ A0 :: Γ4, C)] ((Γ2 ++ # P :: x) ++ And A B :: x0 ++ A0 :: Γ4, C)).
          apply AndLRule_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). destruct p. clear s0. pose (s (Γ2 ++ # P :: x ++ A :: B :: x0 ++ A0 :: Γ4, C)).
          assert (AndLRule [(Γ2 ++ # P :: x ++ A :: B :: x0 ++ A0 :: Γ4, C)] (Γ2 ++ # P :: (x ++ And A B :: x0) ++ A0 :: Γ4, C)).
          repeat rewrite <- app_assoc. simpl. auto. apply s0 in H1. destruct H1. clear s0. clear s.
          pose (dlCons x2 DersNilF). apply AtomImpL1 in H0. repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc in H0. simpl in H0.
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(Γ2 ++ # P :: x ++ A :: B :: x0 ++ A0 :: Γ4, C)])
          (Γ2 ++ # P :: x ++ A :: B :: x0 ++ Imp # P A0 :: Γ4, C) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil.
          lia. reflexivity. }
    + destruct x. simpl in e0. inversion e0. inversion e0. subst. clear e0.
       assert (J30: dersrec_height d = dersrec_height d). reflexivity.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (AtomImpL1Rule [((Γ0 ++ A :: B :: x) ++ # P :: Γ3 ++ A0 :: Γ4, C)]
       ((Γ0 ++ A :: B :: x) ++ # P :: Γ3 ++ Imp # P A0 :: Γ4, C)). apply AtomImpL1Rule_I.
       assert (J4: AndLRule [(Γ0 ++ A :: B :: x ++ # P :: Γ3 ++ A0 :: Γ4, C)] (Γ0 ++ And A B :: x ++ # P :: Γ3 ++ A0 :: Γ4, C)). apply AndLRule_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). destruct p. clear s0. pose (s ((Γ0 ++ A :: B :: x) ++ # P :: Γ3 ++ A0 :: Γ4, C)).
       assert (AndLRule [((Γ0 ++ A :: B :: x) ++ # P :: Γ3 ++ A0 :: Γ4, C)] ((Γ0 ++ And A B :: x) ++ # P :: Γ3 ++ A0 :: Γ4, C)).
       repeat rewrite <- app_assoc. simpl ; auto. apply s0 in H1. destruct H1.
       pose (dlCons x1 DersNilF). apply AtomImpL1 in H0.
       assert (((Γ0 ++ A :: B :: x) ++ # P :: Γ3 ++ Imp # P A0 :: Γ4, C) = (Γ0 ++ A :: B :: x ++ # P :: Γ3 ++ Imp # P A0 :: Γ4, C)).
       repeat rewrite <- app_assoc. auto. rewrite H1 in H0.
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[((Γ0 ++ A :: B :: x) ++ # P :: Γ3 ++ A0 :: Γ4, C)])
       (Γ0 ++ A :: B :: x ++ # P :: Γ3 ++ Imp # P A0 :: Γ4, C) H0 d0). repeat rewrite <- app_assoc. 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.
   + inversion e0.
   + destruct x.
      { inversion e0. }
      { inversion e0.  subst. apply app2_find_hole in H2. destruct H2. repeat destruct s ; destruct p ; subst.
        - inversion e1.
        - destruct x0. simpl in e1. inversion e1. inversion e1. subst. clear e1. clear e0.
          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 :: B :: Γ1, C)]
          (Γ2 ++ Imp # P A0 :: Γ3 ++ # P :: x0 ++ A :: B :: Γ1, C)). apply AtomImpL2Rule_I.
          assert (J4: AndLRule [((Γ2 ++ A0 :: Γ3 ++ # P :: x0) ++ A :: B :: Γ1, C)] ((Γ2 ++ A0 :: Γ3 ++ # P :: x0) ++ And A B :: Γ1, C)).
          apply AndLRule_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). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
          pose (dlCons x1 DersNilF). apply AtomImpL2 in H0. repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. simpl.
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(Γ2 ++ A0 :: Γ3 ++ # P :: x0 ++ A :: B :: Γ1, C)])
          (Γ2 ++ Imp (# P) A0 :: Γ3 ++ # P :: x0 ++ A :: B :: Γ1, C) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil.
          lia. reflexivity.
        - destruct x0. simpl in e1. inversion e1. inversion e1. subst. simpl.
          assert (J30: dersrec_height d = dersrec_height d). reflexivity.
          pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s. clear e0. clear e1.
          assert (AtomImpL2Rule [(Γ2 ++ A0 :: (x ++ A :: B :: x0) ++ # P :: Γ4, C)]
          (Γ2 ++ Imp # P A0 :: (x ++ A :: B :: x0) ++ # P :: Γ4, C)). apply AtomImpL2Rule_I.
          assert (J4: AndLRule [((Γ2 ++ A0 :: x) ++ A :: B :: x0 ++ # P :: Γ4, C)] ((Γ2 ++ A0 :: x) ++ And A B :: x0 ++ # P :: Γ4, C)).
          apply AndLRule_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). destruct p. clear s0. pose (s (Γ2 ++ A0 :: x ++ A :: B :: x0 ++ # P :: Γ4, C)).
          assert (AndLRule [(Γ2 ++ A0 :: x ++ A :: B :: x0 ++ # P :: Γ4, C)] (Γ2 ++ A0 :: (x ++ And A B :: x0) ++ # P :: Γ4, C)).
          repeat rewrite <- app_assoc. simpl. auto. apply s0 in H1. destruct H1. clear s0. clear s.
          pose (dlCons x2 DersNilF). apply AtomImpL2 in H0. repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc in H0. simpl in H0.
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(Γ2 ++ A0 :: x ++ A :: B :: x0 ++ # P :: Γ4, C)])
          (Γ2 ++ Imp # P A0 :: x ++ A :: B :: x0 ++ # P :: Γ4, C) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil.
          lia. reflexivity. }
    + destruct x. simpl in e0. inversion e0. inversion e0. subst. clear e0.
       assert (J30: dersrec_height d = dersrec_height d). reflexivity.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (AtomImpL2Rule [((Γ0 ++ A :: B :: x) ++ A0 :: Γ3 ++ # P :: Γ4, C)]
       ((Γ0 ++ A :: B :: x) ++Imp # P A0  :: Γ3 ++ # P :: Γ4, C)). apply AtomImpL2Rule_I.
       assert (J4: AndLRule [(Γ0 ++ A :: B :: x ++ A0 :: Γ3 ++ # P :: Γ4, C)] (Γ0 ++ And A B :: x ++ A0 :: Γ3 ++ # P :: Γ4, C)). apply AndLRule_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). destruct p. clear s0. pose (s ((Γ0 ++ A :: B :: x) ++ A0 :: Γ3 ++ # P :: Γ4, C)).
       assert (AndLRule [((Γ0 ++ A :: B :: x) ++ A0 :: Γ3 ++ # P :: Γ4, C)] ((Γ0 ++ And A B :: x) ++ A0 :: Γ3 ++ # P :: Γ4, C)).
       repeat rewrite <- app_assoc. simpl ; auto. apply s0 in H1. destruct H1.
       pose (dlCons x1 DersNilF). apply AtomImpL2 in H0.
       assert (((Γ0 ++ A :: B :: x) ++ Imp # P A0 :: Γ3 ++ # P :: Γ4, C) = (Γ0 ++ A :: B :: x ++ Imp # P A0 :: Γ3 ++ # P :: Γ4, C)).
       repeat rewrite <- app_assoc. auto. rewrite H1 in H0.
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[((Γ0 ++ A :: B :: x) ++ A0 :: Γ3 ++ # P :: Γ4, C)])
       (Γ0 ++ A :: B :: x ++ Imp # P A0 :: Γ3 ++ # P :: Γ4, C) H0 d0). repeat rewrite <- app_assoc. 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.
   + inversion e0.
   + destruct x.
      { inversion e0. }
      { 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 C0) :: x) ++ A :: B :: Γ1, C)]
        ((Γ2 ++ Imp (And A0 B0) C0 :: x) ++ A :: B :: Γ1, C)). repeat rewrite <- app_assoc. simpl.
        repeat rewrite <- app_assoc. apply AndImpLRule_I.
        assert (J4: AndLRule [((Γ2 ++ Imp A0 (Imp B0 C0) :: x) ++ A :: B :: Γ1, C)] ((Γ2 ++ Imp A0 (Imp B0 C0) :: x) ++ And A B :: Γ1, C)).
        apply AndLRule_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). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
        pose (dlCons x1 DersNilF). apply AndImpL in H0. repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. simpl.
        repeat rewrite <- app_assoc in H0.
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ2 ++ Imp A0 (Imp B0 C0) :: x ++ A :: B :: Γ1, C)])
       (Γ2 ++ Imp (And A0 B0) C0 :: x ++ A :: B :: Γ1, C) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
    + destruct x. simpl in e0. inversion e0. inversion e0. subst. clear e0.
       assert (J30: dersrec_height d = dersrec_height d). reflexivity.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (AndImpLRule [((Γ0 ++ A :: B :: x) ++ Imp A0 (Imp B0 C0) :: Γ3, C)]
      ((Γ0 ++ A :: B :: x) ++ Imp (And A0 B0) C0 :: Γ3, C)). apply AndImpLRule_I. repeat rewrite <- app_assoc in H0.
       assert (J4: AndLRule [(Γ0 ++ A :: B :: x ++ Imp (And A0 B0) C0 :: Γ3, C)] (Γ0 ++ And A B :: x ++ Imp (And A0 B0) C0 :: Γ3, C)). apply AndLRule_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). destruct p. clear s0. pose (s ((Γ0 ++ A :: B :: x) ++ Imp A0 (Imp B0 C0) :: Γ3, C)).
       assert (AndLRule [((Γ0 ++ A :: B :: x) ++ Imp A0 (Imp B0 C0) :: Γ3, C)] ((Γ0 ++ And A B :: x) ++ Imp A0 (Imp B0 C0) :: Γ3, C)).
       repeat rewrite <- app_assoc. apply AndLRule_I. apply s0 in H1. destruct H1.
       pose (dlCons x1 DersNilF). apply AndImpL in H0.
       assert (Γ0 ++ (A :: B :: x) ++ Imp A0 (Imp B0 C0) :: Γ3 =(Γ0 ++ A :: B :: x) ++ Imp A0 (Imp B0 C0) :: Γ3).
       repeat rewrite <- app_assoc. auto. rewrite H1 in H0.
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[((Γ0 ++ A :: B :: x) ++ Imp A0 (Imp B0 C0) :: Γ3, C)])
       (Γ0 ++ A :: B :: x ++ Imp (And A0 B0) C0 :: Γ3, C) 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.
   + inversion e0.
   + destruct x.
      { inversion e0. }
      { 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 (OrImpLRule [((Γ2 ++ Imp A0 C0 :: Γ3) ++ Imp B0 C0 :: A :: B :: Γ1, C)]
          ((Γ2 ++ Imp (Or A0 B0) C0 :: Γ3) ++ A :: B :: Γ1, C)). repeat rewrite <- app_assoc.
          simpl. apply OrImpLRule_I. simpl. repeat rewrite <- app_assoc. simpl.
          assert (J4: AndLRule [((Γ2 ++ Imp A0 C0 :: Γ3 ++ [Imp B0 C0]) ++ A :: B :: Γ1, C)]
          ((Γ2 ++ Imp A0 C0 :: Γ3 ++ [Imp B0 C0]) ++ And A B :: Γ1, C)).
          apply AndLRule_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). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
          pose (dlCons x1 DersNilF). apply OrImpL in H0. repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. simpl.
          repeat rewrite <- app_assoc in H0. simpl in H0.
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(Γ2 ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: A :: B :: Γ1, C)])
          (Γ2 ++ Imp (Or A0 B0) C0 :: Γ3 ++ A :: B :: Γ1, C) H0 d0). repeat rewrite <- app_assoc. 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. simpl. repeat rewrite <- app_assoc. simpl.
          repeat rewrite <- app_assoc.
          assert (OrImpLRule [(Γ2 ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: x0 ++ A :: B :: Γ1, C)]
          (Γ2 ++ Imp (Or A0 B0) C0 :: Γ3 ++ x0 ++ A :: B :: Γ1, C)). apply OrImpLRule_I.
          assert (J4: AndLRule [((Γ2 ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: x0) ++ A :: B :: Γ1, C)]
          ((Γ2 ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: x0) ++ And A B :: Γ1, C)).
          apply AndLRule_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). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
          pose (dlCons x1 DersNilF). apply OrImpL in H0. repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. simpl.
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(Γ2 ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: x0 ++ A :: B :: Γ1, C)])
          (Γ2 ++ Imp (Or A0 B0) C0 :: Γ3 ++ x0 ++ A :: B :: Γ1, C) H0 d0). repeat rewrite <- app_assoc. 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. simpl. repeat rewrite <- app_assoc. simpl.
               assert (OrImpLRule [(Γ2 ++ Imp A0 C0 :: x ++ Imp B0 C0 :: A :: B :: Γ1, C)]
               (Γ2 ++ Imp (Or A0 B0) C0 :: x ++ A :: B :: Γ1, C)). apply OrImpLRule_I.
               assert (J4: AndLRule [((Γ2 ++ Imp A0 C0 :: x ++ [Imp B0 C0]) ++ A :: B :: Γ1, C)]
               ((Γ2 ++ Imp A0 C0 :: x ++ [Imp B0 C0]) ++ And A B :: Γ1, C)).
               apply AndLRule_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). destruct p. clear s0. pose (s (Γ2 ++ Imp A0 C0 :: x ++ Imp B0 C0 :: A :: B :: Γ1, C)).
               assert (AndLRule [(Γ2 ++ Imp A0 C0 :: x ++ Imp B0 C0 :: A :: B :: Γ1, C)]
               (Γ2 ++ Imp A0 C0 :: (x ++ []) ++ Imp B0 C0 :: And A B :: Γ1, C)). repeat rewrite <- app_assoc. simpl. auto.
               apply s0 in H1. destruct H1. clear s0. clear s.
               pose (dlCons x1 DersNilF). apply OrImpL in H0.
               pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
               (ps:=[(Γ2 ++ Imp A0 C0 :: x ++ Imp B0 C0 :: A :: B :: Γ1, C)])
              (Γ2 ++ Imp (Or A0 B0) C0 :: x ++ A :: B :: Γ1, C) H0 d0). repeat rewrite <- app_assoc. exists d1.
               simpl. rewrite dersrec_height_nil. lia. reflexivity.
            +  inversion e1. subst. simpl. repeat rewrite <- app_assoc. simpl.
                assert (J30: dersrec_height d = dersrec_height d). reflexivity.
                pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s. clear e0. clear e1.
                assert (OrImpLRule [(Γ2 ++ Imp A0 C0 :: (x ++ A :: B :: x0) ++ Imp B0 C0 :: Γ4, C)]
                (Γ2 ++ Imp (Or A0 B0) C0 :: (x ++ A :: B :: x0) ++ Γ4, C)). apply OrImpLRule_I.
                assert (J4: AndLRule [((Γ2 ++ Imp A0 C0 :: x) ++ A :: B :: x0 ++ Imp B0 C0 :: Γ4, C)]
                ((Γ2 ++ Imp A0 C0 :: x) ++ And A B :: x0 ++ Imp B0 C0 :: Γ4, C)).
                apply AndLRule_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). destruct p. clear s0. pose (s (Γ2 ++ Imp A0 C0 :: x ++ A :: B :: x0 ++ Imp B0 C0 :: Γ4, C)).
                assert (AndLRule [(Γ2 ++ Imp A0 C0 :: x ++ A :: B :: x0 ++ Imp B0 C0 :: Γ4, C)]
                (Γ2 ++ Imp A0 C0 :: (x ++ And A B :: x0) ++ Imp B0 C0 :: Γ4, C)).
                repeat rewrite <- app_assoc. simpl. auto. apply s0 in H1. destruct H1. clear s0. clear s.
                pose (dlCons x2 DersNilF). apply OrImpL in H0. repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc in H0. simpl in H0.
                pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
                (ps:=[(Γ2 ++ Imp A0 C0 :: x ++ A :: B :: x0 ++ Imp B0 C0 :: Γ4, C)])
                (Γ2 ++ Imp (Or A0 B0) C0 :: x ++ A :: B :: x0 ++ Γ4, C) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl.
                rewrite dersrec_height_nil. lia. reflexivity. }
    + destruct x. simpl in e0. inversion e0. inversion e0. subst. clear e0.
       assert (J30: dersrec_height d = dersrec_height d). reflexivity. simpl.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (OrImpLRule [((Γ0 ++ A :: B :: x) ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, C)]
       ((Γ0 ++ A :: B :: x) ++ Imp (Or A0 B0) C0 :: Γ3 ++ Γ4, C)). apply OrImpLRule_I. repeat rewrite <- app_assoc in H0. simpl in H0.
       assert (J4: AndLRule [(Γ0 ++ A :: B :: x ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, C)]
       (Γ0 ++ And A B :: x ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, C)). apply AndLRule_I.
       assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
       assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
       pose (IH _ J5 _ _ J6). destruct p. clear s0. pose (s (Γ0 ++ A :: B :: x ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, C)).
       assert (AndLRule [(Γ0 ++ A :: B :: x ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, C)]
      ((Γ0 ++ And A B :: x) ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, C)).
       repeat rewrite <- app_assoc. simpl ; auto. apply s0 in H1. destruct H1.
       pose (dlCons x1 DersNilF). apply OrImpL in H0.
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[(Γ0 ++ A :: B :: x ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, C)])
       (Γ0 ++ A :: B :: x ++ Imp (Or A0 B0) C0 :: Γ3 ++ Γ4, C) H0 d0). repeat rewrite <- app_assoc. 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.
   + inversion e0.
   + destruct x.
      { inversion e0. }
      { 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 C0 :: x ++ A :: B :: Γ1, Imp A0 B0); (Γ2 ++ C0 :: x ++ A :: B :: Γ1, C)]
        (Γ2 ++ Imp (Imp A0 B0) C0 :: x ++ A :: B :: Γ1, C)). apply ImpImpLRule_I. apply ImpImpL in H0.
        assert (J4: AndLRule [((Γ2 ++ Imp B0 C0 :: x) ++ A :: B :: Γ1, Imp A0 B0)]
        ((Γ2 ++ Imp B0 C0 :: x) ++ And A B :: Γ1, Imp A0 B0)). apply AndLRule_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). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
        assert (J7: AndLRule [((Γ2 ++ C0 :: x) ++ A :: B :: Γ1, C)]
        ((Γ2 ++ C0 :: x) ++ And A B :: Γ1, C)). apply AndLRule_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). destruct p. clear s0. pose (s _ J7). destruct s0. clear s.
        pose (dlCons x3 DersNilF). pose (dlCons x2 d0).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ2 ++ Imp B0 C0 :: x ++ A :: B :: Γ1, Imp A0 B0); (Γ2 ++ C0 :: x ++ A :: B :: Γ1, C)])
        (Γ2 ++ Imp (Imp A0 B0) C0 :: x ++ A :: B :: Γ1, C) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
    + destruct x.
       { simpl in e0. inversion e0. }
       { inversion e0. subst. clear e0. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
          pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
          assert (ImpImpLRule [((Γ0 ++ A :: B :: x) ++ Imp B0 C0 :: Γ3, Imp A0 B0); ((Γ0 ++ A :: B :: x) ++ C0 :: Γ3, C)]
          ((Γ0 ++ A :: B :: x) ++ Imp (Imp A0 B0) C0 :: Γ3, C)). apply ImpImpLRule_I. apply ImpImpL in H0.
          repeat rewrite <- app_assoc in H0. simpl in H0.
          assert (J4: AndLRule [(Γ0 ++ A :: B :: x ++ Imp B0 C0 :: Γ3, Imp A0 B0)]
          ((Γ0 ++ And A B :: x) ++ Imp B0 C0 :: Γ3, Imp A0 B0)). repeat rewrite <- app_assoc. apply AndLRule_I.
          assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
          assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
          pose (IH _ J5 _ _ J6). destruct p. clear s0. pose (s _ J4). destruct s0. clear s.
          assert (J7: AndLRule [(Γ0 ++ A :: B :: x ++ C0 :: Γ3, C)]
          ((Γ0 ++ And A B :: x) ++ C0 :: Γ3, C)). repeat rewrite <- app_assoc. apply AndLRule_I.
          assert (J8: derrec_height x1 < S (dersrec_height d)). lia.
          assert (J9: derrec_height x1 = derrec_height x1). reflexivity.
          pose (IH _ J8 _ _ J9). destruct p. clear s0. pose (s _ J7). destruct s0. clear s.
          pose (dlCons x3 DersNilF). pose (dlCons x2 d0).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(Γ0 ++ A :: B :: x ++ Imp B0 C0 :: Γ3, Imp A0 B0); (Γ0 ++ A :: B :: x ++ C0 :: Γ3, C)])
         (Γ0 ++ A :: B :: x ++ Imp (Imp A0 B0) C0 :: Γ3, C) 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.
   + inversion e0.
   + destruct x.
      { inversion e0. }
      { 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. 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. inversion u1. subst. exfalso.
        apply is_box_is_in_boxed_list with (A:=And A B) in H1. destruct H1.
        inversion H. apply in_or_app. right. apply in_or_app. right. apply in_eq. subst.
        assert (J50: AndLRule [((Γ2 ++ B0 :: x) ++ A :: B :: Γ1, C)]
        ((Γ2 ++ B0 :: x) ++ And A B :: Γ1, C)). apply AndLRule_I. repeat rewrite <- app_assoc in J50. simpl in J50.
        assert (J51: derrec_height x1 < S (dersrec_height d)). lia.
        assert (J52: derrec_height x1 = derrec_height x1). reflexivity.
        pose (IH _ J51 _ _ J52). destruct p. clear s0. pose (s _ J50). destruct s0. clear s.
        destruct (dec_is_boxedT A) ; destruct (dec_is_boxedT B).
        - assert (BoxImpLRule [(XBoxed_list (x2 ++ x4 ++ A :: B :: x5)  ++ [Box A0], A0); (Γ2 ++ B0 :: x ++ A :: B :: Γ1, C)]
          (Γ2 ++ Imp (Box A0) B0 :: x ++ A :: B :: Γ1, C)). 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. destruct i ; subst .
          exists x6. auto. inversion H0. subst. destruct i0. subst. exists x6. auto. apply H1. apply in_or_app. right.
          apply in_or_app. right. auto.
          apply univ_gen_ext_combine ; auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_cons.
          apply univ_gen_ext_cons. auto. apply BoxImpL in X1.
          assert (J1: wkn_L A (XBoxed_list (x2 ++ x4 ++ x5) ++ [Box A0], A0) (XBoxed_list (x2 ++ x4) ++ A :: XBoxed_list x5 ++ [Box A0], A0)).
          repeat rewrite XBox_app_distrib. simpl.
          assert ((XBoxed_list x2 ++ XBoxed_list x4 ++ XBoxed_list x5) ++ [Box A0] = (XBoxed_list x2 ++ XBoxed_list x4) ++ XBoxed_list x5 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H. apply wkn_LI.
          assert (J2: derrec_height x0 = derrec_height x0). reflexivity.
          pose (GL4ip_wkn_L x0 J2 J1). destruct s.
          assert (J3: 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)). repeat rewrite XBox_app_distrib. simpl.
          assert ((XBoxed_list x2 ++ XBoxed_list x4 ++ unBox_formula A :: A :: XBoxed_list x5) ++ [Box A0] =
          (XBoxed_list x2 ++ XBoxed_list x4) ++ unBox_formula A :: A :: XBoxed_list x5 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H. apply wkn_LI.
          assert (J4: derrec_height x6 = derrec_height x6). reflexivity.
          pose (GL4ip_wkn_L x6 J4 J3). destruct s.
          assert (J11: wkn_L B (XBoxed_list (x2 ++ x4 ++ A :: x5) ++ [Box A0], A0) (XBoxed_list (x2 ++ x4) ++ unBox_formula A :: A :: B :: XBoxed_list x5 ++ [Box A0], A0)).
          repeat rewrite XBox_app_distrib. simpl.
          assert ((XBoxed_list x2 ++ XBoxed_list x4 ++ unBox_formula A :: A :: XBoxed_list x5) ++ [Box A0] =
          (XBoxed_list x2 ++ XBoxed_list x4 ++  unBox_formula A :: [A]) ++ XBoxed_list x5 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H.
          assert ((XBoxed_list x2 ++ XBoxed_list x4) ++ unBox_formula A :: A :: B :: XBoxed_list x5 ++ [Box A0] =
          (XBoxed_list x2 ++ XBoxed_list x4 ++ unBox_formula A :: [A]) ++ B :: XBoxed_list x5 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H. apply wkn_LI.
          assert (J21: derrec_height x7 = derrec_height x7). reflexivity.
          pose (GL4ip_wkn_L x7 J21 J11). destruct s.
          assert (J31: wkn_L (unBox_formula B) (XBoxed_list (x2 ++ x4) ++  unBox_formula A :: A :: B :: XBoxed_list x5 ++ [Box A0], A0)
          (XBoxed_list (x2 ++ x4 ++ A :: B :: x5) ++ [Box A0], A0)). repeat rewrite XBox_app_distrib. simpl.
          assert ((XBoxed_list x2 ++ XBoxed_list x4) ++ unBox_formula A :: A :: B :: XBoxed_list x5 ++ [Box A0] =
          (XBoxed_list x2 ++ XBoxed_list x4 ++ unBox_formula A :: [A]) ++ B :: XBoxed_list x5 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H.
          assert ((XBoxed_list x2 ++ XBoxed_list x4 ++ unBox_formula A :: A :: unBox_formula B :: B :: XBoxed_list x5) ++ [Box A0] =
          (XBoxed_list x2 ++ XBoxed_list x4 ++ unBox_formula A :: [A]) ++ unBox_formula B :: B :: XBoxed_list x5 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H. apply wkn_LI.
          assert (J41: derrec_height x8 = derrec_height x8). reflexivity.
          pose (GL4ip_wkn_L x8 J41 J31). destruct s.
          pose (dlCons x3 DersNilF). pose (dlCons x9 d0).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(XBoxed_list (x2 ++ x4 ++ A :: B :: x5) ++ [Box A0], A0); (Γ2 ++ B0 :: x ++ A :: B :: Γ1, C)])
          (Γ2 ++ Imp (Box A0) B0 :: x ++ A :: B :: Γ1, C) X1 d1). exists d2. simpl. rewrite dersrec_height_nil.
          lia. reflexivity.
        - assert (BoxImpLRule [(XBoxed_list (x2 ++ x4 ++ A :: x5)  ++ [Box A0], A0); (Γ2 ++ B0 :: x ++ A :: B :: Γ1, C)]
          (Γ2 ++ Imp (Box A0) B0 :: x ++ A :: B :: Γ1, C)). 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. right. auto.
          apply univ_gen_ext_combine ; auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_cons.
          apply univ_gen_ext_extra. auto. auto. apply BoxImpL in X1.
          assert (J1: wkn_L A (XBoxed_list (x2 ++ x4 ++ x5) ++ [Box A0], A0) (XBoxed_list (x2 ++ x4) ++ A :: XBoxed_list x5 ++ [Box A0], A0)).
          repeat rewrite XBox_app_distrib. simpl.
          assert ((XBoxed_list x2 ++ XBoxed_list x4 ++ XBoxed_list x5) ++ [Box A0] = (XBoxed_list x2 ++ XBoxed_list x4) ++ XBoxed_list x5 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H. apply wkn_LI.
          assert (J2: derrec_height x0 = derrec_height x0). reflexivity.
          pose (GL4ip_wkn_L x0 J2 J1). destruct s.
          assert (J3: 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)). repeat rewrite XBox_app_distrib. simpl.
          assert ((XBoxed_list x2 ++ XBoxed_list x4 ++ unBox_formula A :: A :: XBoxed_list x5) ++ [Box A0] =
          (XBoxed_list x2 ++ XBoxed_list x4) ++ unBox_formula A :: A :: XBoxed_list x5 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H. apply wkn_LI.
          assert (J4: derrec_height x6 = derrec_height x6). reflexivity.
          pose (GL4ip_wkn_L x6 J4 J3). destruct s.
          pose (dlCons x3 DersNilF). pose (dlCons x7 d0).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(XBoxed_list (x2 ++ x4 ++ A :: x5) ++ [Box A0], A0); (Γ2 ++ B0 :: x ++ A :: B :: Γ1, C)])
          (Γ2 ++ Imp (Box A0) B0 :: x ++ A :: B :: Γ1, C) X1 d1). exists d2. simpl. rewrite dersrec_height_nil.
          lia. reflexivity.
        - assert (BoxImpLRule [(XBoxed_list (x2 ++ x4 ++ B :: x5)  ++ [Box A0], A0); (Γ2 ++ B0 :: x ++ A :: B :: Γ1, C)]
          (Γ2 ++ Imp (Box A0) B0 :: x ++ A :: B :: Γ1, C)). 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. right. auto.
          apply univ_gen_ext_combine ; auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_extra ; auto.
          apply univ_gen_ext_cons. auto. apply BoxImpL in X1.
          assert (J1: wkn_L B (XBoxed_list (x2 ++ x4 ++ x5) ++ [Box A0], A0) (XBoxed_list (x2 ++ x4) ++ B :: XBoxed_list x5 ++ [Box A0], A0)).
          repeat rewrite XBox_app_distrib. simpl.
          assert ((XBoxed_list x2 ++ XBoxed_list x4 ++ XBoxed_list x5) ++ [Box A0] = (XBoxed_list x2 ++ XBoxed_list x4) ++ XBoxed_list x5 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H. apply wkn_LI.
          assert (J2: derrec_height x0 = derrec_height x0). reflexivity.
          pose (GL4ip_wkn_L x0 J2 J1). destruct s.
          assert (J3: wkn_L (unBox_formula B) (XBoxed_list (x2 ++ x4) ++ B :: XBoxed_list x5 ++ [Box A0], A0)
          (XBoxed_list (x2 ++ x4 ++ B :: x5) ++ [Box A0], A0)). repeat rewrite XBox_app_distrib. simpl.
          assert ((XBoxed_list x2 ++ XBoxed_list x4 ++ unBox_formula B :: B :: XBoxed_list x5) ++ [Box A0] =
          (XBoxed_list x2 ++ XBoxed_list x4) ++ unBox_formula B :: B :: XBoxed_list x5 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H. apply wkn_LI.
          assert (J4: derrec_height x6 = derrec_height x6). reflexivity.
          pose (GL4ip_wkn_L x6 J4 J3). destruct s.
          pose (dlCons x3 DersNilF). pose (dlCons x7 d0).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(XBoxed_list (x2 ++ x4 ++ B :: x5) ++ [Box A0], A0); (Γ2 ++ B0 :: x ++ A :: B :: Γ1, C)])
          (Γ2 ++ Imp (Box A0) B0 :: x ++ A :: B :: Γ1, C) X1 d1). exists d2. simpl. rewrite dersrec_height_nil.
          lia. reflexivity.
        - assert (BoxImpLRule [(XBoxed_list (x2 ++ x4 ++ x5)  ++ [Box A0], A0); (Γ2 ++ B0 :: x ++ A :: B :: Γ1, C)]
          (Γ2 ++ Imp (Box A0) B0 :: x ++ A :: B :: Γ1, C)). apply BoxImpLRule_I ; auto.
          apply univ_gen_ext_combine ; auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_extra ; auto.
          apply univ_gen_ext_extra ; auto. apply BoxImpL in X1.
          pose (dlCons x3 DersNilF). pose (dlCons x0 d0).
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(XBoxed_list (x2 ++ x4 ++ x5) ++ [Box A0], A0); (Γ2 ++ B0 :: x ++ A :: B :: Γ1, C)])
          (Γ2 ++ Imp (Box A0) B0 :: x ++ A :: B :: Γ1, C) X1 d1). exists d2. simpl. rewrite dersrec_height_nil.
          lia. reflexivity. }
    + destruct x.
       { simpl in e0. inversion e0. }
       { inversion e0. subst. clear e0. 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. repeat rewrite <- app_assoc in X0. simpl in X0.
        apply univ_gen_ext_splitR in X0. destruct X0. destruct s. repeat destruct p.
        subst. inversion u0. subst. exfalso.
        apply is_box_is_in_boxed_list with (A:=And A B) in H1. destruct H1.
        inversion H. apply in_or_app. right. apply in_eq. subst.
        assert (J50: AndLRule [(Γ0 ++ A :: B :: x ++ B0 :: Γ3, C)]
        ((Γ0 ++ And A B :: x) ++ B0 :: Γ3, C)). repeat rewrite <- app_assoc. apply AndLRule_I.
        assert (J51: derrec_height x1 < S (dersrec_height d)). lia.
        assert (J52: derrec_height x1 = derrec_height x1). reflexivity.
        pose (IH _ J51 _ _ J52). destruct p. clear s0. pose (s _ J50). destruct s0. clear s.
        destruct (dec_is_boxedT A) ; destruct (dec_is_boxedT B).
        - assert (BoxImpLRule [(XBoxed_list (x2 ++ A :: B :: x3)  ++ [Box A0], A0); ((Γ0 ++ A :: B :: x) ++ B0 :: Γ3, C)]
          ((Γ0 ++  A :: B :: x) ++ Imp (Box A0) B0 :: Γ3, C)). apply BoxImpLRule_I ; auto.
          intro. intros. apply in_app_or in H. destruct H. apply H1. apply in_or_app ; auto. inversion H. subst. auto.
          inversion H0. subst. destruct i0. subst. exists x5. auto. apply H1. apply in_or_app. auto. repeat rewrite <- app_assoc.
          apply univ_gen_ext_combine ; auto. simpl. apply univ_gen_ext_cons. apply univ_gen_ext_cons. auto. apply BoxImpL in X1.
          assert (J1: 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. simpl. repeat rewrite <- app_assoc. apply wkn_LI.
          assert (J2: derrec_height x0 = derrec_height x0). reflexivity.
          pose (GL4ip_wkn_L x0 J2 J1). destruct s.
          assert (J3: 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.
          rewrite <- app_assoc. apply wkn_LI.
          assert (J4: derrec_height x5 = derrec_height x5). reflexivity.
          pose (GL4ip_wkn_L x5 J4 J3). destruct s.
          assert (J11: wkn_L B (XBoxed_list (x2 ++ A :: x3) ++ [Box A0], A0) (XBoxed_list x2 ++ unBox_formula A :: A :: B :: XBoxed_list x3 ++ [Box A0], A0)).
          repeat rewrite XBox_app_distrib. simpl.
          assert ((XBoxed_list x2 ++ unBox_formula A :: A :: XBoxed_list x3) ++ [Box A0] =
          (XBoxed_list x2 ++ unBox_formula A :: [A]) ++ XBoxed_list x3 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H.
          assert (XBoxed_list x2  ++ unBox_formula A :: A :: B :: XBoxed_list x3 ++ [Box A0] =
          (XBoxed_list x2 ++ unBox_formula A :: [A]) ++ B :: XBoxed_list x3 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H. apply wkn_LI.
          assert (J21: derrec_height x6 = derrec_height x6). reflexivity.
          pose (GL4ip_wkn_L x6 J21 J11). destruct s.
          assert (J31: wkn_L (unBox_formula B) (XBoxed_list x2 ++ unBox_formula A :: A :: B :: XBoxed_list x3 ++ [Box A0], A0)
          (XBoxed_list (x2 ++ A :: B :: x3) ++ [Box A0], A0)). repeat rewrite XBox_app_distrib. simpl.
          assert (XBoxed_list x2 ++ unBox_formula A :: A :: B :: XBoxed_list x3 ++ [Box A0] =
          (XBoxed_list x2 ++ unBox_formula A :: [A]) ++ B :: XBoxed_list x3 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H.
          assert ((XBoxed_list x2 ++unBox_formula A :: A :: unBox_formula B :: B :: XBoxed_list x3) ++ [Box A0] =
          (XBoxed_list x2 ++ unBox_formula A :: [A]) ++ unBox_formula B :: B :: XBoxed_list x3 ++ [Box A0]).
          repeat rewrite <- app_assoc. auto. rewrite H. clear H. apply wkn_LI.
          assert (J41: derrec_height x7 = derrec_height x7). reflexivity.
          pose (GL4ip_wkn_L x7 J41 J31). destruct s.
          pose (dlCons x4 DersNilF). pose (dlCons x8 d0). repeat rewrite <- app_assoc in X1.
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(XBoxed_list (x2 ++ A :: B :: x3) ++ [Box A0], A0); (Γ0 ++ A :: B :: x ++ B0 :: Γ3, C)])
          (Γ0 ++ A :: B :: x ++ Imp (Box A0) B0 :: Γ3, C) X1 d1). exists d2. simpl. rewrite dersrec_height_nil.
          lia. reflexivity.
        - assert (BoxImpLRule [(XBoxed_list (x2 ++ A :: x3)  ++ [Box A0], A0); ((Γ0 ++ A :: B :: x) ++ B0 :: Γ3, C)]
          ((Γ0 ++  A :: B :: x) ++ Imp (Box A0) B0 :: Γ3, C)). apply BoxImpLRule_I ; auto.
          intro. intros. apply in_app_or in H. destruct H. apply H1. apply in_or_app ; auto. inversion H. 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. apply univ_gen_ext_extra. auto. auto. apply BoxImpL in X1.
          assert (J1: 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. simpl. repeat rewrite <- app_assoc. apply wkn_LI.
          assert (J2: derrec_height x0 = derrec_height x0). reflexivity.
          pose (GL4ip_wkn_L x0 J2 J1). destruct s.
          assert (J3: 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.
          rewrite <- app_assoc. apply wkn_LI.
          assert (J4: derrec_height x5 = derrec_height x5). reflexivity.
          pose (GL4ip_wkn_L x5 J4 J3). destruct s.
          pose (dlCons x4 DersNilF). pose (dlCons x6 d0). repeat rewrite <- app_assoc in X1.
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(XBoxed_list (x2 ++ A :: x3) ++ [Box A0], A0); (Γ0 ++ A :: B :: x ++ B0 :: Γ3, C)])
          (Γ0 ++ A :: B :: x ++ Imp (Box A0) B0 :: Γ3, C) X1 d1). exists d2. simpl. rewrite dersrec_height_nil.
          lia. reflexivity.
        - assert (BoxImpLRule [(XBoxed_list (x2 ++ B :: x3)  ++ [Box A0], A0); ((Γ0 ++ A :: B :: x) ++ B0 :: Γ3, C)]
          ((Γ0 ++  A :: B :: x) ++ Imp (Box A0) B0 :: Γ3, C)). apply BoxImpLRule_I ; auto.
          intro. intros. apply in_app_or in H. destruct H. apply H1. apply in_or_app ; auto. inversion H. subst. auto.
          apply H1. apply in_or_app. auto. repeat rewrite <- app_assoc. simpl.
          apply univ_gen_ext_combine ; auto. simpl. apply univ_gen_ext_extra ; auto. apply univ_gen_ext_cons.
          auto. apply BoxImpL in X1.
          assert (J1: wkn_L B (XBoxed_list (x2 ++ x3) ++ [Box A0], A0) (XBoxed_list x2 ++ B :: XBoxed_list x3 ++ [Box A0], A0)).
          repeat rewrite XBox_app_distrib. simpl. repeat rewrite <- app_assoc. apply wkn_LI.
          assert (J2: derrec_height x0 = derrec_height x0). reflexivity.
          pose (GL4ip_wkn_L x0 J2 J1). destruct s.
          assert (J3: wkn_L (unBox_formula B) (XBoxed_list x2 ++ B :: XBoxed_list x3 ++ [Box A0], A0)
          (XBoxed_list (x2 ++ B :: x3) ++ [Box A0], A0)). repeat rewrite XBox_app_distrib. simpl.
          rewrite <- app_assoc. apply wkn_LI.
          assert (J4: derrec_height x5 = derrec_height x5). reflexivity.
          pose (GL4ip_wkn_L x5 J4 J3). destruct s.
          pose (dlCons x4 DersNilF). pose (dlCons x6 d0). repeat rewrite <- app_assoc in X1.
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(XBoxed_list (x2 ++ B :: x3) ++ [Box A0], A0); (Γ0 ++ A :: B :: x ++ B0 :: Γ3, C)])
          (Γ0 ++ A :: B :: x ++ Imp (Box A0) B0 :: Γ3, C) X1 d1). exists d2. simpl. rewrite dersrec_height_nil.
          lia. reflexivity.
        - assert (BoxImpLRule [(XBoxed_list (x2 ++ x3)  ++ [Box A0], A0); ((Γ0 ++ A :: B :: x) ++ B0 :: Γ3, C)]
          ((Γ0 ++  A :: B :: x) ++ Imp (Box A0) B0 :: Γ3, C)). apply BoxImpLRule_I ; auto.
          repeat rewrite <- app_assoc. simpl.
          apply univ_gen_ext_combine ; auto. simpl. apply univ_gen_ext_extra ; auto. apply univ_gen_ext_extra ; auto.
          apply BoxImpL in X1.
          pose (dlCons x4 DersNilF). pose (dlCons x0 d0). repeat rewrite <- app_assoc in X1.
          pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
          (ps:=[(XBoxed_list (x2 ++ x3) ++ [Box A0], A0); (Γ0 ++ A :: B :: x ++ B0 :: Γ3, C)])
          (Γ0 ++ A :: B :: x ++ Imp (Box A0) B0 :: Γ3, C) X1 d1). exists d2. simpl. rewrite dersrec_height_nil.
          lia. reflexivity. }
  (* GLR *)
  * inversion X. subst. simpl.
    assert (GLRRule [(XBoxed_list BΓ ++ [Box A0], A0)] (Γ0 ++ Γ1, Box A0)). apply GLRRule_I ; auto.
    apply univ_gen_ext_splitR in X0. destruct X0. destruct s. repeat destruct p ; subst. inversion u0. exfalso.
    subst. assert (In (And A B) (x ++ And A B :: l)). apply in_or_app. right. apply in_eq. pose (H1 (And A B) H).
    destruct e. inversion H0. apply univ_gen_ext_combine ; auto. simpl in IH.
    apply GLR in X1.
    assert (dersrec_height d = dersrec_height d). reflexivity.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(XBoxed_list BΓ ++ [Box A0], A0)]) (Γ0 ++ Γ1, Box A0) X1 d).
    assert (J1: wkn_L B (Γ0 ++ Γ1, Box A0) (Γ0 ++ B :: Γ1, Box A0)).
    apply wkn_LI.
    assert (J2: derrec_height d0 = derrec_height d0). reflexivity.
    pose (GL4ip_wkn_L d0 J2 J1). destruct s.
    assert (J3: wkn_L A (Γ0 ++ B :: Γ1, Box A0) (Γ0 ++ A :: B :: Γ1, Box A0)).
    apply wkn_LI.
    assert (J4: derrec_height x = derrec_height x). reflexivity.
    pose (GL4ip_wkn_L x J4 J3). destruct s. exists x0.
    pose (Nat.le_trans _ _ _ l0 l). simpl in l1. assumption. }

(* Invertibility AndR *)
{ intros prem1 prem2 RA. inversion RA. subst.
  inversion g ; subst.
  (* IdP *)
  * inversion H.
  (* BotL *)
  * inversion H. subst. simpl.
    assert (BotLRule [] (Γ0 ++ Bot :: Γ1, A)).
    apply BotLRule_I. apply BotL in H0.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[]) (Γ0 ++ Bot :: Γ1, A) H0 DersNilF). exists d0.
    assert (BotLRule [] (Γ0 ++ Bot :: Γ1, B)).
    apply BotLRule_I. apply BotL in H1.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[]) (Γ0 ++ Bot :: Γ1, B) H1 DersNilF). exists d1.
    simpl. rewrite dersrec_height_nil. split ; lia. reflexivity.
  (* AndR *)
  * inversion H. subst. assert (J0: (dersrec_height d) = (dersrec_height d)). reflexivity.
    pose (dersrec_derrec2_height d J0). repeat destruct s. exists x. exists x0. simpl. split ; lia.
  (* AndL *)
  * 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 (AndLRule [(Γ0 ++ A0 :: B0 :: Γ1, A)] (Γ0 ++ And A0 B0 :: Γ1, A)).
    apply AndLRule_I. apply AndL in H0.
    assert (AndLRule [(Γ0 ++ A0 :: B0 :: Γ1, B)] (Γ0 ++ And A0 B0 :: Γ1, B)).
    apply AndLRule_I. apply AndL in H1.
    assert (J4: AndRRule [(Γ0 ++ A0 :: B0 :: Γ1, A);(Γ0 ++ A0 :: B0 :: Γ1, B)]
    (Γ0 ++ A0 :: B0 :: Γ1, And A B)). apply AndRRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6). destruct p. clear s. pose (s0 _ _ J4). destruct s. clear s0. destruct s.
    pose (dlCons x0 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ A0 :: B0 :: Γ1, A)]) (Γ0 ++ And A0 B0 :: Γ1, A) H0 d0). exists d1.
    pose (dlCons x1 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ A0 :: B0 :: Γ1, B)]) (Γ0 ++ And A0 B0 :: Γ1, B) H1 d2). exists d3.
    simpl. rewrite dersrec_height_nil. simpl. split. simpl. destruct p. lia. destruct p. lia. reflexivity.
  (* OrR1 *)
  * inversion H.
  (* OrR2 *)
  * inversion H.
  (* OrL *)
  * inversion H. subst. simpl. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
    assert (OrLRule [(Γ0 ++ A0 :: Γ1, A);(Γ0 ++ B0 :: Γ1, A)] (Γ0 ++ Or A0 B0 :: Γ1, A)).
    apply OrLRule_I. apply OrL in H0.
    assert (OrLRule [(Γ0 ++ A0 :: Γ1, B);(Γ0 ++ B0 :: Γ1, B)] (Γ0 ++ Or A0 B0 :: Γ1, B)).
    apply OrLRule_I. apply OrL in H1.
    assert (J4: AndRRule [(Γ0 ++ A0 :: Γ1, A);(Γ0 ++ A0 :: Γ1, B)]
    (Γ0 ++ A0 :: Γ1, And A B)). apply AndRRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6). destruct p. clear s. pose (s0 _ _ J4). destruct s. clear s0. destruct s. destruct p.
    assert (J7: AndRRule [(Γ0 ++ B0 :: Γ1, A);(Γ0 ++ B0 :: Γ1, B)]
    (Γ0 ++ B0 :: Γ1, And A B)). apply AndRRule_I.
    assert (J8: derrec_height x0 < S (dersrec_height d)). lia.
    assert (J9: derrec_height x0 = derrec_height x0). reflexivity.
    pose (IH _ J8 _ _ J9). destruct p. clear s. pose (s0 _ _ J7). destruct s. clear s0. destruct s. destruct p.
    pose (dlCons x3 DersNilF).  pose (dlCons x1 d0).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ A0 :: Γ1, A); (Γ0 ++ B0 :: Γ1, A)]) (Γ0 ++ Or A0 B0 :: Γ1, A) H0 d1). exists d2.
    pose (dlCons x4 DersNilF).  pose (dlCons x2 d3).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ A0 :: Γ1, B); (Γ0 ++ B0 :: Γ1, B)]) (Γ0 ++ Or A0 B0 :: Γ1, B) H1 d4). exists d5.
    simpl. rewrite dersrec_height_nil. simpl. split. simpl. lia. lia. reflexivity.
  (* ImpR *)
  * inversion H.
  (* AtomImpL1 *)
  * inversion H. subst. simpl. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). repeat destruct s.
    assert (AtomImpL1Rule [(Γ0 ++ # P :: Γ1 ++ A0 :: Γ2, A)] (Γ0 ++ # P :: Γ1 ++ Imp # P A0 :: Γ2, A)).
    apply AtomImpL1Rule_I. apply AtomImpL1 in H0.
    assert (AtomImpL1Rule [(Γ0 ++ # P :: Γ1 ++ A0 :: Γ2, B)] (Γ0 ++ # P :: Γ1 ++ Imp # P A0 :: Γ2, B)).
    apply AtomImpL1Rule_I. apply AtomImpL1 in H1.
    assert (J4: AndRRule [(Γ0 ++ # P :: Γ1 ++ A0 :: Γ2, A);(Γ0 ++ # P :: Γ1 ++ A0 :: Γ2, B)]
    (Γ0 ++ # P :: Γ1 ++ A0 :: Γ2, And A B)). apply AndRRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6). destruct p. clear s. pose (s0 _ _ J4). destruct s. clear s0. destruct s. destruct p.
    pose (dlCons x0 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ # P :: Γ1 ++ A0 :: Γ2, A)]) (Γ0 ++ # P :: Γ1 ++ Imp # P A0 :: Γ2, A) H0 d0). exists d1.
    pose (dlCons x1 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ # P :: Γ1 ++ A0 :: Γ2, B)]) (Γ0 ++ # P :: Γ1 ++ Imp # P A0 :: Γ2, B) H1 d2). exists d3.
    simpl. rewrite dersrec_height_nil. simpl. split. simpl. lia. lia. reflexivity.
  (* AtomImpL2 *)
  * inversion H. subst. simpl. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). repeat destruct s.
    assert (AtomImpL2Rule [(Γ0 ++ A0 :: Γ1 ++ # P :: Γ2, A)] (Γ0 ++ Imp # P A0 :: Γ1 ++ # P :: Γ2, A)).
    apply AtomImpL2Rule_I. apply AtomImpL2 in H0.
    assert (AtomImpL2Rule [(Γ0 ++ A0 :: Γ1 ++ # P :: Γ2, B)] (Γ0 ++ Imp # P A0 :: Γ1 ++ # P :: Γ2, B)).
    apply AtomImpL2Rule_I. apply AtomImpL2 in H1.
    assert (J4: AndRRule [(Γ0 ++ A0 :: Γ1 ++ # P :: Γ2, A);(Γ0 ++ A0 :: Γ1 ++ # P :: Γ2, B)]
    (Γ0 ++ A0 :: Γ1 ++ # P :: Γ2, And A B)). apply AndRRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6). destruct p. clear s. pose (s0 _ _ J4). destruct s. clear s0. destruct s. destruct p.
    pose (dlCons x0 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ A0 :: Γ1 ++ # P :: Γ2, A)]) (Γ0 ++ Imp # P A0 :: Γ1 ++ # P :: Γ2, A) H0 d0). exists d1.
    pose (dlCons x1 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ A0 :: Γ1 ++ # P :: Γ2, B)]) (Γ0 ++ Imp # P A0 :: Γ1 ++ # P :: Γ2, B) H1 d2). exists d3.
    simpl. rewrite dersrec_height_nil. simpl. split. simpl. lia. lia. reflexivity.
  (* AndImpL *)
  * inversion H. subst. simpl. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). repeat destruct s.
    assert (AndImpLRule [(Γ0 ++ Imp A0 (Imp B0 C) :: Γ1, A)] (Γ0 ++ Imp (And A0 B0) C :: Γ1, A)).
    apply AndImpLRule_I. apply AndImpL in H0.
    assert (AndImpLRule [(Γ0 ++ Imp A0 (Imp B0 C) :: Γ1, B)] (Γ0 ++ Imp (And A0 B0) C :: Γ1, B)).
    apply AndImpLRule_I. apply AndImpL in H1.
    assert (J4: AndRRule [(Γ0 ++ Imp A0 (Imp B0 C) :: Γ1, A);(Γ0 ++ Imp A0 (Imp B0 C) :: Γ1, B)]
    (Γ0 ++ Imp A0 (Imp B0 C) :: Γ1, And A B)). apply AndRRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6). destruct p. clear s. pose (s0 _ _ J4). destruct s. clear s0. destruct s. destruct p.
    pose (dlCons x0 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ Imp A0 (Imp B0 C) :: Γ1, A)]) (Γ0 ++ Imp (And A0 B0) C :: Γ1, A) H0 d0). exists d1.
    pose (dlCons x1 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ Imp A0 (Imp B0 C) :: Γ1, B)]) (Γ0 ++ Imp (And A0 B0) C :: Γ1, B) H1 d2). exists d3.
    simpl. rewrite dersrec_height_nil. simpl. split. simpl. lia. lia. reflexivity.
  (* OrImpL *)
  * inversion H. subst. simpl. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). repeat destruct s.
    assert (OrImpLRule [(Γ0 ++ Imp A0 C :: Γ1 ++ Imp B0 C ::Γ2, A)] (Γ0 ++ Imp (Or A0 B0) C :: Γ1 ++ Γ2, A)).
    apply OrImpLRule_I. apply OrImpL in H0.
    assert (OrImpLRule [(Γ0 ++ Imp A0 C :: Γ1 ++ Imp B0 C ::Γ2, B)] (Γ0 ++ Imp (Or A0 B0) C :: Γ1 ++ Γ2, B)).
    apply OrImpLRule_I. apply OrImpL in H1.
    assert (J4: AndRRule [(Γ0 ++ Imp A0 C :: Γ1 ++ Imp B0 C :: Γ2, A);(Γ0 ++ Imp A0 C :: Γ1 ++ Imp B0 C :: Γ2, B)]
    (Γ0 ++ Imp A0 C :: Γ1 ++ Imp B0 C :: Γ2, And A B)). apply AndRRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6). destruct p. clear s. pose (s0 _ _ J4). destruct s. clear s0. destruct s. destruct p.
    pose (dlCons x0 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ Imp A0 C :: Γ1 ++ Imp B0 C :: Γ2, A)]) (Γ0 ++ Imp (Or A0 B0) C :: Γ1 ++ Γ2, A) H0 d0). exists d1.
    pose (dlCons x1 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ Imp A0 C :: Γ1 ++ Imp B0 C :: Γ2, B)]) (Γ0 ++ Imp (Or A0 B0) C :: Γ1 ++ Γ2, B) H1 d2). exists d3.
    simpl. rewrite dersrec_height_nil. simpl. split. simpl. lia. lia. reflexivity.
  (* ImpImpL *)
  * inversion H. subst. simpl. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
    assert (ImpImpLRule [(Γ0 ++ Imp B0 C :: Γ1, Imp A0 B0);(Γ0 ++ C :: Γ1, A)] (Γ0 ++ Imp (Imp A0 B0) C :: Γ1, A)).
    apply ImpImpLRule_I. apply ImpImpL in H0.
    assert (ImpImpLRule [(Γ0 ++ Imp B0 C :: Γ1, Imp A0 B0);(Γ0 ++ C :: Γ1, B)] (Γ0 ++ Imp (Imp A0 B0) C :: Γ1, B)).
    apply ImpImpLRule_I. apply ImpImpL in H1.
    assert (J4: AndRRule [(Γ0 ++ C :: Γ1, A);(Γ0 ++ C :: Γ1, B)]
    (Γ0 ++ C :: Γ1, And A B)). apply AndRRule_I.
    assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
    assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
    pose (IH _ J5 _ _ J6). destruct p. clear s. pose (s0 _ _ J4). destruct s. clear s0. destruct s. destruct p.
    pose (dlCons x1 DersNilF). pose (dlCons x d0).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ Imp B0 C :: Γ1, Imp A0 B0); (Γ0 ++ C :: Γ1, A)]) (Γ0 ++ Imp (Imp A0 B0) C :: Γ1, A) H0 d1). exists d2.
    pose (dlCons x2 DersNilF). pose (dlCons x d3).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ Imp B0 C :: Γ1, Imp A0 B0); (Γ0 ++ C :: Γ1, B)]) (Γ0 ++ Imp (Imp A0 B0) C :: Γ1, B) H1 d4). exists d5.
    simpl. rewrite dersrec_height_nil. simpl. split. simpl. lia. lia. reflexivity.
  (* ImpImpL *)
  * inversion X. subst. simpl. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
    assert (BoxImpLRule [(XBoxed_list BΓ ++ [Box A0], A0); (Γ0 ++ B0 :: Γ1, A)] (Γ0 ++ Imp (Box A0) B0 :: Γ1, A)).
    apply BoxImpLRule_I ; auto. apply BoxImpL in X1.
    assert (BoxImpLRule  [(XBoxed_list BΓ ++ [Box A0], A0); (Γ0 ++ B0 :: Γ1, B)] (Γ0 ++ Imp (Box A0) B0 :: Γ1, B)).
    apply BoxImpLRule_I ; auto. apply BoxImpL in X2.
    assert (J4: AndRRule [(Γ0 ++ B0 :: Γ1, A);(Γ0 ++ B0 :: Γ1, B)]
    (Γ0 ++ B0 :: Γ1, And A B)). apply AndRRule_I.
    assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
    assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
    pose (IH _ J5 _ _ J6). destruct p. clear s. pose (s0 _ _ J4). destruct s. clear s0. destruct s. destruct p.
    pose (dlCons x1 DersNilF). pose (dlCons x d0).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(XBoxed_list BΓ ++ [Box A0], A0); (Γ0 ++ B0 :: Γ1, A)]) (Γ0 ++ Imp (Box A0) B0 :: Γ1, A) X1 d1). exists d2.
    pose (dlCons x2 DersNilF). pose (dlCons x d3).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(XBoxed_list BΓ ++ [Box A0], A0); (Γ0 ++ B0 :: Γ1, B)]) (Γ0 ++ Imp (Box A0) B0 :: Γ1, B) X2 d4). exists d5.
    simpl. rewrite dersrec_height_nil. simpl. split. simpl. lia. lia. reflexivity.
  (* GLR *)
  * inversion X. }
Qed.

Theorem AndL_inv : forall concl prem, (derrec GL4ip_rules (fun _ => False) concl) ->
                                      (AndLRule [prem] concl) ->
                                      (derrec GL4ip_rules (fun _ => False) prem).
Proof.
intros.
assert (J1: derrec_height X = derrec_height X). reflexivity.
pose (AndR_AndL_hpinv _  _ X J1). destruct p. pose (s _ H). destruct s1. assumption.
Qed.

Theorem AndR_inv : forall concl prem1 prem2, (derrec GL4ip_rules (fun _ => False) concl) ->
                                      (AndRRule [prem1;prem2] concl) ->
                                      (derrec GL4ip_rules (fun _ => False) prem1) *
                                      (derrec GL4ip_rules (fun _ => False) prem2).
Proof.
intros.
assert (J1: derrec_height X = derrec_height X). reflexivity.
pose (AndR_AndL_hpinv _ _ X J1). destruct p. pose (s0 _ _ H). repeat destruct s1. auto.
Qed.


(* Copyright 2021 Joshua M. Cohen

Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.
You may obtain a copy of the License at
    http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.
*)

Require Import VST.floyd.proofauto.

Require Import fec.
Require Import MatrixTransform.
Require Import CommonVST.
Require Import VandermondeByte.
Require Import Specs.
Require Import ByteFacts.
Require Import ZSeq.
Require Import FECTactics.
Require Import ReedSolomonList.
Require Import PopArrays.

Set Bullet Behavior "Strict Subproofs".

Section Encoder.

Opaque ByteField.byte_mul.

Lemma body_fec_blk_encode : semax_body Vprog Gprog f_fec_blk_encode fec_blk_encode_spec.
Proof.
  start_function. unfold FEC_TABLES. unfold FIELD_TABLES. Intros.
  assert_PROP (Zlength packets = k) as Hpack. { entailer!. rewrite !Zlength_map in H9. auto. }
  assert_PROP (Zlength parity_ptrs = h) as Hpar. { entailer!. rewrite Zlength_app in H6. lia. }
  assert (Hlenall: forall (i: Z), 0 <= i < k -> Znth i lengths = Zlength (Znth i packets)). {
    intros i Hi. subst. rewrite Znth_map. auto. lia. }
 forward. forward.
  assert_PROP (force_val (sem_binary_operation' Oadd (tptr (tptr tuchar)) tint pd (Vint (Int.repr k))) =
    field_address0 (tarray (tptr (tuchar)) (k + h)) [ArraySubsc k] pd) as Hpd. { entailer!. solve_offset. }
  rewrite Hpd.
  (*we want to pull out z from the locals*)
  erewrite LOCALx_Permutation; [| apply perm_swap].
  remember [ temp _pparity (field_address0 (tarray (tptr tuchar) (k + h)) (SUB k) pd); gvars gv;
      temp _k (Vint (Int.repr k));
      temp _h (Vint (Int.repr h)); temp _c (Vint (Int.repr c)); temp _pdata pd;
      temp _plen pl; temp _pstat ps] as LOCALS.
  remember ( temp _z (Vint (Int.zero_ext 8 (Int.neg (Int.repr 1)))) :: LOCALS) as LOCALS1.
  remember [data_at Ews (tarray (tptr tuchar) (k + h)) (packet_ptrs ++ parity_ptrs) pd;
       iter_sepcon_arrays packet_ptrs packets;
       data_at Ews (tarray tint k) (map Vint (map Int.repr lengths)) pl;
       data_at Ews (tarray tschar k) (zseq k (Vbyte Byte.zero)) ps; INDEX_TABLES gv;
       data_at Ews (tarray tuchar fec_n) (map Vubyte ByteField.byte_invs) (gv _fec_invefec);
       data_at Ews tint (Vint Int.zero) (gv _trace);
       data_at Ews (tarray (tarray tuchar (fec_n - 1)) fec_max_h) (rev_mx_val weight_mx)
         (gv _fec_weights)] as SEPS.
  remember (iter_sepcon_arrays parity_ptrs (zseq h (zseq c Byte.zero)) :: SEPS) as SEPS1.
  (*first loop - check for FLAG_WANTED, trivial bc of precondition*)
  forward_loop (EX (i: Z),
    PROP (0 <= i <= k)
    (LOCALx  ( temp _i (Vint (Int.repr i)) :: LOCALS1 )
    (SEPx SEPS1)))
   break:
    (PROP ( )  (LOCALx LOCALS1 (SEPx SEPS1))).
  { rewrite_eqs. forward. Exists 0%Z. rewrite_eqs. entailer!. }
  { Intros i. rewrite_eqs. forward_if.
    { forward. rewrite zseq_Znth by lia. entailer!.
      forward_if.
      { forward_if True.
        { contradiction. }
        { forward. entailer!. }
        { rewrite zseq_Znth in H7 by lia. inversion H7. }
      }
      { forward. Exists (i+1)%Z. rewrite_eqs. entailer!. simpl_repr_byte. }
    }
    { forward. rewrite_eqs. entailer!. }
  }
  { (*error check that is trivial*) rewrite_eqs. forward_if True. contradiction.
    forward. entailer!.
    (*outer loop - go through all rows selected by weight matrix*)
    rewrite <- HeqLOCALS. rewrite <- HeqSEPS. clear HeqLOCALS1 LOCALS1. clear HeqSEPS1 SEPS1.
    forward_loop (EX (i: Z),
      PROP (0 <= i <= h)
       (LOCALx (temp _i (Vint (Int.repr i)):: temp _z (Vint (Int.repr ((i - 1) mod 256))) :: LOCALS)
       (SEPx (iter_sepcon_arrays parity_ptrs
        (pop_mx_mult h c k (submatrix (fec_n - 1) weight_mx h k) (extend_mx (F:=B) k c packets) i 0)
        :: SEPS))))
      break:
      (PROP ()  (LOCALx LOCALS (SEPx ((iter_sepcon_arrays parity_ptrs (encoder_list h k c packets)) :: SEPS)))).
    { rewrite_eqs. forward. Exists (0%Z).  rewrite_eqs. entailer!. rewrite pop_mx_mult_zero by lia.
      apply derives_refl'. reflexivity. }
    { (*loop body*) Intros i. rewrite_eqs.
      remember (pop_mx_mult h c k (submatrix (F:=B) (fec_n - 1) weight_mx h k) (extend_mx (F:=B) k c packets)i 0)
            as mx.
      assert (Hwf: wf_lmatrix mx h c) by (subst; apply pop_mx_mult_wf; rep_lia). destruct Hwf as [Hmxlen [_ Hinmx]].
      forward_if.
      { (*loop for z - basically trivial for us bc of precondition*)
        rewrite <- HeqLOCALS. rewrite <- HeqSEPS.
        forward_loop (
          PROP ()
          (LOCALx (temp _i (Vint (Int.repr i)) :: temp _z (Vint (Int.repr ((i-1) mod 256))) :: LOCALS)
          (SEPx (iter_sepcon_arrays parity_ptrs mx :: SEPS))))
        break:
          (PROP ()
          (LOCALx (temp _i (Vint (Int.repr i)) :: temp _z (Vint (Int.repr i)) :: LOCALS)
          (SEPx (iter_sepcon_arrays parity_ptrs mx :: SEPS)))). (*bc of simplifying assumption*)
        { rewrite_eqs; entailer!. }
        { rewrite_eqs. forward. forward. (*needed the mod 256 part bc z starts as -1, but now it is i*)
          assert (Hmod: (Int.zero_ext 8 (Int.add (Int.repr ((i - 1) mod 256)) (Int.repr 1))) = (Int.repr i)). {
            unfold Int.add. assert (0 <= (i-1) mod 256 < 256) by (apply Z.mod_pos_bound; lia). simpl_repr_byte.
            f_equal. rewrite Zbits.Zzero_ext_mod by rep_lia.
            replace (two_p 8) with 256 by reflexivity. rewrite <- (Zmod_small 1 256) at 2 by rep_lia.
            rewrite <- Zplus_mod. rewrite Zmod_small; rep_lia. } rewrite Hmod. simpl_repr_byte.
           assert_PROP (force_val (sem_add_ptr_int (tptr tuchar) Signed
            (field_address0 (tarray (tptr tuchar) (k + h)) (SUB k) pd)
            (Vint (Int.repr i))) = field_address (tarray (tptr tuchar) (k + h)) (SUB (k + i)) pd). {
            entailer!. solve_offset. }
           assert (Hlens: Zlength parity_ptrs = Zlength mx) by lia.
           assert (Hith : 0 <= i < Zlength mx) by lia.
           assert (Hznth : (@Znth _ Vundef (k + i) (packet_ptrs ++ parity_ptrs)) = Znth i parity_ptrs). {
            rewrite Znth_app2 by list_solve. f_equal. lia. }
           (*We need the split the ith parity packet from the rest in the [iter_sepcon]*)
           rewrite (iter_sepcon_arrays_remove_one  _ _ _ Hlens Hith). Intros.
           forward; try rewrite Hznth.
          { entailer!. }
          { entailer!. solve_offset. }
          { forward_if False. (*If condition is true due to assumption*)
            { apply (denote_tc_test_eq_split _ (Znth i parity_ptrs) (Vlong (Int64.zero))).
              { sep_apply data_at_memory_block. sep_apply memory_block_valid_ptr. auto. simpl.
                inner_length. entailer!.
              }
              { apply valid_pointer_zero64; auto. (*relies on 64 bit*) }
            }
            { forward. entailer!. rewrite H8 in H12. apply (field_compatible_nullval _ _ _ _ H12). }
            { forward. rewrite_eqs; entailer!. rewrite (iter_sepcon_arrays_remove_one _ _ _ Hlens Hith). entailer!. }
            { rewrite_eqs; entailer!. }
          }
        }
        { (*Now another trivial error check*) rewrite_eqs; forward_if True.
          { contradiction. }
          { forward. entailer!. }
          { (*now, at the (assert < FEC_MAX_H), which, again, is always true*) forward_if True.
            { forward. entailer!. }
            { rep_lia. (* the assertion holds*) }
            { (*finally, we are at the actual inner loop*)
               (*since i and w are not changing, we can add them to LOCALS (but we can't replace LOCALS bc
                 it is used in the POSTCONDITION*)
               rewrite <- HeqLOCALS. rewrite <- HeqSEPS.
               remember (temp _i (Vint (Int.repr i)) :: temp _z (Vint (Int.repr i)) :: LOCALS) as LOCALS1.
               forward_loop (EX (j: Z),
                PROP (0 <= j <= c)
                (LOCALx (temp _j (Vint (Int.repr j)) :: LOCALS1)
                  (SEPx (iter_sepcon_arrays parity_ptrs (pop_mx_mult h c k (submatrix (fec_n - 1) weight_mx h k)
                    (extend_mx (F:=B) k c packets) i j) :: SEPS))))
                break: (PROP () (LOCALx LOCALS1 (SEPx (iter_sepcon_arrays parity_ptrs (pop_mx_mult h c k (submatrix (fec_n - 1) weight_mx h k)
                    (extend_mx (F:=B) k c packets) i c) :: SEPS)))).
              { rewrite_eqs. forward. Exists 0%Z. rewrite_eqs. entailer!. }
              { Intros j. remember (pop_mx_mult h c k (submatrix (F:=B) (fec_n - 1) weight_mx h k)
               (extend_mx (F:=B) k c packets) i j) as mx'. rewrite_eqs. forward_if.
                { (*body of j- loop*) forward. simpl_repr_byte.
                  assert_PROP (force_val (sem_add_ptr_int (tarray tuchar 255) Signed (gv _fec_weights)
                    (Vint (Int.repr i))) =
                    field_address (tarray (tarray tuchar (fec_n - 1)) fec_max_h) (SUB i) (gv _fec_weights)) as Hp. {
                  entailer!. solve_offset. } forward. clear Hp.
                    (*Now we can express p as an actual address in the 2D array.*)
                  assert_PROP ((force_val (sem_binary_operation' Oadd (tarray (tarray tuchar 255) 128) tuchar
                     (gv _fec_weights) (Vint (Int.repr i)))) =
                     field_address0 (tarray (tarray tuchar 255) 128) [ArraySubsc 0; ArraySubsc i]
                       (gv _fec_weights)) as Hp. {
                  entailer!. solve_offset. }
                  rewrite Hp. clear Hp. rewrite <- HeqLOCALS. rewrite <- HeqSEPS.
                  rewrite <- HeqLOCALS1. (*to reduce repetition, add a new LOCALS*)
                  remember (temp _j (Vint (Int.repr j)) :: LOCALS1) as LOCALS2.
                  (*Innermost loop (n loop) - our invariant is that y calculates the dot product up to n*)
                  forward_loop (EX (n: Z),
                    PROP (0 <= n <= k)
                    (LOCALx (temp _n (Vint (Int.repr n)) ::
                      temp _p (field_address0 (tarray (tarray tuchar 255) 128)
                              [ArraySubsc n; ArraySubsc i] (gv _fec_weights)) ::
                      temp _y (Vubyte (dot_prod (F:=B) (submatrix (F:=B) (fec_n - 1) weight_mx h k)
                         (extend_mx (F:=B) k c packets) i j n)) :: LOCALS2)
                    (SEPx (iter_sepcon_arrays parity_ptrs mx' :: SEPS))))
                  break:
                   (PROP ()
                   (LOCALx (temp _p (field_address0 (tarray (tarray tuchar 255) 128)
                              [ArraySubsc k; ArraySubsc i] (gv _fec_weights)) ::
                      temp _y (Vubyte (dot_prod (F:=B) (submatrix (F:=B) (fec_n - 1) weight_mx h k)
                         (extend_mx (F:=B) k c packets) i j k)) :: LOCALS2)
                   (SEPx (iter_sepcon_arrays parity_ptrs mx' :: SEPS)))).
                  { rewrite_eqs; forward. Exists 0%Z. rewrite_eqs; entailer!. }
                  { Intros n. rewrite_eqs; forward_if.
                    { assert_PROP (Zlength lengths = k) as Hlengths. { entailer!. list_solve. }
                      (*body of innermost loop*) forward. rewrite Hlenall by lia.
                      (*we have 2 cases: either we are in bounds, so we do usual multiplication, or
                        we are out of bounds, so we are implicitly extending the matrix with zeroes (which of course
                        does not affect the sum). We need to handle each case separately. The important thing
                        is that the dot product is still preserved*)
                      (*Unfortunately, folding the definitions makes "forward_if" take forever*)
                      forward_if ((PROP ()
                        LOCAL (
                          temp _t'5 (Vint (Int.repr (Zlength (Znth n packets)))); temp _n (Vint (Int.repr n));
                          temp _p (field_address0 (tarray (tarray tuchar 255) 128) [ArraySubsc n; ArraySubsc i]
                            (gv _fec_weights));
                          temp _y (Vubyte (dot_prod (F:=B) (submatrix (F:=B) (fec_n - 1) weight_mx h k)
                            (extend_mx (F:=B) k c packets) i j (n + 1)));
                          temp _j (Vint (Int.repr j)); temp _i (Vint (Int.repr i)); temp _z (Vint (Int.repr i));
                          temp _pparity (field_address0 (tarray (tptr tuchar) (k + h)) (SUB k) pd);
                          gvars gv; temp _k (Vint (Int.repr k)); temp _h (Vint (Int.repr h));
                          temp _c (Vint (Int.repr c)); temp _pdata pd; temp _plen pl; temp _pstat ps)
                        SEP (iter_sepcon_arrays parity_ptrs mx';
                          data_at Ews (tarray (tptr tuchar) (k + h)) (packet_ptrs ++ parity_ptrs) pd;
                          iter_sepcon_arrays packet_ptrs packets;
                          data_at Ews (tarray tint k) (map Vint (map Int.repr lengths)) pl;
                          data_at Ews (tarray tschar k) (zseq k (Vbyte Byte.zero)) ps;
                          INDEX_TABLES gv;
                          data_at Ews (tarray tuchar fec_n) (map Vubyte ByteField.byte_invs) (gv _fec_invefec);
                          data_at Ews tint (Vint Int.zero) (gv _trace);
                          data_at Ews (tarray (tarray tuchar (fec_n - 1)) fec_max_h) (rev_mx_val weight_mx)
                            (gv _fec_weights)))).
                      { (*We need to pull out the specific packet from [iter_sepcon] so we have a [data_at]*)
                        assert (Hlens: Zlength packet_ptrs = Zlength packets) by list_solve.
                        assert (Hjbound : 0 <= n < Zlength packets) by lia.
                        sep_apply (iter_sepcon_arrays_remove_one _ _ _ Hlens Hjbound). Intros.
                        forward.
                        { rewrite Znth_app1 by list_solve. entailer!. }
                        { assert (Hjlen: 0 <= j < Zlength (Znth n packets)). { rewrite Int.signed_repr in H11. lia.
                            inner_length. }
                          assert_PROP (force_val (sem_add_ptr_int tuchar Signed (Znth n (packet_ptrs ++ parity_ptrs))
                            (Vint (Int.repr j))) =
                            field_address (tarray tuchar (Zlength (Znth n packets))) (SUB j) (Znth n packet_ptrs)). {
                            entailer!. rewrite Znth_app1 by list_solve. solve_offset. }
                          forward.
                          { entailer!. simpl_repr_byte. }
                          { entailer!. rewrite !Znth_app1 by lia. auto. }
                          { forward.
                            assert_PROP (field_address0 (tarray (tarray tuchar 255) 128)
                                [ArraySubsc n; ArraySubsc i] (gv _fec_weights) =
                              field_address (tarray (tarray tuchar (fec_n -1)) (fec_max_h))
                                [ArraySubsc n; ArraySubsc i] (gv _fec_weights)). { entailer!. solve_offset. }
                            pose proof (weight_mx_wf) as [Hwlen [Hnotneed Hinwlen]].
                            forward.
                            { entailer!. rewrite !(Znth_default Inhabitant_list). rewrite rev_mx_val_Znth. simpl_repr_byte.
                              lia. inner_length. rewrite rev_mx_val_length1; lia. }
                            { entailer!.  solve_offset. }
                            { rewrite !(Znth_default Inhabitant_list) by (rewrite rev_mx_val_length1; lia).
                              rewrite rev_mx_val_Znth; [|lia| inner_length]. rewrite Znth_map_Vubyte by inner_length.
                              rewrite force_val_byte.
                              forward_call (gv, (Znth (Zlength (Znth i weight_mx) - n - 1) (Znth i weight_mx)),
                                  (Znth j (Znth n packets))).
                              { forward. entailer!.
                              (*finally, need to prove that the postcondition is satisfied*)
                                { unfold Int.xor. rewrite !Int.unsigned_repr by simpl_repr_byte.
                                  rewrite dot_prod_plus_1 by lia. rewrite submatrix_spec by rep_lia.
                                  rewrite extend_mx_spec by rep_lia.
                                  simpl.
                                  destruct (Z_lt_le_dec j (Zlength (Znth n packets))); [simpl | lia].
                                  rewrite byte_xor_fold. simpl_repr_byte. rewrite <- byte_int_repr by rep_lia.
                                  rewrite Byte.repr_unsigned. unfold get.
                                  replace (Zlength (Znth i weight_mx)) with (fec_n - 1) by inner_length. reflexivity.
                                }
                                { rewrite <- iter_sepcon_arrays_remove_one. cancel. lia. lia. }
                              }
                            }
                          }
                        }
                      }
                      { (*other if condition (when we are past the end*)
                        forward. entailer!.
                        (*this time, the proof of the invariant is much simpler*)
                        rewrite dot_prod_plus_1 by lia.
                        rewrite extend_mx_spec by rep_lia. simpl.
                        destruct (Z_lt_le_dec j (Zlength (Znth n packets))); simpl.
                        assert (Hlenbound: Zlength (Znth n packets) <= c) by inner_length.
                        rewrite Int.signed_repr in H11; rep_lia. clear l.
                        rewrite ssralg.GRing.mulr0. rewrite ssralg.GRing.addr0. reflexivity.
                      }
                      { (*increment ptr p*) forward.
                        { entailer!. solve_offset. }
                        { (*innermost loop invariant preserved*) forward. Exists (n+1)%Z.
                          rewrite_eqs; entailer!. solve_offset. }
                      }
                    }
                    { (*end of inner loop*) forward. rewrite_eqs; entailer!.
                      replace (Zlength packet_ptrs) with n by lia. auto.
                    }
                  }
                  { (*write data back to parity*) rewrite_eqs.
                    (*need to remove the ith element of parities from iter_sepcon so we can access it*)
                    assert (Hwf: wf_lmatrix mx' h c) by (subst; apply pop_mx_mult_wf; lia).
                    destruct Hwf as [Hlenmx' [_ Hinmx']].
                    assert (Hparlen: Zlength parity_ptrs = Zlength mx') by lia.
                    assert (Hpari : 0 <= i < Zlength mx') by lia.
                    rewrite (iter_sepcon_arrays_remove_one _ _ _ Hparlen Hpari). Intros.
                    assert_PROP (force_val (sem_add_ptr_int (tptr tuchar) Signed
                      (field_address0 (tarray (tptr tuchar) (k + h)) (SUB k) pd) (Vint (Int.repr i))) =
                      (field_address (tarray (tptr tuchar) (k + h)) (SUB (k + i)) pd)). { entailer!.
                      solve_offset. } forward.
                    { entailer!. rewrite Znth_app2; [ | lia].
                      replace (Zlength packet_ptrs + i - Zlength packet_ptrs) with i by lia.
                      apply isptr_is_pointer_or_null. auto.
                    }
                    { entailer!. solve_offset. }
                    { rewrite !Znth_app2 by lia. replace (k + i - Zlength packet_ptrs) with i by lia.
                      forward.
                      { inner_length. entailer!. }
                      { (*end of j loop*) forward. Exists (j+1)%Z. simpl_repr_byte.
                        rewrite_eqs. replace (Zlength (Znth i mx')) with c by inner_length.
                        rewrite <- !(byte_int_repr (Byte.unsigned _)) by rep_lia.
                        rewrite Byte.repr_unsigned. rewrite upd_Znth_map. entailer!.
                        rewrite <- pop_mx_mult_set by lia.
                        remember (pop_mx_mult (Zlength parity_ptrs) c (Zlength packet_ptrs)
                          (submatrix (F:=B) (fec_n - 1) weight_mx (Zlength parity_ptrs) (Zlength packet_ptrs))
                          (extend_mx (F:=B) (Zlength packet_ptrs) c packets) i j) as mx'.
                        rewrite (@set_default _ _ Inhabitant_byte mx') by reflexivity.
                        remember (set mx' i j (dot_prod (F:=B)
                          (submatrix (F:=B) (fec_n - 1) weight_mx (Zlength parity_ptrs) (Zlength packet_ptrs))
                          (extend_mx (F:=B) (Zlength packet_ptrs) c packets) i j (Zlength packet_ptrs))) as mx''. simpl in Heqmx''.
                        rewrite <- Heqmx''.
                        assert (Hwf: wf_lmatrix mx'' (Zlength parity_ptrs) c). { subst. apply set_wf.
                          apply pop_mx_mult_wf; rep_lia. } destruct Hwf as [Hlenmx'' [_ Hinmx'']].
                        assert (Hlens: Zlength parity_ptrs = Zlength mx'') by lia.
                        assert (Hith: 0 <= i < Zlength mx'') by lia.
                        rewrite (iter_sepcon_arrays_remove_one _ _ _ Hlens Hith).
                        replace (Zlength (Znth i mx'')) with c by inner_length. rewrite Heqmx''. unfold set.
                        simpl in *. rewrite remove_upd_Znth by lia. cancel. rewrite upd_Znth_same by lia. cancel.
                      }
                    }
                  }
                }
                { forward. (*end of j loop - postcondition*)
                  replace j with c by lia. rewrite_eqs. entailer!. replace j with c by lia. cancel.
                }
              }
              { rewrite_eqs. forward. Exists (i+1). (*invariant for i loop*)
                rewrite_eqs; entailer!. split. simpl_repr_byte.
                rewrite Z.mod_small by rep_lia. repeat f_equal; rep_lia.
                rewrite pop_mx_mult_row_finish by rep_lia. cancel.
              }
            }
          }
        }
      }
      { (*end of outer loop*) forward. rewrite_eqs. entailer!.
        replace i with (Zlength parity_ptrs) by lia. rewrite pop_mx_mult_done by lia.
        unfold encoder_list. cancel.
      }
    }
    { (*trivial error again*) rewrite_eqs. forward_if True.
      { contradiction. }
      { forward. entailer!. }
      { forward. entailer!. simpl. unfold FEC_TABLES. unfold FIELD_TABLES. entailer!. }
    }
  }
Qed.

End Encoder.


Require Import isla.isla.
Require Import isla.aarch64.aarch64.
Require Export isla.examples.pkvm_handler.a1823c.

Lemma a1823c_spec `{!islaG Σ} `{!threadG} pc:
  instr pc (Some a1823c) -∗
  instr_body pc (cmp_R_imm_spec pc "R0" 0x2).
Proof.
  iStartProof.
  repeat liAStep; liShow.
  Unshelve. all: prepare_sidecond.
  1: cmp_spec_tac1. 1: cmp_spec_tac2. 1: cmp_spec_tac3. 1: cmp_spec_tac4.
Qed.

Definition a1823c_spec_inst `{!islaG Σ} `{!threadG} pc :=
  entails_to_simplify_hyp 0 (a1823c_spec pc).
Global Existing Instance a1823c_spec_inst.