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 _ : (list (MPropF V)) *(MPropF V)  => False) []).
apply dersrec_nil.
(* Setting up the strong induction on the height. *)
pose (strong_inductionT (fun (x:nat) => forall (concl : (list (MPropF V)) *(MPropF V))
  (D0 : derrec GL4ip_rules (fun _ : (list (MPropF V)) *(MPropF V) => False) concl),
x = derrec_height D0 ->
((forall prem, ((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 _ : (list (MPropF V)) *(MPropF V) => False)
    (ps:=[]) (x ++ # P :: x0, # P) H1 DersNilF). exists d0.
    simpl. rewrite dersrec_height_nil. lia. reflexivity.
  (* BotL *)
  * inversion H. subst. assert (InT (Bot V) (Γ0 ++ And A B :: Γ1)).
    rewrite <- H2. apply InT_or_app. right. apply InT_eq. assert (InT (Bot V) (Γ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 V :: x0, C)). apply BotLRule_I. apply BotL in H1.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
    (ps:=[]) (x ++ Bot V :: 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 V :: Γ1, A)).
    apply BotLRule_I. apply BotL in H0.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
    (ps:=[]) (Γ0 ++ Bot V :: Γ1, A) H0 DersNilF). exists d0.
    assert (BotLRule [] (Γ0 ++ Bot V :: Γ1, B)).
    apply BotLRule_I. apply BotL in H1.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
    (ps:=[]) (Γ0 ++ Bot V :: Γ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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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 _ : (list (MPropF V)) *(MPropF V) => 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.


From iris.algebra Require Import cmra view auth agree csum list excl gmap.
From iris.algebra.lib Require Import excl_auth gmap_view.
From iris.base_logic Require Import bi derived.
From iris.prelude Require Import options.

(** Internalized properties of our CMRA constructions. *)
Local Coercion uPred_holds : uPred >-> Funclass.

Section upred.
Context {M : ucmra}.

(* Force implicit argument M *)
Notation "P ⊢ Q" := (bi_entails (PROP:=uPredI M) P%I Q%I).
Notation "P ⊣⊢ Q" := (equiv (A:=uPredI M) P%I Q%I).

Lemma prod_validI {A B : cmra} (x : A * B) : ✓ x ⊣⊢ ✓ x.1 ∧ ✓ x.2.
Proof. by uPred.unseal. Qed.
Lemma option_validI {A : cmra} (mx : option A) :
  ✓ mx ⊣⊢ match mx with Some x => ✓ x | None => True : uPred M end.
Proof. uPred.unseal. by destruct mx. Qed.
Lemma discrete_fun_validI {A} {B : A → ucmra} (g : discrete_fun B) :
  ✓ g ⊣⊢ ∀ i, ✓ g i.
Proof. by uPred.unseal. Qed.

Lemma frac_validI (q : Qp) : ✓ q ⊣⊢ ⌜q ≤ 1⌝%Qp.
Proof. rewrite uPred.discrete_valid frac_valid //. Qed.

Section gmap_ofe.
  Context `{Countable K} {A : ofe}.
  Implicit Types m : gmap K A.
  Implicit Types i : K.

  Lemma gmap_equivI m1 m2 : m1 ≡ m2 ⊣⊢ ∀ i, m1 !! i ≡ m2 !! i.
  Proof. by uPred.unseal. Qed.
End gmap_ofe.

Section gmap_cmra.
  Context `{Countable K} {A : cmra}.
  Implicit Types m : gmap K A.

  Lemma gmap_validI m : ✓ m ⊣⊢ ∀ i, ✓ (m !! i).
  Proof. by uPred.unseal. Qed.
  Lemma singleton_validI i x : ✓ ({[ i := x ]} : gmap K A) ⊣⊢ ✓ x.
  Proof.
    rewrite gmap_validI. apply: anti_symm.
    - rewrite (bi.forall_elim i) lookup_singleton option_validI. done.
    - apply bi.forall_intro=>j. destruct (decide (i = j)) as [<-|Hne].
      + rewrite lookup_singleton option_validI. done.
      + rewrite lookup_singleton_ne // option_validI.
        apply bi.True_intro.
  Qed.
End gmap_cmra.

Section list_ofe.
  Context {A : ofe}.
  Implicit Types l : list A.

  Lemma list_equivI l1 l2 : l1 ≡ l2 ⊣⊢ ∀ i, l1 !! i ≡ l2 !! i.
  Proof. uPred.unseal; constructor=> n x ?. apply list_dist_lookup. Qed.
End list_ofe.

Section list_cmra.
  Context {A : ucmra}.
  Implicit Types l : list A.

  Lemma list_validI l : ✓ l ⊣⊢ ∀ i, ✓ (l !! i).
  Proof. uPred.unseal; constructor=> n x ?. apply list_lookup_validN. Qed.
End list_cmra.

Section excl.
  Context {A : ofe}.
  Implicit Types a b : A.
  Implicit Types x y : excl A.

  Lemma excl_equivI x y :
    x ≡ y ⊣⊢ match x, y with
                        | Excl a, Excl b => a ≡ b
                        | ExclBot, ExclBot => True
                        | _, _ => False
                        end.
  Proof.
    uPred.unseal. do 2 split.
    - by destruct 1.
    - by destruct x, y; try constructor.
  Qed.
  Lemma excl_validI x :
    ✓ x ⊣⊢ if x is ExclBot then False else True.
  Proof. uPred.unseal. by destruct x. Qed.
End excl.

Section agree.
  Context {A : ofe}.
  Implicit Types a b : A.
  Implicit Types x y : agree A.

  Lemma agree_equivI a b : to_agree a ≡ to_agree b ⊣⊢ (a ≡ b).
  Proof.
    uPred.unseal. do 2 split.
    - intros Hx. exact: (inj to_agree).
    - intros Hx. exact: to_agree_ne.
  Qed.
  Lemma agree_validI x y : ✓ (x ⋅ y) ⊢ x ≡ y.
  Proof. uPred.unseal; split=> r n _ ?; by apply: agree_op_invN. Qed.

  Lemma to_agree_uninjI x : ✓ x ⊢ ∃ a, to_agree a ≡ x.
  Proof. uPred.unseal. split=> n y _. exact: to_agree_uninjN. Qed.
End agree.

Section csum_ofe.
  Context {A B : ofe}.
  Implicit Types a : A.
  Implicit Types b : B.

  Lemma csum_equivI (x y : csum A B) :
    x ≡ y ⊣⊢ match x, y with
                        | Cinl a, Cinl a' => a ≡ a'
                        | Cinr b, Cinr b' => b ≡ b'
                        | CsumBot, CsumBot => True
                        | _, _ => False
                        end.
  Proof.
    uPred.unseal; do 2 split; first by destruct 1.
      by destruct x, y; try destruct 1; try constructor.
  Qed.
End csum_ofe.

Section csum_cmra.
  Context {A B : cmra}.
  Implicit Types a : A.
  Implicit Types b : B.

  Lemma csum_validI (x : csum A B) :
    ✓ x ⊣⊢ match x with
                      | Cinl a => ✓ a
                      | Cinr b => ✓ b
                      | CsumBot => False
                      end.
  Proof. uPred.unseal. by destruct x. Qed.
End csum_cmra.

Section view.
  Context {A B} (rel : view_rel A B).
  Implicit Types a : A.
  Implicit Types ag : option (frac * agree A).
  Implicit Types b : B.
  Implicit Types x y : view rel.

  Lemma view_both_dfrac_validI_1 (relI : uPred M) dq a b :
    (∀ n (x : M), rel n a b → relI n x) →
    ✓ (●V{dq} a ⋅ ◯V b : view rel) ⊢ ⌜✓dq⌝ ∧ relI.
  Proof.
    intros Hrel. uPred.unseal. split=> n x _ /=.
    rewrite /uPred_holds /= view_both_dfrac_validN. by move=> [? /Hrel].
  Qed.
  Lemma view_both_dfrac_validI_2 (relI : uPred M) dq a b :
    (∀ n (x : M), relI n x → rel n a b) →
    ⌜✓dq⌝%Qp ∧ relI ⊢ ✓ (●V{dq} a ⋅ ◯V b : view rel).
  Proof.
    intros Hrel. uPred.unseal. split=> n x _ /=.
    rewrite /uPred_holds /= view_both_dfrac_validN. by move=> [? /Hrel].
  Qed.
  Lemma view_both_dfrac_validI (relI : uPred M) dq a b :
    (∀ n (x : M), rel n a b ↔ relI n x) →
    ✓ (●V{dq} a ⋅ ◯V b : view rel) ⊣⊢ ⌜✓dq⌝ ∧ relI.
  Proof.
    intros. apply (anti_symm _);
      [apply view_both_dfrac_validI_1|apply view_both_dfrac_validI_2]; naive_solver.
  Qed.

  Lemma view_both_validI_1 (relI : uPred M) a b :
    (∀ n (x : M), rel n a b → relI n x) →
    ✓ (●V a ⋅ ◯V b : view rel) ⊢ relI.
  Proof. intros. by rewrite view_both_dfrac_validI_1 // bi.and_elim_r. Qed.
  Lemma view_both_validI_2 (relI : uPred M) a b :
    (∀ n (x : M), relI n x → rel n a b) →
    relI ⊢ ✓ (●V a ⋅ ◯V b : view rel).
  Proof.
    intros. rewrite -view_both_dfrac_validI_2 //.
    apply bi.and_intro; [|done]. by apply bi.pure_intro.
  Qed.
  Lemma view_both_validI (relI : uPred M) a b :
    (∀ n (x : M), rel n a b ↔ relI n x) →
    ✓ (●V a ⋅ ◯V b : view rel) ⊣⊢ relI.
  Proof.
    intros. apply (anti_symm _);
      [apply view_both_validI_1|apply view_both_validI_2]; naive_solver.
  Qed.

  Lemma view_auth_dfrac_validI (relI : uPred M) dq a :
    (∀ n (x : M), relI n x ↔ rel n a ε) →
    ✓ (●V{dq} a : view rel) ⊣⊢ ⌜✓dq⌝ ∧ relI.
  Proof.
    intros. rewrite -(right_id ε op (●V{dq} a)). by apply view_both_dfrac_validI.
  Qed.
  Lemma view_auth_validI (relI : uPred M) a :
    (∀ n (x : M), relI n x ↔ rel n a ε) →
    ✓ (●V a : view rel) ⊣⊢ relI.
  Proof. intros. rewrite -(right_id ε op (●V a)). by apply view_both_validI. Qed.

  Lemma view_frag_validI (relI : uPred M) b :
    (∀ n (x : M), relI n x ↔ ∃ a, rel n a b) →
    ✓ (◯V b : view rel) ⊣⊢ relI.
  Proof. uPred.unseal=> Hrel. split=> n x _. by rewrite Hrel. Qed.
End view.

Section auth.
  Context {A : ucmra}.
  Implicit Types a b : A.
  Implicit Types x y : auth A.

  Lemma auth_auth_dfrac_validI dq a : ✓ (●{dq} a) ⊣⊢ ⌜✓dq⌝ ∧ ✓ a.
  Proof.
    apply view_auth_dfrac_validI=> n. uPred.unseal; split; [|by intros [??]].
    split; [|done]. apply ucmra_unit_leastN.
  Qed.
  Lemma auth_auth_validI a : ✓ (● a) ⊣⊢ ✓ a.
  Proof.
    by rewrite auth_auth_dfrac_validI bi.pure_True // left_id.
  Qed.

  Lemma auth_frag_validI a : ✓ (◯ a) ⊣⊢ ✓ a.
  Proof.
    apply view_frag_validI=> n x.
    rewrite auth_view_rel_exists. by uPred.unseal.
  Qed.

  Lemma auth_both_dfrac_validI dq a b :
    ✓ (●{dq} a ⋅ ◯ b) ⊣⊢ ⌜✓dq⌝ ∧ (∃ c, a ≡ b ⋅ c) ∧ ✓ a.
  Proof. apply view_both_dfrac_validI=> n. by uPred.unseal. Qed.
  Lemma auth_both_validI a b :
    ✓ (● a ⋅ ◯ b) ⊣⊢ (∃ c, a ≡ b ⋅ c) ∧ ✓ a.
  Proof.
    by rewrite auth_both_dfrac_validI bi.pure_True // left_id.
  Qed.

End auth.

Section excl_auth.
  Context {A : ofe}.
  Implicit Types a b : A.

  Lemma excl_auth_agreeI a b : ✓ (●E a ⋅ ◯E b) ⊢ (a ≡ b).
  Proof.
    rewrite auth_both_validI bi.and_elim_l.
    apply bi.exist_elim=> -[[c|]|];
      by rewrite option_equivI /= excl_equivI //= bi.False_elim.
  Qed.
End excl_auth.

Section gmap_view.
  Context {K : Type} `{Countable K} {V : ofe}.
  Implicit Types (m : gmap K V) (k : K) (dq : dfrac) (v : V).

  Lemma gmap_view_both_validI m k dq v :
    ✓ (gmap_view_auth 1 m ⋅ gmap_view_frag k dq v) ⊢
    ✓ dq ∧ m !! k ≡ Some v.
  Proof.
    rewrite /gmap_view_auth /gmap_view_frag. apply view_both_validI_1.
    intros n a. uPred.unseal. apply gmap_view.gmap_view_rel_lookup.
  Qed.

  Lemma gmap_view_frag_op_validI k dq1 dq2 v1 v2 :
    ✓ (gmap_view_frag k dq1 v1 ⋅ gmap_view_frag k dq2 v2) ⊣⊢
    ✓ (dq1 ⋅ dq2) ∧ v1 ≡ v2.
  Proof.
    rewrite /gmap_view_frag -view_frag_op. apply view_frag_validI=> n x.
    rewrite gmap_view.gmap_view_rel_exists singleton_op singleton_validN.
    rewrite -pair_op pair_validN to_agree_op_validN. by uPred.unseal.
  Qed.

End gmap_view.

End upred.


(* Celsius project *)
(* Clément Blaudeau - Lamp@EPFL & Inria 2020-2022 *)
(* ------------------------------------------------------------------------ *)
(* This file defines the scopability property. Given two stores [σ] and [σ'], and two sets of
locations [L] and [L'], the pair [(σ, L)] "scopes" [(σ',L')] if all locations reachable from [L'] in
[σ'] were already reachable from [L] in [σ]. Wellformedness conditions are needed at some point for
reachability lemmas. *)
From Celsius Require Export  Wellformedness.
Implicit Type (σ: Store) (ρ ω: Env) (l: Loc) (L: LocSet) (el: list Expr).

(* ------------------------------------------------------------------------ *)
(** ** Definition *)

Definition scopability σ σ' L L' :=
  L ⪽ σ ->
  L' ⪽ σ' ->
  (forall (l:Loc), l < dom σ -> (σ' ⊨ L' ⇝ l) -> σ ⊨ L ⇝ l).

Notation "( σ1 , L1 )  ⋖  ( σ2 , L2 )" := (scopability σ1 σ2 L1 L2) (at level 0).
Notation "( σ1 ,  { l } )  ⋖  ( σ2 , L2 )" := (scopability σ1 σ2 {l} L2) (at level 0).
Notation "( σ1 , L1 )  ⋖  ( σ2 ,  { l } )" := (scopability σ1 σ2 L1 {l}) (at level 0).
Notation "( σ1 ,  { l1 } )  ⋖  ( σ2 ,  { l2 } )" := (scopability σ1 σ2 {l1} {l2}) (at level 0).

Local Hint Unfold reachability_set scopability : scp.

(* ------------------------------------------------------------------------ *)
(** ** Basic results *)

Lemma scp_refl :
  forall σ L, (σ, L) ⋖ (σ, L).
Proof.
  eauto with scp.
Qed.
Global Hint Resolve scp_refl: scp.

Lemma scp_refl2 :
  forall σ L1 L2, L2 ⊆ L1 -> (σ, L1) ⋖ (σ, L2).
Proof.
  unfold scopability. steps; rch_set.
  exists l0; steps; eapply H => //.
Qed.

Lemma scp_subset :
  forall σ1 σ2 L L1 L2,
    (σ1, L1) ⋖ (σ2, L2) ->
    L ⊆ L2 ->
    L2 ⪽ σ2  ->
    (σ1, L1) ⋖ (σ2, L).
Proof with (eauto with scp lia).
  unfold scopability; steps ...
  apply H ...
  rch_set.
  exists l0; steps ...
Qed.

Lemma scp_union :
  forall σ1 σ2 L L1 L2,
    (σ1, L)  ⋖ (σ2, L1) ->
    (σ1, L)  ⋖ (σ2, L2) ->
    (σ1, L)  ⋖ (σ2, L1∪L2).
Proof with (eauto with wf rch).
  unfold scopability; intros.
  inversion H4; steps...
  inversion H6; steps...
  - apply H5...
    exists x...
  - apply H...
    exists x...
Qed.
Global Hint Resolve scp_union: scp.

Lemma scp_union_introl :
  forall σ1 σ2 L L1 L2,
    (L1 ∪ L2) ⪽ σ2 ->
    (σ1, L) ⋖ (σ2, L1∪L2) ->
    (σ1, L) ⋖ (σ2, L1).
Proof with (eauto with wf rch).
  unfold scopability; intros.
  inversion H4; steps...
Qed.

Lemma scp_union_intror :
  forall σ1 σ2 L L1 L2,
    (L1 ∪ L2) ⪽ σ2 ->
    (σ1, L) ⋖ (σ2, L1∪L2) ->
    (σ1, L) ⋖ (σ2, L2).
Proof with (eauto with wf rch).
  unfold scopability; intros.
  inversion H4; steps...
Qed.

Lemma scp_trans:
  forall σ1 σ2 σ3 L1 L2 L3,
    dom σ1 <= dom σ2 ->
    L2 ⪽ σ2 ->
    (σ1, L1) ⋖ (σ2, L2) ->
    (σ2, L2) ⋖ (σ3, L3) ->
    (σ1, L1) ⋖ (σ3, L3).
Proof with (eauto with scp lia).
  autounfold with notations scp. steps...
Qed.
Global Hint Resolve scp_trans: scp.

(* ------------------------------------------------------------------------ *)
(** ** Scopability and reachability *)
(* Here we link scopability and reachability. We also add two technical results about reachability
with wellformed stores *)

Lemma scp_reachability:
  forall σ l1 l2,
    σ ⊨ l1 ⇝ l2 ->
    (σ, {l1}) ⋖ (σ, {l2}).
Proof with (eauto with rch).
  unfold scopability; intros; rch_set...
Qed.
Global Hint Resolve scp_reachability: scp.

Lemma rch_add_empty: forall σ C l1 l2,
    wf σ ->
    (σ ++ [(C, [])]) ⊨ l1 ⇝ l2 ->
    (l1 = dom σ /\ l2 = dom σ) \/ ( σ ⊨ l1 ⇝ l2).
Proof with (updates; eauto with wf rch lia).
  intros.
  remember (σ++[(C,[])]) as σ0.
  induction H0; steps ...
  - assert (l = dom σ \/ l < dom σ) as [|] by lia...
  - eapply getObj_last_empty in H1; steps ...
    right...
Qed.

Lemma rch_add_empty_set: forall σ C L l,
    wf σ ->
    (σ++[(C, [])]) ⊨ L ⇝ l ->
    (σ ⊨ L ⇝ l) \/ l = length σ.
Proof.
  intros.
  inversion H0 as [l1 [Hl1 Hrch]].
  eapply rch_add_empty in Hrch; steps.
  left. exists l1; eauto.
Qed.

(* ------------------------------------------------------------------------ *)
(** ** Scopability and assignments *)
(* Adding new fields or new objects has an impact on the reachable sets. The conditions to preserve
scopability are thus a bit subtle. *)

(** First, we consider updating an existing field. The key reasonning technique is to do a case
analysis on whether or not the modified entry is in the reachability path. *)
Lemma scp_assign:
  forall σ L l v f C ω,
    getObj σ l = Some (C, ω) ->
    (σ, L ∪ {v}) ⋖ ([l ↦ (C, [f ↦ v] (ω))]σ, L ∪ {v}).

Proof with (eauto with scp rch).
  unfold scopability; intros.
  destruct H3 as [l1 [H__l1 H__rch]].
  lets [? | [H__rch1 H__rch2 ]]: rch_asgn H__rch; eauto;
    eexists...
Qed.

(* Then, we consider adding a new field to an existing object *)
Lemma scp_assign_new:
  forall σ σ' x v L C,
    wf σ ->
    assign_new C x v σ = Some σ' ->
    (σ, L ∪ {v}) ⋖ (σ', L ∪ {v}).
Proof with (eauto with scp rch).
  unfold assign_new; intros. steps; [| eapply scp_assign; eauto].
  rewrite_anywhere PeanoNat.Nat.eqb_eq. subst.
  unfold scopability; intros.
  destruct H3 as [l1 [H__l1 H__rch]].
  lets [? | [H__rch1 H__rch2 ]]: rch_asgn_new H__rch; eauto;
    eexists...
Qed.
Global Hint Resolve scp_assign_new: scp.

(* ------------------------------------------------------------------------ *)
(** ** Scopability theorem *)
(* The key of the proof is to generalize the induction hypothesis to a superset of locations L*)

Lemma subset_union_l: forall (A B C: LocSet),
        A ⊆ B -> A ⊆ (B ∪ C).
Proof.
  intros;
    intros l ?;
      eauto with ss.
Qed.
Local Hint Resolve subset_union_l: ss.

Lemma subset_union_r: forall (A B C: LocSet),
        A ⊆ C -> A ⊆ (B ∪ C).
Proof.
  intros;
    intros l ?;
      eauto with ss.
Qed.
Local Hint Resolve subset_union_r: ss.

Ltac union_assoc :=
    repeat match goal with
    | H:context [(?A ∪ ?B) ∪ ?C] |- _ => rewrite Union_associative in H
    | H:_ |- context [(?A ∪ ?B) ∪ ?C] => rewrite Union_associative
    end.

Lemma union_subset : forall (A B C: LocSet),
        A ⊆ C -> B ⊆ C -> (A ∪ B) ⊆ C.
Proof.
  intros;
    intros l [ ];
    eauto with ss.
Qed.
Local Hint Resolve union_subset: ss.

Lemma subset_refl : forall A, A ⊆ A.
Proof.
  intros A l ?; done.
Qed.
Local Hint Resolve subset_refl: ss.

Theorem scp_theorem:

  (forall e σ ρ ψ v σ',
      ⟦e⟧p (σ, ρ, ψ) --> (v, σ') ->
      (codom ρ) ∪ {ψ} ⪽ σ -> wf σ ->
      forall L , L ⪽ σ -> (codom ρ ∪ {ψ}) ⊆ L -> (σ, L) ⋖ (σ', L ∪ {v})) /\

    (forall el σ ρ ψ vl σ',
         ⟦el⟧ (σ, ρ, ψ) --> (vl, σ') ->
         (codom ρ ∪ {ψ}) ⪽ σ ->
         wf σ ->
         (forall L, L ⪽ σ -> (codom ρ ∪ {ψ}) ⊆ L -> (σ, L) ⋖ (σ', L ∪ codom vl))) /\

    (forall C ψ x ρ σ σ',
        initP C ψ x ρ σ σ' ->
        wf σ ->
        (codom ρ ∪ {ψ}) ⪽ σ ->
        forall ω, getObj σ ψ = Some (C, ω) ->
             (forall L, L ⪽ σ -> (codom ρ ∪ {ψ}) ⊆ L -> (σ, L) ⋖ (σ', L))).

Proof with (rch_set; updates; eauto 3 with scp wf ss lia).

  apply evalP_multi_ind;
    unfold assign in * ; intros; eval_dom; eval_wf.

  - (* e = x *)
    apply scp_union...
    unfold scopability; steps ... ss.
    exists l; split; eauto using getVal_codom with ss.

  - (* e = this *)
    apply scp_union...
    unfold scopability; steps...
    exists ψ; split...

  - (* e = e.f *)
    intuition auto...
    lets: H5 L H2...
    unfold scopability; steps...
    apply H4...
    inverts H__ln...
    + exists l0...
    + exists v1; split... apply rch_trans with v...
      eauto with rch.

  - (* e = e0.m(l0) *)
    assert ((codom vl2 ∪ {v1}) ⪽ σ2); ss...
    assert (((L ∪ {v1}) ∪ codom vl2) ⪽ σ2); ss... apply ss_trans with σ...
    intuition auto; union_assoc.
    unfold scopability; intros.
    apply H9; eauto with ss.
    apply H10; eauto with ss lia.
    apply H11; eauto with ss lia.
    lets (l0 & H__in & ?): H14.
    exists l0; split; inverts H__in...
    eauto 6 using Union.

  - (* e = new C(l0) *)
    assert ((L ∪ {dom σ1}) ⪽ σ1 ++ [(C, [])]). { ss... apply ss_trans with σ1... }
    eapply scp_trans with σ1 (L ∪ codom vl__args)...
    eapply scp_trans with (σ1++[(C,[])]) (L ∪ codom vl__args ∪ {dom σ1})...
    + ss; updates; try lia; apply ss_trans with σ1...
    + intros ? ? l ? ?.
      apply rch_add_empty_set in H9 as [|]...
      lets: rch_dom2 H9.
      inverts H__ln; rch_set... exists l0...
    + intros ? ? l ? ?.
      eapply IH__init...
      * ss... apply ss_trans with σ1...
      * intros ? [ ]...
      * ss. apply ss_trans with σ1...
      * exists l0; split... inverts H__ln...

  - (* e = e0.f = e1; e2 *)
    apply scp_trans with σ1 (L∪{v1})...
    assert (((L ∪ {v1}) ∪ {v2}) ⪽ σ2). { ss... apply ss_trans with σ... }
    apply scp_trans with σ2 ((L∪{v1})∪{v2})... { apply IH__e2... }
    destruct (getObj σ2 v1) as [[C ω] |] eqn: H__obj...
    + assert ((((L ∪ {v1}) ∪ {v2}) ∪ {v3}) ⪽ σ3). { steps; ss; try apply ss_trans with σ... }
      apply scp_trans with σ3 (((L∪{v1})∪{v2})∪{v3})...
      assert ((((L ∪ {v1}) ∪ {v2}) ∪ {v3}) ⪽ σ3). { ss... apply ss_trans with σ... }
      * eapply scp_trans with ([v1 ↦ (C, [x ↦ v2] (ω))] (σ2)) ((L ∪ {v1}) ∪ {v2})...
        -- ss...  apply ss_trans with σ...
        -- apply scp_assign...
        -- apply IH__e'... ss... apply ss_trans with σ...
      * apply scp_refl2... intros ? [ ]; eauto using Union.
    + assert ((((L ∪ {v1}) ∪ {v2}) ∪ {v3}) ⪽ σ3). { steps; ss; try apply ss_trans with σ... }
      apply scp_trans with σ3 (((L∪{v1})∪{v2})∪{v3})... { apply IH__e'... }
      apply scp_refl2... intros ? [ ]; eauto using Union.

  - (* el = nil *)
    apply scp_refl2. intros ? [ ] ... inverts H3.

  - (* el = e::el *)
    rewrite codom_cons.
    eapply scp_trans with σ1 (L ∪ {v1})...
    (* Union associativity would simplify things *)
    unfold scopability; intros.
    apply IH__el...
    exists l0; split...
    inverts H__ln... inverts H9...

  - (* init_nil *)
    done...

  - (* init_cons *)
    lets: scp_assign_new L H__assign ...
    lets: assign_new_dom H__assign.
    apply scp_trans with σ1 (L ∪ {v})...
    apply scp_trans with σ3 (L ∪ {v})... {
      ss... apply ss_trans with σ1...
    }
    apply scp_trans with σ2 (L ∪ {v})...
    + eapply ss_trans with σ1 ...
    + lets: init_field H__init...
      lets H__pM: pM_theorem_expr H__e.
      lets H__pM1: pM_assign_new H__assign.
      lets (?ω & H__obj1 & ?): H__pM I H1.
      lets (?ω & H__obj2 & ?): H__pM1 I H__obj1.
      eapply IH__init; try eapply ss_trans with σ1 ...
      eapply wf_assign_new...
    + eapply scp_subset...
      ss... eapply ss_trans with σ...
Qed.

Corollary scp_theorem_expr:
  forall e σ ρ ψ v σ',
    ⟦e⟧p (σ, ρ, ψ) --> (v, σ') ->
    (codom ρ) ∪ {ψ} ⪽ σ -> wf σ ->
    ((σ, (codom ρ) ∪ {ψ}) ⋖ (σ', {v})).
Proof.
  intros.
  lets (? & _ & _): scp_theorem.
  lets: H2 H (codom ρ ∪ {ψ}) H0; eauto.
  eval_dom; eval_wf.
  apply scp_trans with σ' ((codom ρ ∪ {ψ}) ∪ {v}); eauto 3 with scp.
  + apply H3; intros ?; eauto.
  + apply scp_refl2. intros ? []; eauto using Union.
Qed.

Corollary scp_theorem_init:
  forall C I x ρ σ σ',
    initP C I x ρ σ σ' ->
    wf σ ->
    (codom ρ ∪ {I}) ⪽ σ ->
    forall ω, getObj σ I = Some (C, ω) ->
         (σ, codom ρ ∪ {I}) ⋖ (σ', codom ρ ∪ {I}).
Proof.
  intros.
  lets (_ & _ & ?): scp_theorem.
  eapply H3; eauto.
  intros ? => //.
Qed.