(** * LL as a Meta-logical framework.  *)

(** In this file we show how the cut-elimination procedure for FLL can
be used to prove cut-elimination for object logics that are
cut-coherent in the sense of Miller & Pimentel. Roughly, a system is
cut-coherent if the encoding of the right and left rules of each
connective are dual. *)

Require Export LL.Misc.Hybrid.
Require Export LL.SL.FLL.Specifications.StructuralClauses.
Require Export LL.SL.FLL.Specifications.Requirement1.
Require Export LL.SL.FLL.Specifications.OLTheory.

Require Import Coq.Init.Nat.
Require Import LL.SL.FLL.CutElimination.
Require Import LL.OL.SyntaxResults.

Import LL.Misc.Permutations.
Export ListNotations.
Export LLNotations.
Set Implicit Arguments.

(** ** Cut Elimination Procedure *)
Section CutElimination .
  Context `{OLR: OORules}.

  (** As a general hypothesis, we assume that the Object logic is cut-coherent *)
  Hypothesis LTWell1 : wellFormedTheory.
  Hypothesis LTCutCoherence: CutCoherence cutR1.

  Definition ctWellFormed := proj1 LTWell1.
  Definition unWellFormed := proj1 (proj2 LTWell1).
  Definition biWellFormed := proj1 (proj2 (proj2 LTWell1)).
  Definition quWellFormed := proj2 (proj2 (proj2 LTWell1)).

  Definition ctCutCo := proj1 LTCutCoherence.
  Definition unCutCo := proj1 (proj2 LTCutCoherence).
  Definition biCutCo := proj1 (proj2 (proj2 LTCutCoherence)).
  Definition quCutCo := proj2 (proj2 (proj2 LTCutCoherence)).

   (** Extracting the needed facts given that all the OL constants are well-defined *)
   Ltac wellConstant HSeq :=
    let HS := type of HSeq in
    match HS with
    | flln ?Rules ?n ?Gamma ?M (DW (?Side ?C)) =>
      let Side' :=
          match Side with
          makeRRuleC => Right
           | makeLRuleC => Left end in
        let LTWell' := fresh "LTWell'" in
        let bpEnum := fresh "bpEnum" in
        generalize (ctWellFormed Rules Gamma M C Side' );intro LTWell';
        destruct LTWell' as [bpEnum  LTWell' ];
          destruct bpEnum;[ apply LTWell' in HSeq; contradiction (* fail case *)
                          | generalize (LTWell' _ HSeq);intro;clear LTWell' (* axiom *)
                          | generalize (LTWell' _ HSeq);intro;clear LTWell'] (* one premise *)
    end.

   Ltac wellUnary HSeq  :=
    let HS := type of HSeq in
    match HS with
    | (flln ?Rules ?n ?Gamma ?M (DW (?Side ?C ?F))) =>
      let Side' :=
          match Side with
          makeRRuleU => Right
          | makeLRuleU => Left end in
        let LTWell' := fresh "LTWell'" in
        let bpEnum := fresh "bpEnum" in
        generalize  (unWellFormed Rules Gamma M C Side' );
        intro LTWell';generalize (LTWell' _ _ HSeq);intro;clear LTWell'
    end.

  (** Extracting well-formed conditions for binary predicates *)
  Ltac wellBinary HSeq :=
    let HS := type of HSeq in
    match HS with
    | (flln ?Rules ?n ?Gamma ?M (DW (?Side ?C ?F ?G))) =>
      let Side' :=
          match Side with makeRRuleB => Right | makeLRuleB => Left end in
        let LTWell' := fresh "LTWell'" in
        let bpEnum := fresh "bpEnum" in
        generalize (biWellFormed Rules Gamma M C Side' );intro LTWell';
        destruct LTWell' as [bpEnum  LTWell' ];
        destruct bpEnum;generalize (LTWell' _ _ _ HSeq);intro;clear LTWell'
    end.

  Ltac wellQuantifier HSeq :=
    let HS := type of HSeq in
    match HS with
    | (flln ?Rules ?n ?Gamma ?M (DW (?Side ?C ?F))) =>
      let Side' :=
          match Side with makeRRuleQ => Right | makeLRuleQ => Left end in
        let LTWell' := fresh "LTWell'" in
        let bpEnum := fresh "bpEnum" in
         let HUniform := fresh "HUniform" in
        generalize  (quWellFormed Rules Gamma M C Side' F); intro LTWell';
      destruct LTWell' as [HUniform LTWell'];generalize (LTWell'  _ HSeq); intro; clear LTWell'
    end.

 (** This is the case when a constant is principal in both premises *)
  Theorem ConstantPrincipalCase :
    forall Gamma M N C,
      (flls (OLTheory nPnN) Gamma M (DW (rc_lftBody (rulesC C)))) ->
      (flls (OLTheory nPnN) Gamma N (DW (rc_rgtBody (rulesC C)))) ->
      flls (OLTheory nPnN) Gamma (N ++ M) (UP []).
 Proof with sauto.
    intros.
    apply seqtoSeqN in H...
    apply seqtoSeqN in H0...
    generalize( ctCutCo C);intro CutC.
    unfold CutCoherenceCte in CutC.
    destruct CutC as [Hc CutC].
    apply EmptySubSet with (theory:= (OLTheory nPnN) ) in CutC.
    apply weakeningGen with (CC':= Gamma) in CutC .
    apply seqtoSeqN in CutC.   destruct CutC as [h CutC].
    rewrite app_nil_r in CutC.
    assert(HCut1: flls (OLTheory nPnN) Gamma ([] ++ N)  ( UP [ (rc_lftBody (rulesC C)) ^])).
    eapply @GeneralCut with  (C:=  rc_rgtBody (rulesC C) ^);eauto.
    rewrite <- ng_involutive;eauto.

    apply seqtoSeqN in HCut1.  destruct HCut1 as [h2 HCut1].
    eapply @GeneralCut with  (C:= (rc_lftBody (rulesC C)) ^); eauto.
    rewrite <- ng_involutive;eauto.
  Qed.

  (** This is the case when a unary connective is principal in both premises *)
  Theorem UConnectivePrincipalCase :
    forall Gamma M N C F n n',
      (flls (OLTheory nPnN) Gamma M (DW (ru_lftBody (rulesU C) F))) ->
      (flls (OLTheory nPnN) Gamma N (DW (ru_rgtBody (rulesU C) F))) ->
      (lengthUexp (t_ucon C F) n') ->
      isOLFormula (t_ucon C F) ->
      n' <= n ->
      flls (OLTheoryCut nPnN (pred n)) Gamma (N ++ M) (UP []).
  Proof with sauto.
    intros.
    inversion H1;subst.
    inversion H2;subst. inversion H4.
    destruct n ;[ lia | simpl].
    apply seqtoSeqN in H.
    apply seqtoSeqN in H0.
    destruct H as [h1 H].
    destruct H0 as [h2 H0].

    generalize( unCutCo C);intro CutC.
    unfold CutCoherenceUnary in CutC.

    generalize (CutC F n1);intro Cut1. clear CutC.
    apply CuteRuleNBound' with (m:= n) in Cut1...
    apply seqtoSeqN in Cut1. destruct Cut1 as [hh  Cut1].
    apply WeakTheoryN with (theory' := OLTheoryCut nPnN n) in Cut1;auto using TheoryEmb2.
    apply weakeningGenN with (CC':= Gamma) in Cut1 .
    rewrite app_nil_r in Cut1.
    apply WeakTheoryN with (theory' := OLTheoryCut nPnN n) in H;auto using TheoryEmb1.
    apply WeakTheoryN with (theory' := OLTheoryCut nPnN n) in H0;auto using TheoryEmb1.
    assert(Cut1': flls (OLTheoryCut nPnN n) Gamma ([] ++ N) ( UP[(ru_lftBody (rulesU C) F) ^] )).
    eapply @GeneralCut with(C := (ru_rgtBody (rulesU C) F)  ^) ;eauto.

    rewrite <- ng_involutive;eauto.

    apply seqtoSeqN in Cut1'.  destruct Cut1' as [h3 Cut1'].
    eapply @GeneralCut with (C:= (ru_lftBody (rulesU C) F) ^); eauto.
    rewrite <- ng_involutive;eauto.
  Qed.

  (** This is the case when a binary connective is principal in both premises *)
  Theorem BinConnectivePrincipalCase :
    forall Gamma M N C F G n n',
      (flls (OLTheory nPnN) Gamma M (DW (rb_lftBody (rulesB C) F G))) ->
      (flls (OLTheory nPnN) Gamma N (DW (rb_rgtBody (rulesB C) F G))) ->
      lengthUexp (t_bcon C F G) n' ->
      isOLFormula (t_bcon C F G) ->
      n' <= n ->
      flls (OLTheoryCut nPnN (pred n)) Gamma (N ++ M) (UP []).
  Proof with sauto.
    intros.
    inversion H1;subst.
    inversion H2;subst. inversion H4.
    destruct n ;[ lia | simpl].
    apply seqtoSeqN in H.     apply seqtoSeqN in H0.
    destruct H as [h1 H].
    destruct H0 as [h2 H0].

    generalize (biCutCo C);intro CutC.
    unfold CutCoherenceBin in CutC.

    generalize (CutC F G n1 n2);intro Cut1. clear CutC.
    apply CuteRuleNBound' with (m:= n) in Cut1...
    apply seqtoSeqN in Cut1. destruct Cut1 as [hh  Cut1].
    apply WeakTheoryN with (theory' := OLTheoryCut nPnN n) in Cut1;auto using TheoryEmb2.
    apply weakeningGenN with (CC':= Gamma) in Cut1 .
    rewrite app_nil_r in Cut1.
    apply WeakTheoryN with (theory' := OLTheoryCut nPnN n) in H;auto using TheoryEmb1.
    apply WeakTheoryN with (theory' := OLTheoryCut nPnN n) in H0;auto using TheoryEmb1.

    assert(Cut1': flls (OLTheoryCut nPnN n) Gamma ([] ++ N) ( UP[ (rb_lftBody (rulesB C) F G) ^] )).
    eapply @GeneralCut with (C := (rb_rgtBody (rulesB C) F G) ^) ;eauto.
    rewrite <- ng_involutive;eauto.

    apply seqtoSeqN in Cut1'.  destruct Cut1' as [h3 Cut1'].
    eapply @GeneralCut with (C:= (rb_lftBody (rulesB C) F G) ^); eauto.     rewrite <- ng_involutive;eauto.
  Qed.

  (** This is the case when a quantifier is principal in both premises *)
  Theorem QuantifierPrincipalCase :
    forall Gamma M N C FX FX0 n n',
      (flls (OLTheory nPnN) Gamma M (DW (rq_lftBody (rulesQ C) FX0))) ->
      (flls (OLTheory nPnN) Gamma N (DW (rq_rgtBody (rulesQ C) FX))) ->
      isOLFormula (t_qcon C FX) ->
      isOLFormula (t_qcon C FX0) ->
      lengthUexp (t_qcon C FX) n' ->
      uniform FX -> uniform FX0 ->
      lbind 0%nat FX0 = lbind 0%nat FX ->
      n' <= n ->
      flls (OLTheoryCut nPnN (pred n)) Gamma (N ++ M) (UP []).
  Proof with sauto.
    intros.
    inversion H1. inversion H8.
    inversion H2. inversion H12.
    subst.
    assert (ext_eq FX FX0).
    eapply lbindEq;eauto.
    assert (ext_eq FX FX1). eapply lbindEq;eauto.
    assert (ext_eq FX FX2). eapply lbindEq;eauto.  rewrite <- H6. auto.
    inversion H3...
    destruct n ;[ lia | simpl].
    assert (ext_eq FX M0). eapply lbindEq;eauto.
    generalize ( quCutCo C) ;intro CutC.
    assert (Hsize: lengthUexp (FX (Var 0%nat)) n0).
    { rewrite H17...  apply proper_VAR.  }
    assert(HIs: (forall t : expr Econ, proper t -> isOLFormula (FX t))).
    {intros t pt. rewrite H12... }
    unfold CutCoherenceQ in *.
    generalize (CutC FX FX0 n0); intro Cut1. clear CutC.
    apply CuteRuleNBound' with (m:= n) in Cut1...
    apply WeakTheory with (theory' := OLTheoryCut nPnN n) in Cut1;auto using TheoryEmb1.
    apply weakeningGen with (CC':= Gamma) in Cut1 .
    rewrite app_nil_r in Cut1.
    apply WeakTheory with (theory' := OLTheoryCut nPnN n) in H;auto using TheoryEmb1.
    apply WeakTheory with (theory' := OLTheoryCut nPnN n) in H0;auto using TheoryEmb1.

    apply seqtoSeqN in H.  apply seqtoSeqN in H0. apply seqtoSeqN in Cut1.
    destruct H as [h1 H].
    destruct H0 as [h2 H0]. destruct Cut1 as [h3 Cut1].

    assert(Cut1': flls (OLTheoryCut nPnN n) Gamma ([] ++ N) ( UP[(rq_lftBody (rulesQ C) FX0) ^] )).
    eapply @GeneralCut with  (C := (rq_rgtBody (rulesQ C) FX) ^) ;eauto.
    rewrite <- ng_involutive;eauto.
    simpl in Cut1'.
    apply seqtoSeqN in Cut1'.
    destruct Cut1' as [h4 Cut1'].

    eapply @GeneralCut with (C := (rq_lftBody (rulesQ C) FX0) ^) ;eauto.
    rewrite <- ng_involutive;eauto.
  Qed.

 (** Inductive hypothesis in the theorem [OLCutElimStep]. This is
  useful to simplify the theorems below *)
  Definition OOCut n' h : Prop :=
    forall n h1 h2 FCut M N Gamma,
      h1 + h2 < h ->
          n' <= n ->
            isOLFormula FCut ->
            lengthUexp FCut n' ->
              IsPositiveAtomFormulaL M ->
                IsPositiveAtomFormulaL N ->
                  IsPositiveAtomFormulaL Gamma ->
                  flln (OLTheory nPnN) h1 Gamma (atom (up FCut)::N) (UP [] ) ->
                  flln (OLTheory nPnN) h2 Gamma (atom (down FCut)::M) (UP []) -> flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).

 Ltac applyOOCut :=
  match goal with
  | [ H: OOCut _ _ |-
         flln ?th ?x ?BX (?FF::?N) (UP []) ->
         flln ?th ?y ?BX (?GG::?M) (UP [])->
         flls ?thc ?BX (?M++?N) (UP []) ] => eapply H
  | _ => idtac end.

Ltac cutOL P1 P2 :=
   let tP1 := type of P1 in
   let tP2 := type of P2 in
   let H' := fresh "OLCut" in
   match tP1 with
   | flln ?th ?h1 ?B (atom (up ?FC) :: ?N) (UP []) =>
          match tP2 with
          | flln ?th ?h2 ?B (atom (down ?FC) :: ?M) (UP []) =>
           match goal with
           | [ H: OOCut ?n' _, Hn: ?n' <= ?n  |- _ ] =>    assert(H': tP1 -> tP2 -> flls (OLTheoryCut nPnN (pred n)) B (M++N) (UP []));applyOOCut
           end
           | _ => idtac "type of " P2 " is " tP2 end
   | _ => idtac "type of " P1 " is " tP1 end;sauto;try OLSolve.

Ltac SubCases :=
repeat
match goal with
  | H: Permutation (_::_) (_::_) |- _ => checkPermutationCases H
  | H: Permutation (_ ++ _) (_ :: _) |- _ => checkPermutationCases H
  | H: Permutation (_ :: _) (_ ++ _) |- _ => checkPermutationCases H
  | H:  (⌈ ?F ⌉) =  (⌈ ?G ⌉) |- _ => inversion H;sauto
  | H:  (⌊ ?F ⌋) =  (⌊ ?G ⌋) |- _ => inversion H;sauto
end.

Ltac Cases H := destruct H;sauto;SubCases;
repeat
match goal with
| H: Permutation ?M (_::_) |- context[?M] => rewrite H
| H: Permutation (_++_) ?M  |- context[?M] => rewrite <- H
end
.

Ltac unformSeq :=
repeat
  match goal with
   |[ H: flln _ ?n ?G ( (atom ( _ _ ) :: _) ++ _) (UP []) |- _] =>
      try rewrite <- app_comm_cons in H
   | _ => idtac
end.

Ltac PermuteLeft :=
  match goal with
     |[ Hr: flln _ ?x ?G (?X ++ _) (UP []),
        Hr': flln _ ?x ?G (?X ++ _) (UP []),
       Hl: flln ?th ?n ?G ( (⌈ ?F ⌉) :: _) (UP []),
       Hp: Permutation ?X ((⌊ ?F ⌋) :: _) |- _] =>
   rewrite Hp in Hr, Hr'
   |[ Hr: flln _ ?x ?G (?X ++ _) (UP []),
        Hr': flln _ ?x ?G (?X ++ _) (UP []),
       Hl: flln ?th ?n ?G ( (⌊ ?F  ⌋) :: _) (UP []),
       Hp: Permutation ?X ( (⌈ ?F ⌉) :: _)  |- _] =>
   rewrite Hp in Hr, Hr'
   |[ Hr: flln _ ?x ?G (?X ++ _) (UP []),
       Hl: flln _ ?n ?G ( (⌈ ?F ⌉) :: _) (UP []),
       Hp: Permutation ?X ((⌊ ?F ⌋) :: _) |- _] =>
       rewrite Hp in Hr
   |[ Hr: flln _ ?x ?G (?X ++ _) (UP []),
       Hl: flln _ ?n ?G ( (⌊ ?F ⌋) :: _) (UP []),
       Hp: Permutation ?X ((⌈ ?F ⌉) :: _) |- _] =>
       rewrite Hp in Hr
   | _ => idtac
       end;unformSeq.

(** Unary Right is not principal on the left branch *)
Lemma UnaryRightNotPrincipalL n n' n0 n1 C FCut F Gamma M N:
 n' <= n ->
OOCut n' (S n0 + S n1) ->
lengthUexp FCut n' ->
isOLFormula FCut ->
isOLFormula (t_ucon C F) ->
IsPositiveAtomFormulaL M ->
IsPositiveAtomFormulaL N ->
IsPositiveAtomFormulaL Gamma ->
buildTheory (makeRRuleU C F) ->
flln (OLTheory nPnN) (S n0) Gamma ( (⌈ FCut ⌉) :: N) (UP []) ->
flln (OLTheory nPnN) n1 Gamma ((⌊ FCut ⌋) :: M)
     (DW (makeRRuleU C F)) ->
flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto; try OLSolve.
  intros.
  wellUnary H9.
  * Cases H10.
     - PermuteLeft.
        cutOL H8 H12.
        OLSolve.
        rewrite <- app_comm_cons.
        apply H18...
        rewrite Permutation_assoc_comm...
     -  PermuteLeft.
        cutOL H8 H14.
        TFocus (makeRRuleU C F).
        inversion H10.
        FLLsplit (@nil oo) (M++N).
        apply H18...
        rewrite Permutation_assoc_comm...
Qed.

(** Unary Left is not principal on the left branch *)
Lemma UnaryLeftNotPrincipalL n n' n0 n1 C FCut F Gamma M N:
FCut <> t_ucon C F ->
 n' <= n ->
OOCut n' (S n0 + S n1) ->
lengthUexp FCut n' ->
isOLFormula FCut ->
isOLFormula (t_ucon C F) ->
IsPositiveAtomFormulaL M ->
IsPositiveAtomFormulaL N ->
IsPositiveAtomFormulaL Gamma ->
buildTheory (makeLRuleU C F) ->
flln (OLTheory nPnN) (S n0) Gamma ( (⌈ FCut ⌉) :: N) (UP []) ->
flln (OLTheory nPnN) n1 Gamma ( (⌊ FCut ⌋) :: M)
     (DW (makeLRuleU C F)) ->
flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto.
  intros.
  wellUnary H10.
  * Cases H11.
     - PermuteLeft.
        cutOL H9 H13.
        OLSolve.
        rewrite <- app_comm_cons.
        apply H19...
        rewrite Permutation_assoc_comm...
     - PermuteLeft.
        cutOL H9 H15.
        TFocus (makeLRuleU C F).
        inversion H11.
        FLLsplit (@nil oo) (M++N).
        apply H19...
        rewrite Permutation_assoc_comm...
Qed.

(** Binary Right is not principal on the left branch *)
Lemma BinaryRightNotPrincipalL n n' n0 n1 C FCut F G Gamma M N:
 n' <= n ->
OOCut n' (S n0 + S n1) ->
lengthUexp FCut n' ->
isOLFormula FCut ->
isOLFormula (t_bcon C F G) ->
IsPositiveAtomFormulaL M ->
IsPositiveAtomFormulaL N ->
IsPositiveAtomFormulaL Gamma ->
buildTheory (makeRRuleB C F G) ->
flln (OLTheory nPnN) (S n0) Gamma ( (⌈ FCut ⌉) :: N) (UP []) ->
flln (OLTheory nPnN) n1 Gamma ( (⌊ FCut ⌋) :: M)
     (DW (makeRRuleB C F G)) ->
flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto.
  intros.
  wellBinary H9.
  * Cases H10.
     - PermuteLeft.
        cutOL H8 H12.
        OLSolve.
        rewrite <- app_comm_cons.
        apply H18...
        rewrite Permutation_assoc_comm...
     - PermuteLeft.
        cutOL H8 H14.
        TFocus (makeRRuleB C F G).
        inversion H10.
        FLLsplit (@nil oo) (M++N).
        apply H18...
        rewrite Permutation_assoc_comm...
  * Cases H10.
     - PermuteLeft.
       cutOL H8 H15.
       rewrite <- H19 in H18.
       rewrite H18 in H4.
       inversion H4...
       OLSolve.
       rewrite <- app_comm_cons.
        rewrite Permutation_assoc_comm...
        apply H20...
        rewrite Permutation_assoc_comm...
        apply seqNtoSeq in H16...
        apply WeakTheory with (theory' := OLTheoryCut nPnN (pred n)) in H16;auto using TheoryEmb1.
    -  PermuteLeft.
        cutOL H8 H16.
       rewrite <- H19 in H18.
       rewrite H18 in H4.
       inversion H4...
       OLSolve.
          rewrite <- app_comm_cons.
        rewrite app_assoc_reverse.
        apply H20...
        apply seqNtoSeq in H15...
        apply WeakTheory with (theory' := OLTheoryCut nPnN (pred n)) in H15;auto using TheoryEmb1.
        rewrite Permutation_assoc_comm...
    -  PermuteLeft.
        cutOL H8 H16.
       rewrite <- H19 in H4.
       OLSolve.

        rewrite app_assoc_reverse.
        TFocus (makeRRuleB C F G).
        inversion H10.
        FLLsplit (@nil oo) ((x5 ++ N )++ x0).
        apply H21...
         rewrite Permutation_assoc_comm...
    apply seqNtoSeq in H17...
        apply WeakTheory with (theory' := OLTheoryCut nPnN (pred n)) in H17;auto using TheoryEmb1.
     -  PermuteLeft.
        cutOL H8 H17.
       rewrite <- H19 in H4.
       OLSolve.
        TFocus (makeRRuleB C F G).
        inversion H10.
        FLLsplit (@nil oo) (x++(x5 ++ N )).
        apply H21...
          apply seqNtoSeq in H16...
        apply WeakTheory with (theory' := OLTheoryCut nPnN (pred n)) in H16;auto using TheoryEmb1.

         rewrite Permutation_assoc_comm...
* Cases H10.
     - PermuteLeft.
       cutOL H8 H15.
       rewrite H18 in H4.
        OLSolve.
        cutOL H8 H16.
       rewrite H18 in H4.
        OLSolve.
        rewrite <- app_comm_cons.
        apply H20...
        rewrite Permutation_assoc_comm...
        rewrite Permutation_assoc_comm...
      - PermuteLeft.
        cutOL H8 H16.
        cutOL H8 H15.
        TFocus (makeRRuleB C F G).
        inversion H10.
        FLLsplit (@nil oo) (M ++ N).
        apply H20...
        rewrite Permutation_assoc_comm...
        rewrite Permutation_assoc_comm...
Qed.

(** Unary Left is not principal on the left branch *)
Lemma BinaryLeftNotPrincipalL n n' n0 n1 C FCut F G Gamma M N:
FCut <> t_bcon C F G ->
 n' <= n ->
OOCut n' (S n0 + S n1) ->
lengthUexp FCut n' ->
isOLFormula FCut ->
isOLFormula (t_bcon C F G) ->
IsPositiveAtomFormulaL M ->
IsPositiveAtomFormulaL N ->
IsPositiveAtomFormulaL Gamma ->
buildTheory (makeLRuleB C F G) ->
flln (OLTheory nPnN) (S n0) Gamma ((⌈ FCut ⌉) :: N) (UP []) ->
flln (OLTheory nPnN) n1 Gamma ((⌊ FCut ⌋) :: M)
     (DW (makeLRuleB C F G)) ->
flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto.
  intros.
  wellBinary H10.
  * Cases H11.
     - PermuteLeft.
        cutOL H9 H13.
        rewrite H17 in H5.
        OLSolve.
        rewrite <- app_comm_cons.
        apply H19...
        rewrite Permutation_assoc_comm...
     - PermuteLeft.
        cutOL H9 H15.
        TFocus (makeLRuleB C F G).
        inversion H11.
        FLLsplit (@nil oo) (M++N).
        apply H19...
        rewrite Permutation_assoc_comm...
  * Cases H11.
     - PermuteLeft.
        cutOL H9 H16.
        rewrite <- H20 in H19.
        rewrite H19 in H5.
        inversion H5...
        OLSolve.
        rewrite <- app_comm_cons.
        rewrite Permutation_assoc_comm...
        apply H21...
        rewrite Permutation_assoc_comm...
        apply seqNtoSeq in H17...
        apply WeakTheory with (theory' := OLTheoryCut nPnN (pred n)) in H17;auto using TheoryEmb1.
     - PermuteLeft.
        cutOL H9 H17.
        rewrite <- H20 in H19.
        rewrite H19 in H5.
        inversion H5...
        OLSolve.
        rewrite <- app_comm_cons.
        rewrite app_assoc_reverse.
        apply H21...
        apply seqNtoSeq in H16...
        apply WeakTheory with (theory' := OLTheoryCut nPnN (pred n)) in H16;auto using TheoryEmb1.
        rewrite Permutation_assoc_comm...
     - PermuteLeft.
       cutOL H9 H17.
       rewrite <- H20 in H5.
       OLSolve.
       rewrite Permutation_assoc_comm...
       TFocus  (makeLRuleB C F G).
       inversion H11.
       FLLsplit (@nil oo) ((x5 ++ N) ++ x0).
       apply H22...
       rewrite Permutation_assoc_comm...
       apply seqNtoSeq in H18...
       apply WeakTheory with (theory' := OLTheoryCut nPnN (pred n)) in H18;auto using TheoryEmb1.
     - PermuteLeft.
        cutOL H9 H18.
        rewrite <- H20 in H5.
        OLSolve.
        rewrite app_assoc_reverse.
         TFocus  (makeLRuleB C F G).
       inversion H11.
       FLLsplit (@nil oo) (x++(x5 ++ N)).
        apply H22...
        apply seqNtoSeq in H17...
        apply WeakTheory with (theory' := OLTheoryCut nPnN (pred n)) in H17;auto using TheoryEmb1.
         rewrite Permutation_assoc_comm...
  * Cases H11.
     - PermuteLeft.
        cutOL H9 H16.
        rewrite H19 in H5.
        OLSolve.
        cutOL H9 H17.
        rewrite H19 in H5.
        OLSolve.
        rewrite <- app_comm_cons.
        apply H21...
        1-2: rewrite Permutation_assoc_comm...
     - PermuteLeft.
        cutOL H9 H16.
        cutOL H9 H17.
         TFocus  (makeLRuleB C F G).
       inversion H11.
       FLLsplit (@nil oo) (M++N).
        apply H21...
        1-2: rewrite Permutation_assoc_comm...
 Qed.

 (** Quantifier Right is not principal on the left branch *)
 Lemma QuantifierRightNotPrincipalL n n' n0 n1 C FCut FX Gamma M N:
 n' <= n ->
OOCut n' (S n0 + S n1) ->
lengthUexp FCut n' ->
isOLFormula FCut ->
isOLFormula (t_qcon C FX) ->
IsPositiveAtomFormulaL M ->
IsPositiveAtomFormulaL N ->
IsPositiveAtomFormulaL Gamma ->
buildTheory (makeRRuleQ C FX) ->
flln (OLTheory nPnN) (S n0) Gamma ( (⌈ FCut ⌉) :: N) (UP []) ->
flln (OLTheory nPnN) n1 Gamma ( (⌊ FCut ⌋) :: M)
     (DW (makeRRuleQ C FX)) ->
flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto.
  intros.
  wellQuantifier H9.
  * Cases H10.
     - PermuteLeft.
        cutOL H8 H12.
        rewrite H16 in H4.
        OLSolve.
        rewrite <- app_comm_cons.
        apply H18...
        rewrite Permutation_assoc_comm...
     - PermuteLeft.
        cutOL H8 H14.
        TFocus (makeRRuleQ C FX).
        inversion H10.
        FLLsplit (@nil oo) (M++N).
        apply H18...
        rewrite Permutation_assoc_comm...
Qed.

 (** Quantifier Left is not principal on the left branch *)
 Lemma QuantifierLeftNotPrincipalL n n' n0 n1 C FCut FX Gamma M N:
 FCut <> t_qcon C FX ->
 n' <= n ->
OOCut n' (S n0 + S n1) ->
lengthUexp FCut n' ->
isOLFormula FCut ->
isOLFormula (t_qcon C FX) ->
IsPositiveAtomFormulaL M ->
IsPositiveAtomFormulaL N ->
IsPositiveAtomFormulaL Gamma ->
buildTheory (makeLRuleQ C FX) ->
flln (OLTheory nPnN) (S n0) Gamma ( (⌈ FCut ⌉) :: N) (UP []) ->
flln (OLTheory nPnN) n1 Gamma ( (⌊ FCut ⌋) :: M)
     (DW (makeLRuleQ C FX)) ->
flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto.
  intros.
  wellQuantifier H10.
  * Cases H11.
     - PermuteLeft.
        cutOL H9 H13.
        rewrite H17 in H5.
        OLSolve.
        rewrite <- app_comm_cons.
        apply H19...
        rewrite Permutation_assoc_comm...
     - PermuteLeft.
        cutOL H9 H15.
        TFocus (makeLRuleQ C FX).
        inversion H11.
        FLLsplit (@nil oo) (M++N).
        apply H19...
        rewrite Permutation_assoc_comm...
 Qed.

Ltac permuteUnary :=
match goal with
| [H: ?n' <= ?n,
   Hl: flln _ _ _ (_ :: ?N) (UP []) ,
   Hr : flln _ _ _ (_ :: ?M) (DW (makeRRuleU _ _))
  |-  flls _ _ (?M ++ ?N) (UP []) ] =>
   refine (UnaryRightNotPrincipalL H _ _ _ _ _ _ _ _ Hl Hr);sauto

| [H: ?n' <= ?n,
   Hl: flln _ _ _ (_ :: ?N) (UP []) ,
   Hr : flln _ _ _ (_ :: ?M) (DW (makeLRuleU _ _))
  |-  flls _ _ (?M ++ ?N) (UP []) ] =>
refine (UnaryLeftNotPrincipalL _ H _ _ _ _ _ _ _ _ Hl Hr);
  sauto;
  intro Hf; inversion Hf
 end.

Ltac permuteBinary :=
match goal with
| [H: ?n' <= ?n,
   Hl: flln _ _ _ (_ :: ?N) (UP []) ,
   Hr : flln _ _ _ (_ :: ?M) (DW (makeRRuleB _ _ _))
  |-  flls _ _ (?M ++ ?N) (UP []) ] =>
   refine (BinaryRightNotPrincipalL H _ _ _ _ _ _ _ _ Hl Hr);sauto
| [H: ?n' <= ?n,
   Hl: flln _ _ _ (_ :: ?N) (UP []) ,
   Hr : flln _ _ _ (_ :: ?M) (DW (makeLRuleB _ _ _))
  |-  flls _ _ (?M ++ ?N) (UP []) ] =>
refine (BinaryLeftNotPrincipalL _ H _ _ _ _ _ _ _ _ Hl Hr);
  sauto;
  intro Hf; inversion Hf
 end.

 Ltac permuteQuantifier :=
match goal with
| [H: ?n' <= ?n,
   Hl: flln _ _ _ (_ :: ?N) (UP []) ,
   Hr : flln _ _ _ (_ :: ?M) (DW (makeRRuleQ _ _))
  |-  flls _ _ (?M ++ ?N) (UP []) ] =>
   refine (QuantifierRightNotPrincipalL H _ _ _ _ _ _ _ _ Hl Hr);sauto
| [H: ?n' <= ?n,
   Hl: flln _ _ _ (_ :: ?N) (UP []) ,
   Hr : flln _ _ _ (_ :: ?M) (DW (makeLRuleQ _ _))
  |-  flls _ _ (?M ++ ?N) (UP []) ] =>
refine (QuantifierLeftNotPrincipalL _ H _ _ _ _ _ _ _ _ Hl Hr);
  sauto;
  intro Hf; inversion Hf
 end.

Ltac Cases' H := destruct H;sauto;SubCases.

 Lemma dualRev F G: F = dual G -> G = dual F.
 Proof with sauto.
 intros.
 rewrite H...
 rewrite <- ng_involutive...
 Qed.

Lemma ConstantRIGHT n n' n0 n1  C FCut M N Gamma F0:
  n' <= n ->
  isOLFormula (t_ccon C) ->
  isOLFormula FCut ->
  lengthUexp FCut n' ->
  IsPositiveAtomFormulaL M ->
  IsPositiveAtomFormulaL N ->
  IsPositiveAtomFormulaL Gamma ->
  flln (OLTheory nPnN) (S n0) Gamma ( (⌈ FCut ⌉) :: N) (UP []) ->
  flln (OLTheory nPnN) (S n1) Gamma ( (⌊ FCut ⌋) :: M) (UP []) ->
  flln (OLTheory nPnN) n0 Gamma ((⌈ FCut ⌉) :: N) (DW (makeRRuleC C)) ->
  flln (OLTheory nPnN) n1 Gamma ( (⌊ FCut ⌋) :: M) (DW F0) ->
  OOCut n' (S n0 + S n1) ->
  buildTheory (makeRRuleC C) ->
  buildTheory F0 ->
  flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto.
  intros HL' HisFC HisF HL PosM PosN PosG Hseq1 Hseq2.
  intros Hseq1' Hseq2' OLCut Hth Hth'.
  wellConstant Hseq1'.
  * Cases H.
     2:{ LLPerm ((⌈ t_ccon C ⌉) :: x0++M)... }
    rewrite <- H4 in H2.
    clear H4.
    inversion Hth'...
           -- wellConstant Hseq2'.
               Cases H0.
               rewrite <- app_comm_cons...
               Cases H0.
               PermuteLeft.
               cutOL Hseq1 H4.
               OLSolve.
               rewrite <- app_comm_cons...
               apply H10...
               LLPerm ((x3 ++ x) ++ N)...
               PermuteLeft.
               cutOL Hseq1 H6.
               TFocus (makeRRuleC C0).
               inversion H0.
               FLLsplit (@nil oo) (M++N).
               apply H10...
               LLPerm ( (M ++ x) ++ N)...
           -- wellConstant Hseq2'.
               Cases H0.
               2:{ rewrite <- app_comm_cons... }
               rewrite <- H7 in H5.
               rewrite Permutation_app_comm.
               apply WeakTheory with (theory := OLTheory nPnN ). auto using TheoryEmb1.

               refine (ConstantPrincipalCase _ H5 H2).

               Cases H0.
              rewrite <- H9 in H6.
               rewrite Permutation_app_comm.
               apply WeakTheory with (theory := OLTheory nPnN ). auto using TheoryEmb1.

               refine (ConstantPrincipalCase _ H6 H2).
               PermuteLeft.
               cutOL Hseq1 H4.
               OLSolve.
               rewrite <- app_comm_cons...
               apply H10...
               LLPerm ((x3 ++ x) ++ N)...
               PermuteLeft.
               cutOL Hseq1 H6.
               TFocus (makeLRuleC C0).
               inversion H0.
               FLLsplit (@nil oo) (M++N).
               apply H10...
               LLPerm ( (M ++ x) ++ N)...
           -- permuteUnary.
           -- permuteUnary.
           -- permuteBinary.
           -- permuteBinary.
           -- permuteQuantifier.
           -- permuteQuantifier.
(** 1.2 ONE PREMISSE *)
  * Cases H.
     2:{
       PermuteLeft.
         cutOL H1 Hseq2.
         OLSolve.
         LLPerm ((⌈ t_ccon C ⌉) ::(M++ x3))...
         apply H7...
         rewrite app_assoc_reverse... }
     2:{  PermuteLeft.
               cutOL H3 Hseq2.
               TFocus (makeRRuleC C).
               inversion H.
               FLLsplit (@nil oo) (M++N).
               apply H7...
               rewrite app_assoc_reverse... }

         inversion Hth'...
         - wellConstant Hseq2'.
           -- Cases H2.
               rewrite <- app_comm_cons...
           -- Cases H2.
               rewrite <- app_comm_cons...
               PermuteLeft.
               cutOL Hseq1 H8.
               OLSolve.
               apply H14...
               rewrite Permutation_assoc_comm...
               PermuteLeft.
               cutOL Hseq1 H10.
               TFocus (makeRRuleC C0).
               inversion H2.
               FLLsplit (@nil oo) (M++N).
               apply H14...
               rewrite Permutation_assoc_comm...
         - wellConstant Hseq2'.
           -- Cases H2.
               rewrite <- H11 in H9.
               rewrite <- H6 in H3.
               rewrite Permutation_app_comm.
               apply WeakTheory with (theory := OLTheory nPnN ). auto using TheoryEmb1.

               refine (ConstantPrincipalCase _ H9 H3).

               rewrite <- app_comm_cons...
           -- Cases H2.
               rewrite <- H13 in H10.
               rewrite <- H6 in H3.
               rewrite Permutation_app_comm.
               apply WeakTheory with (theory := OLTheory nPnN ). auto using TheoryEmb1.
               refine (ConstantPrincipalCase _ H10 H3).

               rewrite <- app_comm_cons...
               PermuteLeft.
               cutOL Hseq1 H8.
               OLSolve.
               apply H14...
               rewrite Permutation_assoc_comm...
               PermuteLeft.
               cutOL Hseq1 H10.
               TFocus (makeLRuleC C0).
               inversion H2.
               FLLsplit (@nil oo) (M++N).
               apply H14...
               rewrite Permutation_assoc_comm...
         - permuteUnary.
         - permuteUnary.
         - permuteBinary.
         - permuteBinary.
         - permuteQuantifier.
         - permuteQuantifier.
 Qed.

Lemma UnaryRIGHT n n' n0 n1  C F FCut M N Gamma F0:
  n' <= n ->
  isOLFormula (t_ucon C F) ->
  isOLFormula FCut ->
  lengthUexp FCut n' ->
  IsPositiveAtomFormulaL M ->
  IsPositiveAtomFormulaL N ->
  IsPositiveAtomFormulaL Gamma ->
  flln (OLTheory nPnN) (S n0) Gamma  ( (⌈ FCut ⌉) ::N) (UP []) ->
  flln (OLTheory nPnN) (S n1)  Gamma ( (⌊ FCut ⌋) ::M) (UP []) ->
  flln (OLTheory nPnN) n0 Gamma ( (⌈ FCut ⌉) :: N) (DW (makeRRuleU C F)) ->
  flln (OLTheory nPnN) n1 Gamma ( (⌊ FCut ⌋) :: M) (DW F0) ->
  OOCut n' (S n0 + S n1) ->
  buildTheory (makeRRuleU C F) ->
  buildTheory F0 ->
  flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto.
  intros HL' HisFC HisF HL PosM PosN PosG Hseq1 Hseq2.
  intros Hseq1' Hseq2' OLCut Hth Hth'.
  wellUnary Hseq1'.
  * Cases H.
     2:{  PermuteLeft.
         cutOL H1 Hseq2.
         OLSolve.
         LLPerm ((⌈ t_ucon C F ⌉) ::(M++ x3))...
         apply H7...
         rewrite app_assoc_reverse... }
     2:{ PermuteLeft.
        cutOL H3 Hseq2.
               TFocus (makeRRuleU C F).
               inversion H.
               FLLsplit (@nil oo) (M++N).
               apply H7...
               rewrite app_assoc_reverse... }
         inversion Hth'...
         - wellConstant Hseq2'.
           -- Cases H2.
               rewrite <- app_comm_cons...
           -- Cases H2.
               rewrite <- app_comm_cons...
               PermuteLeft.
               cutOL Hseq1 H8.
               OLSolve.
               apply H14...
               rewrite Permutation_assoc_comm...
               PermuteLeft.
               cutOL Hseq1 H10.
               TFocus (makeRRuleC C0).
               inversion H2.
               FLLsplit (@nil oo) (M++N).
               apply H14...
               rewrite Permutation_assoc_comm...
         - wellConstant Hseq2'.
           -- Cases H2.
              rewrite <- app_comm_cons...
           -- Cases H2.
              PermuteLeft.
              cutOL Hseq1 H8.
               rewrite H12 in PosM.
               OLSolve.
               rewrite <- app_comm_cons ...
               apply H14...
               rewrite Permutation_assoc_comm...
              PermuteLeft.
              cutOL Hseq1 H10.
                 TFocus (makeLRuleC C0).
                 inversion H2.
             FLLsplit (@nil oo) (M++N).
               apply H14...
               rewrite Permutation_assoc_comm...
         - permuteUnary.
         - wellUnary Hseq2'.
            Cases H2.

            rewrite <- H6 in H3.
            rewrite <- H13 in H10.
            rewrite Permutation_app_comm.
            refine(UConnectivePrincipalCase _ H3 _ _ HL')...
             PermuteLeft.
              cutOL Hseq1 H8.
               rewrite H12 in PosM.
               OLSolve.
               rewrite <- app_comm_cons ...
               apply H14...
               rewrite Permutation_assoc_comm...

PermuteLeft.
              cutOL Hseq1 H10.
                 TFocus (makeLRuleU C0 F1).
                 inversion H2.
             FLLsplit (@nil oo) (M++N).
               apply H14...
               rewrite Permutation_assoc_comm...
         - permuteBinary.
         - permuteBinary.
         - permuteQuantifier.
         - permuteQuantifier.
  Qed.

Ltac doubleH H :=
let tH := type of H in
   let H := fresh H in assert(H:tH) by auto.

Lemma BinaryRIGHT n n' n0 n1  C F G FCut M N Gamma F0:
  n' <= n ->
  isOLFormula (t_bcon C F G) ->
  isOLFormula FCut ->
  lengthUexp FCut n' ->
  IsPositiveAtomFormulaL M ->
  IsPositiveAtomFormulaL N ->
  IsPositiveAtomFormulaL Gamma ->
  flln (OLTheory nPnN) (S n0) Gamma ( (⌈ FCut ⌉) :: N) (UP []) ->
  flln (OLTheory nPnN) (S n1) Gamma ( (⌊ FCut ⌋) :: M) (UP []) ->
  flln (OLTheory nPnN) n0 Gamma ( (⌈ FCut ⌉) :: N) (DW (makeRRuleB C F G)) ->
  flln (OLTheory nPnN) n1 Gamma ( (⌊ FCut ⌋) ::M) (DW F0) ->
  OOCut n' (S n0 + S n1) ->
  buildTheory (makeRRuleB C F G) ->
  buildTheory F0 ->
  flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto.
  intros HL' HisFC HisF HL PosM PosN PosG Hseq1 Hseq2.
  intros Hseq1' Hseq2' OLCut Hth Hth'.
  wellBinary Hseq1'.
  * Cases H.
     2:{ PermuteLeft. cutOL H1 Hseq2.
           OLSolve.
         LLPerm ( (⌈ t_bcon C F G ⌉) ::(M++ x3))...
         apply H7...
         rewrite app_assoc_reverse... }
     + inversion Hth'...
         - wellConstant Hseq2'.
            -- Cases H2.
               rewrite <- app_comm_cons...
            -- Cases H2.
               PermuteLeft.
               cutOL Hseq1 H8.
               OLSolve.
               rewrite <- app_comm_cons...
               apply H14...
               LLPerm ((x7 ++ x3) ++ N)...
               PermuteLeft.
               cutOL Hseq1 H10.
               OLSolve.
               TFocus (makeRRuleC C0).
               inversion H2.
               FLLsplit (@nil oo) (M++N).
               apply H14...
               LLPerm ( (M ++ x3) ++ N)...
           - wellConstant Hseq2'.
               Cases H2.
               rewrite <- app_comm_cons...
               Cases H2.
               PermuteLeft.
               cutOL Hseq1 H8.
               OLSolve.
               rewrite <- app_comm_cons...
               apply H14...
               LLPerm ((x7 ++ x3) ++ N)...
               PermuteLeft.
               cutOL Hseq1 H10.
               OLSolve.
               TFocus (makeLRuleC C0).
               inversion H2.
               FLLsplit (@nil oo) (M++N).
               apply H14...
               LLPerm ( (M ++ x3) ++ N)...
           - permuteUnary.
           - permuteUnary.
           - permuteBinary.
           - wellBinary Hseq2'.
               { Cases H2.
              2:{  PermuteLeft.
               cutOL Hseq1 H8.
               OLSolve.
               LLPerm ( (⌊  t_bcon C0 F1 G0 ⌋) :: x7++ N).
               apply H14...
               LLPerm ((x7 ++ x3) ++ N)... }
               rewrite H6, H13.
               LLPerm (x2++x6).
                refine (BinConnectivePrincipalCase H10 H3 _ _ HL')...
               PermuteLeft.
              cutOL Hseq1 H10.
               OLSolve.
               TFocus (makeLRuleB C0 F1 G0).
               inversion H2.
               FLLsplit (@nil oo) (M++N).
               apply H14...
               LLPerm ( (M ++ x3) ++ N)... }
               { Cases H2.

               2:{ PermuteLeft.
              cutOL Hseq1 H11.
               assert (IsPositiveAtomFormulaL x9). OLSolve.
 OLSolve.
               LLPerm (( (⌊  t_bcon C0 F1 G0 ⌋) :: N ++ x10) ++ x4).
               apply H16...
               LLPerm  ((x10 ++ x5) ++ N)... eauto. }
               rewrite <- H15 in H8.
              rewrite H6. LLPerm (x2++M).
               refine (BinConnectivePrincipalCase H8 H3 _ _ HL')...
               PermuteLeft.
               cutOL Hseq1 H12.
                     assert (IsPositiveAtomFormulaL x9). OLSolve.
 OLSolve.
                LLPerm ((⌊ t_bcon C0 F1 G0 ⌋ :: x3 ) ++ x10++N).
                apply H16...
             eauto.
                LLPerm ((x10 ++ x6) ++ N )...
               PermuteLeft.
               cutOL Hseq1 H12. OLSolve.
               TFocus (makeLRuleB C0 F1 G0).
               inversion H2.
               FLLsplit (@nil oo) ((x9 ++ x4) ++ N).
               LLPerm ((x9 ++ N) ++ x4).
               apply H17...
               LLPerm ((x9 ++ x5) ++ N)...
               eauto.
               PermuteLeft.
               cutOL Hseq1 H13. OLSolve.
               TFocus (makeLRuleB C0 F1 G0).
               inversion H2.
               FLLsplit (@nil oo) ((x9 ++ x3) ++ N).
               LLPerm (x3++(x9 ++ N)).
               apply H17... eauto.
               LLPerm ((x9 ++ x6) ++ N)... }
               { Cases H2.
               rewrite H6, H15.
               LLPerm (x2++x3).
               refine (BinConnectivePrincipalCase H8 H3 _ _ HL')...
               PermuteLeft.
               cutOL Hseq1 H11.
               OLSolve.
               cutOL Hseq1 H12.
               OLSolve.
               LLPerm ( (⌊  t_bcon C0 F1 G0 ⌋) :: x8 ++ N).
               apply H16...
               LLPerm ((x8 ++ x4) ++ N)...
               LLPerm ((x8 ++ x5) ++ N)...
               PermuteLeft.
               cutOL Hseq1 H11.
               OLSolve.
               cutOL Hseq1 H12.
               OLSolve.
               TFocus (makeLRuleB C0 F1 G0).
               inversion H2.
               FLLsplit (@nil oo) ( M++ N).
               apply H16...
               LLPerm ((M ++ x4) ++ N)...
               LLPerm ((M ++ x5) ++ N)... }
           - permuteQuantifier.
           - permuteQuantifier.
        + PermuteLeft. cutOL H3 Hseq2.
            TFocus (makeRRuleB C F G).
            inversion H.
            FLLsplit (@nil oo) (M++N).
            apply H7...
            LLPerm (M++N++x)...
  * Cases H.
     2:{ PermuteLeft. cutOL H4 Hseq2.
        assert (IsPositiveAtomFormulaL x5). OLSolve.
 OLSolve.
         PermuteLeft.
         LLPerm  (⌈ t_bcon C F G ⌉ :: (M ++  x6) ++ x0) .
         apply H9...
          LLPerm (M ++ x6 ++ x1)... eauto. }
      2:{   PermuteLeft.
         cutOL H5 Hseq2.
        assert (IsPositiveAtomFormulaL x5). OLSolve.
 OLSolve.
                LLPerm (( (⌈ t_bcon C F G ⌉) :: x ) ++ M ++x6)...
         apply H9... eauto.
         rewrite app_assoc_reverse... }
     + rewrite <- H8 in H1.
         inversion Hth'...
         - wellConstant Hseq2'.
            -- Cases H3.
               rewrite <- app_comm_cons...
            -- Cases H3.
               PermuteLeft.
               cutOL Hseq1 H10.
               OLSolve.
               rewrite <- app_comm_cons...
               apply H16...
               LLPerm ((x9 ++ x5) ++ N)...
               PermuteLeft.
               cutOL Hseq1 H12.
               OLSolve.
               TFocus (makeRRuleC C0).
               inversion H3.
               FLLsplit (@nil oo) (M++N).
               apply H16...
               LLPerm ( (M ++ x5) ++ N)...
           - wellConstant Hseq2'.
               Cases H3.
               rewrite <- app_comm_cons...
               Cases H3.
               PermuteLeft.
               cutOL Hseq1 H10.
               OLSolve.
               rewrite <- app_comm_cons...
               apply H16...
               LLPerm ((x9 ++ x5) ++ N)...
               PermuteLeft.
               cutOL Hseq1 H12.
               OLSolve.
               TFocus (makeLRuleC C0).
               inversion H3.
               FLLsplit (@nil oo) (M++N).
               apply H16...
               LLPerm ( (M ++ x5) ++ N)...
           - permuteUnary.
           - permuteUnary.
           - permuteBinary.
           - wellBinary Hseq2'.
               { Cases H3.
              2:{  PermuteLeft.
               cutOL Hseq1 H10.
               OLSolve.
               LLPerm ( (⌊  t_bcon C0 F1 G0 ⌋) :: x9++ N).
               apply H16...
               LLPerm ((x9 ++ x5) ++ N)... }
               rewrite H15.
               LLPerm (N++x8).
                refine (BinConnectivePrincipalCase H12 H1 _ _ HL')...
               PermuteLeft.
              cutOL Hseq1 H12.
               OLSolve.
               TFocus (makeLRuleB C0 F1 G0).
               inversion H3.
               FLLsplit (@nil oo) (M++N).
               apply H16...
               LLPerm ( (M ++ x5) ++ N)... }
               { Cases H3.

               2:{ PermuteLeft.
              cutOL Hseq1 H13.
        assert (IsPositiveAtomFormulaL x11). OLSolve.
 OLSolve.
       LLPerm (( (⌊  t_bcon C0 F1 G0 ⌋) :: N ++ x12) ++ x6).
               apply H18...
               LLPerm  ((x12 ++ x7) ++ N)... eauto. }
               rewrite <- H17 in H10.
               LLPerm (N++M).
               refine (BinConnectivePrincipalCase H10 H1 _ _ HL')...
               PermuteLeft.
               cutOL Hseq1 H14.
        assert (IsPositiveAtomFormulaL x11). OLSolve.
 OLSolve.
                LLPerm ((⌊ t_bcon C0 F1 G0 ⌋ :: x5) ++ x12++N).
                apply H18...
             eauto.
                LLPerm ((x12 ++ x8) ++ N )...
               PermuteLeft.
               cutOL Hseq1 H14. OLSolve.
               TFocus (makeLRuleB C0 F1 G0).
               inversion H3.
               FLLsplit (@nil oo) ((x11 ++ x6) ++ N).
               LLPerm ((x11 ++ N) ++ x6).
               apply H19...
               LLPerm ((x11 ++ x7) ++ N)...
               eauto.
               PermuteLeft.
               cutOL Hseq1 H15. OLSolve.
               TFocus (makeLRuleB C0 F1 G0).
               inversion H3.
               FLLsplit (@nil oo) ((x11 ++ x5) ++ N).
               LLPerm (x5++(x11 ++ N)).
               apply H19... eauto.
               LLPerm ((x11 ++ x8) ++ N)... }
               { Cases H3.
               rewrite H17.
               LLPerm (N++x5).
               refine (BinConnectivePrincipalCase H10 H1 _ _ HL')...
               PermuteLeft.
               cutOL Hseq1 H13.
               OLSolve.
               cutOL Hseq1 H14.
               OLSolve.
               LLPerm ( (⌊  t_bcon C0 F1 G0 ⌋) :: x10 ++ N).
               apply H18...
               LLPerm ((x10 ++ x6) ++ N)...
               LLPerm ((x10 ++ x7) ++ N)...
               PermuteLeft.
               cutOL Hseq1 H13.
               OLSolve.
               cutOL Hseq1 H14.
               OLSolve.
               TFocus (makeLRuleB C0 F1 G0).
               inversion H3.
               FLLsplit (@nil oo) ( M++ N).
               apply H18...
               LLPerm ((M ++ x6) ++ N)...
               LLPerm ((M ++ x7) ++ N)... }
           - permuteQuantifier.
           - permuteQuantifier.
        + PermuteLeft. cutOL H5 Hseq2. OLSolve.
            TFocus (makeRRuleB C F G).
            inversion H.
            FLLsplit (@nil oo) ((M ++ x5) ++ x0).
            apply H10...
            LLPerm (M ++ x5 ++ x1)... eauto.
          + PermuteLeft. cutOL H6 Hseq2. OLSolve.
            TFocus (makeRRuleB C F G).
            inversion H.
            FLLsplit (@nil oo) (x++(M ++ x5)).
            apply H10... eauto.
            LLPerm (M ++ x5 ++ x2)...
  * Cases H.
     2:{ PermuteLeft. cutOL H4 Hseq2.
         OLSolve. cutOL H5 Hseq2. OLSolve.
         LLPerm  (⌈ t_bcon C F G ⌉ :: M ++  x4) .
         apply H9...
          LLPerm (M ++ x4 ++ x0)... LLPerm (M ++ x4 ++ x1)...  }
      2:{   PermuteLeft.
        cutOL H4 Hseq2.
         OLSolve. cutOL H5 Hseq2. OLSolve.
          TFocus (makeRRuleB C F G).
            inversion H.
            FLLsplit (@nil oo) (M++N).
           apply H9... eauto.
         1-2: rewrite app_assoc_reverse... }
     + rewrite <- H8 in H1.
         inversion Hth'...
         - wellConstant Hseq2'.
            -- Cases H3.
               rewrite <- app_comm_cons...
            -- Cases H3.
               PermuteLeft.
               cutOL Hseq1 H10.
               OLSolve.
               rewrite <- app_comm_cons...
               apply H16...
               LLPerm ((x8 ++ x4) ++ N)...
               PermuteLeft.
               cutOL Hseq1 H12.
               OLSolve.
               TFocus (makeRRuleC C0).
               inversion H3.
               FLLsplit (@nil oo) (M++N).
               apply H16...
               LLPerm ( (M ++ x4) ++ N)...
           - wellConstant Hseq2'.
               Cases H3.
               rewrite <- app_comm_cons...
               Cases H3.
               PermuteLeft.
               cutOL Hseq1 H10.
               OLSolve.
               rewrite <- app_comm_cons...
               apply H16...
               LLPerm ((x8 ++ x4) ++ N)...
               PermuteLeft.
               cutOL Hseq1 H12.
               OLSolve.
               TFocus (makeLRuleC C0).
               inversion H3.
               FLLsplit (@nil oo) (M++N).
               apply H16...
               LLPerm ( (M ++ x4) ++ N)...
           - permuteUnary.
           - permuteUnary.
           - permuteBinary.
           - wellBinary Hseq2'.
               { Cases H3.
              2:{  PermuteLeft.
               cutOL Hseq1 H10.
               OLSolve.
               LLPerm ( (⌊  t_bcon C0 F1 G0 ⌋) :: x8++ N).
               apply H16...
               LLPerm ((x8 ++ x4) ++ N)... }
               rewrite H15.
               LLPerm (N++x7).
                refine (BinConnectivePrincipalCase H12 H1 _ _ HL')...
               PermuteLeft.
              cutOL Hseq1 H12.
               OLSolve.
               TFocus (makeLRuleB C0 F1 G0).
               inversion H3.
               FLLsplit (@nil oo) (M++N).
               apply H16...
               LLPerm ( (M ++ x4) ++ N)... }
               { Cases H3.

               2:{ PermuteLeft.
              cutOL Hseq1 H13.
        assert (IsPositiveAtomFormulaL x10). OLSolve.
 OLSolve.
               LLPerm (( (⌊  t_bcon C0 F1 G0 ⌋) :: N ++ x11) ++ x5).
               apply H18...
               LLPerm  ((x11 ++ x6) ++ N)... eauto. }
               rewrite <- H17 in H10.
               LLPerm (N++M).
               refine (BinConnectivePrincipalCase H10 H1 _ _ HL')...
               PermuteLeft.
               cutOL Hseq1 H14.
        assert (IsPositiveAtomFormulaL x10). OLSolve.
 OLSolve.
       LLPerm ((⌊ t_bcon C0 F1 G0 ⌋ :: x4) ++ x11++N).
                apply H18...
             eauto.
                LLPerm ((x11 ++ x7) ++ N )...
               PermuteLeft.
               cutOL Hseq1 H14. OLSolve.
               TFocus (makeLRuleB C0 F1 G0).
               inversion H3.
               FLLsplit (@nil oo) ((x10 ++ x5) ++ N).
               LLPerm ((x10 ++ N) ++ x5).
               apply H19...
               LLPerm ((x10 ++ x6) ++ N)...
               eauto.
               PermuteLeft.
               cutOL Hseq1 H15. OLSolve.
               TFocus (makeLRuleB C0 F1 G0).
               inversion H3.
               FLLsplit (@nil oo) ((x10 ++ x4) ++ N).
               LLPerm (x4++(x10 ++ N)).
               apply H19... eauto.
               LLPerm ((x10 ++ x7) ++ N)... }
               { Cases H3.
               rewrite H17.
               LLPerm (N++x4).
               refine (BinConnectivePrincipalCase H10 H1 _ _ HL')...
               PermuteLeft.
               cutOL Hseq1 H13.
               OLSolve.
               cutOL Hseq1 H14.
               OLSolve.
               LLPerm ( (⌊  t_bcon C0 F1 G0 ⌋) :: x9 ++ N).
               apply H18...
               LLPerm ((x9 ++ x5) ++ N)...
               LLPerm ((x9 ++ x6) ++ N)...
               PermuteLeft.
               cutOL Hseq1 H13.
               OLSolve.
               cutOL Hseq1 H14.
               OLSolve.
               TFocus (makeLRuleB C0 F1 G0).
               inversion H3.
               FLLsplit (@nil oo) ( M++ N).
               apply H18...
               LLPerm ((M ++ x5) ++ N)...
               LLPerm ((M ++ x6) ++ N)... }
           - permuteQuantifier.
           - permuteQuantifier.
Qed.

Lemma QuantifierRIGHT n n' n0 n1  C FX FCut M N Gamma F0:
  n' <= n ->
  isOLFormula (t_qcon C FX) ->
  isOLFormula FCut ->
  lengthUexp FCut n' ->
  IsPositiveAtomFormulaL M ->
  IsPositiveAtomFormulaL N ->
  IsPositiveAtomFormulaL Gamma ->
  flln (OLTheory nPnN) (S n0)  Gamma ( (⌈ FCut ⌉) ::N) (UP []) ->
  flln (OLTheory nPnN) (S n1) Gamma ( (⌊ FCut ⌋) :: M) (UP []) ->
  flln (OLTheory nPnN) n0 Gamma ( (⌈ FCut ⌉) :: N) (DW (makeRRuleQ C FX)) ->
  flln (OLTheory nPnN) n1 Gamma ( (⌊ FCut ⌋) :: M) (DW F0) ->
  OOCut n' (S n0 + S n1) ->
  buildTheory (makeRRuleQ C FX) ->
  buildTheory F0 ->
  flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto.
  intros HL' HisFC HisF HL PosM PosN PosG Hseq1 Hseq2.
  intros Hseq1' Hseq2' OLCut Hth Hth'.
  wellQuantifier Hseq1'.
  Cases H.
  2:{ PermuteLeft.
         cutOL H1 Hseq2.
         OLSolve.
         LLPerm ( (⌈ t_qcon C FX ⌉) ::(M++ x3))...
         apply H7...
         rewrite app_assoc_reverse... }
  2:{ PermuteLeft.
         cutOL H3 Hseq2.
         TFocus (makeRRuleQ C FX).
         inversion H.
         FLLsplit (@nil oo) (M++N).
         apply H7...
         rewrite app_assoc_reverse... }
    inversion Hth'...
           -- wellConstant Hseq2'.
               Cases H2.
               rewrite <- app_comm_cons...
               Cases H2.
               PermuteLeft.
               cutOL Hseq1 H8.
               OLSolve.
               rewrite <- app_comm_cons...
               apply H14...
               LLPerm ((x7 ++ x3) ++ N)...
               PermuteLeft.
               cutOL Hseq1 H10.
               TFocus (makeRRuleC C0).
               inversion H2.
               FLLsplit (@nil oo) (M++N).
               apply H14...
               LLPerm ( (M ++ x3) ++ N)...
           -- wellConstant Hseq2'.
               Cases H2.
               rewrite <- app_comm_cons...
               Cases H2.
               PermuteLeft.
               cutOL Hseq1 H8.
               OLSolve.
               rewrite <- app_comm_cons...
               apply H14...
               LLPerm ((x7 ++ x3) ++ N)...
               PermuteLeft.
               cutOL Hseq1 H10.
               TFocus (makeLRuleC C0).
               inversion H2.
               FLLsplit (@nil oo) (M++N).
               apply H14...
               LLPerm ( (M ++ x3) ++ N)...
           -- permuteUnary.
           -- permuteUnary.
           -- permuteBinary.
           -- permuteBinary.
           -- permuteQuantifier.
           -- wellQuantifier Hseq2'.
               destruct H2...
               checkPermutationCases H2.
               inversion H12...
               rewrite <- H6 in H3.
               rewrite <- H13 in H10.
               rewrite Permutation_app_comm.
               refine (QuantifierPrincipalCase H10 H3 _ _ _ _ _ _ HL')...
               PermuteLeft.
               cutOL Hseq1 H8.
               OLSolve.
               rewrite H12.
               LLPerm ( (⌊t_qcon C0 FX0 ⌋) :: x7++ N).
               apply H14...
               LLPerm ((x7 ++ x3) ++ N)...

               PermuteLeft.
               cutOL Hseq1 H10.
              TFocus (makeLRuleQ C0 FX0).
               inversion H2.
               FLLsplit (@nil oo) (M++N).
               apply H14...
               LLPerm ((M ++ x3) ++ N)...
     Qed.

Definition ConnectiveLeft connective rule := forall n n' n0 n1  FCut M N Gamma,
  n' <= n ->
  isOLFormula connective ->
  isOLFormula FCut ->
  lengthUexp FCut n' ->
  IsPositiveAtomFormulaL M ->
  IsPositiveAtomFormulaL N ->
  IsPositiveAtomFormulaL Gamma ->
  flln (OLTheory nPnN) (S n1) Gamma ((⌊ FCut ⌋) :: M) (UP []) ->
  flln (OLTheory nPnN) n0 Gamma ( (⌈ FCut ⌉) :: N) (DW rule) ->
  OOCut n' (S n0 + S n1) ->
  buildTheory rule ->
  flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).

Lemma ConstantLEFT n n' n0 n1  C FCut M N Gamma:
  n' <= n ->
  isOLFormula (t_ccon C) ->
  isOLFormula FCut ->
  lengthUexp FCut n' ->
  IsPositiveAtomFormulaL M ->
  IsPositiveAtomFormulaL N ->
  IsPositiveAtomFormulaL Gamma ->
  flln (OLTheory nPnN) (S n1) Gamma ((⌊ FCut ⌋) :: M) (UP []) ->
  flln (OLTheory nPnN) n0 Gamma ( (⌈ FCut ⌉) :: N) (DW (makeLRuleC C)) ->
  OOCut n' (S n0 + S n1) ->
  buildTheory (makeLRuleC C) ->
  flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto.
  intros HL' HisFC HisF HL PosM PosN PosG Hseq2.
  intros Hseq1' OLCut Hth.
  wellConstant Hseq1'.
  * Cases H.
     + LLPerm ( (⌊ t_ccon C ⌋) :: x0++M)...
  * Cases H.
     + PermuteLeft.
         cutOL H1 Hseq2.
         OLSolve.
         LLPerm ( (⌊ t_ccon C ⌋) ::(M++ x3)).
         apply H7...
         LLPerm(M ++ x3 ++ x)...
    + PermuteLeft.
         cutOL H3 Hseq2.
         TFocus (makeLRuleC C).
         inversion H.
         FLLsplit (@nil oo) (M++N).
         apply H7...
         LLPerm(M ++ N ++ x)...
Qed.

 Lemma UnaryLEFT n n' n0 n1 C F FCut M N Gamma:
  n' <= n ->
  isOLFormula (t_ucon C F) ->
  isOLFormula FCut ->
  lengthUexp FCut n' ->
  IsPositiveAtomFormulaL M ->
  IsPositiveAtomFormulaL N ->
  IsPositiveAtomFormulaL Gamma ->
  flln (OLTheory nPnN) (S n1) Gamma  ( (⌊ FCut ⌋) :: M) (UP []) ->
  flln (OLTheory nPnN) n0 Gamma ( (⌈ FCut ⌉) :: N) (DW (makeLRuleU C F)) ->
  OOCut n' (S n0 + S n1) ->
  buildTheory (makeLRuleU C F) ->
  flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto.
  intros HL' HisFC HisF HL PosM PosN PosG Hseq2.
  intros Hseq1' OLCut Hth.
  wellUnary Hseq1'.
  * Cases H.
     + PermuteLeft.
         cutOL H1 Hseq2.
         OLSolve.
         LLPerm ( (⌊ t_ucon C F ⌋) ::(M++ x3)).
         apply H7...
         LLPerm(M ++ x3 ++ x)...
     + PermuteLeft.
         cutOL H3 Hseq2.
         TFocus (makeLRuleU C F).
         inversion H.
         FLLsplit (@nil oo) (M++N).
         apply H7...
         LLPerm(M ++ N ++ x)...
Qed.

 Lemma BinaryLEFT n n' n0 n1 C F G FCut M N Gamma:
  n' <= n ->
  isOLFormula (t_bcon C F G) ->
  isOLFormula FCut ->
  lengthUexp FCut n' ->
  IsPositiveAtomFormulaL M ->
  IsPositiveAtomFormulaL N ->
  IsPositiveAtomFormulaL Gamma ->
  flln (OLTheory nPnN) (S n1) Gamma ((⌊ FCut ⌋) :: M) (UP []) ->
  flln (OLTheory nPnN) n0 Gamma ( (⌈ FCut ⌉) :: N) (DW (makeLRuleB C F G)) ->
  OOCut n' (S n0 + S n1) ->
  buildTheory (makeLRuleB C F G) ->
  flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto.
  intros HL' HisFC HisF HL PosM PosN PosG Hseq2.
  intros Hseq1' OLCut Hth.
  wellBinary Hseq1'.
  * Cases H.
    +  PermuteLeft.
           cutOL H1 Hseq2.
         OLSolve.
         LLPerm ( (⌊t_bcon C F G ⌋) ::(M++ x3)).
         apply H7...
         LLPerm(M ++ x3 ++ x)...
     + PermuteLeft.
        cutOL H3 Hseq2.
         TFocus (makeLRuleB C F G).
         inversion H.
         FLLsplit (@nil oo) (M++N).
         apply H7...
         LLPerm(M ++ N ++ x)...
  * Cases H.
     +
     PermuteLeft.
      cutOL H4 Hseq2.
        assert (IsPositiveAtomFormulaL x5). OLSolve.
 OLSolve.
         LLPerm ((⌊ t_bcon C F G ⌋) :: (M++x6) ++ x0).
         apply H9...
         rewrite app_assoc_reverse... eauto.
     +
     PermuteLeft.    cutOL H5 Hseq2.
        assert (IsPositiveAtomFormulaL x5). OLSolve.
 OLSolve.
         LLPerm ( (⌊ t_bcon C F G ⌋) :: x++(M++x6)).
         apply H9... eauto.
         rewrite app_assoc_reverse...
     +
     PermuteLeft.    cutOL H5 Hseq2.
         OLSolve.
         TFocus  (makeLRuleB C F G).
         inversion H.
         FLLsplit (@nil oo) ((M ++ x5) ++ x0).
         apply H10...
         rewrite app_assoc_reverse... eauto.
     +
     PermuteLeft.    cutOL H6 Hseq2.
         OLSolve.
         TFocus  (makeLRuleB C F G).
         inversion H.
         FLLsplit (@nil oo) (x++(M ++ x5)).
         apply H10... eauto.
           rewrite app_assoc_reverse...
  * Cases H.
     + PermuteLeft.
        cutOL H4 Hseq2.
         OLSolve.
        cutOL H5 Hseq2.
         OLSolve.
         LLPerm ( (⌊ t_bcon C F G ⌋) :: M++x4).
         apply H9...
         1-2: rewrite app_assoc_reverse...
     + PermuteLeft.
        cutOL H4 Hseq2.
         OLSolve.
        cutOL H5 Hseq2.
         OLSolve.
         TFocus (makeLRuleB C F G).
         inversion H.
         FLLsplit (@nil oo) (M++N).
         apply H9...
         1-2: rewrite app_assoc_reverse...
Qed.

Lemma QuantifierLEFT n n' n0 n1 C FX FCut M N Gamma:
  n' <= n ->
  isOLFormula (t_qcon C FX) ->
  isOLFormula FCut ->
  lengthUexp FCut n' ->
  IsPositiveAtomFormulaL M ->
  IsPositiveAtomFormulaL N ->
  IsPositiveAtomFormulaL Gamma ->
  flln (OLTheory nPnN) (S n1) Gamma ( (⌊ FCut ⌋) :: M) (UP []) ->
  flln (OLTheory nPnN) n0 Gamma ( (⌈ FCut ⌉) :: N) (DW (makeLRuleQ C FX)) ->
  OOCut n' (S n0 + S n1) ->
  buildTheory (makeLRuleQ C FX) ->
  flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP []).
Proof with sauto.
  intros HL' HisFC HisF HL PosM PosN PosG Hseq2.
  intros Hseq1' OLCut Hth.
  wellQuantifier Hseq1'.
  * Cases H.
     + PermuteLeft.
         cutOL H1 Hseq2.
         OLSolve.
         LLPerm ( (⌊ t_qcon C FX ⌋) ::(M++ x3)).
         apply H7...
         LLPerm(M ++ x3 ++ x)...
     + PermuteLeft.
         cutOL H3 Hseq2.
         TFocus (makeLRuleQ C FX).
         inversion H.
         FLLsplit (@nil oo) (M++N).
         apply H7...
         LLPerm(M ++ N ++ x)...
Qed.

 (** Main theorem showing that it is possible to fins a proof with
  the theory [ (OLTheoryCut nPnN (pred n))] *)
  Theorem OLCutElimStep :
    forall h1 h2 n N M Gamma FCut n',
      isOLFormula FCut ->
      IsPositiveAtomFormulaL Gamma ->
      IsPositiveAtomFormulaL N ->
      IsPositiveAtomFormulaL M ->
      flln (OLTheory nPnN) h1 Gamma ( atom(up FCut)::N) (UP []) ->
      flln (OLTheory nPnN) h2 Gamma (atom (down FCut)::M) (UP []) ->
      lengthUexp FCut n' -> n'<=n ->
      (flls (OLTheoryCut nPnN (pred n)) Gamma (M ++ N) (UP [])) .
  Proof with sauto.
    intros h1 h2 n N M Gamma FCut n' HisF PosG PosN PosM Hseq1 Hseq2 HL HL'.
    remember (plus h1 h2) as h.
    generalize dependent Gamma.
    generalize dependent N.
    generalize dependent M.
    generalize dependent FCut.
    generalize dependent n.
    generalize dependent h1.
    generalize dependent h2.

    induction h using lt_wf_ind; intros.

    inversion Hseq1...

cut(False);intros...
       refine (onlyAtomsLinear _ H0 H1)...

  cut(False);intros...
       refine (onlyAtomsClassical _ H0 H1)...

   inversion Hseq2...

cut(False);intros...
       refine (onlyAtomsLinear _ H3 H4)...

  cut(False);intros...
    refine (onlyAtomsClassical _ H3 H4)...

    assert(OOCut n' (S n0 + S n1)).
    {
    unfold OOCut; intros.
    revert H13 H14.
    eapply H with  (m:=h1 + h2)... }
    clear H.
    rename n0 into h1.
    rename n1 into h2.
   (* Now we proceed by cases on the last rule applied on both derivations *)
    inversion H1 ;inversion H4...
   all: try match goal with
    | H: neg nPnN |- _ => inversion H
    | H: pos nPnN |- _ => inversion H
    end.
    * inversion H...
       - refine(ConstantRIGHT
                           HL'
                           H7
                           HisF _ _ _ _
                           Hseq1
                           Hseq2 _ _ _ _
                           H8)...
       - refine(ConstantLEFT
                           HL'
                           H7
                           HisF _ _ _ _
                           Hseq2
                           H2 _ _)...
       - refine(UnaryRIGHT
                           HL'
                           H7
                           HisF _ _ _ _
                           Hseq1
                           Hseq2 _ _ _ _
                           H8)...
       - refine(UnaryLEFT
                           HL'
                           H7
                           HisF _ _ _ _
                           Hseq2
                           H2 _ _)...
       - refine(BinaryRIGHT
                           HL'
                           H7
                           HisF _ _ _ _
                           Hseq1
                           Hseq2 _ _ _ _
                           H8)...
       - refine(BinaryLEFT
                           HL'
                           H7
                           HisF _ _ _ _
                           Hseq2
                           H2 _ _)...
       - refine(QuantifierRIGHT
                           HL'
                           H7
                           HisF _ _ _ _
                           Hseq1
                           Hseq2 _ _ _ _
                           H8)...
       - refine(QuantifierLEFT
                           HL'
                           H7
                           HisF _ _ _ _
                           Hseq2
                           H2 _ _)...
    * apply FocusingInitRuleU in H5...
       - checkPermutationCases H7.
          inversion H7...
          apply seqNtoSeq in Hseq1.
          apply WeakTheory with (theory := OLTheory nPnN )...
        - inversion H9...
           apply absorptionInN in Hseq1...
          apply seqNtoSeq in Hseq1.
          apply WeakTheory with (theory := OLTheory nPnN )...
    * apply FocusingInitRuleU in H2...
       - checkPermutationCases H7.
          inversion H9...
          apply seqNtoSeq in Hseq2.
          apply WeakTheory with (theory := OLTheory nPnN )...
         LLExact Hseq2.
        - inversion H7...
           apply absorptionInN in Hseq2...
          apply seqNtoSeq in Hseq2.
          apply WeakTheory with (theory := OLTheory nPnN )...
    * apply FocusingInitRuleU in H2...
       - checkPermutationCases H7.
          inversion H9...
          apply seqNtoSeq in Hseq2.
          apply WeakTheory with (theory := OLTheory nPnN )...
         LLExact Hseq2.
        - inversion H7...
           apply absorptionInN in Hseq2...
          apply seqNtoSeq in Hseq2.
          apply WeakTheory with (theory := OLTheory nPnN )...
 Qed.

  Theorem OLCutElimAux :
    forall n h  B N ,
      IsPositiveAtomFormulaL B ->
      IsPositiveAtomFormulaL N ->
      flln  (OLTheoryCut nPnN n) h  B N (UP[] ) ->
      flls  (OLTheoryCut nPnN 0) B N (UP[] ) .
  Proof with sauto;try OLSolve.
  induction n ; induction h using lt_wf_ind; intros *;intros isFB isFN Hh.
    * eapply seqNtoSeq;eauto.
    * inversion Hh...
      cut(False);intros...
       refine (onlyAtomsLinear _ H0 H1)...
       cut(False);intros...
       refine (onlyAtomsClassical _ H0 H1)...
       inversion H1...
       inversion H3...
       inversion H4...
      + (* constant *)
         wellConstant H2.
         Cases H6.
         apply H10...
         Cases H6.
         apply H14...
         refine (H _ _ _ _ _ _ H8)...
         OLSolve.
         TFocus (makeRRuleC C).
         FLLsplit (@nil oo) N.
         apply H14...
         refine (H _ _ _ _ _ _ H10)...
      + (* constant *)
         wellConstant H2.
         Cases H6.
         apply H10...
         Cases H6.
         apply H14...
         refine (H _ _ _ _ _ _ H8)...
         OLSolve.
         TFocus (makeLRuleC C).
         FLLsplit (@nil oo) N.
         apply H14...
         refine (H _ _ _ _ _ _ H10)...
      + (* unary *)
         wellUnary H2.
         Cases H6.
         apply H14...
         refine (H _ _ _ _ _ _ H8)...
         OLSolve.
         TFocus (makeRRuleU C F0).
         FLLsplit (@nil oo) N.
         apply H14...
         refine (H _ _ _ _ _ _ H10)...
      + (* unary *)
         wellUnary H2.
         Cases H6.
         apply H14...
         refine (H _ _ _ _ _ _ H8)...
         OLSolve.
         TFocus (makeLRuleU C F0).
         FLLsplit (@nil oo) N.
         apply H14...
         refine (H _ _ _ _ _ _ H10)...
      + (* binary *)
         wellBinary H2.
         { Cases H6.
         apply H14...
         refine (H _ _ _ _ _ _ H8)...
         OLSolve.
         TFocus (makeRRuleB C F0 G).
         FLLsplit (@nil oo) N.
         apply H14...
         refine (H _ _ _ _ _ _ H10)... }
         { Cases H6.
         apply H16...
         refine (H _ _ _ _ _ _ H11)...
         OLSolve.
         rewrite H10 in isFN.
         inversion isFN...
         refine (H _ _ _ _ _ _ H12)...
         rewrite H10 in isFN.
         inversion isFN...
         TFocus (makeRRuleB C F0 G).
         FLLsplit (@nil oo) N.
         rewrite H8.
         apply H17...
         refine (H _ _ _ _ _ _ H12)...
         rewrite H8 in isFN.
         inversion isFN...
         refine (H _ _ _ _ _ _ H13)...
         rewrite H8 in isFN.
         inversion isFN... }
         { Cases H6.
         apply H16...
         refine (H _ _ _ _ _ _ H11)...
         OLSolve.
         rewrite H10 in isFN.
         inversion isFN...
         refine (H _ _ _ _ _ _ H12)...
         TFocus (makeRRuleB C F0 G).
         FLLsplit (@nil oo) N.
         apply H16...
         refine (H _ _ _ _ _ _ H11)...
         refine (H _ _ _ _ _ _ H12)...  }
      + (* binary *)
         wellBinary H2.
         { Cases H6.
         apply H14...
         refine (H _ _ _ _ _ _ H8)...
         OLSolve.
         TFocus (makeLRuleB C F0 G).
         FLLsplit (@nil oo) N.
         apply H14...
         refine (H _ _ _ _ _ _ H10)... }
         { Cases H6.
         apply H16...
         refine (H _ _ _ _ _ _ H11)...
         rewrite H10 in isFN.
         inversion isFN...
         refine (H _ _ _ _ _ _ H12)...
         rewrite H10 in isFN.
         inversion isFN...
         TFocus (makeLRuleB C F0 G).
         FLLsplit (@nil oo) N.
         rewrite H8.
         apply H17...
         refine (H _ _ _ _ _ _ H12)...
         rewrite H8 in isFN.
         inversion isFN...
         refine (H _ _ _ _ _ _ H13)...
         rewrite H8 in isFN.
         inversion isFN... }
         { Cases H6.
         apply H16...
         refine (H _ _ _ _ _ _ H11)...
         rewrite H10 in isFN.
         inversion isFN...
         refine (H _ _ _ _ _ _ H12)...
         rewrite H10 in isFN.
         inversion isFN...
         TFocus (makeLRuleB C F0 G).
         FLLsplit (@nil oo) N.
         apply H16...
         refine (H _ _ _ _ _ _ H11)...
         refine (H _ _ _ _ _ _ H12)...  }
      + (* quantifier *)
         wellQuantifier H2.
         Cases H6.
         apply H14...
         refine (H _ _ _ _ _ _ H8)...
         OLSolve.
         TFocus (makeRRuleQ C FX).
         FLLsplit (@nil oo) N.
         apply H14...
         refine (H _ _ _ _ _ _ H10)...
      + (* quantifier *)
         wellQuantifier H2.
         Cases H6.
         apply H14...
         refine (H _ _ _ _ _ _ H8)...
         OLSolve.
         TFocus (makeLRuleQ C FX).
         FLLsplit (@nil oo) N.
         apply H14...
         refine (H _ _ _ _ _ _ H10)...
      + (* init *)
         apply FocusingInitRuleU in H2...
         rewrite H5.
         TFocus (RINIT OO).
         FLLsplit [ (⌈ OO ⌉)] [(⌊ OO ⌋)].
         TFocus (RINIT OO).
         FLLsplit [ (⌈ OO ⌉)] (@nil oo).
         TFocus (RINIT OO).
         FLLsplit (@nil oo) [ (⌊ OO ⌋)].
         TFocus (RINIT OO).
         FLLsplit.
      + inversion f.
     + inversion f.
      + (* cut *)
          inversion H3... 2:{ firstorder. }
         inversion H2...
         2:{ inversion H8. }
         invTri H13.
         invTri H14.
         invTri H13.
         invTri H15.
         clear H0 H1 H2 H3 Hh.
         apply H in H16...
         2: repeat OLSolve.
         apply H in H14...
         2: repeat OLSolve.
         apply WeakTheory with (theory' := OLTheory nPnN) in H16;auto;try apply OOTheryCut0.
         apply WeakTheory with (theory' := OLTheory nPnN) in H14;auto;try apply OOTheryCut0.
         rewrite H9.
         apply WeakTheory with (theory := OLTheory nPnN).
         apply OOTheryCut0.

         destruct m.
         generalize(LengthFormula H4 H5);intro;lia.
         assert (flls (OLTheoryCut nPnN (pred  (S (n)))) B (M ++ N0) (UP [])) .
         rewrite Permutation_app_comm.
         apply seqtoSeqN in H16...
         apply seqtoSeqN in H14...
         refine(OLCutElimStep _ _ _ _ H14 H16 H5 _)...
        simpl in H0...
       apply seqtoSeqN in H0...
        apply IHn in H0...
        apply WeakTheory with (theory' := OLTheory nPnN) in H0;auto;try apply  OOTheryCut0.
Qed.
         (** Cut-elimination theorem for Object Logics satisfying cut-]
  coherence *)
  Theorem OLCutElimination :
    forall n h  B N ,
      IsPositiveAtomFormulaL B ->
      IsPositiveAtomFormulaL N ->
      flln (OLTheoryCut nPnN n) h  B N (UP [] ) ->
      flls (OLTheory nPnN) B N (UP [] ) .
  Proof with sauto.
    intros.
    apply OLCutElimAux in H1 ...
    eapply WeakTheory with (theory':= OLTheory nPnN) in H1 ...
    apply OOTheryCut0.
  Qed.

End CutElimination.


From iris.algebra Require Export monoid.
From stdpp Require Export functions gmap gmultiset.
Set Default Proof Using "Type*".
Local Existing Instances monoid_ne monoid_assoc monoid_comm
  monoid_left_id monoid_right_id monoid_proper
  monoid_homomorphism_rel_po monoid_homomorphism_rel_proper
  monoid_homomorphism_op_proper
  monoid_homomorphism_ne weak_monoid_homomorphism_proper.

(** We define the following big operators with binders build in:

- The operator [ [^o list] k ↦ x ∈ l, P ] folds over a list [l]. The binder [x]
  refers to each element at index [k].
- The operator [ [^o map] k ↦ x ∈ m, P ] folds over a map [m]. The binder [x]
  refers to each element at index [k].
- The operator [ [^o set] x ∈ X, P ] folds over a set [X]. The binder [x] refers
  to each element.

Since these big operators are like quantifiers, they have the same precedence as
[∀] and [∃]. *)

(** * Big ops over lists *)
Fixpoint big_opL `{Monoid M o} {A} (f : nat → A → M) (xs : list A) : M :=
  match xs with
  | [] => monoid_unit
  | x :: xs => o (f 0 x) (big_opL (λ n, f (S n)) xs)
  end.
Instance: Params (@big_opL) 4.
Arguments big_opL {M} o {_ A} _ !_ /.
Typeclasses Opaque big_opL.
Notation "'[^' o 'list]' k ↦ x ∈ l , P" := (big_opL o (λ k x, P) l)
  (at level 200, o at level 1, l at level 10, k, x at level 1, right associativity,
   format "[^ o  list]  k ↦ x  ∈  l ,  P") : stdpp_scope.
Notation "'[^' o 'list]' x ∈ l , P" := (big_opL o (λ _ x, P) l)
  (at level 200, o at level 1, l at level 10, x at level 1, right associativity,
   format "[^ o  list]  x  ∈  l ,  P") : stdpp_scope.

Definition big_opM `{Monoid M o} `{Countable K} {A} (f : K → A → M)
    (m : gmap K A) : M := big_opL o (λ _, curry f) (map_to_list m).
Instance: Params (@big_opM) 7.
Arguments big_opM {M} o {_ K _ _ A} _ _ : simpl never.
Typeclasses Opaque big_opM.
Notation "'[^' o 'map]' k ↦ x ∈ m , P" := (big_opM o (λ k x, P) m)
  (at level 200, o at level 1, m at level 10, k, x at level 1, right associativity,
   format "[^  o  map]  k ↦ x  ∈  m ,  P") : stdpp_scope.
Notation "'[^' o 'map]' x ∈ m , P" := (big_opM o (λ _ x, P) m)
  (at level 200, o at level 1, m at level 10, x at level 1, right associativity,
   format "[^ o  map]  x  ∈  m ,  P") : stdpp_scope.

Definition big_opS `{Monoid M o} `{Countable A} (f : A → M)
  (X : gset A) : M := big_opL o (λ _, f) (elements X).
Instance: Params (@big_opS) 6.
Arguments big_opS {M} o {_ A _ _} _ _ : simpl never.
Typeclasses Opaque big_opS.
Notation "'[^' o 'set]' x ∈ X , P" := (big_opS o (λ x, P) X)
  (at level 200, o at level 1, X at level 10, x at level 1, right associativity,
   format "[^ o  set]  x  ∈  X ,  P") : stdpp_scope.

Definition big_opMS `{Monoid M o} `{Countable A} (f : A → M)
  (X : gmultiset A) : M := big_opL o (λ _, f) (elements X).
Instance: Params (@big_opMS) 7.
Arguments big_opMS {M} o {_ A _ _} _ _ : simpl never.
Typeclasses Opaque big_opMS.
Notation "'[^' o 'mset]' x ∈ X , P" := (big_opMS o (λ x, P) X)
  (at level 200, o at level 1, X at level 10, x at level 1, right associativity,
   format "[^ o  mset]  x  ∈  X ,  P") : stdpp_scope.

(** * Properties about big ops *)
Section big_op.
Context `{Monoid M o}.
Implicit Types xs : list M.
Infix "`o`" := o (at level 50, left associativity).

(** ** Big ops over lists *)
Section list.
  Context {A : Type}.
  Implicit Types l : list A.
  Implicit Types f g : nat → A → M.

  Lemma big_opL_nil f : ([^o list] k↦y ∈ [], f k y) = monoid_unit.
  Proof. done. Qed.
  Lemma big_opL_cons f x l :
    ([^o list] k↦y ∈ x :: l, f k y) = f 0 x `o` [^o list] k↦y ∈ l, f (S k) y.
  Proof. done. Qed.
  Lemma big_opL_singleton f x : ([^o list] k↦y ∈ [x], f k y) ≡ f 0 x.
  Proof. by rewrite /= right_id. Qed.
  Lemma big_opL_app f l1 l2 :
    ([^o list] k↦y ∈ l1 ++ l2, f k y)
    ≡ ([^o list] k↦y ∈ l1, f k y) `o` ([^o list] k↦y ∈ l2, f (length l1 + k) y).
  Proof.
    revert f. induction l1 as [|x l1 IH]=> f /=; first by rewrite left_id.
    by rewrite IH assoc.
  Qed.

  Lemma big_opL_unit l : ([^o list] k↦y ∈ l, monoid_unit) ≡ (monoid_unit : M).
  Proof. induction l; rewrite /= ?left_id //. Qed.

  Lemma big_opL_forall R f g l :
    Reflexive R →
    Proper (R ==> R ==> R) o →
    (∀ k y, l !! k = Some y → R (f k y) (g k y)) →
    R ([^o list] k ↦ y ∈ l, f k y) ([^o list] k ↦ y ∈ l, g k y).
  Proof.
    intros ??. revert f g. induction l as [|x l IH]=> f g ? //=; f_equiv; eauto.
  Qed.

  Lemma big_opL_ext f g l :
    (∀ k y, l !! k = Some y → f k y = g k y) →
    ([^o list] k ↦ y ∈ l, f k y) = [^o list] k ↦ y ∈ l, g k y.
  Proof. apply big_opL_forall; apply _. Qed.
  Lemma big_opL_proper f g l :
    (∀ k y, l !! k = Some y → f k y ≡ g k y) →
    ([^o list] k ↦ y ∈ l, f k y) ≡ ([^o list] k ↦ y ∈ l, g k y).
  Proof. apply big_opL_forall; apply _. Qed.

  Lemma big_opL_permutation (f : A → M) l1 l2 :
    l1 ≡ₚ l2 → ([^o list] x ∈ l1, f x) ≡ ([^o list] x ∈ l2, f x).
  Proof.
    induction 1 as [|x xs1 xs2 ? IH|x y xs|xs1 xs2 xs3]; simpl; auto.
    - by rewrite IH.
    - by rewrite !assoc (comm _ (f x)).
    - by etrans.
  Qed.
  Global Instance big_opL_permutation' (f : A → M) :
    Proper ((≡ₚ) ==> (≡)) (big_opL o (λ _, f)).
  Proof. intros xs1 xs2. apply big_opL_permutation. Qed.

  Global Instance big_opL_ne n :
    Proper (pointwise_relation _ (pointwise_relation _ (dist n)) ==>
            eq ==> dist n) (big_opL o (A:=A)).
  Proof. intros f g Hf m ? <-. apply big_opL_forall; apply _ || intros; apply Hf. Qed.
  Global Instance big_opL_proper' :
    Proper (pointwise_relation _ (pointwise_relation _ (≡)) ==> eq ==> (≡))
           (big_opL o (A:=A)).
  Proof. intros f g Hf m ? <-. apply big_opL_forall; apply _ || intros; apply Hf. Qed.

  Lemma big_opL_consZ_l (f : Z → A → M) x l :
    ([^o list] k↦y ∈ x :: l, f k y) = f 0 x `o` [^o list] k↦y ∈ l, f (1 + k)%Z y.
  Proof. rewrite big_opL_cons. auto using big_opL_ext with f_equal lia. Qed.
  Lemma big_opL_consZ_r (f : Z → A → M) x l :
    ([^o list] k↦y ∈ x :: l, f k y) = f 0 x `o` [^o list] k↦y ∈ l, f (k + 1)%Z y.
  Proof. rewrite big_opL_cons. auto using big_opL_ext with f_equal lia. Qed.

  Lemma big_opL_fmap {B} (h : A → B) (f : nat → B → M) l :
    ([^o list] k↦y ∈ h <$> l, f k y) ≡ ([^o list] k↦y ∈ l, f k (h y)).
  Proof. revert f. induction l as [|x l IH]=> f; csimpl=> //. by rewrite IH. Qed.

  Lemma big_opL_opL f g l :
    ([^o list] k↦x ∈ l, f k x `o` g k x)
    ≡ ([^o list] k↦x ∈ l, f k x) `o` ([^o list] k↦x ∈ l, g k x).
  Proof.
    revert f g; induction l as [|x l IH]=> f g /=; first by rewrite left_id.
    by rewrite IH -!assoc (assoc _ (g _ _)) [(g _ _ `o` _)]comm -!assoc.
  Qed.
End list.

(** ** Big ops over finite maps *)
Section gmap.
  Context `{Countable K} {A : Type}.
  Implicit Types m : gmap K A.
  Implicit Types f g : K → A → M.

  Lemma big_opM_forall R f g m :
    Reflexive R → Proper (R ==> R ==> R) o →
    (∀ k x, m !! k = Some x → R (f k x) (g k x)) →
    R ([^o map] k ↦ x ∈ m, f k x) ([^o map] k ↦ x ∈ m, g k x).
  Proof.
    intros ?? Hf. apply (big_opL_forall R); auto.
    intros k [i x] ?%elem_of_list_lookup_2. by apply Hf, elem_of_map_to_list.
  Qed.

  Lemma big_opM_ext f g m :
    (∀ k x, m !! k = Some x → f k x = g k x) →
    ([^o map] k ↦ x ∈ m, f k x) = ([^o map] k ↦ x ∈ m, g k x).
  Proof. apply big_opM_forall; apply _. Qed.
  Lemma big_opM_proper f g m :
    (∀ k x, m !! k = Some x → f k x ≡ g k x) →
    ([^o map] k ↦ x ∈ m, f k x) ≡ ([^o map] k ↦ x ∈ m, g k x).
  Proof. apply big_opM_forall; apply _. Qed.

  Global Instance big_opM_ne n :
    Proper (pointwise_relation _ (pointwise_relation _ (dist n)) ==> eq ==> dist n)
           (big_opM o (K:=K) (A:=A)).
  Proof. intros f g Hf m ? <-. apply big_opM_forall; apply _ || intros; apply Hf. Qed.
  Global Instance big_opM_proper' :
    Proper (pointwise_relation _ (pointwise_relation _ (≡)) ==> eq ==> (≡))
           (big_opM o (K:=K) (A:=A)).
  Proof. intros f g Hf m ? <-. apply big_opM_forall; apply _ || intros; apply Hf. Qed.

  Lemma big_opM_empty f : ([^o map] k↦x ∈ ∅, f k x) = monoid_unit.
  Proof. by rewrite /big_opM map_to_list_empty. Qed.

  Lemma big_opM_insert f m i x :
    m !! i = None →
    ([^o map] k↦y ∈ <[i:=x]> m, f k y) ≡ f i x `o` [^o map] k↦y ∈ m, f k y.
  Proof. intros ?. by rewrite /big_opM map_to_list_insert. Qed.

  Lemma big_opM_delete f m i x :
    m !! i = Some x →
    ([^o map] k↦y ∈ m, f k y) ≡ f i x `o` [^o map] k↦y ∈ delete i m, f k y.
  Proof.
    intros. rewrite -big_opM_insert ?lookup_delete //.
    by rewrite insert_delete insert_id.
  Qed.

  Lemma big_opM_singleton f i x : ([^o map] k↦y ∈ {[i:=x]}, f k y) ≡ f i x.
  Proof.
    rewrite -insert_empty big_opM_insert/=; last auto using lookup_empty.
    by rewrite big_opM_empty right_id.
  Qed.

  Lemma big_opM_unit m : ([^o map] k↦y ∈ m, monoid_unit) ≡ (monoid_unit : M).
  Proof. induction m using map_ind; rewrite /= ?big_opM_insert ?left_id //. Qed.

  Lemma big_opM_fmap {B} (h : A → B) (f : K → B → M) m :
    ([^o map] k↦y ∈ h <$> m, f k y) ≡ ([^o map] k↦y ∈ m, f k (h y)).
  Proof.
    rewrite /big_opM map_to_list_fmap big_opL_fmap.
    by apply big_opL_proper=> ? [??].
  Qed.

  Lemma big_opM_insert_override (f : K → A → M) m i x x' :
    m !! i = Some x → f i x ≡ f i x' →
    ([^o map] k↦y ∈ <[i:=x']> m, f k y) ≡ ([^o map] k↦y ∈ m, f k y).
  Proof.
    intros ? Hx. rewrite -insert_delete big_opM_insert ?lookup_delete //.
    by rewrite -Hx -big_opM_delete.
  Qed.

  Lemma big_opM_fn_insert {B} (g : K → A → B → M) (f : K → B) m i (x : A) b :
    m !! i = None →
    ([^o map] k↦y ∈ <[i:=x]> m, g k y (<[i:=b]> f k))
    ≡ g i x b `o` [^o map] k↦y ∈ m, g k y (f k).
  Proof.
    intros. rewrite big_opM_insert // fn_lookup_insert.
    f_equiv; apply big_opM_proper; auto=> k y ?.
    by rewrite fn_lookup_insert_ne; last set_solver.
  Qed.
  Lemma big_opM_fn_insert' (f : K → M) m i x P :
    m !! i = None →
    ([^o map] k↦y ∈ <[i:=x]> m, <[i:=P]> f k) ≡ (P `o` [^o map] k↦y ∈ m, f k).
  Proof. apply (big_opM_fn_insert (λ _ _, id)). Qed.

  Lemma big_opM_opM f g m :
    ([^o map] k↦x ∈ m, f k x `o` g k x)
    ≡ ([^o map] k↦x ∈ m, f k x) `o` ([^o map] k↦x ∈ m, g k x).
  Proof. rewrite /big_opM -big_opL_opL. by apply big_opL_proper=> ? [??]. Qed.
End gmap.

(** ** Big ops over finite sets *)
Section gset.
  Context `{Countable A}.
  Implicit Types X : gset A.
  Implicit Types f : A → M.

  Lemma big_opS_forall R f g X :
    Reflexive R → Proper (R ==> R ==> R) o →
    (∀ x, x ∈ X → R (f x) (g x)) →
    R ([^o set] x ∈ X, f x) ([^o set] x ∈ X, g x).
  Proof.
    intros ?? Hf. apply (big_opL_forall R); auto.
    intros k x ?%elem_of_list_lookup_2. by apply Hf, elem_of_elements.
  Qed.

  Lemma big_opS_ext f g X :
    (∀ x, x ∈ X → f x = g x) →
    ([^o set] x ∈ X, f x) = ([^o set] x ∈ X, g x).
  Proof. apply big_opS_forall; apply _. Qed.
  Lemma big_opS_proper f g X :
    (∀ x, x ∈ X → f x ≡ g x) →
    ([^o set] x ∈ X, f x) ≡ ([^o set] x ∈ X, g x).
  Proof. apply big_opS_forall; apply _. Qed.

  Global Instance big_opS_ne n :
    Proper (pointwise_relation _ (dist n) ==> eq ==> dist n) (big_opS o (A:=A)).
  Proof. intros f g Hf m ? <-. apply big_opS_forall; apply _ || intros; apply Hf. Qed.
  Global Instance big_opS_proper' :
    Proper (pointwise_relation _ (≡) ==> eq ==> (≡)) (big_opS o (A:=A)).
  Proof. intros f g Hf m ? <-. apply big_opS_forall; apply _ || intros; apply Hf. Qed.

  Lemma big_opS_empty f : ([^o set] x ∈ ∅, f x) = monoid_unit.
  Proof. by rewrite /big_opS elements_empty. Qed.

  Lemma big_opS_insert f X x :
    x ∉ X → ([^o set] y ∈ {[ x ]} ∪ X, f y) ≡ (f x `o` [^o set] y ∈ X, f y).
  Proof. intros. by rewrite /big_opS elements_union_singleton. Qed.
  Lemma big_opS_fn_insert {B} (f : A → B → M) h X x b :
    x ∉ X →
    ([^o set] y ∈ {[ x ]} ∪ X, f y (<[x:=b]> h y))
    ≡ f x b `o` [^o set] y ∈ X, f y (h y).
  Proof.
    intros. rewrite big_opS_insert // fn_lookup_insert.
    f_equiv; apply big_opS_proper; auto=> y ?.
    by rewrite fn_lookup_insert_ne; last set_solver.
  Qed.
  Lemma big_opS_fn_insert' f X x P :
    x ∉ X → ([^o set] y ∈ {[ x ]} ∪ X, <[x:=P]> f y) ≡ (P `o` [^o set] y ∈ X, f y).
  Proof. apply (big_opS_fn_insert (λ y, id)). Qed.

  Lemma big_opS_union f X Y :
    X ## Y →
    ([^o set] y ∈ X ∪ Y, f y) ≡ ([^o set] y ∈ X, f y) `o` ([^o set] y ∈ Y, f y).
  Proof.
    intros. induction X as [|x X ? IH] using collection_ind_L.
    { by rewrite left_id_L big_opS_empty left_id. }
    rewrite -assoc_L !big_opS_insert; [|set_solver..].
    by rewrite -assoc IH; last set_solver.
  Qed.

  Lemma big_opS_delete f X x :
    x ∈ X → ([^o set] y ∈ X, f y) ≡ f x `o` [^o set] y ∈ X ∖ {[ x ]}, f y.
  Proof.
    intros. rewrite -big_opS_insert; last set_solver.
    by rewrite -union_difference_L; last set_solver.
  Qed.

  Lemma big_opS_singleton f x : ([^o set] y ∈ {[ x ]}, f y) ≡ f x.
  Proof. intros. by rewrite /big_opS elements_singleton /= right_id. Qed.

  Lemma big_opS_unit X : ([^o set] y ∈ X, monoid_unit) ≡ (monoid_unit : M).
  Proof.
    induction X using collection_ind_L; rewrite /= ?big_opS_insert ?left_id //.
  Qed.

  Lemma big_opS_opS f g X :
    ([^o set] y ∈ X, f y `o` g y) ≡ ([^o set] y ∈ X, f y) `o` ([^o set] y ∈ X, g y).
  Proof. by rewrite /big_opS -big_opL_opL. Qed.
End gset.

Lemma big_opM_dom `{Countable K} {A} (f : K → M) (m : gmap K A) :
  ([^o map] k↦_ ∈ m, f k) ≡ ([^o set] k ∈ dom _ m, f k).
Proof.
  induction m as [|i x ?? IH] using map_ind; [by rewrite dom_empty_L|].
  by rewrite dom_insert_L big_opM_insert // IH big_opS_insert ?not_elem_of_dom.
Qed.

(** ** Big ops over finite msets *)
Section gmultiset.
  Context `{Countable A}.
  Implicit Types X : gmultiset A.
  Implicit Types f : A → M.

  Lemma big_opMS_forall R f g X :
    Reflexive R → Proper (R ==> R ==> R) o →
    (∀ x, x ∈ X → R (f x) (g x)) →
    R ([^o mset] x ∈ X, f x) ([^o mset] x ∈ X, g x).
  Proof.
    intros ?? Hf. apply (big_opL_forall R); auto.
    intros k x ?%elem_of_list_lookup_2. by apply Hf, gmultiset_elem_of_elements.
  Qed.

  Lemma big_opMS_ext f g X :
    (∀ x, x ∈ X → f x = g x) →
    ([^o mset] x ∈ X, f x) = ([^o mset] x ∈ X, g x).
  Proof. apply big_opMS_forall; apply _. Qed.
  Lemma big_opMS_proper f g X :
    (∀ x, x ∈ X → f x ≡ g x) →
    ([^o mset] x ∈ X, f x) ≡ ([^o mset] x ∈ X, g x).
  Proof. apply big_opMS_forall; apply _. Qed.

  Global Instance big_opMS_ne n :
    Proper (pointwise_relation _ (dist n) ==> eq ==> dist n) (big_opMS o (A:=A)).
  Proof. intros f g Hf m ? <-. apply big_opMS_forall; apply _ || intros; apply Hf. Qed.
  Global Instance big_opMS_proper' :
    Proper (pointwise_relation _ (≡) ==> eq ==> (≡)) (big_opMS o (A:=A)).
  Proof. intros f g Hf m ? <-. apply big_opMS_forall; apply _ || intros; apply Hf. Qed.

  Lemma big_opMS_empty f : ([^o mset] x ∈ ∅, f x) = monoid_unit.
  Proof. by rewrite /big_opMS gmultiset_elements_empty. Qed.

  Lemma big_opMS_union f X Y :
    ([^o mset] y ∈ X ∪ Y, f y) ≡ ([^o mset] y ∈ X, f y) `o` [^o mset] y ∈ Y, f y.
  Proof. by rewrite /big_opMS gmultiset_elements_union big_opL_app. Qed.

  Lemma big_opMS_singleton f x : ([^o mset] y ∈ {[ x ]}, f y) ≡ f x.
  Proof.
    intros. by rewrite /big_opMS gmultiset_elements_singleton /= right_id.
  Qed.

  Lemma big_opMS_delete f X x :
    x ∈ X → ([^o mset] y ∈ X, f y) ≡ f x `o` [^o mset] y ∈ X ∖ {[ x ]}, f y.
  Proof.
    intros. rewrite -big_opMS_singleton -big_opMS_union.
    by rewrite -gmultiset_union_difference'.
  Qed.

  Lemma big_opMS_unit X : ([^o mset] y ∈ X, monoid_unit) ≡ (monoid_unit : M).
  Proof.
    induction X using gmultiset_ind;
      rewrite /= ?big_opMS_union ?big_opMS_singleton ?left_id //.
  Qed.

  Lemma big_opMS_opMS f g X :
    ([^o mset] y ∈ X, f y `o` g y) ≡ ([^o mset] y ∈ X, f y) `o` ([^o mset] y ∈ X, g y).
  Proof. by rewrite /big_opMS -big_opL_opL. Qed.
End gmultiset.
End big_op.

Section homomorphisms.
  Context `{Monoid M1 o1, Monoid M2 o2}.
  Infix "`o1`" := o1 (at level 50, left associativity).
  Infix "`o2`" := o2 (at level 50, left associativity).
  Instance foo {A} (R : relation A) : RewriteRelation R.

  Lemma big_opL_commute {A} (h : M1 → M2) `{!MonoidHomomorphism o1 o2 R h}
      (f : nat → A → M1) l :
    R (h ([^o1 list] k↦x ∈ l, f k x)) ([^o2 list] k↦x ∈ l, h (f k x)).
  Proof.
    revert f. induction l as [|x l IH]=> f /=.
    - apply monoid_homomorphism_unit.
    - by rewrite monoid_homomorphism IH.
  Qed.
  Lemma big_opL_commute1 {A} (h : M1 → M2) `{!WeakMonoidHomomorphism o1 o2 R h}
      (f : nat → A → M1) l :
    l ≠ [] → R (h ([^o1 list] k↦x ∈ l, f k x)) ([^o2 list] k↦x ∈ l, h (f k x)).
  Proof.
    intros ?. revert f. induction l as [|x [|x' l'] IH]=> f //.
    - by rewrite !big_opL_singleton.
    - by rewrite !(big_opL_cons _ x) monoid_homomorphism IH.
  Qed.

  Lemma big_opM_commute `{Countable K} {A} (h : M1 → M2)
      `{!MonoidHomomorphism o1 o2 R h} (f : K → A → M1) m :
    R (h ([^o1 map] k↦x ∈ m, f k x)) ([^o2 map] k↦x ∈ m, h (f k x)).
  Proof.
    intros. induction m as [|i x m ? IH] using map_ind.
    - by rewrite !big_opM_empty monoid_homomorphism_unit.
    - by rewrite !big_opM_insert // monoid_homomorphism -IH.
  Qed.
  Lemma big_opM_commute1 `{Countable K} {A} (h : M1 → M2)
      `{!WeakMonoidHomomorphism o1 o2 R h} (f : K → A → M1) m :
    m ≠ ∅ → R (h ([^o1 map] k↦x ∈ m, f k x)) ([^o2 map] k↦x ∈ m, h (f k x)).
  Proof.
    intros. induction m as [|i x m ? IH] using map_ind; [done|].
    destruct (decide (m = ∅)) as [->|].
    - by rewrite !big_opM_insert // !big_opM_empty !right_id.
    - by rewrite !big_opM_insert // monoid_homomorphism -IH //.
  Qed.

  Lemma big_opS_commute `{Countable A} (h : M1 → M2)
      `{!MonoidHomomorphism o1 o2 R h} (f : A → M1) X :
    R (h ([^o1 set] x ∈ X, f x)) ([^o2 set] x ∈ X, h (f x)).
  Proof.
    intros. induction X as [|x X ? IH] using collection_ind_L.
    - by rewrite !big_opS_empty monoid_homomorphism_unit.
    - by rewrite !big_opS_insert // monoid_homomorphism -IH.
  Qed.
  Lemma big_opS_commute1 `{Countable A} (h : M1 → M2)
      `{!WeakMonoidHomomorphism o1 o2 R h} (f : A → M1) X :
    X ≠ ∅ → R (h ([^o1 set] x ∈ X, f x)) ([^o2 set] x ∈ X, h (f x)).
  Proof.
    intros. induction X as [|x X ? IH] using collection_ind_L; [done|].
    destruct (decide (X = ∅)) as [->|].
    - by rewrite !big_opS_insert // !big_opS_empty !right_id.
    - by rewrite !big_opS_insert // monoid_homomorphism -IH //.
  Qed.

  Lemma big_opMS_commute `{Countable A} (h : M1 → M2)
      `{!MonoidHomomorphism o1 o2 R h} (f : A → M1) X :
    R (h ([^o1 mset] x ∈ X, f x)) ([^o2 mset] x ∈ X, h (f x)).
  Proof.
    intros. induction X as [|x X IH] using gmultiset_ind.
    - by rewrite !big_opMS_empty monoid_homomorphism_unit.
    - by rewrite !big_opMS_union !big_opMS_singleton monoid_homomorphism -IH.
  Qed.
  Lemma big_opMS_commute1 `{Countable A} (h : M1 → M2)
      `{!WeakMonoidHomomorphism o1 o2 R h} (f : A → M1) X :
    X ≠ ∅ → R (h ([^o1 mset] x ∈ X, f x)) ([^o2 mset] x ∈ X, h (f x)).
  Proof.
    intros. induction X as [|x X IH] using gmultiset_ind; [done|].
    destruct (decide (X = ∅)) as [->|].
    - by rewrite !big_opMS_union !big_opMS_singleton !big_opMS_empty !right_id.
    - by rewrite !big_opMS_union !big_opMS_singleton monoid_homomorphism -IH //.
  Qed.

  Context `{!LeibnizEquiv M2}.

  Lemma big_opL_commute_L {A} (h : M1 → M2)
      `{!MonoidHomomorphism o1 o2 (≡) h} (f : nat → A → M1) l :
    h ([^o1 list] k↦x ∈ l, f k x) = ([^o2 list] k↦x ∈ l, h (f k x)).
  Proof. unfold_leibniz. by apply big_opL_commute. Qed.
  Lemma big_opL_commute1_L {A} (h : M1 → M2)
      `{!WeakMonoidHomomorphism o1 o2 (≡) h} (f : nat → A → M1) l :
    l ≠ [] → h ([^o1 list] k↦x ∈ l, f k x) = ([^o2 list] k↦x ∈ l, h (f k x)).
  Proof. unfold_leibniz. by apply big_opL_commute1. Qed.

  Lemma big_opM_commute_L `{Countable K} {A} (h : M1 → M2)
      `{!MonoidHomomorphism o1 o2 (≡) h} (f : K → A → M1) m :
    h ([^o1 map] k↦x ∈ m, f k x) = ([^o2 map] k↦x ∈ m, h (f k x)).
  Proof. unfold_leibniz. by apply big_opM_commute. Qed.
  Lemma big_opM_commute1_L `{Countable K} {A} (h : M1 → M2)
      `{!WeakMonoidHomomorphism o1 o2 (≡) h} (f : K → A → M1) m :
    m ≠ ∅ → h ([^o1 map] k↦x ∈ m, f k x) = ([^o2 map] k↦x ∈ m, h (f k x)).
  Proof. unfold_leibniz. by apply big_opM_commute1. Qed.

  Lemma big_opS_commute_L `{Countable A} (h : M1 → M2)
      `{!MonoidHomomorphism o1 o2 (≡) h} (f : A → M1) X :
    h ([^o1 set] x ∈ X, f x) = ([^o2 set] x ∈ X, h (f x)).
  Proof. unfold_leibniz. by apply big_opS_commute. Qed.
  Lemma big_opS_commute1_L `{ Countable A} (h : M1 → M2)
      `{!WeakMonoidHomomorphism o1 o2 (≡) h} (f : A → M1) X :
    X ≠ ∅ → h ([^o1 set] x ∈ X, f x) = ([^o2 set] x ∈ X, h (f x)).
  Proof. intros. rewrite <-leibniz_equiv_iff. by apply big_opS_commute1. Qed.

  Lemma big_opMS_commute_L `{Countable A} (h : M1 → M2)
      `{!MonoidHomomorphism o1 o2 (≡) h} (f : A → M1) X :
    h ([^o1 mset] x ∈ X, f x) = ([^o2 mset] x ∈ X, h (f x)).
  Proof. unfold_leibniz. by apply big_opMS_commute. Qed.
  Lemma big_opMS_commute1_L `{Countable A} (h : M1 → M2)
      `{!WeakMonoidHomomorphism o1 o2 (≡) h} (f : A → M1) X :
    X ≠ ∅ → h ([^o1 mset] x ∈ X, f x) = ([^o2 mset] x ∈ X, h (f x)).
  Proof. intros. rewrite <-leibniz_equiv_iff. by apply big_opMS_commute1. Qed.
End homomorphisms.