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 OrL_hpinv : forall (k : nat) concl
        (D0 : derrec GL4ip_rules (fun _ => False) concl),
        k = (derrec_height D0) ->
          ((forall prem1 prem2, ((OrLRule [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 prem1 prem2, ((OrLRule [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 s. intros n IH. clear s.
(* Now we do the actual proof-theoretical work. *)
intros s D0. remember D0 as D0'. destruct D0.
(* D0 is a leaf *)
- destruct f.
(* D0 is ends with an application of rule *)
- intros hei. intros prem1 prem2 RA. inversion RA. subst. simpl.
  inversion g ; subst.
  (* IdP *)
  * inversion H ; subst. assert (InT (# P) (Γ0 ++ Γ1)). assert (InT (# P) (Γ0 ++ A ∨ B :: Γ1)).
    rewrite <- H2. apply InT_or_app. right. apply InT_eq.
    apply InT_app_or in H0. destruct H0. apply InT_or_app. auto. apply InT_or_app. right. inversion i. inversion H1.
    auto. apply InT_app_or in H0. destruct H0.
    + apply InT_split in i. destruct i. destruct s. rewrite e. repeat rewrite <- app_assoc. simpl.
       assert (IdPRule [] (x ++ # P :: x0 ++ A :: Γ1, # P)). apply IdPRule_I. apply IdP in H0.
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[]) (x ++ # P :: x0 ++ A :: Γ1, # P) H0 DersNilF). exists d0.
       assert (IdPRule [] (x ++ # P :: x0 ++ B :: Γ1, # P)). apply IdPRule_I. apply IdP in H1.
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[]) (x ++ # P :: x0 ++ B :: Γ1, # P) H1 DersNilF). exists d1. split. simpl.
       rewrite dersrec_height_nil. lia. reflexivity. simpl. rewrite dersrec_height_nil. lia. reflexivity.
    + apply InT_split in i. destruct i. destruct s. rewrite e.
       assert (IdPRule [] ((Γ0 ++ A :: x) ++ # P :: x0, # P)). apply IdPRule_I. apply IdP in H0. repeat rewrite <- app_assoc in H0.
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[])(Γ0 ++ A :: x ++ # P :: x0, # P) H0 DersNilF). exists d0.
       assert (IdPRule [] ((Γ0 ++ B :: x) ++ # P :: x0, # P)). apply IdPRule_I. apply IdP in H1. repeat rewrite <- app_assoc in H1.
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[]) (Γ0 ++ B :: x ++ # P :: x0, # P) H1 DersNilF). exists d1. split. simpl.
       rewrite dersrec_height_nil. lia. reflexivity. simpl. rewrite dersrec_height_nil. lia. reflexivity.
  (* BotL *)
  * inversion H. subst. assert (InT (Bot) (Γ0 ++ Γ1)).
    assert (InT (Bot) (Γ0 ++ A ∨ B :: Γ1)). rewrite <- H2. apply InT_or_app. right. apply InT_eq.
    apply InT_app_or in H0. destruct H0. apply InT_or_app. auto. apply InT_or_app. right. inversion i.
    inversion H1. auto. assert (InT (Bot) (Γ0 ++ A :: Γ1)). apply InT_app_or in H0. destruct H0. apply InT_or_app. auto.
    apply InT_or_app. right. apply InT_cons ; auto. assert (InT (Bot) (Γ0 ++ B :: Γ1)). apply InT_app_or in H0. destruct H0.
    apply InT_or_app. auto. apply InT_or_app. right. apply InT_cons ; auto.
    apply InT_split in H1. destruct H1. destruct s. rewrite e. apply InT_split in H3. destruct H3. destruct s. rewrite e0.
    assert (BotLRule [] (x ++ ⊥ :: x0, C)). apply BotLRule_I. apply BotL in H1.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[]) (x ++ ⊥ :: x0, C) H1 DersNilF). exists d0.
    assert (BotLRule [] (x1 ++ ⊥ :: x2, C)). apply BotLRule_I. apply BotL in H3.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[]) (x1 ++ ⊥ :: x2, C) H3 DersNilF). exists d1.
    simpl. rewrite dersrec_height_nil. split ; 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.
    assert (AndRRule [(Γ0 ++ A :: Γ1, A0);(Γ0 ++ A :: Γ1, B0)]
    (Γ0 ++ A :: Γ1, A0 ∧ B0)). apply AndRRule_I. apply AndR in H0.
    assert (AndRRule [(Γ0 ++ B :: Γ1, A0);(Γ0 ++ B :: Γ1, B0)]
    (Γ0 ++ B :: Γ1, A0 ∧ B0)). apply AndRRule_I. apply AndR in H1.
    assert (J4: OrLRule [(Γ0 ++ A :: Γ1, A0);(Γ0 ++ B :: Γ1, A0)]
    (Γ0 ++ A ∨ B :: Γ1, A0)). apply OrLRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
    assert (J7: OrLRule [(Γ0 ++ A :: Γ1, B0);(Γ0 ++ B :: Γ1, B0)]
    (Γ0 ++ A ∨ B :: Γ1, B0)). apply OrLRule_I.
    assert (J8: derrec_height x0 < S (dersrec_height d)). lia.
    assert (J9: derrec_height x0 = derrec_height x0). reflexivity.
    pose (IH _ J8 _ _ J9 _ _ J7). repeat destruct s. repeat destruct p.
    pose (dlCons x4 DersNilF). pose (dlCons x2 d0).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ B :: Γ1, A0); (Γ0 ++ B :: Γ1, B0)]) (Γ0 ++ B :: Γ1, A0 ∧ B0) H1 d1).
    pose (dlCons x3 DersNilF). pose (dlCons x1 d3).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ A :: Γ1, A0); (Γ0 ++ A :: Γ1, B0)]) (Γ0 ++ A :: Γ1, A0 ∧ B0) H0 d4).
    exists d5. exists d2. simpl. rewrite dersrec_height_nil. split ; lia. reflexivity.
  (* AndL *)
  * inversion H. subst. apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e0.
   + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
      assert (AndLRule  [((Γ0 ++ A :: x0) ++ A0 :: B0 :: Γ3, C)]
      ((Γ0 ++ A :: x0) ++ A0 ∧ B0 :: Γ3, C)). apply AndLRule_I. apply AndL in H0.
      repeat rewrite <- app_assoc in H0. simpl in H0.
      assert (AndLRule  [((Γ0 ++ B :: x0) ++ A0 :: B0 :: Γ3, C)]
      ((Γ0 ++ B :: x0) ++ A0 ∧ B0 :: Γ3, C)). apply AndLRule_I. apply AndL in H1.
      repeat rewrite <- app_assoc in H1. simpl in H1.
      assert (J4: OrLRule [(Γ0 ++ A :: x0 ++ A0 :: B0 :: Γ3, C);(Γ0 ++ B :: x0 ++ A0 :: B0 :: Γ3, C)]
      (((Γ0 ++ [A ∨ B]) ++ x0) ++ A0 :: B0 :: Γ3, C)). repeat rewrite <- app_assoc. apply OrLRule_I.
      assert (J5: derrec_height x < S (dersrec_height d)). lia.
      assert (J6: derrec_height x = derrec_height x). reflexivity.
      pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
      pose (dlCons x1 DersNilF).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:= [(Γ0 ++ A :: x0 ++ A0 :: B0 :: Γ3, C)]) (Γ0 ++ A :: x0 ++ And A0 B0 :: Γ3, C) H0 d0).
      pose (dlCons x2 DersNilF).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:= [(Γ0 ++ B :: x0 ++ A0 :: B0 :: Γ3, C)]) (Γ0 ++ B :: x0 ++ And A0 B0 :: Γ3, C) H1 d2).
      exists d1. exists d3. simpl. rewrite dersrec_height_nil. split ; lia. reflexivity.
   + repeat destruct s. repeat destruct p. subst.
      assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
      assert (AndLRule  [(Γ2 ++ A0 :: B0 :: x ++ A :: Γ1, C)]
      ((Γ2 ++ A0 ∧ B0 :: x) ++ A :: Γ1, C)). repeat rewrite <- app_assoc. apply AndLRule_I. apply AndL in H0.
      assert (AndLRule  [(Γ2 ++ A0 :: B0 :: x ++ B :: Γ1, C)]
      ((Γ2 ++ A0 ∧ B0 :: x) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. apply AndLRule_I. apply AndL in H1.
      assert (J4: OrLRule [((Γ2 ++ A0 :: B0 :: x) ++ A :: Γ1, C);((Γ2 ++ A0 :: B0 :: x) ++ B :: Γ1, C)]
      ((Γ2 ++ A0 :: B0 :: x) ++ A ∨ B :: Γ1, C)). apply OrLRule_I. repeat rewrite <- app_assoc 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 _ _ J4). repeat destruct s. repeat destruct p.
      pose (dlCons x1 DersNilF).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:= [(Γ2 ++ (A0 :: B0 :: x) ++ A :: Γ1, C)]) ((Γ2 ++ A0 ∧ B0 :: x) ++ A :: Γ1, C) H0 d0).
      pose (dlCons x2 DersNilF).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:= [(Γ2 ++ (A0 :: B0 :: x) ++ B :: Γ1, C)]) ((Γ2 ++ A0 ∧ B0 :: x) ++ B :: Γ1, C) H1 d2).
      exists d1. exists d3. cbn. rewrite dersrec_height_nil ; auto. repeat rewrite Nat.max_0_r. rewrite <- e.
      split ; apply le_n_S ; auto.
  (* 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.
    assert (OrR1Rule [(Γ0 ++ A :: Γ1, A0)]
    (Γ0 ++ A :: Γ1, A0 ∨ B0)). apply OrR1Rule_I. apply OrR1 in H0.
    assert (OrR1Rule [(Γ0 ++ B :: Γ1, A0)]
    (Γ0 ++ B :: Γ1, A0 ∨ B0)). apply OrR1Rule_I. apply OrR1 in H1.
    assert (J4: OrLRule [(Γ0 ++ A :: Γ1, A0);(Γ0 ++ B :: Γ1, A0)]
    (Γ0 ++ A ∨ B :: Γ1, A0)). apply OrLRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
    pose (dlCons x0 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ A :: Γ1, A0)]) (Γ0 ++ A :: Γ1, A0 ∨ B0) H0 d0).
    pose (dlCons x1 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ B :: Γ1, A0)]) (Γ0 ++ B :: Γ1, A0 ∨ B0) H1 d2).
    exists d1. exists d3. simpl. rewrite dersrec_height_nil ; auto. split ; lia.
  (* 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.
    assert (OrR2Rule [(Γ0 ++ A :: Γ1, B0)]
    (Γ0 ++ A :: Γ1, A0 ∨ B0)). apply OrR2Rule_I. apply OrR2 in H0.
    assert (OrR2Rule [(Γ0 ++ B :: Γ1, B0)]
    (Γ0 ++ B :: Γ1, A0 ∨ B0)). apply OrR2Rule_I. apply OrR2 in H1.
    assert (J4: OrLRule [(Γ0 ++ A :: Γ1, B0);(Γ0 ++ B :: Γ1, B0)]
    (Γ0 ++ A ∨ B :: Γ1, B0)). apply OrLRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
    pose (dlCons x0 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ A :: Γ1, B0)]) (Γ0 ++ A :: Γ1, A0 ∨ B0) H0 d0).
    pose (dlCons x1 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(Γ0 ++ B :: Γ1, B0)]) (Γ0 ++ B :: Γ1, A0 ∨ B0) H1 d2).
    exists d1. exists d3. simpl. rewrite dersrec_height_nil ; auto. split ; lia.
  (* OrL *)
  * inversion H. subst. apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e0. subst.
      assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. exists x. exists x0.
      rewrite e. simpl. split ; lia.
   + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
      assert (OrLRule [((Γ0 ++ A :: x0) ++ A0 :: Γ3, C);((Γ0 ++ A :: x0) ++ B0 :: Γ3, C)]
      ((Γ0 ++ A :: x0) ++ A0 ∨ B0 :: Γ3, C)). apply OrLRule_I. apply OrL in H0. repeat rewrite <- app_assoc in H0.
      assert (OrLRule [((Γ0 ++ B :: x0) ++ A0 :: Γ3, C);((Γ0 ++ B :: x0) ++ B0 :: Γ3, C)]
      ((Γ0 ++ B :: x0) ++ A0 ∨ B0 :: Γ3, C)). apply OrLRule_I. apply OrL in H1. repeat rewrite <- app_assoc in H1.
      assert (J4: OrLRule [(Γ0 ++ A :: x0 ++ A0 :: Γ3, C);(Γ0 ++ B :: x0 ++ A0 :: Γ3, C)]
      (((Γ0 ++ [A ∨ B]) ++ x0) ++ A0 :: Γ3, C)). repeat rewrite <- app_assoc. simpl. apply OrLRule_I.
      assert (J5: derrec_height x < S (dersrec_height d)). lia.
      assert (J6: derrec_height x = derrec_height x). reflexivity.
      pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
      assert (J7: OrLRule [(Γ0 ++ A :: x0 ++ B0 :: Γ3, C);(Γ0 ++ B :: x0 ++ B0 :: Γ3, C)]
      (((Γ0 ++ [A ∨ B]) ++ x0) ++ B0 :: Γ3, C)). repeat rewrite <- app_assoc. simpl. apply OrLRule_I.
      assert (J8: derrec_height x1 < S (dersrec_height d)). lia.
      assert (J9: derrec_height x1 = derrec_height x1). reflexivity.
      pose (IH _ J8 _ _ J9 _ _ J7). repeat destruct s. repeat destruct p.
      pose (dlCons x4 DersNilF). pose (dlCons x2 d0).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:=[(Γ0 ++ A :: x0 ++ A0 :: Γ3, C); (Γ0 ++ A :: x0 ++ B0 :: Γ3, C)]) (Γ0 ++ A :: x0 ++ A0 ∨ B0 :: Γ3, C) H0 d1).
      pose (dlCons x5 DersNilF). pose (dlCons x3 d3).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:= [(Γ0 ++ B :: x0 ++ A0 :: Γ3, C); (Γ0 ++ B :: x0 ++ B0 :: Γ3, C)]) (Γ0 ++ B :: x0 ++ A0 ∨ B0 :: Γ3, C) H1 d4).
      exists d2. exists d5. simpl. rewrite dersrec_height_nil. split ; lia. reflexivity.
   + repeat destruct s. repeat destruct p ; subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
      assert (OrLRule [(Γ2 ++ A0 :: x ++ A :: Γ1, C);(Γ2 ++ B0 :: x ++ A :: Γ1, C)]
      ((Γ2 ++ A0 ∨ B0 :: x) ++ A :: Γ1, C)). repeat rewrite <- app_assoc; apply OrLRule_I. apply OrL in H0.
      assert (OrLRule [(Γ2 ++ A0 :: x ++ B :: Γ1, C);(Γ2 ++ B0 :: x ++ B :: Γ1, C)]
      ((Γ2 ++ A0 ∨ B0 :: x) ++ B :: Γ1, C)). repeat rewrite <- app_assoc; apply OrLRule_I. apply OrL in H1.
      assert (J4: OrLRule [((Γ2 ++ A0 :: x) ++ A :: Γ1, C);((Γ2 ++ A0 :: x) ++ B :: Γ1, C)]
      ((Γ2 ++ A0 :: x) ++ A ∨ B :: Γ1, C)). apply OrLRule_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 _ _ J4). repeat destruct s. repeat destruct p.
      assert (J7: OrLRule [((Γ2 ++ B0 :: x) ++ A :: Γ1, C);((Γ2 ++ B0 :: x) ++ B :: Γ1, C)]
      ((Γ2 ++ B0 :: x) ++ A ∨ B :: Γ1, C)). apply OrLRule_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 _ _ J7). repeat destruct s. repeat destruct p.
      pose (dlCons x4 DersNilF). pose (dlCons x2 d0).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:=[(Γ2 ++ A0 :: x ++ A :: Γ1, C); (Γ2 ++ B0 :: x ++ A :: Γ1, C)]) ((Γ2 ++ A0 ∨ B0 :: x) ++ A :: Γ1, C) H0 d1).
      pose (dlCons x5 DersNilF). pose (dlCons x3 d3).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:= [(Γ2 ++ A0 :: x ++ B :: Γ1, C); (Γ2 ++ B0 :: x ++ B :: Γ1, C)]) ((Γ2 ++ A0 ∨ B0 :: x) ++ B :: Γ1, C) H1 d4).
      exists d2. exists d5. simpl. rewrite dersrec_height_nil. split ; lia. reflexivity.
  (* ImpR *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). repeat destruct s.
    assert (J50: list_exch_L (Γ2 ++ A0 :: Γ3, B0) (A0 :: Γ0 ++ A ∨ B :: Γ1, B0)). rewrite <- H2.
    assert (Γ2 ++ A0 :: Γ3 = [] ++ [] ++ Γ2 ++ [A0] ++ Γ3). auto. rewrite H0.
    assert (A0 :: Γ2 ++ Γ3 = [] ++ [A0] ++ Γ2 ++ [] ++ Γ3). auto. rewrite H1. apply list_exch_LI.
    assert (J51: derrec_height x = derrec_height x). auto.
    pose (GL4ip_hpadm_list_exch_L (derrec_height x) _ x J51 _ J50). destruct s.
    assert (ImpRRule [([] ++ A0 :: Γ0 ++ A :: Γ1, B0)]
    ([] ++ Γ0 ++ A :: Γ1, A0 → B0)). apply ImpRRule_I. apply ImpR in H0. simpl in H0.
    assert (ImpRRule [([] ++ A0 :: Γ0 ++ B :: Γ1, B0)]
    ([] ++ Γ0 ++ B :: Γ1, A0 → B0)). apply ImpRRule_I. apply ImpR in H1. simpl in H1.
    assert (J4: OrLRule [((A0 :: Γ0) ++ A :: Γ1, B0);((A0 :: Γ0) ++ B :: Γ1, B0)]
    ((A0 :: Γ0) ++ A ∨ B :: Γ1, B0)). apply OrLRule_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 _ _ J4). repeat destruct s. repeat destruct p.
    pose (dlCons x1 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(A0 :: Γ0 ++ A :: Γ1, B0)]) (Γ0 ++ A :: Γ1, A0 → B0) H0 d0).
    pose (dlCons x2 DersNilF).
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
    (ps:=[(A0 :: Γ0 ++ B :: Γ1, B0)]) (Γ0 ++ B :: Γ1, A0 → B0) H1 d2).
    exists d1. exists d3. simpl. rewrite dersrec_height_nil ; auto. split ; lia.
  (* AtomImpL *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
     pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
     apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
    + inversion e1.
    + assert (AtomImpL1Rule  [((Γ0 ++ A :: x1) ++ # P :: Γ3 ++ A0 :: Γ4, C)]
       ((Γ0 ++ A :: x1) ++ # P :: Γ3 ++ # P → A0 :: Γ4, C)). apply AtomImpL1Rule_I. apply AtomImpL1 in H0.
       repeat rewrite <- app_assoc in H0. simpl in H0.
       assert (AtomImpL1Rule  [((Γ0 ++ B :: x1) ++ # P :: Γ3 ++ A0 :: Γ4, C)]
       ((Γ0 ++ B :: x1) ++ # P :: Γ3 ++ # P → A0 :: Γ4, C)). apply AtomImpL1Rule_I. apply AtomImpL1 in H1.
       repeat rewrite <- app_assoc in H1. simpl in H1.
      assert (J4: OrLRule [(Γ0 ++ A :: x1 ++ # P :: Γ3 ++ A0 :: Γ4, C);(Γ0 ++ B :: x1 ++ # P :: Γ3 ++ A0 :: Γ4, C)]
      (((Γ0 ++ [A ∨ B]) ++ x1) ++ # P :: Γ3 ++ A0 :: Γ4, C)). repeat rewrite <- app_assoc. apply OrLRule_I.
      assert (J5: derrec_height x < S (dersrec_height d)). lia.
      assert (J6: derrec_height x = derrec_height x). reflexivity.
      pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
      pose (dlCons x0 DersNilF).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:= [(Γ0 ++ A :: x1 ++ # P :: Γ3 ++ A0 :: Γ4, C)]) (Γ0 ++ A :: x1 ++ # P :: Γ3 ++ # P → A0 :: Γ4, C) H0 d0).
      pose (dlCons x2 DersNilF).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:= [(Γ0 ++ B :: x1 ++ # P :: Γ3 ++ A0 :: Γ4, C)]) (Γ0 ++ B :: x1 ++ # P :: Γ3 ++ # P → A0 :: Γ4, C) H1 d2).
      exists d1. exists d3. simpl. rewrite dersrec_height_nil. split ; lia. reflexivity.
   + repeat destruct s. repeat destruct p ; subst.
      apply list_split_form in e1. destruct e1. repeat destruct s ; repeat destruct p ; subst.
      { inversion e1. }
      { assert (AtomImpL1Rule  [(Γ2 ++ # P :: (x0 ++ A :: x2) ++ A0 :: Γ4, C)]
         ((Γ2 ++ # P :: x0) ++ A :: x2 ++ # P → A0 :: Γ4, C)).
         assert ((Γ2 ++ # P :: x0) ++ A :: x2 ++ # P → A0 :: Γ4 = Γ2 ++ # P :: (x0 ++ A :: x2) ++ # P → A0 :: Γ4).
         repeat rewrite <- app_assoc ; auto. rewrite H0. apply AtomImpL1Rule_I. apply AtomImpL1 in H0.
         assert (AtomImpL1Rule  [(Γ2 ++ # P :: (x0 ++ B :: x2) ++ A0 :: Γ4, C)]
         ((Γ2 ++ # P :: x0) ++ B :: x2 ++ # P → A0 :: Γ4, C)).
         assert ((Γ2 ++ # P :: x0) ++ B :: x2 ++ # P → A0 :: Γ4 = Γ2 ++ # P :: (x0 ++ B :: x2) ++ # P → A0 :: Γ4).
         repeat rewrite <- app_assoc ; auto. rewrite H1. apply AtomImpL1Rule_I. apply AtomImpL1 in H1.
        assert (J4: OrLRule [(Γ2 ++ # P :: (x0 ++ A :: x2) ++ A0 :: Γ4, C);(Γ2 ++ # P :: (x0 ++ B :: x2) ++ A0 :: Γ4, C)]
        (Γ2 ++ # P :: ((x0 ++ [A ∨ B]) ++ x2) ++ A0 :: Γ4, C)).
         assert (Γ2 ++ # P :: ((x0 ++ [A ∨ B]) ++ x2) ++ A0 :: Γ4 = (Γ2 ++ # P :: x0) ++ A ∨ B :: x2 ++ A0 :: Γ4).
         repeat rewrite <- app_assoc ; auto. rewrite H2.
         assert (Γ2 ++ # P :: (x0 ++ A :: x2) ++ A0 :: Γ4 = (Γ2 ++ # P :: x0) ++ A :: x2 ++ A0 :: Γ4).
         repeat rewrite <- app_assoc ; auto. rewrite H3.
         assert (Γ2 ++ # P :: (x0 ++ B :: x2) ++ A0 :: Γ4 = (Γ2 ++ # P :: x0) ++ B :: x2 ++ A0 :: Γ4).
         repeat rewrite <- app_assoc ; auto. rewrite H4. apply OrLRule_I.
        assert (J5: derrec_height x < S (dersrec_height d)). lia.
        assert (J6: derrec_height x = derrec_height x). reflexivity.
        pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
        pose (dlCons x1 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ2 ++ # P :: (x0 ++ A :: x2) ++ A0 :: Γ4, C)]) ((Γ2 ++ # P :: x0) ++ A :: x2 ++ # P → A0 :: Γ4, C) H0 d0).
        pose (dlCons x3 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:= [(Γ2 ++ # P :: (x0 ++ B :: x2) ++ A0 :: Γ4, C)]) ((Γ2 ++ # P :: x0) ++ B :: x2 ++ # P → A0 :: Γ4, C) H1 d2).
        exists d1. exists d3. simpl. rewrite dersrec_height_nil. split ; lia. reflexivity. }
      { repeat destruct s. repeat destruct p ; subst.
         assert (AtomImpL1Rule  [(Γ2 ++ # P :: Γ3 ++ A0 :: x1 ++ A :: Γ1, C)]
        ((Γ2 ++ # P :: Γ3 ++ # P → A0 :: x1) ++ A :: Γ1, C)). repeat rewrite <- app_assoc.
        simpl. repeat rewrite <- app_assoc. apply AtomImpL1Rule_I. apply AtomImpL1 in H0.
         assert (AtomImpL1Rule  [(Γ2 ++ # P :: Γ3 ++ A0 :: x1 ++ B :: Γ1, C)]
        ((Γ2 ++ # P :: Γ3 ++ # P → A0 :: x1) ++ B :: Γ1, C)). repeat rewrite <- app_assoc.
        simpl. repeat rewrite <- app_assoc. apply AtomImpL1Rule_I. apply AtomImpL1 in H1.
        assert (J4: OrLRule [(Γ2 ++ # P :: Γ3 ++ A0 :: x1 ++ A :: Γ1, C);(Γ2 ++ # P :: Γ3 ++ A0 :: x1 ++ B :: Γ1, C)]
        (Γ2 ++ # P :: Γ3 ++ A0 :: x1 ++ A ∨ B :: Γ1, C)).
         assert (Γ2 ++ # P :: Γ3 ++ A0 :: x1 ++ A ∨ B :: Γ1 = (Γ2 ++ # P :: Γ3 ++ A0 :: x1) ++ A ∨ B :: Γ1).
         repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto. rewrite H2.
         assert (Γ2 ++ # P :: Γ3 ++ A0 :: x1 ++ A :: Γ1 = (Γ2 ++ # P :: Γ3 ++ A0 :: x1) ++ A :: Γ1).
         repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto. rewrite H3.
         assert (Γ2 ++ # P :: Γ3 ++ A0 :: x1 ++ B :: Γ1 = (Γ2 ++ # P :: Γ3 ++ A0 :: x1) ++ B :: Γ1).
         repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto. rewrite H4. apply OrLRule_I.
        assert (J5: derrec_height x < S (dersrec_height d)). lia.
        assert (J6: derrec_height x = derrec_height x). reflexivity.
        pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
        pose (dlCons x0 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ2 ++ # P :: Γ3 ++ A0 :: x1 ++ A :: Γ1, C)]) ((Γ2 ++ # P :: Γ3 ++ # P → A0 :: x1) ++ A :: Γ1, C) H0 d0).
        pose (dlCons x2 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ2 ++ # P :: Γ3 ++ A0 :: x1 ++ B :: Γ1, C)]) ((Γ2 ++ # P :: Γ3 ++ # P → A0 :: x1) ++ B :: Γ1, C) H1 d2).
        exists d1. exists d3. simpl. rewrite dersrec_height_nil. split ; lia. reflexivity. }
 (* AtomImpL2 *)
   * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
     pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
     apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
    + inversion e1.
    + assert (AtomImpL2Rule  [((Γ0 ++ A :: x1) ++ A0 :: Γ3 ++ # P :: Γ4, C)]
       ((Γ0 ++ A :: x1) ++ # P → A0 :: Γ3 ++ # P :: Γ4, C)). apply AtomImpL2Rule_I. apply AtomImpL2 in H0.
       repeat rewrite <- app_assoc in H0. simpl in H0.
       assert (AtomImpL2Rule  [((Γ0 ++ B :: x1) ++A0 :: Γ3 ++ # P :: Γ4, C)]
       ((Γ0 ++ B :: x1) ++ # P → A0 :: Γ3 ++ # P :: Γ4, C)). apply AtomImpL2Rule_I. apply AtomImpL2 in H1.
       repeat rewrite <- app_assoc in H1. simpl in H1.
      assert (J4: OrLRule [(Γ0 ++ A :: x1 ++ A0 :: Γ3 ++ # P :: Γ4, C);(Γ0 ++ B :: x1 ++ A0 :: Γ3 ++ # P :: Γ4, C)]
      (((Γ0 ++ [A ∨ B]) ++ x1) ++ A0 :: Γ3 ++ # P :: Γ4, C)). repeat rewrite <- app_assoc. apply OrLRule_I.
      assert (J5: derrec_height x < S (dersrec_height d)). lia.
      assert (J6: derrec_height x = derrec_height x). reflexivity.
      pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
      pose (dlCons x0 DersNilF).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:= [(Γ0 ++ A :: x1 ++ A0 :: Γ3 ++ # P :: Γ4, C)]) (Γ0 ++ A :: x1 ++ # P → A0 :: Γ3 ++ # P :: Γ4, C) H0 d0).
      pose (dlCons x2 DersNilF).
      pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
      (ps:= [(Γ0 ++ B :: x1 ++ A0 :: Γ3 ++ # P :: Γ4, C)]) (Γ0 ++ B :: x1 ++ # P → A0 :: Γ3 ++ # P :: Γ4, C) H1 d2).
      exists d1. exists d3. simpl. rewrite dersrec_height_nil. split ; lia. reflexivity.
   + repeat destruct s. repeat destruct p ; subst.
      apply list_split_form in e1. destruct e1. repeat destruct s ; repeat destruct p ; subst.
      { inversion e1. }
      { assert (AtomImpL2Rule  [(Γ2 ++ A0 :: (x0 ++ A :: x2) ++ # P :: Γ4, C)]
         ((Γ2 ++ # P → A0 :: x0) ++ A :: x2 ++ # P :: Γ4, C)).
         assert ((Γ2 ++ # P → A0 :: x0) ++ A :: x2 ++ # P :: Γ4 = Γ2 ++ # P → A0 :: (x0 ++ A :: x2) ++ # P :: Γ4).
         repeat rewrite <- app_assoc ; auto. rewrite H0. apply AtomImpL2Rule_I. apply AtomImpL2 in H0.
         assert (AtomImpL2Rule  [(Γ2 ++ A0 :: (x0 ++ B :: x2) ++ # P :: Γ4, C)]
         ((Γ2 ++ # P → A0 :: x0) ++ B :: x2 ++ # P :: Γ4, C)).
         assert ((Γ2 ++ # P → A0 :: x0) ++ B :: x2 ++ # P :: Γ4 = Γ2 ++ # P → A0 :: (x0 ++ B :: x2) ++ # P :: Γ4).
         repeat rewrite <- app_assoc ; auto. rewrite H1. apply AtomImpL2Rule_I. apply AtomImpL2 in H1.
        assert (J4: OrLRule [(Γ2 ++ A0 :: (x0 ++ A :: x2) ++ # P :: Γ4, C);(Γ2 ++ A0 :: (x0 ++ B :: x2) ++ # P :: Γ4, C)]
        (Γ2 ++ A0 :: ((x0 ++ [A ∨ B]) ++ x2) ++ # P :: Γ4, C)).
         assert (Γ2 ++ A0 :: ((x0 ++ [A ∨ B]) ++ x2) ++ # P :: Γ4 = (Γ2 ++ A0 :: x0) ++ A ∨ B :: x2 ++ # P :: Γ4).
         repeat rewrite <- app_assoc ; auto. rewrite H2.
         assert (Γ2 ++ A0 :: (x0 ++ A :: x2) ++ # P :: Γ4 = (Γ2 ++ A0 :: x0) ++ A :: x2 ++ # P :: Γ4).
         repeat rewrite <- app_assoc ; auto. rewrite H3.
         assert (Γ2 ++ A0 :: (x0 ++ B :: x2) ++ # P :: Γ4 = (Γ2 ++ A0 :: x0) ++ B :: x2 ++ # P :: Γ4).
         repeat rewrite <- app_assoc ; auto. rewrite H4. apply OrLRule_I.
        assert (J5: derrec_height x < S (dersrec_height d)). lia.
        assert (J6: derrec_height x = derrec_height x). reflexivity.
        pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
        pose (dlCons x1 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ2 ++ A0 :: (x0 ++ A :: x2) ++ # P :: Γ4, C)]) ((Γ2 ++ # P → A0 :: x0) ++ A :: x2 ++ # P :: Γ4, C) H0 d0).
        pose (dlCons x3 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:= [(Γ2 ++A0 :: (x0 ++ B :: x2) ++ # P :: Γ4, C)]) ((Γ2 ++ # P → A0 :: x0) ++ B :: x2 ++ # P :: Γ4, C) H1 d2).
        exists d1. exists d3. simpl. rewrite dersrec_height_nil. split ; lia. reflexivity. }
      { repeat destruct s. repeat destruct p ; subst.
         assert (AtomImpL2Rule  [(Γ2 ++ A0 :: Γ3 ++ # P :: x1 ++ A :: Γ1, C)]
        ((Γ2 ++ # P → A0 :: Γ3 ++ # P :: x1) ++ A :: Γ1, C)). repeat rewrite <- app_assoc.
        simpl. repeat rewrite <- app_assoc. apply AtomImpL2Rule_I. apply AtomImpL2 in H0.
         assert (AtomImpL2Rule  [(Γ2 ++ A0 :: Γ3 ++ # P :: x1 ++ B :: Γ1, C)]
        ((Γ2 ++ # P → A0 :: Γ3 ++ # P :: x1) ++ B :: Γ1, C)). repeat rewrite <- app_assoc.
        simpl. repeat rewrite <- app_assoc. apply AtomImpL2Rule_I. apply AtomImpL2 in H1.
        assert (J4: OrLRule [(Γ2 ++A0 :: Γ3 ++ # P :: x1 ++ A :: Γ1, C);(Γ2 ++ A0 :: Γ3 ++ # P :: x1 ++ B :: Γ1, C)]
        (Γ2 ++ A0 :: Γ3 ++ # P :: x1 ++ A ∨ B :: Γ1, C)).
         assert (Γ2 ++ A0 :: Γ3 ++ # P :: x1 ++ A ∨ B :: Γ1 = (Γ2 ++ A0 :: Γ3 ++ # P :: x1) ++ A ∨ B :: Γ1).
         repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto. rewrite H2.
         assert (Γ2 ++ A0 :: Γ3 ++ # P :: x1 ++ A :: Γ1 = (Γ2 ++ A0 :: Γ3 ++ # P :: x1) ++ A :: Γ1).
         repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto. rewrite H3.
         assert (Γ2 ++ A0 :: Γ3 ++ # P :: x1 ++ B :: Γ1 = (Γ2 ++ A0 :: Γ3 ++ # P :: x1) ++ B :: Γ1).
         repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto. rewrite H4. apply OrLRule_I.
        assert (J5: derrec_height x < S (dersrec_height d)). lia.
        assert (J6: derrec_height x = derrec_height x). reflexivity.
        pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
        pose (dlCons x0 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ2 ++ A0 :: Γ3 ++ # P :: x1 ++ A :: Γ1, C)]) ((Γ2 ++ # P → A0 :: Γ3 ++ # P :: x1) ++ A :: Γ1, C) H0 d0).
        pose (dlCons x2 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ2 ++A0 :: Γ3 ++ # P :: x1 ++ B :: Γ1, C)]) ((Γ2 ++ # P → A0 :: Γ3 ++ # P :: x1) ++ B :: Γ1, C) H1 d2).
        exists d1. exists d3. simpl. rewrite dersrec_height_nil. split ; lia. reflexivity. }
 (* AndImpL *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). repeat destruct s.
    apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
    + inversion e1.
    +  assert (AndImpLRule [((Γ0 ++ A :: x1) ++ A0 → B0 → C0 :: Γ3, C)]
        ((Γ0 ++ A :: x1) ++ (A0 ∧ B0) → C0 :: Γ3, C)). apply AndImpLRule_I. apply AndImpL in H0.
        repeat rewrite <- app_assoc in H0 ; simpl in H0.
        assert (AndImpLRule [((Γ0 ++ B :: x1) ++ A0 → B0 → C0 :: Γ3, C)]
        ((Γ0 ++ B :: x1) ++ (A0 ∧ B0) → C0 :: Γ3, C)). apply AndImpLRule_I. apply AndImpL in H1.
        repeat rewrite <- app_assoc in H1 ; simpl in H1.
        assert (J4: OrLRule [(Γ0 ++ A :: x1 ++ A0 → B0 → C0 :: Γ3, C);(Γ0 ++ B :: x1 ++ A0 → B0 → C0 :: Γ3, C)]
        (((Γ0 ++ [A ∨ B]) ++ x1) ++ A0 → B0 → C0 :: Γ3, C)). repeat rewrite <- app_assoc ; simpl.
        apply OrLRule_I.
        assert (J5: derrec_height x < S (dersrec_height d)). lia.
        assert (J6: derrec_height x = derrec_height x). reflexivity.
        pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
        pose (dlCons x0 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ0 ++ A :: x1 ++ A0 → B0 → C0 :: Γ3, C)]) (Γ0 ++ A :: x1 ++ (A0 ∧ B0) → C0 :: Γ3, C) H0 d0).
        pose (dlCons x2 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ0 ++ B :: x1 ++ A0 → B0 → C0 :: Γ3, C)]) (Γ0 ++ B :: x1 ++ (A0 ∧ B0) → C0 :: Γ3, C) H1 d2).
        exists d1. exists d3. simpl. rewrite dersrec_height_nil ; auto. split ; lia.
    +  repeat destruct s. repeat destruct p ; subst.
        assert (AndImpLRule [(Γ2 ++ A0 → B0 → C0 :: x0 ++ A :: Γ1, C)]
        ((Γ2 ++ (A0 ∧ B0) → C0 :: x0) ++ A :: Γ1, C)). repeat rewrite <- app_assoc. apply AndImpLRule_I. apply AndImpL in H0.
        assert (AndImpLRule [(Γ2 ++ A0 → B0 → C0 :: x0 ++ B :: Γ1, C)]
        ((Γ2 ++ (A0 ∧ B0) → C0 :: x0) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. apply AndImpLRule_I. apply AndImpL in H1.
        assert (J4: OrLRule [(Γ2 ++ A0 → B0 → C0 :: x0 ++ A :: Γ1, C);(Γ2 ++ A0 → B0 → C0 :: x0 ++ B :: Γ1, C)]
       (Γ2 ++ A0 → B0 → C0 :: x0 ++ A ∨ B :: Γ1, C)).
       assert (Γ2 ++ A0 → B0 → C0 :: x0 ++ A ∨ B :: Γ1 = (Γ2 ++ A0 → B0 → C0 :: x0) ++ A ∨ B :: Γ1).
       repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto. rewrite H2.
       assert (Γ2 ++ A0 → B0 → C0 :: x0 ++ A :: Γ1 = (Γ2 ++ A0 → B0 → C0 :: x0) ++ A :: Γ1).
       repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto. rewrite H3.
       assert (Γ2 ++ A0 → B0 → C0 :: x0 ++ B :: Γ1 = (Γ2 ++ A0 → B0 → C0 :: x0) ++ B :: Γ1).
       repeat rewrite <- app_assoc ; simpl ; repeat rewrite <- app_assoc ; auto. rewrite H4. apply OrLRule_I.
        assert (J5: derrec_height x < S (dersrec_height d)). lia.
        assert (J6: derrec_height x = derrec_height x). reflexivity.
        pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
        pose (dlCons x1 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ2 ++ A0 → B0 → C0 :: x0 ++ A :: Γ1, C)]) ((Γ2 ++ (A0 ∧ B0) → C0 :: x0) ++ A :: Γ1, C) H0 d0).
        pose (dlCons x2 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ2 ++ A0 → B0 → C0 :: x0 ++ B :: Γ1, C)]) ((Γ2 ++ (A0 ∧ B0) → C0 :: x0) ++ B :: Γ1, C) H1 d2).
        exists d1. exists d3. simpl. rewrite dersrec_height_nil ; auto. split ; lia.
 (* OrImpL *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). repeat destruct s.
    apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e1.
   +  assert (OrImpLRule [((Γ0 ++ A :: x1) ++ A0 → C0 :: Γ3 ++  B0 → C0 :: Γ4, C)]
        ((Γ0 ++ A :: x1) ++ (A0 ∨ B0) → C0 :: Γ3 ++ Γ4, C)). apply OrImpLRule_I. apply OrImpL in H0.
        repeat rewrite <- app_assoc in H0 ; simpl in H0.
        assert (OrImpLRule [((Γ0 ++ B :: x1) ++ A0 → C0 :: Γ3 ++  B0 → C0 :: Γ4, C)]
        ((Γ0 ++ B :: x1) ++ (A0 ∨ B0) → C0 :: Γ3 ++ Γ4, C)). apply OrImpLRule_I. apply OrImpL in H1.
        repeat rewrite <- app_assoc in H1 ; simpl in H1.
        assert (J4: OrLRule [(Γ0 ++ A :: x1 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: Γ4, C);(Γ0 ++ B:: x1 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: Γ4, C)]
        (((Γ0 ++ [A ∨ B]) ++ x1) ++ A0 → C0 :: Γ3 ++ B0 → C0 :: Γ4, C)). repeat rewrite <- app_assoc ; simpl.
        apply OrLRule_I.
        assert (J5: derrec_height x < S (dersrec_height d)). lia.
        assert (J6: derrec_height x = derrec_height x). reflexivity.
        pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
        pose (dlCons x0 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ0 ++ A :: x1 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: Γ4, C)]) (Γ0 ++ A :: x1 ++ (A0 ∨ B0) → C0 :: Γ3 ++ Γ4, C) H0 d0).
        pose (dlCons x2 DersNilF).
        pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
        (ps:=[(Γ0 ++ B :: x1 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: Γ4, C)]) (Γ0 ++ B :: x1 ++ (A0 ∨ B0) → C0 :: Γ3 ++ Γ4, C) H1 d2).
        exists d1. exists d3. simpl. rewrite dersrec_height_nil ; auto. split ; lia.
   +   repeat destruct s. repeat destruct p ; subst. apply app2_find_hole in e1. destruct e1. repeat destruct s ; destruct p ; subst.
        {   assert (OrImpLRule [(Γ2 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: A :: Γ1, C)]
            ((Γ2 ++ (A0 ∨ B0) → C0 :: Γ3) ++ A :: Γ1, C)). repeat rewrite <- app_assoc. apply OrImpLRule_I. apply OrImpL in H0.
            assert (OrImpLRule [(Γ2 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: B :: Γ1, C)]
            ((Γ2 ++ (A0 ∨ B0) → C0 :: Γ3) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. apply OrImpLRule_I. apply OrImpL in H1.
            assert (J4: OrLRule [((Γ2 ++ A0 → C0 :: Γ3 ++ [B0 → C0]) ++ A :: Γ1, C);((Γ2 ++ A0 → C0 :: Γ3 ++ [B0 → C0]) ++ B :: Γ1, C)]
            ((Γ2 ++ A0 → C0 :: Γ3 ++ [B0 → C0]) ++ A ∨ B :: Γ1, C)). apply OrLRule_I.
            repeat rewrite <- app_assoc in J4 ; simpl in J4 ; repeat rewrite <- app_assoc 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 _ _ J4). repeat destruct s. repeat destruct p.
            pose (dlCons x0 DersNilF).
            pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
            (ps:=[(Γ2 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: A :: Γ1, C)]) ((Γ2 ++ (A0 ∨ B0) → C0 :: Γ3) ++ A :: Γ1, C) H0 d0).
            pose (dlCons x2 DersNilF).
            pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
            (ps:=[(Γ2 ++ A0 → C0 :: Γ3 ++ [B0 → C0] ++ B :: Γ1, C)]) ((Γ2 ++ (A0 ∨ B0) → C0 :: Γ3) ++ B :: Γ1, C) H1 d2).
            exists d1. exists d3. simpl. rewrite dersrec_height_nil ; auto. split ; rewrite Nat.max_0_r ; apply le_n_S ; rewrite <- e ; auto. }
        {   assert (OrImpLRule [(Γ2 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: x1 ++ A :: Γ1, C)]
            ((Γ2 ++ (A0 ∨ B0) → C0 :: Γ3 ++ x1) ++ A :: Γ1, C)). repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc.
            apply OrImpLRule_I. apply OrImpL in H0.
            assert (OrImpLRule [(Γ2 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: x1 ++ B :: Γ1, C)]
            ((Γ2 ++ (A0 ∨ B0) → C0 :: Γ3 ++ x1) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc.
            apply OrImpLRule_I. apply OrImpL in H1.
            assert (J4: OrLRule [((Γ2 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: x1) ++ A :: Γ1, C);((Γ2 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: x1) ++ B :: Γ1, C)]
            ((Γ2 ++ A0 → C0 :: Γ3 ++ B0 → C0 :: x1) ++ A ∨ B :: Γ1, C)). apply OrLRule_I.
            repeat rewrite <- app_assoc in J4 ; simpl in J4 ; repeat rewrite <- app_assoc 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 _ _ J4). repeat destruct s. repeat destruct p.
            pose (dlCons x0 DersNilF).
            pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
            (ps:=[(Γ2 ++ A0 → C0 :: Γ3 ++ (B0 → C0 :: x1) ++ A :: Γ1, C)]) ((Γ2 ++ (A0 ∨ B0) → C0 :: Γ3 ++ x1) ++ A :: Γ1, C) H0 d0).
            pose (dlCons x2 DersNilF).
            pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
            (ps:=[(Γ2 ++ A0 → C0 :: Γ3 ++ (B0 → C0 :: x1) ++ B :: Γ1, C)]) ((Γ2 ++ (A0 ∨ B0) → C0 :: Γ3 ++ x1) ++ B :: Γ1, C) H1 d2).
            exists d1. exists d3. simpl. rewrite dersrec_height_nil ; auto. split ; rewrite Nat.max_0_r ; apply le_n_S ; rewrite <- e ; auto. }
        {   destruct x1.
            -  simpl in e1. subst. assert (OrImpLRule [(Γ2 ++ A0 → C0 :: x0 ++ B0 → C0 :: A :: Γ1, C)]
              ((Γ2 ++ (A0 ∨ B0) → C0 :: x0) ++ A :: Γ1, C)). repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc.
              apply OrImpLRule_I. apply OrImpL in H0.
              assert (OrImpLRule [(Γ2 ++ A0 → C0 :: x0 ++ B0 → C0 :: B :: Γ1, C)]
              ((Γ2 ++ (A0 ∨ B0) → C0 :: x0) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc.
              apply OrImpLRule_I. apply OrImpL in H1.
              assert (J4: OrLRule [(Γ2 ++ A0 → C0 :: x0 ++ B0 → C0 :: A :: Γ1, C);(Γ2 ++ A0 → C0 :: x0 ++ B0 → C0 :: B :: Γ1, C)]
              (Γ2 ++ A0 → C0 :: (x0 ++ []) ++ B0 → C0 :: A ∨ B :: Γ1, C)).
              assert (Γ2 ++ A0 → C0 :: x0 ++ B0 → C0 :: A :: Γ1 = (Γ2 ++ A0 → C0 :: x0 ++ [B0 → C0]) ++ A :: Γ1).
              repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. auto. rewrite H2.
              assert (Γ2 ++ A0 → C0 :: x0 ++ B0 → C0 :: B :: Γ1 = (Γ2 ++ A0 → C0 :: x0 ++ [B0 → C0]) ++ B :: Γ1).
              repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. auto. rewrite H3.
              assert (Γ2 ++ A0 → C0 :: (x0 ++ []) ++ B0 → C0 :: A ∨ B :: Γ1 = (Γ2 ++ A0 → C0 :: x0 ++ [B0 → C0]) ++ A ∨ B :: Γ1).
              repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. auto. rewrite H4.
              apply OrLRule_I.
              assert (J5: derrec_height x < S (dersrec_height d)). lia.
              assert (J6: derrec_height x = derrec_height x). reflexivity.
              pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
              pose (dlCons x1 DersNilF).
              pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
              (ps:=[(Γ2 ++ A0 → C0 :: x0 ++ B0 → C0 :: A :: Γ1, C)]) ((Γ2 ++ (A0 ∨ B0) → C0 :: x0) ++ A :: Γ1, C) H0 d0).
              pose (dlCons x2 DersNilF).
              pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
              (ps:=[(Γ2 ++ A0 → C0 :: x0 ++ B0 → C0 :: B :: Γ1, C)]) ((Γ2 ++ (A0 ∨ B0) → C0 :: x0) ++ B :: Γ1, C) H1 d2).
              exists d1. exists d3. simpl. rewrite dersrec_height_nil ; auto. split ; lia.
            -  inversion e1. subst. assert (OrImpLRule [(Γ2 ++ A0 → C0 :: x0 ++ A :: x1 ++ B0 → C0 :: Γ4, C)]
              ((Γ2 ++ (A0 ∨ B0) → C0 :: x0) ++ A :: x1 ++ Γ4, C)).
              assert (Γ2 ++ A0 → C0 :: x0 ++ A :: x1 ++ B0 → C0 :: Γ4 = Γ2 ++ A0 → C0 :: (x0 ++ A :: x1) ++ B0 → C0 :: Γ4).
              repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. auto. rewrite H0.
              assert ((Γ2 ++ (A0 ∨ B0) → C0 :: x0) ++ A :: x1 ++ Γ4 = Γ2 ++ (A0 ∨ B0) → C0 :: (x0 ++ A :: x1) ++ Γ4).
              repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. auto. rewrite H1.
              apply OrImpLRule_I. apply OrImpL in H0.
              assert (OrImpLRule [(Γ2 ++ A0 → C0 :: x0 ++ B :: x1 ++ B0 → C0 :: Γ4, C)]
              ((Γ2 ++ (A0 ∨ B0) → C0 :: x0) ++ B :: x1 ++ Γ4, C)).
              assert (Γ2 ++ A0 → C0 :: x0 ++ B :: x1 ++ B0 → C0 :: Γ4 = Γ2 ++ A0 → C0 :: (x0 ++ B :: x1) ++ B0 → C0 :: Γ4).
              repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. auto. rewrite H1.
              assert ((Γ2 ++ (A0 ∨ B0) → C0 :: x0) ++ B :: x1 ++ Γ4 = Γ2 ++ (A0 ∨ B0) → C0 :: (x0 ++ B :: x1) ++ Γ4).
              repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. auto. rewrite H2.
              apply OrImpLRule_I. apply OrImpL in H1.
              assert (J4: OrLRule [(Γ2 ++ A0 → C0 :: x0 ++ A :: x1 ++ B0 → C0 :: Γ4, C);(Γ2 ++ A0 → C0 :: x0 ++ B :: x1 ++ B0 → C0 :: Γ4, C)]
              (Γ2 ++ A0 → C0 :: (x0 ++ A ∨ B :: x1) ++ B0 → C0 :: Γ4, C)).
              assert (Γ2 ++ A0 → C0 :: x0 ++ A :: x1 ++ B0 → C0 :: Γ4 = (Γ2 ++ A0 → C0 :: x0) ++ A :: x1 ++ B0 → C0 :: Γ4).
              repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. auto. rewrite H2.
              assert (Γ2 ++ A0 → C0 :: x0 ++ B :: x1 ++ B0 → C0 :: Γ4 = (Γ2 ++ A0 → C0 :: x0) ++ B :: x1 ++ B0 → C0 :: Γ4).
              repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. auto. rewrite H3.
              assert (Γ2 ++ A0 → C0 :: (x0 ++ A ∨ B :: x1) ++ B0 → C0 :: Γ4 = (Γ2 ++ A0 → C0 :: x0) ++ A ∨ B :: x1 ++ B0 → C0 :: Γ4).
              repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc. auto. rewrite H4.
              apply OrLRule_I.
              assert (J5: derrec_height x < S (dersrec_height d)). lia.
              assert (J6: derrec_height x = derrec_height x). reflexivity.
              pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
              pose (dlCons x2 DersNilF).
              pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
              (ps:=[(Γ2 ++ A0 → C0 :: x0 ++ A :: x1 ++ B0 → C0 :: Γ4, C)]) ((Γ2 ++ (A0 ∨ B0) → C0 :: x0) ++ A :: x1 ++ Γ4, C) H0 d0).
              pose (dlCons x3 DersNilF).
              pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
              (ps:=[(Γ2 ++ A0 → C0 :: x0 ++ B :: x1 ++ B0 → C0 :: Γ4, C)]) ((Γ2 ++ (A0 ∨ B0) → C0 :: x0) ++ B :: x1 ++ Γ4, C) H1 d2).
              exists d1. exists d3. simpl. rewrite dersrec_height_nil ; auto. split ; lia. }
  (* ImpImpL *)
  * inversion H. subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
    apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
    + inversion e1.
    + assert (ImpImpLRule [((Γ0 ++ A :: x2) ++ B0 → C0 :: Γ3, A0 → B0);((Γ0 ++ A :: x2) ++ C0 :: Γ3, C)]
       ((Γ0 ++ A :: x2) ++ (A0 → B0) → C0 :: Γ3, C)). apply ImpImpLRule_I. apply ImpImpL in H0.
       repeat rewrite <- app_assoc in H0. simpl in H0.
       assert (ImpImpLRule [((Γ0 ++ B :: x2) ++ B0 → C0 :: Γ3, A0 → B0);((Γ0 ++ B :: x2) ++ C0 :: Γ3, C)]
       ((Γ0 ++ B :: x2) ++ (A0 → B0) → C0 :: Γ3, C)). apply ImpImpLRule_I. apply ImpImpL in H1.
       repeat rewrite <- app_assoc in H1. simpl in H1.
       assert (J4: OrLRule [(Γ0 ++ A :: x2 ++ B0 → C0 :: Γ3, A0 → B0);(Γ0 ++ B :: x2 ++ B0 → C0 :: Γ3, A0 → B0)]
       (((Γ0 ++ [A ∨ B]) ++ x2) ++ B0 → C0 :: Γ3, A0 → B0)). repeat rewrite <- app_assoc. simpl. apply OrLRule_I.
       assert (J5: derrec_height x < S (dersrec_height d)). lia.
       assert (J6: derrec_height x = derrec_height x). reflexivity.
       pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
       assert (J7: OrLRule [(Γ0 ++ A :: x2 ++ C0 :: Γ3, C);(Γ0 ++ B :: x2 ++ C0 :: Γ3, C)]
       (((Γ0 ++ [A ∨ B]) ++ x2) ++ C0 :: Γ3, C)). repeat rewrite <- app_assoc. simpl. apply OrLRule_I.
       assert (J8: derrec_height x0 < S (dersrec_height d)). lia.
       assert (J9: derrec_height x0 = derrec_height x0). reflexivity.
       pose (IH _ J8 _ _ J9 _ _ J7). repeat destruct s. repeat destruct p.
       pose (dlCons x4 DersNilF). pose (dlCons x1 d0).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[(Γ0 ++ A :: x2 ++ B0 → C0 :: Γ3, A0 → B0); (Γ0 ++ A :: x2 ++ C0 :: Γ3, C)]) (Γ0 ++ A :: x2 ++ (A0 → B0) → C0 :: Γ3, C) H0 d1).
       pose (dlCons x5 DersNilF). pose (dlCons x3 d3).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:= [(Γ0 ++ B :: x2 ++ B0 → C0 :: Γ3, A0 → B0); (Γ0 ++ B :: x2 ++ C0 :: Γ3, C)]) (Γ0 ++ B :: x2 ++ (A0 → B0) → C0 :: Γ3, C) H1 d4).
       exists d2. exists d5. simpl. rewrite dersrec_height_nil ; auto. split ; lia.
    + repeat destruct s. repeat destruct p ; subst.
       assert (ImpImpLRule [(Γ2 ++ B0 → C0 :: x1 ++ A :: Γ1, A0 → B0);(Γ2 ++ C0 :: x1 ++ A :: Γ1, C)]
       ((Γ2 ++ (A0 → B0) → C0 :: x1) ++ A :: Γ1, C)). repeat rewrite <- app_assoc. apply ImpImpLRule_I. apply ImpImpL in H0.
       assert (ImpImpLRule [(Γ2 ++ B0 → C0 :: x1 ++ B :: Γ1, A0 → B0);(Γ2 ++ C0 :: x1 ++ B :: Γ1, C)]
       ((Γ2 ++ (A0 → B0) → C0 :: x1) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. apply ImpImpLRule_I. apply ImpImpL in H1.
       assert (J4: OrLRule [(Γ2 ++ B0 → C0 :: x1 ++ A :: Γ1, A0 → B0);(Γ2 ++ B0 → C0 :: x1 ++ B :: Γ1, A0 → B0)]
       (Γ2 ++ B0 → C0 :: x1 ++ A ∨ B :: Γ1, A0 → B0)).
       assert (Γ2 ++ B0 → C0 :: x1 ++ A :: Γ1 = (Γ2 ++ B0 → C0 :: x1) ++ A :: Γ1).
       repeat rewrite <- app_assoc ; auto. rewrite H2.
       assert (Γ2 ++ B0 → C0 :: x1 ++ B :: Γ1 = (Γ2 ++ B0 → C0 :: x1) ++ B :: Γ1).
       repeat rewrite <- app_assoc ; auto. rewrite H3.
       assert (Γ2 ++ B0 → C0 :: x1 ++ A ∨ B :: Γ1 = (Γ2 ++ B0 → C0 :: x1) ++ A ∨ B :: Γ1).
       repeat rewrite <- app_assoc ; auto. rewrite H4.
       apply OrLRule_I.
       assert (J5: derrec_height x < S (dersrec_height d)). lia.
       assert (J6: derrec_height x = derrec_height x). reflexivity.
       pose (IH _ J5 _ _ J6 _ _ J4). repeat destruct s. repeat destruct p.
       assert (J7: OrLRule [(Γ2 ++ C0 :: x1 ++ A :: Γ1, C);(Γ2 ++ C0 :: x1 ++ B :: Γ1, C)]
       (Γ2 ++ C0 :: x1 ++ A ∨ B :: Γ1, C)).
       assert (Γ2 ++ C0 :: x1 ++ A :: Γ1 = (Γ2 ++ C0 :: x1) ++ A :: Γ1).
       repeat rewrite <- app_assoc ; auto. rewrite H2.
       assert (Γ2 ++ C0 :: x1 ++ B :: Γ1 = (Γ2 ++ C0 :: x1) ++ B :: Γ1).
       repeat rewrite <- app_assoc ; auto. rewrite H3.
       assert (Γ2 ++ C0 :: x1 ++ A ∨ B :: Γ1 = (Γ2 ++ C0 :: x1) ++ A ∨ B :: Γ1).
       repeat rewrite <- app_assoc ; auto. rewrite H4.
       apply OrLRule_I.
       assert (J8: derrec_height x0 < S (dersrec_height d)). lia.
       assert (J9: derrec_height x0 = derrec_height x0). reflexivity.
       pose (IH _ J8 _ _ J9 _ _ J7). repeat destruct s. repeat destruct p.
       pose (dlCons x4 DersNilF). pose (dlCons x2 d0).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[(Γ2 ++ B0 → C0 :: x1 ++ A :: Γ1, A0 → B0); (Γ2 ++ C0 :: x1 ++ A :: Γ1, C)]) ((Γ2 ++ (A0 → B0) → C0 :: x1) ++ A :: Γ1, C) H0 d1).
       pose (dlCons x5 DersNilF). pose (dlCons x3 d3).
       pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
       (ps:=[(Γ2 ++ B0 → C0 :: x1 ++ B :: Γ1, A0 → B0); (Γ2 ++ C0 :: x1 ++ B :: Γ1, C)]) ((Γ2 ++ (A0 → B0) → C0 :: x1) ++ B :: Γ1, C) H1 d4).
       exists d2. exists d5. simpl. rewrite dersrec_height_nil ; auto. split ; lia.
  (* BoxImpL *)
 * inversion X. subst. apply univ_gen_ext_splitR in X0. destruct X0. destruct s. repeat destruct p. subst.
    assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
    apply list_split_form in H. destruct H. repeat destruct s ; repeat destruct p ; subst.
    + inversion e1.
    + apply univ_gen_ext_splitR in u. destruct u. destruct s. repeat destruct p. subst.
       apply univ_gen_ext_splitR in u. destruct u. destruct s. repeat destruct p. subst. inversion u2. subst.
       exfalso. assert (In (A ∨ B) (((x ++ A ∨ B :: l) ++ x5) ++ x0)). apply in_or_app. left. apply in_or_app. left.
       apply in_or_app. right. apply in_eq. apply H1 in H. destruct H. inversion H. subst. inversion X0. subst.
       assert (J7: OrLRule [(Γ0 ++ A :: x4 ++ B0 :: Γ3, C);(Γ0 ++ B :: x4 ++ B0 :: Γ3, C)]
       (((Γ0 ++ [A ∨ B]) ++ x4) ++ B0 :: Γ3, C)). repeat rewrite <- app_assoc. simpl. apply OrLRule_I.
       assert (J8: derrec_height x2 < S (dersrec_height d)). lia.
       assert (J9: derrec_height x2 = derrec_height x2). reflexivity.
       pose (IH _ J8 _ _ J9 _ _ J7). repeat destruct s. repeat destruct p.
       assert (existsT2 (D1 : derrec GL4ip_rules (fun _ : Seq => False) (Γ0 ++ A :: x4 ++ Box A0 → B0 :: Γ3, C)),
       (derrec_height D1 <= S (dersrec_height d))).
       { destruct (dec_is_boxedT A).
          -  assert (BoxImpLRule [(XBoxed_list (((x ++ []) ++ A :: x5) ++ x0) ++ [Box A0], A0);((Γ0 ++ A :: x4) ++ B0 :: Γ3, C)]
             ((Γ0 ++ A :: x4) ++ Box A0 → B0 :: Γ3, C)). apply BoxImpLRule_I ; auto.
             repeat rewrite <- app_assoc. simpl. intro. intros. repeat rewrite <- app_assoc in H1. simpl in H1.
             apply in_app_or in H. destruct H. apply H1. apply in_or_app ; auto. inversion H. subst.
             destruct i. exists x7. subst. auto. apply in_app_or in H0. destruct H0. apply H1.
             apply in_or_app ; right ; apply in_or_app ; auto. apply H1. apply in_or_app ; right ; 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_combine ; auto. repeat rewrite <- app_assoc in X1. simpl in X1.
             assert (existsT2 (D2 : derrec GL4ip_rules (fun _ : Seq => False) (XBoxed_list (x ++ A :: x5 ++ x0) ++ [Box A0], A0)),
             (derrec_height D2 <= derrec_height x1)).
             assert (J50: derrec_height x1 = derrec_height x1). auto.
             assert (J51 : wkn_L A (XBoxed_list (((x ++ []) ++ x5) ++ x0) ++ [Box A0], A0) (XBoxed_list x ++ A :: XBoxed_list (x5 ++ x0) ++ [Box A0], A0)).
             repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. apply wkn_LI.
             pose (@GL4ip_wkn_L (derrec_height x1) (XBoxed_list (((x ++ []) ++ x5) ++ x0) ++ [Box A0], A0) x1 J50
             (XBoxed_list x ++ A :: XBoxed_list (x5 ++ x0) ++ [Box A0], A0) A J51). destruct s.
             assert (J52: derrec_height x7 = derrec_height x7). auto.
             assert (J53 : wkn_L (unBox_formula A) (XBoxed_list x ++ A :: XBoxed_list (x5 ++ x0) ++ [Box A0], A0) (XBoxed_list (x ++ A :: x5 ++ x0) ++ [Box A0], A0)).
             repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. simpl.
             repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. simpl. apply wkn_LI.
             pose (@GL4ip_wkn_L (derrec_height x7) (XBoxed_list x ++ A :: XBoxed_list (x5 ++ x0) ++ [Box A0], A0) x7 J52
             (XBoxed_list (x ++ A :: x5 ++ x0) ++ [Box A0], A0) (unBox_formula A) J53). destruct s. exists x8. lia.
             destruct X2. pose (dlCons x3 DersNilF). pose (dlCons x7 d0). apply BoxImpL in X1.
             pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
             (ps:=[(XBoxed_list (x ++ A :: x5 ++ x0) ++ [Box A0], A0); (Γ0 ++ A :: x4 ++ B0 :: Γ3, C)]) (Γ0 ++ A :: x4 ++ Box A0 → B0 :: Γ3, C) X1 d1).
             exists d2. simpl. rewrite dersrec_height_nil ; auto. lia.
          -  assert (BoxImpLRule [(XBoxed_list (((x ++ []) ++ x5) ++ x0) ++ [Box A0], A0);(Γ0 ++ A :: x4 ++ B0 :: Γ3, C)]
             (Γ0 ++ A :: x4 ++ Box A0 → B0 :: Γ3, C)).
             assert (Γ0 ++ A :: x4 ++ B0 :: Γ3 = (Γ0 ++ A :: x4) ++ B0 :: Γ3). repeat rewrite <- app_assoc ; auto.
             rewrite H.
             assert (Γ0 ++ A :: x4 ++ Box A0 → B0 :: Γ3 = (Γ0 ++ A :: x4) ++ Box A0 → B0 :: Γ3). repeat rewrite <- app_assoc ; auto.
             rewrite H0.
             apply BoxImpLRule_I ; auto.
             repeat rewrite <- app_assoc. simpl. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_extra ; auto.
             apply univ_gen_ext_combine ; auto.
             pose (dlCons x3 DersNilF). pose (dlCons x1 d0). apply BoxImpL in X1.
             pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
             (ps:=[(XBoxed_list (((x ++ []) ++ x5) ++ x0) ++ [Box A0], A0); (Γ0 ++ A :: x4 ++ B0 :: Γ3, C)]) (Γ0 ++ A :: x4 ++ Box A0 → B0 :: Γ3, C) X1 d1).
             exists d2. simpl. rewrite dersrec_height_nil ; auto. lia. }
       assert (existsT2 (D1 : derrec GL4ip_rules (fun _ : Seq => False) (Γ0 ++ B :: x4 ++ Box A0 → B0 :: Γ3, C)),
       (derrec_height D1 <= S (dersrec_height d))).
       { destruct (dec_is_boxedT B).
          -  assert (BoxImpLRule [(XBoxed_list (((x ++ []) ++ B :: x5) ++ x0) ++ [Box A0], A0);((Γ0 ++ B :: x4) ++ B0 :: Γ3, C)]
             ((Γ0 ++ B :: x4) ++ Box A0 → B0 :: Γ3, C)). apply BoxImpLRule_I ; auto.
             repeat rewrite <- app_assoc. simpl. intro. intros. repeat rewrite <- app_assoc in H1. simpl in H1.
             apply in_app_or in H. destruct H. apply H1. apply in_or_app ; auto. inversion H. subst.
             destruct i. exists x7. subst. auto. apply in_app_or in H0. destruct H0. apply H1.
             apply in_or_app ; right ; apply in_or_app ; auto. apply H1. apply in_or_app ; right ; 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_combine ; auto. repeat rewrite <- app_assoc in X1. simpl in X1.
             assert (existsT2 (D2 : derrec GL4ip_rules (fun _ : Seq => False) (XBoxed_list (x ++ B :: x5 ++ x0) ++ [Box A0], A0)),
             (derrec_height D2 <= derrec_height x1)).
             assert (J50: derrec_height x1 = derrec_height x1). auto.
             assert (J51 : wkn_L B (XBoxed_list (((x ++ []) ++ x5) ++ x0) ++ [Box A0], A0) (XBoxed_list x ++ B :: XBoxed_list (x5 ++ x0) ++ [Box A0], A0)).
             repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. apply wkn_LI.
             pose (@GL4ip_wkn_L (derrec_height x1) (XBoxed_list (((x ++ []) ++ x5) ++ x0) ++ [Box A0], A0) x1 J50
             (XBoxed_list x ++ B :: XBoxed_list (x5 ++ x0) ++ [Box A0], A0) B J51). destruct s.
             assert (J52: derrec_height x7 = derrec_height x7). auto.
             assert (J53 : wkn_L (unBox_formula B) (XBoxed_list x ++ B :: XBoxed_list (x5 ++ x0) ++ [Box A0], A0) (XBoxed_list (x ++ B :: x5 ++ x0) ++ [Box A0], A0)).
             repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. simpl.
             repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. simpl. apply wkn_LI.
             pose (@GL4ip_wkn_L (derrec_height x7) (XBoxed_list x ++ B :: XBoxed_list (x5 ++ x0) ++ [Box A0], A0) x7 J52
             (XBoxed_list (x ++ B :: x5 ++ x0) ++ [Box A0], A0) (unBox_formula B) J53). destruct s. exists x8. lia.
             destruct X3. pose (dlCons x6 DersNilF). pose (dlCons x7 d0). apply BoxImpL in X2. repeat rewrite <- app_assoc in X2. simpl in X2.
             pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
             (ps:=[(XBoxed_list (x ++ B :: x5 ++ x0) ++ [Box A0], A0); (Γ0 ++ B :: x4 ++ B0 :: Γ3, C)]) (Γ0 ++ B :: x4 ++ Box A0 → B0 :: Γ3, C) X2 d1).
             exists d2. simpl. rewrite dersrec_height_nil ; auto. lia.
          -  assert (BoxImpLRule [(XBoxed_list (((x ++ []) ++ x5) ++ x0) ++ [Box A0], A0);(Γ0 ++ B :: x4 ++ B0 :: Γ3, C)]
             (Γ0 ++ B :: x4 ++ Box A0 → B0 :: Γ3, C)).
             assert (Γ0 ++ B :: x4 ++ B0 :: Γ3 = (Γ0 ++ B :: x4) ++ B0 :: Γ3). repeat rewrite <- app_assoc ; auto.
             rewrite H.
             assert (Γ0 ++ B :: x4 ++ Box A0 → B0 :: Γ3 = (Γ0 ++ B :: x4) ++ Box A0 → B0 :: Γ3). repeat rewrite <- app_assoc ; auto.
             rewrite H0.
             apply BoxImpLRule_I ; auto.
             repeat rewrite <- app_assoc. simpl. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_extra ; auto.
             apply univ_gen_ext_combine ; auto.
             pose (dlCons x6 DersNilF). pose (dlCons x1 d0). apply BoxImpL in X2.
             pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
             (ps:=[(XBoxed_list (((x ++ []) ++ x5) ++ x0) ++ [Box A0], A0); (Γ0 ++ B :: x4 ++ B0 :: Γ3, C)]) (Γ0 ++ B :: x4 ++ Box A0 → B0 :: Γ3, C) X2 d1).
             exists d2. simpl. rewrite dersrec_height_nil ; auto. lia. }
       destruct X1. destruct X2. exists x7. exists x8. split ; lia.
    + repeat destruct s. repeat destruct p ; subst.
       apply univ_gen_ext_splitR in u0. destruct u0. destruct s. repeat destruct p. subst.
       inversion u1. subst. exfalso. assert (In (A ∨ B) (x ++ x4 ++ A ∨ B :: l)). apply in_or_app. right. apply in_or_app. right.
       apply in_eq. apply H1 in H. destruct H. inversion H. subst.
       assert (J7: OrLRule [((Γ2 ++ B0 :: x3) ++ A :: Γ1, C);((Γ2 ++ B0 :: x3) ++ B :: Γ1, C)]
       ((Γ2 ++ B0 :: x3) ++ A ∨ B :: Γ1, C)). apply OrLRule_I. repeat rewrite <- app_assoc in J7 ; simpl in J7.
       assert (J8: derrec_height x2 < S (dersrec_height d)). lia.
       assert (J9: derrec_height x2 = derrec_height x2). reflexivity.
       pose (IH _ J8 _ _ J9 _ _ J7). repeat destruct s. repeat destruct p.
       assert (existsT2 (D1 : derrec GL4ip_rules (fun _ : Seq => False) ((Γ2 ++ Box A0 → B0 :: x3) ++ A :: Γ1, C)),
       (derrec_height D1 <= S (dersrec_height d))).
       { destruct (dec_is_boxedT A).
          -  assert (BoxImpLRule [(XBoxed_list (x ++ x4 ++ A :: x5) ++ [Box A0], A0);(Γ2 ++ B0 :: x3 ++ A :: Γ1, C)]
             ((Γ2 ++ Box A0 → B0 :: x3) ++ A :: Γ1, C)). repeat rewrite <- app_assoc. apply BoxImpLRule_I ; auto.
             intro. intros. apply in_app_or in H. destruct H. apply H1. apply in_or_app ; auto. apply in_app_or in H. destruct H.
             apply H1. apply in_or_app ; right ; apply in_or_app ; auto. inversion H. subst.
             destruct i. exists x7. subst. auto. apply H1.
             apply in_or_app ; right ; apply in_or_app ; auto. apply univ_gen_ext_combine ; auto.
             apply univ_gen_ext_combine ; auto. apply univ_gen_ext_cons ; auto.
             assert (existsT2 (D2 : derrec GL4ip_rules (fun _ : Seq => False) (XBoxed_list (x ++ x4 ++ A :: x5) ++ [Box A0], A0)),
             (derrec_height D2 <= derrec_height x1)).
             assert (J50: derrec_height x1 = derrec_height x1). auto.
             assert (J51 : wkn_L A (XBoxed_list (x ++ x4 ++ x5) ++ [Box A0], A0) (XBoxed_list (x ++ x4) ++ A :: XBoxed_list x5 ++ [Box A0], A0)).
             assert (XBoxed_list (x ++ x4 ++ x5) ++ [Box A0] = XBoxed_list (x ++ x4) ++ XBoxed_list x5 ++ [Box A0]).
             repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. auto. rewrite H. apply wkn_LI.
             pose (@GL4ip_wkn_L (derrec_height x1) (XBoxed_list (x ++ x4 ++ x5) ++ [Box A0], A0) x1 J50
             (XBoxed_list (x ++ x4) ++ A :: XBoxed_list x5 ++ [Box A0], A0) A J51). destruct s.
             assert (J52: derrec_height x7 = derrec_height x7). auto.
             assert (J53 : wkn_L (unBox_formula A) (XBoxed_list (x ++ x4) ++ A :: XBoxed_list x5 ++ [Box A0], A0) (XBoxed_list (x ++ x4 ++ A :: x5) ++ [Box A0], A0)).
             assert (XBoxed_list (x ++ x4 ++ A :: x5) ++ [Box A0] = XBoxed_list (x ++ x4) ++ unBox_formula A :: A :: XBoxed_list x5 ++ [Box A0]).
             repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. simpl. auto. rewrite H. apply wkn_LI.
             pose (@GL4ip_wkn_L (derrec_height x7) (XBoxed_list (x ++ x4) ++ A :: XBoxed_list x5 ++ [Box A0], A0) x7 J52
             (XBoxed_list (x ++ x4 ++ A :: x5) ++ [Box A0], A0) (unBox_formula A) J53). destruct s. exists x8. lia.
             destruct X2. pose (dlCons x0 DersNilF). pose (dlCons x7 d0). apply BoxImpL in X1.
             pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
             (ps:=[(XBoxed_list (x ++ x4 ++ A :: x5) ++ [Box A0], A0); (Γ2 ++ B0 :: x3 ++ A :: Γ1, C)]) ((Γ2 ++ Box A0 → B0 :: x3) ++ A :: Γ1, C) X1 d1).
             exists d2. simpl. rewrite dersrec_height_nil ; auto. lia.
          -  assert (BoxImpLRule [(XBoxed_list (x ++ x4 ++ x5) ++ [Box A0], A0);(Γ2 ++ B0 :: x3 ++ A :: Γ1, C)]
             ((Γ2 ++ Box A0 → B0 :: x3) ++ A :: Γ1, C)). repeat rewrite <- app_assoc.
             apply BoxImpLRule_I ; auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_combine ; auto.
             apply univ_gen_ext_extra ; auto. pose (dlCons x0 DersNilF). pose (dlCons x1 d0). apply BoxImpL in X1.
             pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
             (ps:=[(XBoxed_list (x ++ x4 ++ x5) ++ [Box A0], A0); (Γ2 ++ B0 :: x3 ++ A :: Γ1, C)]) ((Γ2 ++ Box A0 → B0 :: x3) ++ A :: Γ1, C) X1 d1).
             exists d2. simpl. rewrite dersrec_height_nil ; auto. lia. }
       assert (existsT2 (D1 : derrec GL4ip_rules (fun _ : Seq => False) ((Γ2 ++ Box A0 → B0 :: x3) ++ B :: Γ1, C)),
       (derrec_height D1 <= S (dersrec_height d))).
       { destruct (dec_is_boxedT B).
          -  assert (BoxImpLRule [(XBoxed_list (x ++ x4 ++ B :: x5) ++ [Box A0], A0);(Γ2 ++ B0 :: x3 ++ B :: Γ1, C)]
             ((Γ2 ++ Box A0 → B0 :: x3) ++ B :: Γ1, C)). repeat rewrite <- app_assoc. apply BoxImpLRule_I ; auto.
             intro. intros. apply in_app_or in H. destruct H. apply H1. apply in_or_app ; auto. apply in_app_or in H. destruct H.
             apply H1. apply in_or_app ; right ; apply in_or_app ; auto. inversion H. subst.
             destruct i. exists x7. subst. auto. apply H1.
             apply in_or_app ; right ; apply in_or_app ; auto. apply univ_gen_ext_combine ; auto.
             apply univ_gen_ext_combine ; auto. apply univ_gen_ext_cons ; auto.
             assert (existsT2 (D2 : derrec GL4ip_rules (fun _ : Seq => False) (XBoxed_list (x ++ x4 ++ B :: x5) ++ [Box A0], A0)),
             (derrec_height D2 <= derrec_height x1)).
             assert (J50: derrec_height x1 = derrec_height x1). auto.
             assert (J51 : wkn_L B (XBoxed_list (x ++ x4 ++ x5) ++ [Box A0], A0) (XBoxed_list (x ++ x4) ++ B :: XBoxed_list x5 ++ [Box A0], A0)).
             assert (XBoxed_list (x ++ x4 ++ x5) ++ [Box A0] = XBoxed_list (x ++ x4) ++ XBoxed_list x5 ++ [Box A0]).
             repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. auto. rewrite H. apply wkn_LI.
             pose (@GL4ip_wkn_L (derrec_height x1) (XBoxed_list (x ++ x4 ++ x5) ++ [Box A0], A0) x1 J50
             (XBoxed_list (x ++ x4) ++ B :: XBoxed_list x5 ++ [Box A0], A0) B J51). destruct s.
             assert (J52: derrec_height x7 = derrec_height x7). auto.
             assert (J53 : wkn_L (unBox_formula B) (XBoxed_list (x ++ x4) ++ B :: XBoxed_list x5 ++ [Box A0], A0) (XBoxed_list (x ++ x4 ++ B :: x5) ++ [Box A0], A0)).
             assert (XBoxed_list (x ++ x4 ++ B :: x5) ++ [Box A0] = XBoxed_list (x ++ x4) ++ unBox_formula B :: B :: XBoxed_list x5 ++ [Box A0]).
             repeat rewrite <- app_assoc. simpl. repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. simpl. auto. rewrite H. apply wkn_LI.
             pose (@GL4ip_wkn_L (derrec_height x7) (XBoxed_list (x ++ x4) ++ B :: XBoxed_list x5 ++ [Box A0], A0) x7 J52
             (XBoxed_list (x ++ x4 ++ B :: x5) ++ [Box A0], A0) (unBox_formula B) J53). destruct s. exists x8. lia.
             destruct X3. pose (dlCons x6 DersNilF). pose (dlCons x7 d0). apply BoxImpL in X2.
             pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
             (ps:=[(XBoxed_list (x ++ x4 ++ B :: x5) ++ [Box A0], A0); (Γ2 ++ B0 :: x3 ++ B :: Γ1, C)]) ((Γ2 ++ Box A0 → B0 :: x3) ++ B :: Γ1, C) X2 d1).
             exists d2. simpl. rewrite dersrec_height_nil ; auto. lia.
          -  assert (BoxImpLRule [(XBoxed_list (x ++ x4 ++ x5) ++ [Box A0], A0);(Γ2 ++ B0 :: x3 ++ B :: Γ1, C)]
             ((Γ2 ++ Box A0 → B0 :: x3) ++ B :: Γ1, C)). repeat rewrite <- app_assoc.
             apply BoxImpLRule_I ; auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_combine ; auto.
             apply univ_gen_ext_extra ; auto. pose (dlCons x6 DersNilF). pose (dlCons x1 d0). apply BoxImpL in X2.
             pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
             (ps:=[(XBoxed_list (x ++ x4 ++ x5) ++ [Box A0], A0); (Γ2 ++ B0 :: x3 ++ B :: Γ1, C)]) ((Γ2 ++ Box A0 → B0 :: x3) ++ B :: Γ1, C) X2 d1).
             exists d2. simpl. rewrite dersrec_height_nil ; auto. lia. }
       destruct X1. destruct X2. exists x7. exists x8. split ; lia.
  (* GLR *)
  * inversion X. subst. apply univ_gen_ext_splitR in X0. destruct X0. destruct s. repeat destruct p. subst.
    inversion u0. subst. exfalso.  assert (In (A ∨ B) (x ++ A ∨ B :: l)). apply in_or_app. right.
    apply in_eq. apply H1 in H. destruct H. inversion H. subst.
    assert (J30: dersrec_height d = dersrec_height d). reflexivity.
    pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). repeat destruct s.
    assert (existsT2 (D1 : derrec GL4ip_rules (fun _ : Seq => False) (Γ0 ++ A :: Γ1, Box A0)),
    (derrec_height D1 <= S (dersrec_height d))).
    { destruct (dec_is_boxedT A).
       -  assert (GLRRule [(XBoxed_list (x ++ A :: x0) ++ [Box A0], A0)]
         (Γ0 ++ A :: Γ1, Box A0)). apply GLRRule_I ; auto.
         intro. intros. apply in_app_or in H. destruct H. apply H1. apply in_or_app ; auto.
         inversion H. subst. destruct i. subst. exists x2. auto. apply H1.
         apply in_or_app ; auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_cons ; auto.
         assert (existsT2 (D2 : derrec GL4ip_rules (fun _ : Seq => False) (XBoxed_list (x ++ A :: x0) ++ [Box A0], A0)),
         (derrec_height D2 <= derrec_height x1)).
         assert (J50: derrec_height x1 = derrec_height x1). auto.
         assert (J51 : wkn_L A (XBoxed_list (x ++ x0) ++ [Box A0], A0) (XBoxed_list x ++ A :: XBoxed_list x0 ++ [Box A0], A0)).
         repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. apply wkn_LI.
         pose (@GL4ip_wkn_L (derrec_height x1) (XBoxed_list (x ++ x0) ++ [Box A0], A0) x1 J50
         (XBoxed_list x  ++ A :: XBoxed_list x0 ++ [Box A0], A0) A J51). destruct s.
         assert (J52: derrec_height x2 = derrec_height x2). auto.
         assert (J53 : wkn_L (unBox_formula A) (XBoxed_list x ++ A :: XBoxed_list x0 ++ [Box A0], A0) (XBoxed_list (x ++ A :: x0) ++ [Box A0], A0)).
         repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. simpl. apply wkn_LI.
         pose (@GL4ip_wkn_L (derrec_height x2) (XBoxed_list x ++ A :: XBoxed_list x0 ++ [Box A0], A0) x2 J52
         (XBoxed_list (x ++ A :: x0) ++ [Box A0], A0) (unBox_formula A) J53). destruct s. exists x3. lia.
         destruct X2. pose (dlCons x2 DersNilF). apply GLR in X1.
         pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
         (ps:=[(XBoxed_list (x ++ A :: x0) ++ [Box A0], A0)]) (Γ0 ++ A :: Γ1, Box A0) X1 d0).
         exists d1. simpl. rewrite dersrec_height_nil ; auto. lia.
      -  assert (GLRRule [(XBoxed_list (x ++ x0) ++ [Box A0], A0)] (Γ0 ++ A :: Γ1, Box A0)).
         apply GLRRule_I ; auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_extra ; auto.
         pose (dlCons x1 DersNilF). apply GLR in X1.
         pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
         (ps:=[(XBoxed_list (x ++ x0) ++ [Box A0], A0)]) (Γ0 ++ A :: Γ1, Box A0) X1 d0).
         exists d1. simpl. rewrite dersrec_height_nil ; auto. lia. }
    assert (existsT2 (D1 : derrec GL4ip_rules (fun _ : Seq => False) (Γ0 ++ B :: Γ1, Box A0)),
    (derrec_height D1 <= S (dersrec_height d))).
    { destruct (dec_is_boxedT B).
       -  assert (GLRRule [(XBoxed_list (x ++ B :: x0) ++ [Box A0], A0)]
         (Γ0 ++ B :: Γ1, Box A0)). apply GLRRule_I ; auto.
         intro. intros. apply in_app_or in H. destruct H. apply H1. apply in_or_app ; auto.
         inversion H. subst. destruct i. subst. exists x2. auto. apply H1.
         apply in_or_app ; auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_cons ; auto.
         assert (existsT2 (D2 : derrec GL4ip_rules (fun _ : Seq => False) (XBoxed_list (x ++ B :: x0) ++ [Box A0], A0)),
         (derrec_height D2 <= derrec_height x1)).
         assert (J50: derrec_height x1 = derrec_height x1). auto.
         assert (J51 : wkn_L B (XBoxed_list (x ++ x0) ++ [Box A0], A0) (XBoxed_list x ++ B :: XBoxed_list x0 ++ [Box A0], A0)).
         repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. apply wkn_LI.
         pose (@GL4ip_wkn_L (derrec_height x1) (XBoxed_list (x ++ x0) ++ [Box A0], A0) x1 J50
         (XBoxed_list x  ++ B :: XBoxed_list x0 ++ [Box A0], A0) B J51). destruct s.
         assert (J52: derrec_height x2 = derrec_height x2). auto.
         assert (J53 : wkn_L (unBox_formula B) (XBoxed_list x ++ B :: XBoxed_list x0 ++ [Box A0], A0) (XBoxed_list (x ++ B :: x0) ++ [Box A0], A0)).
         repeat rewrite XBox_app_distrib. repeat rewrite <- app_assoc. simpl. apply wkn_LI.
         pose (@GL4ip_wkn_L (derrec_height x2) (XBoxed_list x ++ B :: XBoxed_list x0 ++ [Box A0], A0) x2 J52
         (XBoxed_list (x ++ B :: x0) ++ [Box A0], A0) (unBox_formula B) J53). destruct s. exists x3. lia.
         destruct X3. pose (dlCons x2 DersNilF). apply GLR in X2.
         pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
         (ps:=[(XBoxed_list (x ++ B :: x0) ++ [Box A0], A0)]) (Γ0 ++ B :: Γ1, Box A0) X2 d0).
         exists d1. simpl. rewrite dersrec_height_nil ; auto. lia.
      -  assert (GLRRule [(XBoxed_list (x ++ x0) ++ [Box A0], A0)] (Γ0 ++ B :: Γ1, Box A0)).
         apply GLRRule_I ; auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_extra ; auto.
         pose (dlCons x1 DersNilF). apply GLR in X2.
         pose (derI (rules:=GL4ip_rules) (prems:=fun _ : Seq => False)
         (ps:=[(XBoxed_list (x ++ x0) ++ [Box A0], A0)]) (Γ0 ++ B :: Γ1, Box A0) X2 d0).
         exists d1. simpl. rewrite dersrec_height_nil ; auto. lia. }
    destruct X1. destruct X2. exists x2. exists x3. split ; lia.
Qed.

Theorem OrL_inv : forall concl prem1 prem2, (derrec GL4ip_rules (fun _ => False) concl) ->
                                      (OrLRule [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 (OrL_hpinv _  _ X J1). pose (s _ _ H). destruct s0. destruct s0. auto.
Qed.


Require Import ssreflect ssrfun seq ssrbool ssrnat fintype eqtype tuple.
Require Import Coq.Strings.String.
Require Import cast codec regex.
Require Import Setoid Morphisms RelationClasses.
Require Import FunctionalExtensionality.

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

(*======================================================================================
  Transformation to regular expressions
  ======================================================================================*)
Fixpoint codecToRegex t (c:Codec t) : Regex _ :=
match c with
| Any => RAny _
| Emp => REmp _
| Sym b => RSym b
| Void _ => RVoid _
| Cast _ _ f c => codecToRegex c
| Seq _ _ c d => rSeq (codecToRegex c) (codecToRegex d)
| Alt _ c d => rAlt (codecToRegex c) (codecToRegex d)
| Star _ c => RStar (codecToRegex c)
end.

Lemma starFreeCodec t (c: Codec t) : finiteCodec c -> starfree (codecToRegex c).
Proof. induction c => //=.
rewrite finiteCodecSeq. move => [C1 C2].
apply starfreerSeq; firstorder.
rewrite finiteCodecAlt. move => [C1 C2].
apply starfreerAlt; firstorder.
by rewrite /finiteCodec.
Qed.

Lemma CondToRegex t u (c: Codec t) (d: Codec u):
codecToRegex (Cond c d) =
  rAlt (rSeq (RSym false) (codecToRegex c)) (rSeq (RSym true) (codecToRegex d)).
Proof. done. Qed.

Lemma rinterpsCodec t (c: Codec t) :
  (forall l v, interp c l v -> rinterp (codecToRegex c) l) ->
  forall v l, interps (interp c) l v -> rinterp (RStar (codecToRegex c)) l.
Proof. move => H. induction v => l /=I.
+ by rewrite I rinterpRStar.
+ rewrite rinterpRStar. destruct I as [s [l1 [l2 [H1 [H2 H3]]]]]. subst.
  exists l1, l2. firstorder.
Qed.

(* Need to apply IH to strictly smaller list but not necessarily to the tail *)
(* Hence more complex formulation using bound on size *)
Lemma rinterpsCodecConvAux t (c: Codec t) :
  (forall l, rinterp (codecToRegex c) l -> exists v, interp c l v) ->
  forall n, forall l, size l <= n -> rinterp (RStar (codecToRegex c)) l ->
  exists v, interps (interp c) l v.
Proof. move => H. induction n.
+ move => l S I. exists nil. destruct l => //.
+ move => l S /=I.
  destruct l => //. by exists nil.
  rewrite /=ltnS in S.
  rewrite -> rinterpRStar in I.
  destruct I as [l1 [l2 [H1 [H2 H3]]]].
  destruct (H _ H2) as [v H0].
  specialize (IHn l2).
  subst. rewrite size_cat in S.
  have LE: size l2 <= n. apply: leq_trans S. by apply leq_addl.
  specialize (IHn LE H3).
  destruct IHn as [vs I].
  exists (v::vs).
  simpl.
  exists s, l1, l2. firstorder.
Qed.

Corollary rinterpsCodecConv t (c: Codec t) :
  (forall l, rinterp (codecToRegex c) l -> exists v, interp c l v) ->
  forall l, rinterp (RStar (codecToRegex c)) l ->
  exists v, interps (interp c) l v.
Proof.  move => H l I.
apply (@rinterpsCodecConvAux t c H (size l)) => //.
Qed.

Lemma rinterpCodec t (c: Codec t) : forall l, (exists v, interp c l v) <-> rinterp (codecToRegex c) l.
Proof. induction c => l.
(* Any *)
rewrite /= rinterpRAny.
split => [[b H] | [b H]]. subst. by exists b.
subst. by exists b.
(* Sym *)
rewrite /= rinterpRSym.
split => [[[] H] | H] //=.
(* Emp *)
rewrite /= rinterpREmp.
split => [[[] H] | H] //=.
(* Void *)
rewrite /= rinterpRVoid. firstorder.
(* Seq *)
rewrite /= rSeqDef rinterpRSeq. split => //=.
move => [[v1 v2] H].
destruct H as [l1 [l2 [H1 [H2 H3]]]]. exists l1, l2.
split => //.
split.
apply (proj1 (IHc1 _)). by exists v1.
apply (proj1 (IHc2 _)). by exists v2.
move => [l1 [l2 [H1 [H2 H3]]]].
have I1 := (proj2 (IHc1 _) H2).
have I2 := (proj2 (IHc2 _) H3).
destruct I1 as [v1 I1].
destruct I2 as [v2 I2].
exists (v1,v2). exists l1, l2.
intuition.
(* Dep *)
(* Alt *)
rewrite /= rAltDef rinterpRAlt.
split => //=.
move => [v H].
destruct H. left. firstorder.
right. firstorder.
move => H.
destruct H.
destruct (proj2 (IHc1 _) H) as [v' H']. exists v'. by left.
destruct (proj2 (IHc2 _) H) as [v' H']. exists v'. by right.
(* Star *)
split => //=.
+ move => [v H]. apply: rinterpsCodec H => l0 v0 I. apply IHc. firstorder.
+ apply: rinterpsCodecConv => l0 I. by apply IHc.
(* Cast *)
rewrite <- IHc. split => //.
move => [v H]. rewrite -> interpCast in H. destruct H as [w [H1 H2]]. subst. by exists w.
move => [w I1]. exists (c w). rewrite interpCast. by exists w.
Qed.

(* Syntactic notion of non-ambiguous *)
Fixpoint NonAmbiguous t (c: Codec t) :=
match c with
| Alt _ c d =>
  (NonOverlapping (codecToRegex c) (codecToRegex d) &&
   NonOverlapping (codecToRegex d) (codecToRegex c)) &&
  (NonAmbiguous c && NonAmbiguous d)
| Seq _ _ c d => NonAmbiguous c && NonAmbiguous d
| Cast _ _ _ c => NonAmbiguous c
| Star _ c => false
| _ => true
end.

Lemma NonAmbiguousFinite t (c: Codec t) : NonAmbiguous c -> finiteCodec c.
Proof. induction c => //=.
move/andP => [N1 N2]. rewrite finiteCodecSeq. split; [by apply IHc1 | by apply IHc2].
move/andP => [/andP[N1a N1b] /andP[N2a N2b]].
rewrite finiteCodecAlt. split; [by apply IHc1 | by apply IHc2].
Qed.

(* Non-trivial proof: if codec c is syntactically non-ambiguuous,
   then codec is deterministic and prefix-free *)
Lemma nonAmbiguousDet t (c: Codec t) : NonAmbiguous c -> dpfInterp c.
Proof. rewrite /dpfInterp. induction c => NA l e v w /=; autorewrite with interp; move =>Iv Iw.
(* Any *)
subst. simpl in Iw. by injection Iw => ->.
(* Sym *)
destruct v. destruct w.
subst. by injection Iw => ->.
(* Emp *)
destruct v. destruct w. subst.
firstorder.
(* Void *)
done.
(* Seq *)
simpl in NA.
destruct (andP NA) as [NA1 NA2].
specialize (IHc1 NA1). specialize (IHc2 NA2).
destruct v as [v1 v2]. destruct w as [w1 w2].
destruct Iv as [l1 [l2 [H3a [H3b H3c]]]].
destruct Iw as [l3 [l4 [H4a [H4b H4c]]]].
subst.
rewrite -catA in H4a. have AP := appeqpref H4a.
destruct AP.
+ destruct H as [e' [E1 E2]]. subst. simpl in *.
 destruct (IHc1 _ _ _ _ H4b H3b) as [H1 H2]. subst. simpl in *. rewrite cats0 in H3b.
 destruct (IHc2 _ _ _ _ H3c H4c) as [H3 H4]. by subst.
+ destruct H as [e' [E1 E2]]. subst. simpl in *.
  destruct (IHc1 _ _ _ _ H3b H4b) as [H1 H2]. subst. simpl in *. subst.
  destruct (IHc2 _ _ _ _ H3c H4c) as [H1 H2]. by subst.
(* Alt *)
simpl in NA. destruct (andP NA) as [NO NA12].
destruct (andP NO) as [NO1 NO2].
destruct (andP NA12) as [NA1 NA2].
specialize (IHc1 NA1). specialize (IHc2 NA2).
apply NonOverlappingSound in NO1. apply NonOverlappingSound in NO2.
rewrite /nonOverlapping in NO1, NO2.
destruct Iv.
+ destruct Iw.
  - by apply (IHc1 _ _ _ _ H H0).
  - contradiction (NO1 l e).
    * apply rinterpCodec. by exists v.
    * apply rinterpCodec. by exists w.
+ destruct Iw.
  - contradiction (NO2 l e).
    * apply rinterpCodec. by exists v.
    * apply rinterpCodec. by exists w.
  - by apply (IHc2 _ _ _ _ H H0).
apply starFreeCodec.
apply NonAmbiguousFinite => //.
apply starFreeCodec.
apply NonAmbiguousFinite => //.
apply starFreeCodec.
apply NonAmbiguousFinite => //.
apply starFreeCodec.
apply NonAmbiguousFinite => //.
(* Star *)
done.
(* Cast *)
destruct Iv as [v1 [E1 I1]].
destruct Iw as [v2 [E2 I2]].
simpl in NA. specialize (IHc NA).
specialize (IHc _ _ _ _ I1 I2). subst. destruct IHc as [H1 H2]. by subst.
Qed.

Lemma decSoundNo t (c: Codec t) :
  NonAmbiguous c ->
  forall l e x, dec c (l++e) = DecNo ->
  ~interp c l x.
Proof. induction c => NA l e x /=; autorewrite with interp => EQ I.
(* Any *)
by destruct l.
(* Sym *)
subst. simpl in EQ. by rewrite eq_refl in EQ.
(* Emp *)
done.
(* Void *)
done.
(* Seq *)
simpl in NA. destruct (andP NA) as [NA1 NA2].
destruct x as [x1 x2].
case E1: (dec c1 (l++e)) => [x l' |]; rewrite E1 in EQ => //.
(* First decode succeeds *)
- case E2: (dec c2 l') => [y l'' |]; rewrite E2 in EQ => //.
  (* Second decode fails *)
  destruct I as [l1 [l2 [E [I1 I2]]]]. simpl in I1, I2. subst. clear EQ.
  rewrite -catA in E1. destruct (decSound E1) as [e' [H1 H2]].
  have DET1 := nonAmbiguousDet NA1. rewrite /dpfInterp in DET1.
  have AP := appeqpref H1.
  destruct AP.
  - destruct H as [e0 [H3 H4]]. subst.
    destruct (DET1 _ _ _ _ H2 I1) as [D1 D2]. subst.
    simpl in E2. by specialize (IHc2 NA2 _ _ x2 E2).
  - destruct H as [e0 [H3 H4]]. subst.
    destruct (DET1 _ _ _ _ I1 H2) as [D1 D2]. subst. simpl in H4. subst.
    by specialize (IHc2 NA2 _ _ x2 E2).
(* First decode fails *)
destruct I as [l1 [l2 [E [I1 I2]]]]. simpl in I1, I2. subst.
rewrite -catA in E1.
by specialize (IHc1 NA1 _ _ x1 E1).
(* Alt *)
simpl in NA. destruct (andP NA) as [NO NA12].
destruct (andP NA12) as [NA1 NA2]. specialize (IHc1 NA1). specialize (IHc2 NA2).
case E1: (dec c1 (l++e)) => [x' l' |]; rewrite E1 in EQ => //.
destruct I.
by specialize (IHc1 _ _ _ E1 H).
by specialize (IHc2 _ _ _ EQ H).
(* Star *)
done.
(* Cast *)
case E1: (dec c0 (l++e)) => [x' l' |]; rewrite E1 in EQ => //.
destruct I as [w [E2 E3]]. subst.
by specialize (IHc NA _ _ _ E1 E3).
Qed.

Lemma CodecComplete : forall t (c: Codec t),
  NonAmbiguous c ->
  forall l x, interp c l x ->
  forall e, dec c (l ++ e) = DecYes x e.
Proof.
induction c => NA l x /=; autorewrite with interp => I e.
(* Any *)
by subst.
(* Sym *)
destruct x. autorewrite with interp in I.
subst. simpl. by rewrite eq_refl.
(* Emp *)
destruct x. autorewrite with interp in I.
by subst.
(* Void *)
done.
(* Seq *)
simpl in NA. destruct (andP NA) as [NA1 NA2].
destruct x as [x1 x2].
destruct I as [l1 [l2 [E [I1 I2]]]]. simpl in I1, I2.
specialize (IHc1 NA1 _ _ I1).
specialize (IHc2 NA2 _ _ I2).
by rewrite E -catA IHc1 IHc2.
(* Alt *)
simpl in NA. destruct (andP NA) as [NO NA12].
destruct (andP NA12) as [NA1 NA2].
destruct (andP NO) as [NO1 NO2].
apply NonOverlappingSound in NO1. rewrite /nonOverlapping in NO1.
apply NonOverlappingSound in NO2. rewrite /nonOverlapping in NO2.
(* OK, we have that [[c2]] contains (l,x) *)
case E: (dec c1 (l++e)) => [r l' |].

destruct I.
by rewrite (IHc1 NA1 _ _ H) in E.

destruct (decSound E) as [l1 [E' I]].
clear E.
have AE := appeqpref E'.
destruct AE.
destruct H0 as [e' [H1 H2]]. subst. clear E'.

contradiction (NO1 l1 e'). apply rinterpCodec. by exists r.
apply rinterpCodec. by exists x.
destruct H0 as [e' [H1 H2]]. subst. clear E'.
contradiction (NO2 l e').
apply rinterpCodec. by exists x.
apply rinterpCodec. by exists r.

destruct I.
by have S := decSoundNo NA1 E H.
apply IHc2 => //.
apply starFreeCodec.
apply NonAmbiguousFinite => //.
apply starFreeCodec.
apply NonAmbiguousFinite => //.
apply starFreeCodec.
apply NonAmbiguousFinite => //.
apply starFreeCodec.
apply NonAmbiguousFinite => //.
(* Star *)
done.
(* Cast *)
destruct I as [v [E I]].
specialize (IHc NA _ _ I). rewrite IHc. by subst.
Qed.

Corollary CodecRoundtrip t (c: Codec t) l e x:
  NonAmbiguous c ->
  enc c x = Some l ->
  dec c (l ++ e) = DecYes x e.
Proof. move => NA ENC. apply CodecComplete => //. by apply encSound. Qed.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import AbsAccessor.Spec.
Require Import RVIC2.Spec.

Local Open Scope Z_scope.

Section SpecLow.

  Definition rvic_set_masked_spec0 (rvic: Pointer) (intid: Z64) (adt: RData) : option RData :=
    match rvic, intid with
    | (_rvic_base, _rvic_ofst), VZ64 _intid =>
      when'' _bits_base, _bits_ofst == get_rvic_mask_bits_spec (_rvic_base, _rvic_ofst) adt;
      rely is_int _bits_ofst;
      rely is_int64 _intid;
      when adt == rvic_set_flag_spec (VZ64 _intid) (_bits_base, _bits_ofst) adt;
      Some adt
     end
    .

End SpecLow.


(* ************************************************************************** *)
(*                                                                            *)
(* Verified Flash Translation Layer                                           *)
(*                                                                            *)
(*                                                                            *)
(*   Author: Yu Guo <aciclo@gmail.com>                                        *)
(*                                        Computer Science Department, USTC   *)
(*                                                                            *)
(*                                                                            *)
(*                                                                            *)
(*                                                                            *)
(* ************************************************************************** *)

(* ************* ************************************* *****)

Require Import ListEx.
Require Import Monad.
Require Import Data.

Require Import Params.
Require Import Nand.
Require Import Bast0.

(*  -------------------------------------------------------------

  Predicates for block no.

*)

Definition valid_logical_block_no (lbn: block_no) := bvalid_logical_block_no lbn = true.

Definition valid_block_no (pbn: block_no) := bvalid_block_no pbn = true.

Definition valid_page_off (off: page_off) := bvalid_page_off off = true.

Lemma valid_page_off_dec :
  forall off,
    valid_page_off off \/ ~ valid_page_off off.
Proof.
  intros.
  unfold valid_page_off.
  destruct (bvalid_page_off off).
  left; trivial.
  right.
  auto.
Qed.

(*  -------------------------------------------------------------

  Predicates for block mapping table

*)

Definition pbn_in_bmt_data (bmt: block_mapping_table)
           (lbn: block_no) (pbn: block_no) : Prop :=
  exists x, bmt_get bmt lbn = Some (Some pbn, x).

Definition pbn_in_bmt_log (bmt: block_mapping_table)
           (lbn: block_no) (pbn: block_no) : Prop :=
  exists x, bmt_get bmt lbn = Some (x, Some pbn).

Definition pbn_in_bmt_lbn (bmt: block_mapping_table)
           (lbn: block_no) (pbn: block_no) : Prop :=
  pbn_in_bmt_data bmt lbn pbn \/ pbn_in_bmt_log bmt lbn pbn .

Definition pbn_in_bmt (bmt: block_mapping_table) (pbn: block_no) : Prop:=
  exists lbn, pbn_in_bmt_lbn bmt lbn pbn.

Definition pbn_in_bmr (pbn: block_no) (bmr: prod (option block_no) (option block_no)) : Prop :=
  match bmr with
    | (Some pbn', None) => pbn = pbn'
    | (None, Some pbn') => pbn = pbn'
    | (Some pbn', Some pbn'') => pbn = pbn' \/ pbn = pbn''
    | (None, None) => False
  end.

Definition pbn_not_in_bmr (pbn: block_no) (bmr: bmt_record) : Prop :=
  match bmr with
    | (Some pbn', Some pbn'') => pbn <> pbn' /\ pbn <> pbn''
    | (Some pbn', None) => pbn <> pbn'
    | (None, Some pbn') => pbn <> pbn'
    | (None, None) => True
  end.

Definition pbn_not_in_bmt (bmt: block_mapping_table) (pbn: block_no) : Prop:=
  ~ pbn_in_bmt bmt pbn.

(*  -------------------------------------------------------------

  Predicates for page mapping table

*)

Definition pmt_domain_is_complete (pmt: page_mapping_table) : Prop :=
  pmt_len pmt = PAGES_PER_BLOCK.

Definition pmt_page_state (pmt: page_mapping_table) (b: block) : Prop :=
  forall loc,
     valid_page_off loc
     -> (pmt_get pmt loc = Some (pmte_empty)
         -> exists p, block_get_page b loc = Some p
                  /\ page_state p = ps_free)
        /\ (forall off,
              pmt_get pmt loc = Some (pmte_log off)
              -> exists p, block_get_page b loc = Some p
                           /\ page_state p = ps_programmed).

Definition pmt_shape (pmt: page_mapping_table) (np: page_off) : Prop :=
  forall loc,
    valid_page_off loc
    -> (blt_nat loc np = true
        -> exists off, pmt_get pmt loc = Some (pmte_log off))
       /\ (blt_nat loc np = false
           -> pmt_get pmt loc = Some pmte_empty).

(*  -------------------------------------------------------------

  Predicates for "block info"

*)

Definition block_coherent_log (bi: block_info) (b: block): Prop :=
  exists pmt lbn,
    bi_state bi = bs_log lbn pmt
    /\ bi_used_pages bi = next_page b
    /\ block_state b = bs_programmed
    /\ pmt_domain_is_complete pmt
    /\ pmt_page_state pmt b
    /\ pmt_shape pmt (next_page b).

Definition block_coherent_data (bi: block_info) (b: block) : Prop :=
  exists lbn,
    bi_state bi = bs_data lbn
    /\ bi_used_pages bi = next_page b
    /\ block_state b = bs_programmed
    /\ next_page b = PAGES_PER_BLOCK
    /\ (forall loc,
          valid_page_off loc
          -> exists p, block_get_page b loc = Some p
                       /\ page_state p = ps_programmed).

Definition block_coherent_erased (bi: block_info) (b: block) : Prop :=
  bi_state bi = bs_erased
  /\ bi_used_pages bi = next_page b
  /\ block_state b = bs_free
  /\ next_page b = 0
  /\ (forall loc,
        valid_page_off loc
        -> exists p, block_get_page b loc = Some p
                     /\ page_state p = ps_free).

Definition block_coherent_data_partial (loc: page_off) (b: block): Prop :=
  next_page b = loc
  /\ block_state b = bs_programmed
  /\ (forall off,
        valid_page_off off
        -> (blt_nat off loc = true
            -> exists p, block_get_page b off = Some p
                         /\ page_state p = ps_programmed)
           /\ (blt_nat off loc = false
               -> exists p, block_get_page b off = Some p
                            /\ page_state p = ps_free)).