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 AndImpL_hpinv : forall (k : nat) concl
        (D0 : derrec GL4ip_rules (fun _ => False) concl),
        k = (derrec_height D0) ->
          ((forall prem, ((AndImpLRule [prem] concl) ->
          existsT2 (D1 : derrec GL4ip_rules (fun _ => False) prem),
          (derrec_height D1 <= k)))).
Proof.
assert (DersNilF: dersrec GL4ip_rules (fun _ : (list (MPropF V)) *(MPropF V)  => False) []).
apply dersrec_nil.
(* Setting up the strong induction on the height. *)
pose (strong_inductionT (fun (x:nat) => forall (concl : (list (MPropF V)) *(MPropF V))
   (D0 : derrec GL4ip_rules (fun _ => False) concl),
        x = (derrec_height D0) ->
          ((forall prem, ((AndImpLRule [prem] concl) ->
          existsT2 (D1 : derrec GL4ip_rules (fun _ => False) prem),
          (derrec_height D1 <= x)))))).
apply s. intros n IH. clear s.
(* Now we do the actual proof-theoretical work. *)
intros s D0. remember D0 as D0'. destruct D0.
(* D0 is a leaf *)
- destruct f.
(* D0 is ends with an application of rule *)
- intros hei. intros prem RA. inversion RA. subst.
  inversion g ; subst.
  (* IdP *)
  * inversion H. subst. assert (InT # P (Γ0 ++ (A ∧ B) → C :: Γ1)).
    rewrite <- H2. apply InT_or_app. right. apply InT_eq. assert (InT # P (Γ0 ++ A → B → C :: Γ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. auto.
    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 ++ (A ∧ B) → C :: Γ1)).
    rewrite <- H2. apply InT_or_app. right. apply InT_eq. assert (InT (Bot V) (Γ0 ++ A → B → C :: Γ1)).
    apply InT_app_or in H0. destruct H0. apply InT_or_app. auto. apply InT_or_app. right.
    apply InT_cons. inversion 0. subst. inversion H1. auto. apply InT_split in H1. destruct H1. destruct s. rewrite e.
    assert (BotLRule [] (x ++ Bot V :: x0, D)). 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, D) 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: AndImpLRule [(Γ0 ++ A → B → C :: Γ1, B0)] (Γ0 ++ (A ∧ B) → C :: Γ1, B0)). apply AndImpLRule_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 _ J1). destruct s.
    assert (J4: AndImpLRule [(Γ0 ++ A → B → C :: Γ1, A0)] (Γ0 ++ (A ∧ B) → C :: Γ1, A0)). apply AndImpLRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6 _ J4). destruct s.
    assert (AndRRule [(Γ0 ++ A → B → C :: Γ1, A0); (Γ0 ++ A → B → C :: Γ1, B0)]
   (Γ0 ++ A → B → C :: Γ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 → C :: Γ1, A0); (Γ0 ++ A → B → C :: Γ1, B0)])
    (Γ0 ++ A → B → C :: Γ1, And A0 B0) H0 d1). exists d2. simpl. rewrite dersrec_height_nil. lia. reflexivity.
  (* AndL *)
  * inversion H. subst. apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e0.
   + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
      assert (AndLRule [((Γ0 ++ A → B → C :: x0) ++ A0 :: B0 :: Γ3, D)]
       ((Γ0 ++ A → B → C :: x0) ++ And A0 B0 :: Γ3, D)). apply AndLRule_I. repeat rewrite <- app_assoc in H0. simpl in H0.
       assert (J4: AndImpLRule [(Γ0 ++ A → B → C :: x0 ++ A0 :: B0 :: Γ3, D)]
       (Γ0 ++ (A ∧ B) → C :: x0 ++ A0 :: B0 :: Γ3, D)). apply AndImpLRule_I.
       assert (J5: derrec_height x < S (dersrec_height d)). lia.
       assert (J6: derrec_height x = derrec_height x). reflexivity.
       pose (IH _ J5 _ _ J6). pose (s ((Γ0 ++ A → B → C :: x0) ++ A0 :: B0 :: Γ3, D)).
       assert (AndImpLRule [((Γ0 ++ A → B → C :: x0) ++ A0 :: B0 :: Γ3, D)] (((Γ0 ++ [(A ∧ B) → C]) ++ x0) ++ A0 :: B0 :: Γ3, D)).
       repeat rewrite <- app_assoc. apply AndImpLRule_I. apply s0 in H1. destruct H1.
       pose (dlCons x1 DersNilF). apply AndL in H0.
       assert (Γ0 ++ A → B → C :: x0 ++ A0 :: B0 :: Γ3 =(Γ0 ++ A → B → C :: x0) ++ 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 → C :: x0) ++ A0 :: B0 :: Γ3, D)])
       (Γ0 ++ A → B → C :: x0 ++ And A0 B0 :: Γ3, D) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl.
       rewrite dersrec_height_nil. lia. reflexivity.
  +  repeat destruct s. repeat destruct p ; subst.
      assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
      assert (J4: AndImpLRule [((Γ2 ++ A0 :: B0 :: x) ++ A → B → C :: Γ1, D)]
      ((Γ2 ++ A0 :: B0 :: x) ++ (A ∧ B) → C :: Γ1, D)). apply AndImpLRule_I.
      repeat rewrite <- app_assoc. simpl. repeat rewrite <- app_assoc in J4. simpl in J4.
      assert (AndLRule [(Γ2 ++ A0 :: B0 :: x ++ A → B → C :: Γ1, D)]
      (Γ2 ++ And A0 B0 :: x ++ A → B → C :: Γ1, D)). 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 _ J4). destruct 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 → C :: Γ1, D)])
      (Γ2 ++ And A0 B0 :: x ++ A → B → C :: Γ1, D) H0 d0). 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: AndImpLRule [(Γ0 ++ A → B → C :: Γ1, A0)] (Γ0 ++ (A ∧ B) → C :: Γ1, A0)). apply AndImpLRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6 _ J4). destruct s.
    assert (OrR1Rule [(Γ0 ++ A → B → C :: Γ1, A0)]
    (Γ0 ++ A → B → C :: Γ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 → C :: Γ1, A0)])
    (Γ0 ++ A → B → C :: Γ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: AndImpLRule [(Γ0 ++ A → B → C :: Γ1, B0)] (Γ0 ++ (A ∧ B) → C :: Γ1, B0)). apply AndImpLRule_I.
    assert (J5: derrec_height x < S (dersrec_height d)). lia.
    assert (J6: derrec_height x = derrec_height x). reflexivity.
    pose (IH _ J5 _ _ J6 _ J4). destruct s.
    assert (OrR2Rule [(Γ0 ++ A → B → C :: Γ1, B0)]
    (Γ0 ++ A → B → C :: Γ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 → C :: Γ1, B0)])
    (Γ0 ++ A → B → C :: Γ1, Or A0 B0) H0 d0). exists d1. simpl. rewrite dersrec_height_nil. lia. reflexivity.
  (* OrL *)
  * inversion H. subst. apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e0.
   + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
      assert (OrLRule [((Γ0 ++ A → B → C :: x0) ++ A0 :: Γ3, D);((Γ0 ++ A → B → C :: x0) ++ B0 :: Γ3, D)]
      ((Γ0 ++ A → B → C :: x0) ++ Or A0 B0 :: Γ3, D)). apply OrLRule_I. apply OrL in H0.
      repeat rewrite <- app_assoc in H0. simpl in H0.
      assert (J4: AndImpLRule [(Γ0 ++ A → B → C :: x0 ++ A0 :: Γ3, D)]
      (((Γ0 ++ [(A ∧ B) → C]) ++ x0) ++ A0 :: Γ3, D)). repeat rewrite <- app_assoc. apply AndImpLRule_I.
      assert (J5: derrec_height x < S (dersrec_height d)). lia.
      assert (J6: derrec_height x = derrec_height x). reflexivity.
      pose (IH _ J5 _ _ J6 _ J4). destruct s.
      assert (J7: AndImpLRule [(Γ0 ++ A → B → C :: x0 ++ B0 :: Γ3, D)]
      (((Γ0 ++ [(A ∧ B) → C]) ++ x0) ++ B0 :: Γ3, D)). repeat rewrite <- app_assoc. apply AndImpLRule_I.
      assert (J8: derrec_height x1 < S (dersrec_height d)). lia.
      assert (J9: derrec_height x1 = derrec_height x1). reflexivity.
      pose (IH _ J8 _ _ J9 _ J7). destruct 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 → C :: x0 ++ A0 :: Γ3, D); (Γ0 ++ A → B → C :: x0 ++ B0 :: Γ3, D)])
      (Γ0 ++ A → B → C :: x0 ++ Or A0 B0 :: Γ3, D) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
      lia. reflexivity.
   + repeat destruct s. repeat destruct p ; subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
      repeat rewrite <- app_assoc. simpl.
      assert (OrLRule [(Γ2 ++ A0 :: x ++ A → B → C :: Γ1, D);(Γ2 ++ B0 :: x ++ A → B → C :: Γ1, D)]
      (Γ2 ++ Or A0 B0 :: x ++ A → B → C :: Γ1, D)). apply OrLRule_I. apply OrL in H0.
      assert (J4: AndImpLRule [((Γ2 ++ A0 :: x) ++ A → B → C :: Γ1, D)]
      ((Γ2 ++ A0 :: x) ++ (A ∧ B) → C :: Γ1, D)). apply AndImpLRule_I.
      repeat rewrite <- app_assoc in J4. simpl in J4.
      assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
      pose (IH _ J5 _ _ J6 _ J4). destruct s.
      assert (J7: AndImpLRule [((Γ2 ++ B0 :: x) ++ A → B → C :: Γ1, D)]
      ((Γ2 ++ B0 :: x) ++ (A ∧ B) → C :: Γ1, D)). apply AndImpLRule_I.
      repeat rewrite <- app_assoc in J7. simpl in J7.
      assert (J8: derrec_height x1 < S (dersrec_height d)). lia.
      assert (J9: derrec_height x1 = derrec_height x1). reflexivity.
      pose (IH _ J8 _ _ J9 _ J7). destruct 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 → C :: Γ1, D); (Γ2 ++ B0 :: x ++ A → B → C :: Γ1, D)])
      (Γ2 ++ Or A0 B0 :: x ++ A → B → C :: Γ1, D) 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 → C :: Γ1, B0)] (Γ2 ++ A → B → C :: Γ1, Imp A0 B0)). apply ImpRRule_I.
      assert (J4: AndImpLRule [((Γ2 ++ [A0]) ++ A → B → C :: Γ1, B0)] ((Γ2 ++ [A0]) ++ (A ∧ B) → C :: Γ1, B0)). apply AndImpLRule_I.
      repeat rewrite <- app_assoc in J4. simpl in J4.
      assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
      pose (IH _ J5 _ _ J6 _ J4). destruct 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 → C :: Γ1, B0)])
      (Γ2 ++ A → B → C :: Γ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 → C :: Γ1, B0)] (Γ2 ++ x ++ A → B → C :: Γ1, Imp A0 B0)). apply ImpRRule_I.
      assert (J4: AndImpLRule [((Γ2 ++ A0 :: x) ++ A → B → C :: Γ1, B0)] ((Γ2 ++ A0 :: x) ++ (A ∧ B) → C :: Γ1, B0)). apply AndImpLRule_I.
      repeat rewrite <- app_assoc in J4. simpl in J4.
      assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
      pose (IH _ J5 _ _ J6 _ J4). destruct 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 → C :: Γ1, B0)])
      (Γ2 ++ x ++ A → B → C :: Γ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 → C :: Γ1, B0)]  (Γ0 ++ A → B → C :: Γ1, Imp A0 B0)). apply ImpRRule_I.
        assert (J4: AndImpLRule [((Γ0 ++ [A0]) ++ A → B → C :: Γ1, B0)] ((Γ0 ++ [A0]) ++ (A ∧ B) → C :: Γ1, B0)). apply AndImpLRule_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). pose (s (Γ0 ++ A0 :: A → B → C :: Γ1, B0)).
        assert (AndImpLRule [(Γ0 ++ A0 :: A → B → C :: Γ1, B0)] ((Γ0 ++ []) ++ A0 :: (A ∧ B) → C :: Γ1, B0)). repeat rewrite <- app_assoc. simpl ; auto.
        apply s 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 → C :: Γ1, B0)])
        (Γ0 ++ A → B → C :: Γ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 → C :: x) ++ A0 :: Γ3, B0)]  ((Γ0 ++ A → B → C :: x) ++ Γ3, Imp A0 B0)). apply ImpRRule_I.
        assert (J4: AndImpLRule [(Γ0 ++ A → B → C :: x ++ A0 :: Γ3, B0)] (Γ0 ++ (A ∧ B) → C :: x ++ A0 :: Γ3, B0)). apply AndImpLRule_I.
        repeat rewrite <- app_assoc in J4. simpl in J4.
        assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
        assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s ((Γ0 ++ A → B → C :: x) ++ A0 :: Γ3, B0)).
        assert (AndImpLRule [((Γ0 ++ A → B → C :: x) ++ A0 :: Γ3, B0)] ((Γ0 ++ (A ∧ B) → C :: x) ++ A0 :: Γ3, B0)). repeat rewrite <- app_assoc. simpl ; auto.
        apply s0 in H1. destruct H1.
        pose (dlCons x1 DersNilF). assert ((Γ0 ++ A → B → C :: x) ++ Γ3 = Γ0 ++ A → B → C :: 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 → C :: x) ++ A0 :: Γ3, B0)])
        (Γ0 ++ A → B → C :: 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 list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e0.
   +  assert (J30: dersrec_height d = dersrec_height d). reflexivity.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (AtomImpL1Rule [((Γ0 ++ A → B → C :: x0) ++ # P :: Γ3 ++ A0 :: Γ4, D)]
       ((Γ0 ++ A → B → C :: x0) ++ # P :: Γ3 ++ Imp # P A0 :: Γ4, D)). apply AtomImpL1Rule_I.
       assert (J4: AndImpLRule [(Γ0 ++ A → B → C :: x0 ++ # P :: Γ3 ++ A0 :: Γ4, D)] (Γ0 ++ (A ∧ B) → C :: x0 ++ # P :: Γ3 ++ A0 :: Γ4, D)). apply AndImpLRule_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). pose (s ((Γ0 ++ A → B → C :: x0) ++ # P :: Γ3 ++ A0 :: Γ4, D)).
       assert (AndImpLRule [((Γ0 ++ A → B → C :: x0) ++ # P :: Γ3 ++ A0 :: Γ4, D)] (((Γ0 ++ [(A ∧ B) → C]) ++ x0) ++ # P :: Γ3 ++ A0 :: Γ4, D)).
       repeat rewrite <- app_assoc. simpl ; auto. apply s0 in H1. destruct H1.
       pose (dlCons x1 DersNilF). apply AtomImpL1 in H0.
       assert (((Γ0 ++ A → B → C :: x0) ++ # P :: Γ3 ++ Imp # P A0 :: Γ4, D) = (Γ0 ++ A → B → C :: x0 ++ # P :: Γ3 ++ Imp # P A0 :: Γ4, D)).
       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 → C :: x0) ++ # P :: Γ3 ++ A0 :: Γ4, D)])
       (Γ0 ++ A → B → C :: x0 ++ # P :: Γ3 ++ Imp # P A0 :: Γ4, D) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil. lia. reflexivity.
   + repeat destruct s. repeat destruct p ; subst.
      apply list_split_form in e0. destruct e0. repeat destruct s ; repeat destruct p ; subst.
      { inversion e0. }
      { assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
        assert (AtomImpL1Rule [(Γ2 ++ # P :: (x ++ A → B → C :: x1) ++ A0 :: Γ4, D)]
        (Γ2 ++ # P :: (x ++ A → B → C :: x1) ++ Imp # P A0 :: Γ4, D)). apply AtomImpL1Rule_I.
        assert (J4: AndImpLRule [((Γ2 ++ # P :: x) ++ A → B → C :: x1 ++ A0 :: Γ4, D)] ((Γ2 ++ # P :: x) ++ (A ∧ B) → C :: x1 ++ A0 :: Γ4, D)).
        apply AndImpLRule_I. repeat rewrite <- app_assoc in J4. simpl in J4.
        assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
        assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s (Γ2 ++ # P :: x ++ A → B → C :: x1 ++ A0 :: Γ4, D)).
        assert (AndImpLRule [(Γ2 ++ # P :: x ++ A → B → C :: x1 ++ A0 :: Γ4, D)] (Γ2 ++ # P :: ((x ++ [(A ∧ B) → C]) ++ x1) ++ A0 :: Γ4, D)).
        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 → C :: x1 ++ A0 :: Γ4, D)])
        (Γ2 ++ # P :: x ++ A → B → C :: x1 ++ Imp # P A0 :: Γ4, D) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
      { repeat destruct s ; repeat destruct p ; subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
        assert (AtomImpL1Rule [(Γ2 ++ # P :: Γ3 ++ A0 :: x0 ++ A → B → C :: Γ1, D)]
        (Γ2 ++ # P :: Γ3 ++ Imp # P A0 :: x0 ++ A → B → C :: Γ1, D)). apply AtomImpL1Rule_I.
        assert (J4: AndImpLRule [((Γ2 ++ # P :: Γ3 ++ A0 :: x0) ++ A → B → C :: Γ1, D)] ((Γ2 ++ # P :: Γ3 ++ A0 :: x0) ++ (A ∧ B) → C :: Γ1, D)).
        apply AndImpLRule_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 _ J4). destruct 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 → C :: Γ1, D)])
        (Γ2 ++ # P :: Γ3 ++ Imp (# P) A0 :: x0 ++ A → B → C :: Γ1, D) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
  (* AtomImpL2 *)
  * inversion H. subst. apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e0.
   + assert (J30: dersrec_height d = dersrec_height d). reflexivity.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (AtomImpL2Rule [((Γ0 ++ A → B → C :: x0) ++ A0 :: Γ3 ++ # P :: Γ4, D)]
       ((Γ0 ++ A → B → C :: x0) ++Imp # P A0  :: Γ3 ++ # P :: Γ4, D)). apply AtomImpL2Rule_I.
       assert (J4: AndImpLRule [(Γ0 ++ A → B → C :: x0 ++ A0 :: Γ3 ++ # P :: Γ4, D)] (Γ0 ++ (A ∧ B) → C :: x0 ++ A0 :: Γ3 ++ # P :: Γ4, D)). apply AndImpLRule_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). pose (s ((Γ0 ++ A → B → C :: x0) ++ A0 :: Γ3 ++ # P :: Γ4, D)).
       assert (AndImpLRule [((Γ0 ++ A → B → C :: x0) ++ A0 :: Γ3 ++ # P :: Γ4, D)] (((Γ0 ++ [(A ∧ B) → C]) ++ x0) ++ A0 :: Γ3 ++ # P :: Γ4, D)).
       repeat rewrite <- app_assoc. simpl ; auto. apply s0 in H1. destruct H1.
       pose (dlCons x1 DersNilF). apply AtomImpL2 in H0.
       assert (((Γ0 ++ A → B → C :: x0) ++ Imp # P A0 :: Γ3 ++ # P :: Γ4, D) = (Γ0 ++ A → B → C :: x0 ++ Imp # P A0 :: Γ3 ++ # P :: Γ4, D)).
       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 → C :: x0) ++ A0 :: Γ3 ++ # P :: Γ4, D)])
       (Γ0 ++ A → B → C :: x0 ++ Imp # P A0 :: Γ3 ++ # P :: Γ4, D) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil. lia. reflexivity.
   + repeat destruct s. repeat destruct p ; subst. apply list_split_form in e0. destruct e0. repeat destruct s ; repeat destruct p ; subst.
      { inversion e0. }
      { assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
        assert (AtomImpL2Rule [(Γ2 ++ A0 :: (x ++ A → B → C :: x1) ++ # P :: Γ4, D)]
        (Γ2 ++ Imp # P A0 :: (x ++ A → B → C :: x1) ++ # P :: Γ4, D)). apply AtomImpL2Rule_I.
        assert (J4: AndImpLRule [((Γ2 ++ A0 :: x) ++ A → B → C :: x1 ++ # P :: Γ4, D)] ((Γ2 ++ A0 :: x) ++ (A ∧ B) → C :: x1 ++ # P :: Γ4, D)).
        apply AndImpLRule_I. repeat rewrite <- app_assoc in J4. simpl in J4.
        assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
        assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
        pose (IH _ J5 _ _ J6). pose (s (Γ2 ++ A0 :: x ++ A → B → C :: x1 ++ # P :: Γ4, D)).
        assert (AndImpLRule [(Γ2 ++ A0 :: x ++ A → B → C :: x1 ++ # P :: Γ4, D)] (Γ2 ++ A0 :: ((x ++ [(A ∧ B) → C]) ++ x1) ++ # P :: Γ4, D)).
        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 → C :: x1 ++ # P :: Γ4, D)])
        (Γ2 ++ Imp # P A0 :: x ++ A → B → C :: x1 ++ # P :: Γ4, D) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
      { repeat destruct s. repeat destruct p ; subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
        assert (AtomImpL2Rule [(Γ2 ++ A0 :: Γ3 ++ # P :: x0 ++ A → B → C :: Γ1, D)]
        (Γ2 ++ Imp # P A0 :: Γ3 ++ # P :: x0 ++ A → B → C :: Γ1, D)). apply AtomImpL2Rule_I.
        assert (J4: AndImpLRule [((Γ2 ++ A0 :: Γ3 ++ # P :: x0) ++ A → B → C :: Γ1, D)] ((Γ2 ++ A0 :: Γ3 ++ # P :: x0) ++ (A ∧ B) → C :: Γ1, D)).
        apply AndImpLRule_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 _ J4). destruct 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 → C :: Γ1, D)])
        (Γ2 ++ Imp (# P) A0 :: Γ3 ++ # P :: x0 ++ A → B → C :: Γ1, D) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil.
        lia. reflexivity. }
 (* AndImpL *)
  * inversion H. subst. apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e0 ; subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s. exists x ; auto. simpl. lia.
   + 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 → C :: x0) ++ A0 → B0 → C0 :: Γ3, D)]
    ((Γ0 ++ A → B → C :: x0) ++ (A0 ∧ B0) → C0 :: Γ3, D)). apply AndImpLRule_I. repeat rewrite <- app_assoc in H0.
     assert (J4: AndImpLRule [(Γ0 ++ A → B → C :: x0 ++ Imp (And A0 B0) C0 :: Γ3, D)] (Γ0 ++ (A ∧ B) → C :: x0 ++ Imp (And A0 B0) C0 :: Γ3, D)). apply AndImpLRule_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). pose (s ((Γ0 ++ A → B → C :: x0) ++ Imp A0 (Imp B0 C0) :: Γ3, D)).
     assert (AndImpLRule [((Γ0 ++ A → B → C :: x0) ++ Imp A0 (Imp B0 C0) :: Γ3, D)] (((Γ0 ++ [(A ∧ B) → C]) ++ x0)++ Imp A0 (Imp B0 C0) :: Γ3, D)).
     repeat rewrite <- app_assoc. apply AndImpLRule_I. apply s0 in H1. destruct H1.
     pose (dlCons x1 DersNilF). apply AndImpL in H0.
     assert (Γ0 ++ (A → B → C :: x0) ++ Imp A0 (Imp B0 C0) :: Γ3 =(Γ0 ++ A → B → C :: x0) ++ 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 → C :: x0) ++ Imp A0 (Imp B0 C0) :: Γ3, D)])
     (Γ0 ++ A → B → C :: x0 ++ Imp (And A0 B0) C0 :: Γ3, D) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil. lia. reflexivity.
   + repeat destruct s. repeat destruct p ; subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
      assert (AndImpLRule [((Γ2 ++ Imp A0 (Imp B0 C0) :: x) ++ A → B → C :: Γ1, D)]
      ((Γ2 ++ Imp (And A0 B0) C0 :: x) ++ A → B → C :: Γ1, D)). repeat rewrite <- app_assoc. simpl.
      repeat rewrite <- app_assoc. apply AndImpLRule_I.
      assert (J4: AndImpLRule [((Γ2 ++ Imp A0 (Imp B0 C0) :: x) ++ A → B → C :: Γ1, D)] ((Γ2 ++ Imp A0 (Imp B0 C0) :: x) ++ (A ∧ B) → C :: Γ1, D)).
      apply AndImpLRule_I. repeat rewrite <- app_assoc in J4. simpl in J4.
      assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
      pose (IH _ J5 _ _ J6 _ J4). destruct 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 → C :: Γ1, D)])
     (Γ2 ++ Imp (And A0 B0) C0 :: x ++ A → B → C :: Γ1, D) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl. rewrite dersrec_height_nil.
      lia. reflexivity.
  (* OrImpL *)
  * inversion H. subst. apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e0.
   + assert (J30: dersrec_height d = dersrec_height d). reflexivity. simpl.
       pose (@dersrec_derrec_height (dersrec_height d) _ _ _ _ d J30). destruct s.
       assert (OrImpLRule [((Γ0 ++ A → B → C :: x0) ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, D)]
       ((Γ0 ++ A → B → C :: x0) ++ Imp (Or A0 B0) C0 :: Γ3 ++ Γ4, D)). apply OrImpLRule_I. repeat rewrite <- app_assoc in H0. simpl in H0.
       assert (J4: AndImpLRule [(Γ0 ++ A → B → C :: x0 ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, D)]
       (Γ0 ++ (A ∧ B) → C :: x0 ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, D)). apply AndImpLRule_I.
       assert (J5: derrec_height x < S (dersrec_height d)). lia.
       assert (J6: derrec_height x = derrec_height x). reflexivity.
       pose (IH _ J5 _ _ J6). pose (s (Γ0 ++ A → B → C :: x0 ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, D)).
       assert (AndImpLRule [(Γ0 ++ A → B → C :: x0 ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, D)]
      (((Γ0 ++ [(A ∧ B) → C]) ++ x0) ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, D)).
       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 → C :: x0 ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: Γ4, D)])
       (Γ0 ++ A → B → C :: x0 ++ Imp (Or A0 B0) C0 :: Γ3 ++ Γ4, D) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl.
        rewrite dersrec_height_nil. lia. reflexivity.
   + repeat destruct s. repeat destruct p ; subst. apply app2_find_hole in e0. destruct e0. 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. simpl. repeat rewrite <- app_assoc. simpl.
        repeat rewrite <- app_assoc.
        assert (OrImpLRule [(Γ2 ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: A → B → C :: Γ1, D)]
        (Γ2 ++ Imp (Or A0 B0) C0 :: Γ3 ++ A → B → C :: Γ1, D)). apply OrImpLRule_I.
        assert (J4: AndImpLRule [((Γ2 ++ Imp A0 C0 :: Γ3 ++ [Imp B0 C0]) ++ A → B → C :: Γ1, D)]
        ((Γ2 ++ Imp A0 C0 :: Γ3 ++ [Imp B0 C0]) ++ (A ∧ B) → C :: Γ1, D)).
        apply AndImpLRule_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 _ J4). destruct 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 :: A → B → C :: Γ1, D)])
        (Γ2 ++ Imp (Or A0 B0) C0 :: Γ3 ++ A → B → C :: Γ1, D) 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.
        assert (OrImpLRule [((Γ2 ++ Imp A0 C0 :: Γ3) ++ Imp B0 C0 :: x0 ++ A → B → C :: Γ1, D)]
        ((Γ2 ++ Imp (Or A0 B0) C0 :: Γ3) ++ x0 ++ A → B → C :: Γ1, D)). repeat rewrite <- app_assoc.
        simpl. apply OrImpLRule_I. simpl. repeat rewrite <- app_assoc. simpl.
        assert (J4: AndImpLRule [((Γ2 ++ Imp A0 C0 :: Γ3 ++ Imp B0 C0 :: x0) ++ A → B → C :: Γ1, D)]
        ((Γ2 ++ Imp A0 C0 :: Γ3  ++ Imp B0 C0 :: x0) ++ (A ∧ B) → C :: Γ1, D)).
        apply AndImpLRule_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 _ J4). destruct 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 :: x0 ++ A → B → C :: Γ1, D)])
        (Γ2 ++ Imp (Or A0 B0) C0 :: Γ3 ++ x0 ++ A → B → C :: Γ1, D) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl.
        rewrite dersrec_height_nil. lia. reflexivity. }
      { destruct x0.
         - simpl in e0. 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 → C :: Γ1, D)]
           (Γ2 ++ Imp (Or A0 B0) C0 :: x ++ A → B → C :: Γ1, D)). apply OrImpLRule_I.
           assert (J4: AndImpLRule [((Γ2 ++ Imp A0 C0 :: x ++ [Imp B0 C0]) ++ A → B → C :: Γ1, D)]
           ((Γ2 ++ Imp A0 C0 :: x ++ [Imp B0 C0]) ++ (A ∧ B) → C :: Γ1, D)).
           apply AndImpLRule_I. repeat rewrite <- app_assoc in J4. simpl in J4. repeat rewrite <- app_assoc in J4. simpl in J4.
           assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
           assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
           pose (IH _ J5 _ _ J6). pose (s (Γ2 ++ Imp A0 C0 :: x ++ Imp B0 C0 :: A → B → C :: Γ1, D)).
           assert (AndImpLRule [(Γ2 ++ Imp A0 C0 :: x ++ Imp B0 C0 :: A → B → C :: Γ1, D)]
           (Γ2 ++ Imp A0 C0 :: (x ++ []) ++ Imp B0 C0 :: (A ∧ B) → C :: Γ1, D)). 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 → C :: Γ1, D)])
          (Γ2 ++ Imp (Or A0 B0) C0 :: x ++ A → B → C :: Γ1, D) H0 d0). repeat rewrite <- app_assoc. exists d1.
           simpl. rewrite dersrec_height_nil. lia. reflexivity.
      -  inversion e0. 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.
          assert (OrImpLRule [(Γ2 ++ Imp A0 C0 :: (x ++ A → B → C :: x0) ++ Imp B0 C0 :: Γ4, D)]
          (Γ2 ++ Imp (Or A0 B0) C0 :: (x ++ A → B → C :: x0) ++ Γ4, D)). apply OrImpLRule_I.
          assert (J4: AndImpLRule [((Γ2 ++ Imp A0 C0 :: x) ++ A → B → C :: x0 ++ Imp B0 C0 :: Γ4, D)]
          ((Γ2 ++ Imp A0 C0 :: x) ++ (A ∧ B) → C :: x0 ++ Imp B0 C0 :: Γ4, D)).
          apply AndImpLRule_I. repeat rewrite <- app_assoc in J4. simpl in J4.
          assert (J5: derrec_height x1 < S (dersrec_height d)). lia.
          assert (J6: derrec_height x1 = derrec_height x1). reflexivity.
          pose (IH _ J5 _ _ J6). pose (s (Γ2 ++ Imp A0 C0 :: x ++ A → B → C :: x0 ++ Imp B0 C0 :: Γ4, D)).
          assert (AndImpLRule [(Γ2 ++ Imp A0 C0 :: x ++ A → B → C :: x0 ++ Imp B0 C0 :: Γ4, D)]
          (Γ2 ++ Imp A0 C0 :: (x ++ (A ∧ B) → C :: x0) ++ Imp B0 C0 :: Γ4, D)).
          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 → C :: x0 ++ Imp B0 C0 :: Γ4, D)])
          (Γ2 ++ Imp (Or A0 B0) C0 :: x ++ A → B → C :: x0 ++ Γ4, D) H0 d0). repeat rewrite <- app_assoc. exists d1. simpl.
          rewrite dersrec_height_nil. lia. reflexivity. }
  (* ImpImpL *)
 * inversion H. subst. apply list_split_form in H2. destruct H2. repeat destruct s ; repeat destruct p ; subst.
   + inversion e0.
   +  assert (J30: dersrec_height d = dersrec_height d). reflexivity.
        pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s. simpl.
        assert (ImpImpLRule [((Γ0 ++ A → B → C :: x0) ++ Imp B0 C0 :: Γ3, Imp A0 B0); ((Γ0 ++ A → B → C :: x0) ++ C0 :: Γ3, D)]
        ((Γ0 ++ A → B → C :: x0) ++ Imp (Imp A0 B0) C0 :: Γ3, D)). apply ImpImpLRule_I. apply ImpImpL in H0.
        repeat rewrite <- app_assoc in H0. simpl in H0.
        assert (J4: AndImpLRule [(Γ0 ++ A → B → C :: x0 ++ Imp B0 C0 :: Γ3, Imp A0 B0)]
        (((Γ0 ++ [(A ∧ B) → C]) ++ x0) ++ Imp B0 C0 :: Γ3, Imp A0 B0)). repeat rewrite <- app_assoc. apply AndImpLRule_I.
        assert (J5: derrec_height x < S (dersrec_height d)). lia.
        assert (J6: derrec_height x = derrec_height x). reflexivity.
        pose (IH _ J5 _ _ J6 _ J4). destruct s.
        assert (J7: AndImpLRule [(Γ0 ++ A → B → C :: x0 ++ C0 :: Γ3, D)]
        (((Γ0 ++ [(A ∧ B) → C]) ++ x0) ++ C0 :: Γ3, D)). repeat rewrite <- app_assoc. apply AndImpLRule_I.
        assert (J8: derrec_height x1 < S (dersrec_height d)). lia.
        assert (J9: derrec_height x1 = derrec_height x1). reflexivity.
        pose (IH _ J8 _ _ J9 _ J7). destruct 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 → C :: x0 ++ Imp B0 C0 :: Γ3, Imp A0 B0); (Γ0 ++ A → B → C :: x0 ++ C0 :: Γ3, D)])
       (Γ0 ++ A → B → C :: x0 ++ Imp (Imp A0 B0) C0 :: Γ3, D) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
        lia. reflexivity.
   + repeat destruct s. repeat destruct p ; subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
      repeat rewrite <- app_assoc. simpl.
      assert (ImpImpLRule [(Γ2 ++ Imp B0 C0 :: x ++ A → B → C :: Γ1, Imp A0 B0); (Γ2 ++ C0 :: x ++ A → B → C :: Γ1, D)]
      (Γ2 ++ Imp (Imp A0 B0) C0 :: x ++ A → B → C :: Γ1, D)). apply ImpImpLRule_I. apply ImpImpL in H0.
      assert (J4: AndImpLRule [((Γ2 ++ Imp B0 C0 :: x) ++ A → B → C :: Γ1, Imp A0 B0)]
      ((Γ2 ++ Imp B0 C0 :: x) ++ (A ∧ B) → C :: Γ1, Imp A0 B0)). apply AndImpLRule_I.
      repeat rewrite <- app_assoc in J4. simpl in J4.
      assert (J5: derrec_height x0 < S (dersrec_height d)). lia.
      assert (J6: derrec_height x0 = derrec_height x0). reflexivity.
      pose (IH _ J5 _ _ J6 _ J4). destruct s.
      assert (J7: AndImpLRule [((Γ2 ++ C0 :: x) ++ A → B → C :: Γ1, D)]
      ((Γ2 ++ C0 :: x) ++ (A ∧ B) → C :: Γ1, D)). apply AndImpLRule_I.
      repeat rewrite <- app_assoc in J7. simpl in J7.
      assert (J8: derrec_height x1 < S (dersrec_height d)). lia.
      assert (J9: derrec_height x1 = derrec_height x1). reflexivity.
      pose (IH _ J8 _ _ J9 _ J7). destruct 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 → C :: Γ1, Imp A0 B0); (Γ2 ++ C0 :: x ++ A → B → C :: Γ1, D)])
      (Γ2 ++ Imp (Imp A0 B0) C0 :: x ++ A → B → C :: Γ1, D) H0 d1). exists d2. simpl. rewrite dersrec_height_nil.
      lia. reflexivity.
  (* BoxImpL *)
 * inversion X. subst. apply list_split_form in H. destruct H. repeat destruct s ; repeat destruct p ; subst.
   + inversion 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:=(A ∧ B) → C) in H1. destruct H1.
      inversion H. apply in_or_app. right. apply in_eq. subst.
      assert (J50: AndImpLRule [(Γ0 ++ A → B → C :: x0 ++ B0 :: Γ3, D)]
      (((Γ0 ++ [(A ∧ B) → C]) ++ x0) ++ B0 :: Γ3, D)). repeat rewrite <- app_assoc. apply AndImpLRule_I.
      assert (J51: derrec_height x1 < S (dersrec_height d)). lia.
      assert (J52: derrec_height x1 = derrec_height x1). reflexivity.
      pose (IH _ J51 _ _ J52 _ J50). destruct s.
      assert (BoxImpLRule [(XBoxed_list (x2 ++ x3)  ++ [Box A0], A0); ((Γ0 ++ A → B → C :: x0) ++ B0 :: Γ3, D)]
      ((Γ0 ++  A → B → C :: x0) ++ Imp (Box A0) B0 :: Γ3, D)). apply BoxImpLRule_I ; auto.
      repeat rewrite <- app_assoc. simpl.
      apply univ_gen_ext_combine ; auto. simpl. apply univ_gen_ext_extra ; auto. intro. destruct X1.
      inversion H. apply BoxImpL in X1.
      pose (dlCons x4 DersNilF). pose (dlCons x 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 → C :: x0 ++ B0 :: Γ3, D)])
      (Γ0 ++ A → B → C :: x0 ++ Imp (Box A0) B0 :: Γ3, D) X1 d1). exists d2. simpl. rewrite dersrec_height_nil.
      lia. reflexivity.
   + repeat destruct s. repeat destruct p ; subst. assert (J30: dersrec_height d = dersrec_height d). reflexivity.
      pose (@dersrec_derrec2_height (dersrec_height d) _ _ _ _ _ d J30). repeat destruct s.
      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:=(A ∧ B) → C) in H1. destruct H1.
      inversion H. apply in_or_app. right. apply in_or_app. right. apply in_eq. subst.
      assert (J50: AndImpLRule [((Γ2 ++ B0 :: x) ++ A → B → C :: Γ1, D)]
      ((Γ2 ++ B0 :: x) ++ (A ∧ B) → C :: Γ1, D)). apply AndImpLRule_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 _ J50). destruct s.
      assert (BoxImpLRule [(XBoxed_list (x2 ++ x4 ++ x5)  ++ [Box A0], A0); (Γ2 ++ B0 :: x ++ A → B → C :: Γ1, D)]
      (Γ2 ++ Imp (Box A0) B0 :: x ++ A → B → C :: Γ1, D)). apply BoxImpLRule_I ; auto.
      apply univ_gen_ext_combine ; auto. apply univ_gen_ext_combine ; auto. apply univ_gen_ext_extra ; auto.
      intro. destruct X1. inversion H. 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 → C :: Γ1, D)])
      (Γ2 ++ Imp (Box A0) B0 :: x ++ A → B → C :: Γ1, D) 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 ++ A → B → C :: Γ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 ((A ∧ B) → C) (x ++ (A ∧ B) → C :: l)). apply in_or_app. right. apply in_eq. pose (H1 ((A ∧ B) → C) H).
    destruct e. inversion H0. apply univ_gen_ext_combine ; auto. simpl in IH. subst. apply univ_gen_ext_extra ; auto.
    intro. destruct X1. inversion H. apply GLR in X1.
    pose (derI (rules:=GL4ip_rules) (prems:=fun _ : (list (MPropF V)) *(MPropF V) => False)
    (ps:=[(XBoxed_list BΓ ++ [Box A0], A0)]) (Γ0 ++ A → B → C :: Γ1, Box A0) X1 d). exists d0. simpl. auto.
Qed.

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


Require Import Coq.omega.Omega.
Require Import Coq.Arith.Arith Bedrock.Bedrock Bedrock.sep.Locals Coq.Lists.List Platform.PreAutoSep.

Lemma wordToNat_wminus : forall sz (w u : word sz),
  u <= w
  -> wordToNat (w ^- u) = wordToNat w - wordToNat u.
  intros.
  eapply natToWord_inj; try eapply wordToNat_bound.
  2: generalize (wordToNat_bound w); omega.
  rewrite natToWord_wordToNat.
  unfold wminus.
  rewrite wneg_alt.
  unfold wnegN.
  pattern w at 1.
  rewrite <- (natToWord_wordToNat w).
  rewrite <- natToWord_plus.
  specialize (wordToNat_bound u); intro.
  destruct (le_lt_dec (wordToNat u) (wordToNat w)).
  replace (wordToNat w + (pow2 sz - wordToNat u))
    with (pow2 sz + (wordToNat w - wordToNat u)) by omega.
  rewrite natToWord_plus.
  rewrite natToWord_pow2.
  apply wplus_unit.
  elimtype False; apply H.
  nomega.
Qed.

Hint Rewrite wordToNat_wminus using assumption : sepFormula.

Lemma Nle_out : forall n m, (n <= m)%N -> (N.to_nat n <= N.to_nat m)%nat.
  intros; apply N.lt_eq_cases in H; intuition.
  apply Nlt_out in H0; auto.
Qed.

Lemma wordToNat_wplus : forall (w u : W),
  goodSize (wordToNat w + wordToNat u)
  -> wordToNat (w ^+ u) = wordToNat w + wordToNat u.
  intros.
  rewrite wplus_alt; unfold wplusN, wordBinN.
  apply wordToNat_natToWord_idempotent; auto.
Qed.

Lemma wordToNat_wmult : forall (w u : W),
  goodSize (wordToNat w * wordToNat u)
  -> wordToNat (w ^* u) = wordToNat w * wordToNat u.
  intros.
  rewrite wmult_alt; unfold wmultN, wordBinN.
  apply wordToNat_natToWord_idempotent; auto.
Qed.

Lemma wle_le : forall (n sz : W),
  n <= sz
  -> (wordToNat n <= wordToNat sz)%nat.
  intros; destruct (le_lt_dec (wordToNat n) (wordToNat sz)); auto.
  elimtype False; apply H.
  nomega.
Qed.

Local Hint Resolve simplify_fwd.

Lemma subst_qspecOut_fwd' : forall pc state (specs : codeSpec pc state) A B v v' qs (k : _ -> propX _ _ (A :: B :: nil)),
  interp specs (subst (subst (qspecOut qs k) v) v' ---> qspecOut qs (fun x => subst (subst (k x) v) v')).
  induction qs; simpl; intros.
  apply Imply_refl.
  apply Imply_I.
  eapply Exists_E.
  apply Env; simpl; eauto.
  simpl; intros.
  eapply Exists_I.
  eapply Imply_E.
  apply interp_weaken; eauto.
  eapply Env; simpl; eauto.
Qed.

Lemma subst_qspecOut_fwd : forall pc state (specs : codeSpec pc state) A v qs (k : _ -> propX _ _ (A :: nil)),
  interp specs (subst (qspecOut qs k) v)
  -> interp specs (qspecOut qs (fun x => subst (k x) v)).
  induction qs; propxFo; eauto.
Qed.

Lemma subst_qspecOut_bwd' : forall pc state (specs : codeSpec pc state) A B v v' qs (k : _ -> propX _ _ (A :: B :: nil)),
  interp specs (qspecOut qs (fun x => subst (subst (k x) v) v') ---> subst (subst (qspecOut qs k) v) v').
  induction qs; simpl; intros.
  apply Imply_refl.
  apply Imply_I.
  eapply Exists_E.
  apply Env; simpl; eauto.
  simpl; intros.
  eapply Exists_I.
  eapply Imply_E.
  apply interp_weaken; eauto.
  eapply Env; simpl; eauto.
Qed.

Lemma subst_qspecOut_bwd : forall pc state (specs : codeSpec pc state) A v qs (k : _ -> propX _ _ (A :: nil)),
  interp specs (qspecOut qs (fun x => subst (k x) v))
  -> interp specs (subst (qspecOut qs k) v).
  induction qs; propxFo; eauto.
Qed.

Fixpoint domain (qs : qspec) : Type :=
  match qs with
    | Programming.Body _ => unit
    | Quant _ f => sigT (fun x => domain (f x))
  end.

Fixpoint qspecOut' (qs : qspec) : domain qs -> HProp :=
  match qs with
    | Programming.Body P => fun _ => P
    | Quant _ f => fun d => qspecOut' (f (projT1 d)) (projT2 d)
  end.

Lemma qspecOut_fwd' : forall (specs : codeSpec W (settings * state)) qs k,
  interp specs (qspecOut qs k ---> Ex v : domain qs, k (qspecOut' qs v))%PropX.
  induction qs; simpl; intros.
  apply Imply_I; apply Exists_I with tt; apply Env; simpl; tauto.
  apply Imply_I; eapply Exists_E; [ apply Env; simpl; tauto | ].
  simpl; intros.
  eapply Exists_E.
  eapply Imply_E.
  apply interp_weaken; apply H.
  apply Env; simpl; eauto.
  simpl; intros.
  apply Exists_I with (existT _ B B0).
  apply Env; simpl; eauto.
Qed.

Lemma qspecOut_fwd : forall (specs : codeSpec W (settings * state)) qs k,
  interp specs (qspecOut qs k)
  -> exists v : domain qs, interp specs (k (qspecOut' qs v)).
  intros; apply (Imply_sound (qspecOut_fwd' _ _ _)) in H; propxFo; eauto.
Qed.

Lemma qspecOut_bwd' : forall (specs : codeSpec W (settings * state)) qs k v,
  interp specs (k (qspecOut' qs v) ---> qspecOut qs k).
  induction qs; simpl; intros.
  apply Imply_refl.
  destruct v; simpl.
  eapply Imply_trans; eauto.
  apply Imply_I; eapply Exists_I; apply Env; simpl; eauto.
Qed.

Lemma qspecOut_bwd : forall (specs : codeSpec W (settings * state)) qs k v,
  interp specs (k (qspecOut' qs v))
  -> interp specs (qspecOut qs k).
  intros; eapply (Imply_sound (qspecOut_bwd' _ _ _ _)); eauto.
Qed.

Lemma qspecOut_bwd'' : forall (specs : codeSpec W (settings * state)) qs k,
  interp specs ((Ex v, k (qspecOut' qs v)) ---> qspecOut qs k)%PropX.
  intros.
  apply Imply_I.
  eapply Exists_E; [ apply Env; simpl; eauto | ].
  simpl; intros.
  eapply Imply_E.
  apply interp_weaken; apply qspecOut_bwd'.
  apply Env; simpl; eauto.
Qed.

Theorem localsInvariant_in : forall ns' pre post ns res ns'' res' stn_st specs,
  interp specs (Ex st' : state,
    localsInvariant pre post false (fun w => w) ns res (fst stn_st, st')
    /\ [| evalInstrs (fst stn_st) st' (Assign (LvMem (Sp + 0)%loc) Rp :: nil)
      = Some (snd stn_st) |])%PropX
  -> (length ns' <= res)%nat
  -> res' = res - length ns'
  -> ns ++ ns' = ns''
  -> NoDup ("rp" :: ns ++ ns')
  -> (forall vs1 vs2, (forall x, In x ns
    -> sel vs1 x = sel vs2 x)
  -> pre vs1 = pre vs2)
  -> (forall vs1 vs2, (forall x, In x ns
    -> sel vs1 x = sel vs2 x)
  -> post vs1 = post vs2)
  -> interp specs (localsInvariant pre post true (fun w => w)
    ns'' res' stn_st).
  post; subst.
  apply subst_qspecOut_fwd in H.
  apply qspecOut_fwd in H.
  destruct H.
  post.
  change (locals ("rp" :: ns) x1 res (Regs x Sp))
    with (locals_in ("rp" :: ns) x1 res (Regs x Sp) ns' ("rp" :: ns ++ ns') (res - length ns')) in H1.
  assert (ok_in ("rp" :: ns) res ns' ("rp" :: ns ++ ns') (res - length ns')).
  red; intuition.
  change (LvMem (Sp + 0)%loc) with (LvMem (Sp + variablePosition ("rp" :: ns ++ ns') "rp")%loc) in H7.
  assert (In "rp" ("rp" :: ns ++ ns')) by intuition.
  evaluate auto_ext.
  generalize dependent x2.
  rewrite <- H10.
  erewrite H4.
  intros.
  descend.
  apply subst_qspecOut_bwd.
  eapply qspecOut_bwd.
  post.
  step auto_ext.
  intros.
  match goal with
    | [ |- himp _ ?P ?Q ] =>
      match P with
        | context[pre ?X _] =>
          match Q with
            | context[pre ?Y _] => equate X Y
          end
      end
  end.
  step auto_ext.
  descend.
  clear H8.
  eauto.
  clear H8.
  step auto_ext.
  descend.
  Focus 2.
  intuition subst.
  unfold sel at 1 3.
  rewrite sel_upd_ne.
  specialize (@merge_agree x1 x4 ("rp" :: ns)).
  unfold agree_on; intro Hag.
  rewrite (proj1 (Forall_forall _ _) Hag _ (or_intror _ H11)); auto.
  inversion H3; subst.
  intro; subst.
  apply H14.
  apply in_or_app; tauto.

  step auto_ext.
  erewrite H5.
  instantiate (2 := sel x1).
  generalize dependent x2.
  rewrite H10; intros.
  eapply Imply_trans; [ apply subst_qspecOut_fwd' | ].
  eapply Imply_trans; [ | apply subst_qspecOut_bwd' ].
  eapply Imply_trans; [ apply qspecOut_fwd' | ].
  simpl.
  apply existsL; simpl; intros.
  post.
  eapply Imply_trans; [ | apply qspecOut_bwd' ].
  descend; step auto_ext.
  change ("rp" :: ns ++ ns') with (("rp" :: ns) ++ ns').
  rewrite H1.
  apply prelude_out; auto.
  intros; unfold sel at 1 3.
  rewrite sel_upd_ne.
  specialize (@merge_agree x1 x4 ("rp" :: ns)).
  unfold agree_on; intro Hag.
  rewrite (proj1 (Forall_forall _ _) Hag _ (or_intror _ H12)); auto.
  inversion H3; subst.
  intro; subst.
  apply H15.
  apply in_or_app; tauto.
Qed.

Theorem localsInvariant_inEx : forall specs A p q p',
  (forall x, interp specs (Ex st' : state,
      p st' x
      /\ q st')%PropX
    -> interp specs (p' x))
  -> interp specs (Ex st' : state,
    (Ex x : A, p st' x)
    /\ q st')%PropX
  -> interp (pc := W) (state := settings * state) specs (Ex x : A, p' x).
  propxFo.
  exists x0.
  apply simplify_fwd.
  apply H.
  propxFo; eauto.
Qed.

Lemma word_le : forall sz (u v : word sz),
  u = v \/ u < v
  -> u <= v.
  intuition subst; nomega.
Qed.

Hint Resolve word_le.

Hint Rewrite wordToNat_natToWord_idempotent using reflexivity : sepFormula.


From iris.base_logic Require Export invariants.
From iris.algebra Require Import agree frac.
From iris.proofmode Require Import tactics.
From fae_gtlc_mu.cast_calculus Require Export lang.
Import uPred.

(* Name for invariant that supervises the gradual side *)
Definition specN := nroot .@ "gradual".

(* Iris resources for keeping track of gradual side *)
Canonical Structure exprO := leibnizO expr.
Definition specR := prodR fracR (agreeR exprO).

Class specG Σ := SpecG { specR_inG :> inG Σ specR; spec_name : gname }.

Definition currently `{specG Σ} (e : expr) : iProp Σ :=
  own spec_name ((1%Qp , to_agree e) : specR).

Definition currently_half `{specG Σ} (e : expr) : iProp Σ :=
  own spec_name (((1 / 2)%Qp , to_agree e) : specR).

(* Invariant body to keep track of gradual side *)
Definition initially_body `{specG Σ} (ei' : expr) : iProp Σ :=
  (∃ e', (currently_half e')
            ∗ ⌜rtc erased_step ([ei'] , tt) ([e'] , tt)⌝)%I.

(* Invariant to keep track of gradual side *)
Definition initially_inv `{specG Σ} `{invG Σ} (ei' : expr) : iProp Σ :=
  inv specN (initially_body ei').

Section cfg.
  Context `{!specG Σ}.
  Context `{!invG Σ}.
  Implicit Types P Q : iProp Σ.
  Implicit Types Φ : val → iProp Σ.
  Implicit Types e : expr.
  Implicit Types v : val.

  Local Hint Resolve to_of_val : core.

  (* uninteresting technical lemma *)
  Lemma step_insert_no_fork K e σ e' σ' :
    head_step e e' → erased_step ([fill K e], σ) ([fill K e'], σ').
  Proof. intros Hst. exists []. eapply (step_atomic _ _ _ _ _ _ _ [] [] []); eauto.
         by apply: Ectx_step.
  Qed.

  (* Updating the gradual side with a head step under an evaluation context *)
  Lemma step_pure E ei' K e1' e2' :
    (head_step e1' e2') →
    nclose specN ⊆ E →
    initially_inv ei' ∗ currently_half (fill K e1') ={E}=∗ currently_half (fill K e2').
  Proof.
    iIntros (??) "[Hinv Hj]".
    rewrite /initially_inv /initially_body.
    (* opening invariant *)
    iInv specN as ">Hinit" "Hclose".
    iDestruct "Hinit" as (ef') "[Hown %]".
    rewrite /currently_half.
    iDestruct (own_valid_2 with "Hown Hj") as "#eee".
    rewrite -pair_op frac_op' Qp_half_half.
    iDestruct "eee" as %[_ ->%agree_op_inv'%leibniz_equiv]%pair_valid.
    (** update *)
    (* bring together *)
    iDestruct (equiv_entails_sym _ _ (own_op _ _ _) with "[Hj Hown]") as "HOwnOne".
    iFrame.
    (* actually update *)
    rewrite -pair_op frac_op' Qp_half_half.
    iMod (own_update _ _ (1%Qp, to_agree (fill K e2')) with "HOwnOne") as "HOwnOne".
    rewrite agree_idemp.
    { apply cmra_update_exclusive. done. }
    rewrite -Qp_half_half -frac_op' -(agree_idemp (to_agree (fill K e2'))).
    iDestruct "HOwnOne" as "[Hown1 Hown2]".
    rewrite frac_op' Qp_half_half (agree_idemp (to_agree (fill K e2'))).
    (** close invariant *)
    iApply fupd_wand_r. iSplitL "Hclose Hown1". iApply ("Hclose" with "[Hown1]").
    iNext. iExists (fill K e2'). iFrame.
    iPureIntro.
    eapply rtc_r, step_insert_no_fork; eauto.
    iIntros (_). done.
  Qed.

  (* Different instantiations of step_pure *)
  Lemma step_fst E ei' K e1' e2' :
    AsVal e1' → AsVal e2' →
    nclose specN ⊆ E →
    initially_inv ei' ∗ currently_half (fill K (Fst (Pair e1' e2'))) ={E}=∗ currently_half (fill K e1').
  Proof. intros [? <-] [? <-]. apply step_pure; econstructor; eauto. Qed.

  Lemma step_snd E ei' K e1' e2' :
    AsVal e1' → AsVal e2' → nclose specN ⊆ E →
    initially_inv ei' ∗ currently_half (fill K (Snd (Pair e1' e2'))) ={E}=∗ currently_half (fill K e2').
  Proof. intros [? <-] [? <-]; apply step_pure; econstructor; eauto. Qed.

  Lemma step_lam E ei' K e1' e2' :
    AsVal e2' → nclose specN ⊆ E →
    initially_inv ei' ∗ currently_half (fill K (App (Lam e1') e2'))
    ={E}=∗ currently_half (fill K (e1'.[e2'/])).
  Proof. intros [? <-]; apply step_pure; econstructor; eauto. Qed.

  Lemma step_Fold E ei' K e' :
    AsVal e' → nclose specN ⊆ E →
    initially_inv ei' ∗ currently_half (fill K (Unfold (Fold e'))) ={E}=∗ currently_half (fill K e').
  Proof. intros [? <-]; apply step_pure; econstructor; eauto. Qed.

  Lemma step_case_inl E ei' K e0' e1' e2' :
    AsVal e0' → nclose specN ⊆ E →
    initially_inv ei' ∗ currently_half (fill K (Case (InjL e0') e1' e2'))
      ={E}=∗ currently_half (fill K (e1'.[e0'/])).
  Proof. intros [? <-]; apply step_pure; econstructor; eauto. Qed.

  Lemma step_case_inr E ei' K e0' e1' e2' :
    AsVal e0' → nclose specN ⊆ E →
    initially_inv ei' ∗ currently_half (fill K (Case (InjR e0') e1' e2'))
      ={E}=∗ currently_half (fill K (e2'.[e0'/])).
  Proof. intros [? <-]; apply step_pure; econstructor; eauto. Qed.

End cfg.


Require Import RamifyCoq.CertiGC.gc_spec.

Local Open Scope Z_scope.

Lemma body_create_space: semax_body Vprog Gprog f_create_space create_space_spec.
Proof.
  start_function.
  forward_if True.
  - exfalso. rewrite MSS_eq_unsigned, Int.unsigned_repr in H0;
               [omega | apply MSS_max_unsigned_range; assumption].
  - forward. entailer!.
  - forward_call (Tarray int_or_ptr_type n noattr, gv).
    + entailer!. replace (n * 4) with (4 * n) by omega. reflexivity.
    + split; [|split].
      * simpl. replace (Z.max 0 n) with n. 1: apply MSS_max_4_unsigned_range, H.
        rewrite Z.max_r; [reflexivity | destruct H; assumption].
      * simpl; tauto.
      * compute; tauto.
    + Intros p. if_tac.
      * subst p. forward_if False.
        -- unfold all_string_constants. Intros.
           forward_call ((gv ___stringlit_7),
                         (map init_data2byte (gvar_init v___stringlit_7)), rsh).
           exfalso; assumption.
        -- inversion H0.
      * Intros. forward_if (
                    PROP ( )
                    LOCAL (temp _p p; temp _s s; temp _n (Vint (Int.repr n)))
                    SEP (mem_mgr gv; all_string_constants rsh gv;
                         malloc_token Ews (Tarray int_or_ptr_type n noattr) p;
                         data_at_ Ews (Tarray int_or_ptr_type n noattr) p;
                         data_at_ sh space_type s)).
        -- contradiction.
        -- forward. entailer!.
        -- do 4 forward. Exists p. unfold tarray. entailer!.
Qed.