Require Import HoTT.
(*Some results on coequalizers*)

(*This should be somewhere else. . .*)
Definition prod_uncurryD {A B : Type} {P : A -> B -> Type} :
  (forall p : A*B, P (fst p) (snd p)) -> forall a : A, forall b : B, P a b :=
  (equiv_prod_ind _)^-1 .

Lemma Coeq_precompose `{Funext} {B A : Type} {f : B -> A} {g : B -> A} :
  (@coeq B A f g) o f = coeq o g.
Proof.
  apply path_forall.
  intro b.
  apply cp.
Defined.

Definition functor_coeq `{Funext} {A1 A2 A3 B : Type} (f1 : A1 -> A2) (f2 : A2 -> A3) (g : A1 -> B) :
  pushout (f2 o f1) g <~> pushout f2 (push (f := f1) (g := g) o inl).
Proof.
  srapply @equiv_adjointify.
  - srapply @pushout_rec.
    + intro ab.
      apply push. destruct ab as [a | b].
      * exact (inl a). * apply inr. apply push. exact (inr b).
    + intro a. simpl.
      refine (pp (f1 a) @ _). unfold pushr. apply (ap (push o inr)).
      exact (pp a).
  - srapply @pushout_rec.
    + intros [a | c]. {exact (push (inl a)). }
      revert c.
      srapply @pushout_rec.
      { intro ab. apply push. destruct ab as [a | b].
        - exact (inl (f2 a)). - exact (inr b). }
      intro a. simpl.
      refine (pp a).
    + intro a. reflexivity.
  - srapply @pushout_ind.
    + intros [a | c].
      { reflexivity. }
      revert c. srapply @pushout_ind.
      intros [a | b].
      { simpl. refine (pp a). } reflexivity.
      intro a. simpl.

      refine (transport_paths_FlFr (pp a) (pp (f1 a)) @ _).

(* (*Want to show that Coequ commutes with product: *)
(*    Coeq f g * Coeq f' g' <~> Coeq (functor_prod f f') (functor_prod g g') *)
(*    Then, using equiv_prod_ind, iterated Coequalizers will perhaps be easier to define. *)
(*  *) *)
(* Section Coeq_prod_commute. *)

(*   (*Can generalize this to having *)
(*      r : A -> A' *)
(*      s : B -> B' *)
(*    such that sf = f'r and sg = g'r *)

(*    The case proved is r = const (point A'), s = const (f (point A')) *)

(*    *) *)

(*   Definition prod_coeq_to_coeq_prod *)
(*              {A B A' B' : Type} *)
(*              {a0 : IsPointed A} *)
(*              {f g : A -> B} {f' g' : A'-> B'} *)
(*              {pointed_f : f a0 = g a0} : *)
(*     Coeq f g * Coeq f' g' -> Coeq (functor_prod f f') (functor_prod g g'). *)
(*   Proof. *)
(*     apply prod_curry. *)
(*     refine (Coeq_rec _ _ _). *)
(*     - intro b. *)
(*       refine (functor_coeq _ _ _ _). *)
(*       + exact (fun a' => (point A, a')). *)
(*       + exact (fun b' => (f (point A) , b')). *)
(*       + intro a'. exact idpath. *)
(*       + intro a'. unfold functor_prod. simpl. *)
(*         apply (ap (fun b => (b, g' a'))). *)
(*         exact (pointed_f). *)
(*     - intro a. *)
(*       exact idpath. *)
(*   Defined. *)

(*   Definition prod_coeq_to_coeq_prod2 *)
(*              {A B A' B' A'' B'' : Type} *)
(*              {a0 : IsPointed A} *)
(*              {a0' : IsPointed A'} *)
(*              {f g : A -> B} {f' g' : A'-> B'} {f'' g'' : A''-> B''} *)
(*              {pointed_f : f a0 = g a0} *)
(*              {pointed_f' : f' a0' = g' a0'}: *)

(*     Coeq f g * Coeq f' g' * Coeq f'' g'' -> *)
(*     Coeq (functor_prod (functor_prod f f') f'') (functor_prod (functor_prod g g') g''). *)
(*   Proof. *)
(*     refine (prod_coeq_to_coeq_prod o _). *)
(*     - apply path_prod. exact pointed_f. exact pointed_f'. *)
(*     - refine (functor_prod _ idmap). *)
(*       refine (prod_coeq_to_coeq_prod). exact pointed_f. *)
(*   Defined. *)

(*   Definition coeq_prod_to_prod_coeq *)
(*              {A B A' B' : Type} *)
(*              {f g : A -> B} {f' g' : A'-> B'} : *)
(*     Coeq (functor_prod f f') (functor_prod g g') -> Coeq f g * Coeq f' g'. *)
(*   Proof. *)
(*     refine (Coeq_rec _ _ _). *)
(*     - exact (functor_prod coeq coeq). *)
(*     - intros [a a']. *)
(*       unfold functor_prod. *)
(*       simpl. *)
(*       apply path_prod. apply cp. apply cp. *)
(*   Defined. *)

(* (* (equiv_prod_ind _) *) *)
(*   (*Try to show stuff so that I can use prod_coeq_to_coeq_prod in functor_forall*) *)
(*   Definition pullback_pc_to_cp (*TODO: Better name*) *)
(*              {A B A' B' : Type} *)
(*              {f g : A -> B} {f' g' : A'-> B'} *)
(*              (P : Coeq f g -> Coeq f' g' -> Type) : *)
(*     Coeq (functor_prod f f') (functor_prod g g') -> Type. *)
(*   Proof. *)
(*     refine (Coeq_rec _ _ _). *)
(*     - intros [b b']. *)
(*       exact (P (coeq b) (coeq b')). *)
(*     - intros [a a']. *)
(*       simpl. *)
(*       refine (concat (y:= P (coeq (g a)) (coeq (f' a'))) _ _). *)
(*       + apply (ap (fun c => P c (coeq (f' a')))). *)
(*         apply cp. *)
(*       + apply (ap (fun c => P (coeq (g a)) c)). *)
(*         apply cp. *)
(*   Defined. *)

(*   (*TODO: Prove and give better name*) *)
(*   Definition badbadname *)
(*              {A B A' B' : Type} *)
(*              {a0 : IsPointed A} *)
(*              {f g : A -> B} {f' g' : A'-> B'} *)
(*              {pointed_f : f a0 = g a0} *)
(*              (P : Coeq f g -> Coeq f' g' -> Type) : *)
(*     forall c : Coeq f g, forall c' : Coeq f' g', *)
(*       (pullback_pc_to_cp P (prod_coeq_to_coeq_prod (pointed_f := pointed_f) (c, c'))) -> P c c'. *)
(*     Proof. *)
(*       refine (Coeq_ind _ _ _). *)
(*         intro b. *)
(*         refine (Coeq_ind _ _ _). *)
(*           intro b'. *)
(*           simpl. *)
(*           rewrite pointed_f. *)
(*           Admitted. *)

(*     Definition changebase *)
(*              {A B A' B' : Type} *)
(*              {a0 : IsPointed A} *)
(*              {f g : A -> B} {f' g' : A'-> B'} *)
(*              (pointed_f : f a0 = g a0) *)
(*              (P : Coeq f g -> Coeq f' g' -> Type) *)
(*     : (forall p : Coeq (functor_prod f f') (functor_prod g g'), pullback_pc_to_cp P p) *)
(*       -> (forall c : Coeq f g, forall c' : Coeq f' g', P c c'). *)
(*       intro x. *)
(*       apply prod_uncurryD. *)
(*       revert x. *)
(*       refine (functor_forall _ _). *)
(*       - exact (prod_coeq_to_coeq_prod (pointed_f := pointed_f)). *)
(*       - refine (prod_ind _ _). *)
(*         refine (badbadname  P). *)
(*     Defined. *)

(* (* *)

(*   Lemma Coeq_prod_commute  (f g : A->B) (f' g' : A'->B'): *)
(*     Coeq f g * Coeq f' g' <~> Coeq (functor_prod f f') (functor_prod g g'). *)
(*   Abort. *)

(* *) *)


(** * Utils *)
(** Common definitions including:
 -  theorems about lists and permutation.
 -  the induction scheme for Strong Induction
 -  some arithmetic results (specially dealing with [max] and [min])
 *)

Require Export Coq.Relations.Relations.
Require Export Coq.Classes.Morphisms.
Require Export Permutation.
Require Import Coq.Relations.Relations.
Require Import Coq.Setoids.Setoid.
Require Export Coq.Sorting.PermutSetoid.
Require Export Coq.Sorting.PermutEq.
Require Import Coq.Program.Equality.
Require Export Coq.Lists.List.
Require Export Coq.Sorting.Permutation.
Require Export Coq.Arith.Arith.
Require Export Coq.Init.Nat.
Require Import Lia.
Require Export  LL.Misc.Hybrid.

Export ListNotations.

Set Implicit Arguments.

(** ** External definitions for the Object Logic (OL)
The class [OLSig] specifies the external definitions for terms and
atomic propositions of the object logic. The syntax is parametric on:

 - [atm] : type for atomic propositions (judgments at the Object Logic level)
 - [con] : type for syntactic constructors at the OL level
 - [uniform_atm] : predicate ruling out exotic terms at the OL level
 *)

Class OLSig :=
  {
    (* Signature for atoms (judgments at the OL level) *)
    atm:Set;
    (* Type for constants (constructors for OL syntax) *)
    con:Set;
    (* predicate ruling out exotic terms for atoms *)
    uniform_atm : (expr con -> atm) -> Prop
  }.

Ltac solveUniform :=
  auto;
  repeat
    match goal with
    | [|- uniform _ ] => eauto 10  using uniform_id, uniform_con, uniform_app, proper_uniform, abstr_lambda
    | [|- uniform_atm _ ] => constructor
    | [|- proper _ ] => constructor
    | [|- level _ _ ] => constructor
    end.

Lemma NatComp : forall x y, x >= y + 1 -> S x - y - 2 = x - y - 1.
Proof with subst;auto. lia.
Qed.

Section ForAllMap.

Lemma ForallIn :  forall {A : Type} {F : A} {L : list A} (f : A -> Prop),
      Forall f L -> In F L -> f F.
  Proof.
    intros.
    generalize (Forall_forall f L );intro.
    destruct H1.
    apply H1 with (x:= F) in H ;auto.
  Qed.

Lemma ForallInP : forall {A : Type} {F : A} {L L': list A} (f : A -> Prop),
      Forall f L -> Permutation L (F::L') -> f F.
  Proof.
    intros.
    eapply @ForallIn with (F:=F) in H;auto.
    rewrite H0.
    simpl;auto.
  Qed.

End ForAllMap .

(** ** Operations on lists/multisets *)
Section MultisetOperations.
  Variable T:Type.

  (** removing an element from a list *)
  Inductive Remove :T -> list T -> list T -> Prop :=
  | Remove1: forall t l, Remove t (t::l) l
  | Remove2: forall t t' l1 l2,  Remove t l1 l2 -> Remove t (t'::l1) (t'::l2).

End MultisetOperations.

Global Hint Constructors Remove : core .

(** ** Additional results about permutations *)
Section Permutations.

  Variable A:Type.

Lemma ListConsApp (a b: A) : forall L M , a :: L = M ++ [b] ->
       (L=[]/\M=[]/\a=b) \/ exists X, M = a :: X /\ L = X++[b].
Proof with subst;auto.
  induction M; intros...
  * inversion H...
  * rewrite <- app_comm_cons in H.
    inversion H;subst...
    right.
    exists M...
 Qed.

 Lemma ListConsApp' (a b: A) : forall L M1 M2 , a :: L = M1 ++ [b] ++ M2 ->
        (L=M2/\M1=[]/\a=b) \/
       exists X, M1 = a :: X /\ L = X++[b]++M2.
Proof with subst;auto.
  destruct M1;intros...
  * inversion H;subst...
  * rewrite <- app_comm_cons in H.
    inversion H;subst...
    right.
    exists M1...
 Qed.

  Lemma ListConsApp'' (a : A) M1: forall L M2 , a :: L = M1 ++ M2 ->
       (M1=[ ]/\M2=a::L) \/
       exists X, M1 = a :: X /\ L = X++M2.
Proof with subst;auto.
  induction M1;intros...
  rewrite <- app_comm_cons in H.
   inversion H;subst...
   right.
   exists M1...
 Qed.

 Lemma ListConsApp1 (a b: A) : forall L M1 M2 , L++[a] = M1 ++ [b] ++ M2 ->
        (L=M1/\M2=[]/\a=b) \/
       exists X, M2 = X++[a] /\ L = M1++[b]++X.
Proof with subst;auto.
  intros.
  revert dependent M1.
  revert a b L.

  induction M2;intros...
  * inversion H;subst...
    left... apply app_inj_tail in H1...
    firstorder.
  * right.
    assert(L ++ [a0] = (M1 ++ [b]) ++ [a] ++ M2).
    rewrite app_assoc in H...
    apply IHM2 in H0.
    destruct H0...
    destruct H0...
    destruct H1...

    exists nil...

    destruct H0...
    destruct H0...
    exists (a::x)...
    firstorder.
    assert(M1 ++ [b] ++ a :: x ++ [a0]=(M1 ++ [b] ++ a :: x) ++ [a0]).

    rewrite app_assoc_reverse...
    simpl.
    rewrite app_assoc_reverse...
    Qed.

  Lemma ListConsApp3 (a : A) M1: forall L M2 , M1 ++ M2 = L ++ [a] ->
       (M2=[ ]/\M1=L++[a]) \/
       exists X, M2 = X++[a] /\ L = M1++X.
Proof with subst;auto.
  induction M2;intros...
  left... firstorder.
  rewrite app_nil_r in H...
  right.
  symmetry in H.
  apply ListConsApp1 in H...
  destruct H...
  destruct H...
  destruct H0...
  exists nil... firstorder.
  rewrite app_nil_r...
  destruct H...
  destruct H...
  exists (a0::x)...
 Qed.

  Lemma Perm_swap_inv : forall (x y : A) (N M : list A),
      Permutation (x :: N) (y :: x :: M) ->
      Permutation N ( y :: M).
    intros.
    rewrite perm_swap in H.
    apply Permutation_cons_inv in H;auto.
  Qed.

  Lemma Perm_swap_inv_app : forall y N M (x : A) ,
      Permutation (x :: N) (y ++ x :: M) ->
      Permutation N ( y ++ M).
    intros.
    rewrite  (Permutation_cons_append M x) in H.
    rewrite  Permutation_cons_append in H.
    rewrite app_assoc in H.
    rewrite  <- Permutation_cons_append in H.
    rewrite  <- (Permutation_cons_append (y ++ M) x ) in H.
    apply Permutation_cons_inv in H;auto.
  Qed.

  Theorem PermutConsApp: forall (a : A) l1 b l2,
      Permutation (a :: l1 ++ b :: l2) (b :: a :: l1 ++ l2).
    intros.
    rewrite perm_swap.
    rewrite <- Permutation_middle.
    auto.
  Qed.

  Lemma PermutationInCons : forall (F:A) M N,
      Permutation (F::M) N -> In F N.
    intros.
    eapply Permutation_in with (x:= F) (l':=N);eauto.
    constructor;auto.
  Qed.

  (** A slightly different version of  [Permutation_map] *)
  Lemma PermuteMap : forall (L L' : list A) (f: A->Prop),
      Forall f L -> Permutation L L'-> Forall f L'.
    intros.
    apply Permutation_sym in H0.
    assert(forall x, In x L' -> In x L) by eauto using Permutation_in.
    rewrite Forall_forall in H.
    rewrite Forall_forall;intros.
    firstorder.
  Qed.

(* Permutation_app_inv *)
  Lemma Permutation_mid : forall (F:A) l1 l2 l1' l2',
      Permutation (l1 ++ F :: l2) (l1' ++ F :: l2') ->
      Permutation (l1 ++ l2) (l1' ++ l2').
    intros.
    assert(Permutation (F::l2) (l2 ++ [F]))
      by  apply Permutation_cons_append.
    rewrite H0 in H.
    assert(Permutation (F::l2') (l2' ++ [F]))
      by  apply Permutation_cons_append.
    rewrite H1 in H.
    apply Permutation_app_inv_r with (l:= [F]).
    do 2 rewrite app_assoc_reverse;auto.
  Qed.

 (* perm_takeit_5 *)
  Lemma Permutation_midle : forall  (F:A) l1 l2,
      Permutation (l1 ++ F :: l2) ( F :: l1  ++ l2).
    intros.
    generalize (Permutation_cons_append  l1 F);intro.
    change (F::l1++l2) with ( (F::l1) ++ l2).
    rewrite H.
    assert(l1 ++ F :: l2 = (l1 ++ [F]) ++ l2).
    rewrite app_assoc_reverse;auto.
    rewrite H0.
    auto.
  Qed.

(* Permutation_app_swap_app *)
  Lemma Permutation_midle_app : forall  (la lb lc: list A),
      Permutation (la ++ lb ++ lc) ( lb ++ la  ++ lc).
    intros.
    rewrite <- app_assoc_reverse.
    rewrite Permutation_app_comm with (l:=la).
    rewrite app_assoc_reverse;auto.
  Qed.

  Lemma InPermutation : forall (l:A) L,
      In l L -> exists L', Permutation L (l :: L').
    induction L;intros.
    inversion H.
    inversion H;subst.
    exists L;auto.
    apply IHL in H0.
    destruct H0 as [L' H0].
    exists (a :: L').
    rewrite H0.
    constructor.
  Qed.

End Permutations.

(** ** Properties about [Remove] *)
Section Remove.
  Variable A:Type.

  Lemma Remove_In  : forall (F: A) (L L' :list A),
      Remove F L L' -> In F L.
  Proof.
    induction L;intros.
    + inversion H.
    + inversion H;subst.
      ++ constructor;auto.
      ++ apply IHL in H4.
         right;auto.
  Qed.

  Lemma In_Remove  : forall (F: A) (L :list A),
      In F L -> exists L', Remove F L L'.
  Proof.
    induction L;intros.
    + inversion H.
    + inversion H;subst.
      ++ exists L.
         constructor.
      ++ apply IHL in H0.
         destruct H0 as [L'].
         exists (a::L').
         constructor;auto.
  Qed.

  Lemma RemoveUnique : forall (F G:A) L,
      Remove F [G] L -> F = G.
  Proof.
    intros.
    apply Remove_In in H.
    inversion H;auto.
    inversion H0.
  Qed.

  Lemma Remove_app_head : forall (F:A) L1 L1' L2,
      Remove F L1 L1' -> Remove F (L2 ++ L1) (L2 ++ L1').
  Proof.
    induction L2;intros;auto.
    apply IHL2 in H.
    change ((a :: L2) ++ L1) with (a :: (L2 ++ L1)) .
    change ((a :: L2) ++ L1') with (a :: (L2 ++ L1')) .
    apply Remove2;auto.
  Qed.

  Lemma Remove_app_in : forall (F:A) L1 L2,
      Remove F (L1 ++ F :: L2) (L1 ++ L2).
  Proof.
    intros.
    apply Remove_app_head.
    constructor.
  Qed.

  Lemma Remove_head: forall (F:A) L1 L,
      Remove F (F :: L1) L ->
      L = L1 \/ (exists l1, L = F::l1 /\ Remove F L1 l1).
  Proof.
    intros.
    inversion H;subst;auto.
    right.
    exists l2;auto.
  Qed.

  Lemma Remove_inv: forall (F:A) a L L1,
      Remove F L (a :: L1) ->
      exists b1 b2 L2, L = b1 :: b2 :: L2 /\
                       ( ( b1=F /\ a::L1 = b2::L2) \/
                         (a=b1 /\ Remove F (b2::L2) L1) ) .
  Proof with subst.
    intros.
    revert dependent L1.
    revert dependent a.
    revert dependent F.
    induction L;intros ...
    + inversion H.
    + inversion H ...
      repeat eexists;auto.
      destruct L1.
      ++  inversion H2 ...
          repeat eexists;auto.
      ++ apply IHL in H2.
         destruct H2 as [b1 [b2 [ L2 [H2 H2']]]].
         destruct H2'.
         +++ inversion H2 ...
             repeat eexists;auto.
             right; firstorder ...
             inversion H2...
             constructor.
         +++ destruct H0 ...
             repeat eexists;auto.
  Qed.

  Lemma Remove_inv_cons: forall (F:A) a L L1,
      Remove F (a::L) L1 ->
      (F =a /\ L = L1) \/
      (exists L1', L1 = a::L1' /\ Remove F L L1') .
  Proof.
    intros.
    inversion H;subst.
    + left;auto.
    + right.
      eexists.
      eauto.
  Qed.

End Remove.

(** ** Preperties relating [Remove] and [Permutation] *)
Section RemovePermutation.
  Variable A:Type.

  Lemma Remove_Permutation_Ex  : forall (F : A) (L L' M : list A),
      Remove F L L' -> Permutation L M -> exists M', Remove F M M'.
  Proof.
    intros.
    apply Remove_In in H as Hrm.
    destruct L.
    + inversion Hrm.
    + assert(In F M).
      eapply Permutation_in;eauto.
      apply In_Remove;auto.
  Qed.

  Lemma Remove_upto_permute : forall (F:A) L1 L2 L,
      Remove F L L1 -> Remove F L L2 ->  Permutation L1 L2.
  Proof with subst.
    intros.
    revert dependent L1.
    revert dependent L2.
    induction L;intros.
    +  inversion H.
    + apply Remove_inv_cons in H as H'.
      apply Remove_inv_cons in H0 as H0'.
      destruct H';destruct H0'.
      ++ firstorder;subst;auto. (* case both took the first element *)
      ++ firstorder...
         apply Remove_In in H4 as H4'.
         apply In_Remove in H4'.
         destruct H4'.
         assert (Permutation x x0) by  (eapply IHL;eauto).
         apply Remove_In in H1 as H1'.
         apply in_split in H1'.
         firstorder ...
         assert (Remove a (x1 ++ a :: x2) (x1++x2)) by apply Remove_app_in.
         generalize (IHL x0 H1 (x1++x2) H3);intro.
         assert (Permutation  (a:: x1 ++ x2) (x1 ++a :: x2) ) by  apply Permutation_middle.
         rewrite <- H6.
         constructor.
         rewrite H5.
         rewrite H2.
         auto.
      ++ firstorder...
         apply Remove_In in H4 as H4'.
         apply In_Remove in H4'.
         destruct H4'.
         assert (Permutation x x0) by  (eapply IHL;eauto).
         apply Remove_In in H1 as H1'.
         apply in_split in H1'.
         firstorder ...
         assert (Remove a (x1 ++ a :: x2) (x1++x2)) by apply Remove_app_in.
         generalize (IHL x0 H1 (x1++x2) H3);intro.
         assert (Permutation  (a:: x1 ++ x2) (x1 ++a :: x2) ) by  apply Permutation_middle.
         rewrite <- H6.
         constructor.
         rewrite H5.
         rewrite H2.
         auto.
      ++ firstorder;subst.
         generalize (IHL x0 H4 x H3);intro.
         constructor;auto.
  Qed.

  Lemma Remove_permute : forall (F:A) L1 L2 L,
      Remove F (L1 ++ F :: L2) L -> Permutation (L1 ++ L2) L.
  Proof.
    intros.
    assert(Remove  F (L1 ++ F :: L2) (L1 ++ L2)) by  apply Remove_app_in.
    eapply Remove_upto_permute;eauto.
  Qed.

  Lemma Remove_app_tail : forall (F:A) L1 L1' L2,
      Remove F L1 L1' -> Remove F (L1++L2) (L1'++L2).
  Proof.
    intros. induction H.
    *
      apply Remove1.
    *
      change ((t' :: l1) ++ L2) with (t' ::(l1 ++ L2)).
      change ((t' :: l2) ++ L2) with (t' ::(l2 ++ L2)).
      apply Remove2;auto.
  Qed.

  Lemma Remove_Permutation_Ex2  : forall (F : A) (L L' M : list A),
      Remove F L L' -> Permutation L M ->
      exists M', Remove F M M'  /\ Permutation M' L'.
  Proof.
    intros.
    assert(HFL: In F L) by eauto using Remove_In.
    assert(HFM: In F M).
    { apply Permutation_in with (x:=F) in H0; auto; constructor;auto. }
    apply In_nth_error in HFL as HFL'.
    destruct HFL' as [n  HFL'].
    apply nth_error_split in HFL'.
    destruct HFL' as [l1 [l2 [HFL' HFL''] ]];subst.
    apply In_nth_error in HFM as HFM'.
    destruct HFM' as [n  HFM'].
    apply nth_error_split in HFM'.
    destruct HFM' as [l1' [l2' [HFM' HFM''] ]];subst.
    exists (l1' ++ l2').
    split.
    + apply Remove_app_head.
      constructor.
    + apply Remove_permute in H.
      apply Permutation_mid in H0.
      rewrite <- H0.
      rewrite H.
      auto.
  Qed.

  Lemma Remove_Permute : forall (F : A) (L L' M : list A),
      Remove F L L' -> Permutation L (F :: L').
  Proof.
    induction L;intros.
    inversion H.
    apply Remove_inv_cons in H.
    firstorder;subst.
    constructor;auto.
    assert(Permutation (F::a::x) (a :: F ::x)).
    constructor.
    rewrite H.
    constructor.
    apply IHL;auto.
  Qed.

 Variable B:Type.

  Lemma Remove_Map : forall (F : A) (L L' : list A) (f: A -> B),
      Remove F L L' -> Remove (f F) (map f L) (map f L').
  Proof.
    induction L;intros.
    inversion H.
    simpl...
    apply Remove_inv_cons in H.
    firstorder;subst.
    simpl...
    constructor;auto.
    simpl...
    constructor;auto.
  Qed.

End RemovePermutation.

(** ** Strong Induction *)

Section StrongIndPrinciple.

  Variable P: nat -> Prop.

  Hypothesis P0: P O.

  Hypothesis Pn: forall n, (forall m, m<=n -> P m) -> P (S n).

  Lemma strind_hyp : forall n, (forall m, ((m <= n) -> P m)).
  Proof.
    induction n; intros m H;inversion H;auto.
  Qed.
  (** Strong induction principle *)
  Theorem strongind: forall n, P n.
  Proof.
    induction n; auto.
    apply Pn.
    apply strind_hyp.
  Qed.

End StrongIndPrinciple.

(** ** Aditional results on Arithmentic *)
Section Arithmentic.

  Lemma MaxPlus : forall a b, (Nat.max a b <= plus a  b).
    intros;lia.
  Qed.

  Lemma MaxPlus' : forall a b c, (plus a b <= c -> Nat.max a b <= c).
    intros;lia.
  Qed.

  Theorem GtExists : forall n, n>0 -> exists n', n = S n'.
    intros.
    destruct n;inversion H;subst;eauto.
  Qed.

End Arithmentic.

Ltac mgt0 := let H := fresh "H" in
             match goal with [_ :  ?m >= S _ |- _] =>
                             assert(H : m>0) by lia;
                             apply GtExists in H;
                             destruct H;subst
             end.

Section Pairs.

Variable S:Type. (* SubExps *)
Variable F:Type. (* Formulas *)

(* fst (split L) *)
Definition first (L:list (S * F)) :=  map fst L.
(* snd (split L) *)
Definition second (L:list (S * F)) := map snd L.

Lemma secondApp C1 C2 : second (C1 ++ C2) = second C1 ++ second C2.
Proof.
  induction C1;simpl.
  reflexivity.
  rewrite IHC1.
  reflexivity. Qed.

Lemma firstApp C1 C2 : first (C1 ++ C2) = first C1 ++ first C2.
Proof.
  induction C1;simpl.
  reflexivity.
  rewrite IHC1.
  reflexivity. Qed.

Lemma InFirst c B : In c B -> In (fst c) (first B).
Proof.
 induction B;intros;auto.
 unfold second.
 inversion H;subst;auto;
 simpl;auto.
 Qed.

Lemma InSecond c B : In c B -> In (snd c) (second B).
Proof.
 induction B;intros;auto.
 unfold second.
 inversion H;subst;auto;
 simpl;auto.
 Qed.

 Lemma InSecondInv i A B : In (i,A) B -> In A (second B).
Proof.
 induction B;intros;auto.
 inversion H;subst;auto;
 simpl;auto.
 Qed.

 End Pairs.


Require Import Leapfrog.FinType.
Require Import Leapfrog.P4automaton.
Require Leapfrog.Syntax.

Require Import MirrorSolve.HLists.

Open Scope list_scope.

Section Sum.
  Set Implicit Arguments.

  (* State identifiers. *)
  Variable (St1: Type).
  Context `{St1_eq_dec: EquivDec.EqDec St1 eq}.
  Context `{St1_finite: @Finite St1 _ St1_eq_dec}.

  Variable (St2: Type).
  Context `{St2_eq_dec: EquivDec.EqDec St2 eq}.
  Context `{St2_finite: @Finite St2 _ St2_eq_dec}.

  (* Header identifiers. *)
  Variable (Hdr1: Type).
  Variable (Hdr1_sz : Hdr1 -> nat).
  Context `{Hdr1_eq_dec: EquivDec.EqDec Hdr1 eq}.
  Context `{Hdr1_finite: @Finite Hdr1 _ Hdr1_eq_dec}.

  Variable (Hdr2: Type).
  Variable (Hdr2_sz : Hdr2 -> nat).
  Context `{Hdr2_eq_dec: EquivDec.EqDec Hdr2 eq}.
  Context `{Hdr2_finite: @Finite Hdr2 _ Hdr2_eq_dec}.

  Variable (a1: Syntax.t St1 Hdr1_sz).
  Variable (a2: Syntax.t St2 Hdr2_sz).

  Notation St := (St1 + St2)%type.

  Global Instance St_eq_dec: EquivDec.EqDec St eq :=
    ltac:(typeclasses eauto).

  Global Instance St_finite: @Finite St _ St_eq_dec :=
    ltac:(typeclasses eauto).

  Definition Hdr : Type := Hdr1 + Hdr2.

  Definition make_transparent {X: Type} (eq_dec: forall (x0 x1: X), {x0 = x1} + {x0 <> x1}) {l r} (opaque_eq: l = r) : l = r :=
    match eq_dec l r with
    | left transparent_eq => transparent_eq
    | _ => opaque_eq
    end.

  Definition Hdr_sz (h: Hdr) : nat :=
    match h with
    | inl h => Hdr1_sz h
    | inr h => Hdr2_sz h
    end.

  Program Definition sum : Syntax.t St Hdr_sz :=
    {| Syntax.t_states s :=
         match s with
         | inl s1 => Syntax.state_fmapSH Hdr_sz inl inl _ (a1.(Syntax.t_states) s1)
         | inr s2 => Syntax.state_fmapSH Hdr_sz inr inr _ (a2.(Syntax.t_states) s2)
         end |}.
  Next Obligation.
    destruct h; simpl.
    - apply a1.
    - apply a2.
  Qed.
  Next Obligation.
    destruct a1, a2, s;
      erewrite Syntax.state_fmapSH_size; eauto.
  Qed.

  Definition sum_stores
             (s1: Syntax.store Hdr1 Hdr1_sz)
             (s2: Syntax.store Hdr2 Hdr2_sz) : Syntax.store Hdr Hdr_sz :=
    HList.app (HList.map_inj (fun h => Syntax.v (Hdr_sz h)) inl s1)
              (HList.map_inj (fun h => Syntax.v (Hdr_sz h)) inr s2).

End Sum.


(**********************************************************************)
(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
(**********************************************************************)

(**********************************************************************)
(*                        SF-Calculus                                 *)
(*                                                                    *)
(* is implemented in Coq by adapting the implementation of            *)
(* Lambda Calculus from Project Coq                                   *)
(* 2015                                                               *)
(**********************************************************************)

(**********************************************************************)
(*                       Fixpoints.v                                  *)
(*                                                                    *)
(*                        Barry Jay                                   *)
(*                                                                    *)
(**********************************************************************)

Require Import Bool Arith Omega List Max.
Require Import IntensionalLib.SF_calculus.Test.
Require Import IntensionalLib.SF_calculus.General.
Require Import IntensionalLib.SF_calculus.SF_Terms.
Require Import IntensionalLib.SF_calculus.SF_Tactics.
Require Import IntensionalLib.SF_calculus.SF_reduction.
Require Import IntensionalLib.SF_calculus.SF_Normal.
Require Import IntensionalLib.SF_calculus.SF_Closed.
Require Import IntensionalLib.SF_calculus.Substitution.
Require Import IntensionalLib.SF_calculus.SF_Eval.
Require Import IntensionalLib.SF_calculus.Star.

Lemma maxvar_op: forall o, maxvar (Op o) = 0.  Proof. split_all. Qed.

(* delayed application *)

Definition app_comb M N :=
App (App s_op (App (App s_op (App k_op M)) (App k_op N))) i_op.

Lemma app_comb_red : forall M N P, sf_red (App (app_comb M N) P) (App (App M N) P).
Proof.
unfold app_comb; unfold_op; split_all.
eapply succ_red. eapply2 s_red.
eapply succ_red. eapply app_sf_red. eapply2 s_red.  eapply2 s_red.
eapply succ_red. eapply app_sf_red. eapply app_sf_red. eapply2 f_op_red.  eapply2 f_op_red.
eapply2 f_op_red.
auto.
Qed.

Lemma lift_rec_preserves_app_comb:
forall M1 M2 n k, lift_rec (app_comb M1 M2) n k = app_comb (lift_rec M1 n k) (lift_rec M2 n k).
Proof. intros; unfold app_comb; unfold_op; split_all. Qed.

Lemma subst_rec_preserves_app_comb:
forall i M N k, subst_rec (app_comb i M) N k = app_comb (subst_rec i N k) (subst_rec M N k).
Proof. intros; unfold app_comb; unfold_op; split_all.  Qed.

Lemma app_comb_normal: forall i M, normal i -> normal M -> normal (app_comb i M).
Proof. intros; unfold app_comb; unfold_op. repeat eapply2 nf_compound. Qed.

Lemma maxvar_app_comb : forall M N,  maxvar (app_comb M N) = max(maxvar M) (maxvar N).
Proof. intros; unfold app_comb. unfold_op; split_all. rewrite max_zero. auto. Qed.

Lemma rank_app_comb: forall M N, rank (app_comb M N) > rank (App M N).
Proof. intros; unfold app_comb; split_all. omega. Qed.

Lemma program_app_comb2 : forall M N, program (app_comb M N) -> program M /\ program N.
Proof.
  unfold app_comb; unfold_op; intros. inversion H. simpl in H1. max_out. max_out.
  inversion H0; inversion H6; inversion H12; inversion H16; inversion H22; inversion H17;
  unfold program; repeat split; split_all.
Qed.

Lemma app_comb_preserves_sf_red:
forall M M' N N',
sf_red M M' -> sf_red N N' ->
sf_red (app_comb M N) (app_comb M' N').
Proof.  intros; unfold app_comb. repeat eapply2 preserves_app_sf_red.  Qed.

(*
Lemma soac : forall M N,  occurs0 M  = true -> star_opt (app_comb M N) =
                                               App
    (App (Op Sop)
       (App (App (Op Sop) (App k_op (Op Sop)))
          (App
             (App (Op Sop)
                (App (App (Op Sop) (App k_op (Op Sop)))
                   match M with
                   | Ref 0 => subst k_op (Op Sop)
                   | _ => App (App (Op Sop) (App k_op (subst (App f_op f_op) (Op Sop)))) (star_opt M)
                   end))
             (star_opt N)))) (App k_op (subst (App (App s_op k_op) k_op) (Op Sop))) .
Proof.
  intros; simpl; rewrite H; simpl.
  assert(star_opt N = match N with
             | Ref 0 => subst k_op (Op Sop)
             | _ =>
                 if occurs0 N
                 then App (App (Op Sop) (App k_op (subst (App f_op f_op) (Op Sop)))) (star_opt N)
                 else App k_op (subst (App k_op N) (Op Sop))
                      end).

  unfold star_opt; auto.
 *)

(*
Definition star_opt_app_comb M N :=
  App (App s_op
           (App (App s_op
                     (App k_op s_op))
                (App (App s_op
                          (App (App s_op
                                    (App k_op s_op))
                               (App (App s_op (App k_op k_op)) (star_opt M))))
                     (App (App s_op (App k_op k_op)) (star_opt N)))))
      (App k_op i_op)
.

Lemma star_opt_app_comb_red : forall M N x,
    sf_red (App (star_opt_app_comb M N) x) (app_comb (App (star_opt M) x) (App (star_opt N) x)).
Proof.
  intros; unfold star_opt_app_comb, app_comb; unfold_op. repeat eval_tac.
  eapply2 preserves_app_sf_red.  eapply2 preserves_app_sf_red.
  repeat eval_tac.    eapply2 preserves_app_sf_red.  eapply2 preserves_app_sf_red.
  all: repeat eval_tac.
Qed.
*)

Definition a_op := App
    (App (Op Sop)
       (App (App (Op Sop) (App (App (Op Fop) (Op Fop)) (Op Sop)))
          (App
             (App (Op Sop)
                (App (App (Op Fop) (Op Fop)) (App (Op Sop) (App (App (Op Fop) (Op Fop)) (Op Sop)))))
             (App
                (App (Op Sop)
                   (App (App (Op Sop) (App (App (Op Fop) (Op Fop)) (Op Sop)))
                      (App (App (Op Sop) (App (App (Op Fop) (Op Fop)) (App (Op Fop) (Op Fop))))
                         (App (App (Op Sop) (App (App (Op Fop) (Op Fop)) (Op Sop)))
                            (App (Op Fop) (Op Fop))))))
                (App (App (Op Fop) (Op Fop)) (App (Op Fop) (Op Fop)))))))
    (App (App (Op Fop) (Op Fop))
         (App (App (Op Fop) (Op Fop)) (App (App (Op Sop) (App (Op Fop) (Op Fop))) (App (Op Fop) (Op Fop))))).

Lemma a_op_val: a_op = star_opt (star_opt (app_comb (Ref 1) (Ref 0))).
Proof.  unfold a_op, app_comb; unfold_op; simpl; unfold_op; unfold subst; simpl; auto. Qed.

Ltac unfold_op := unfold a_op, app_comb, i_op, k_op, s_op, f_op.

Lemma a_op2_red: forall M N, sf_red (App (App a_op M) N) (app_comb M N).
Proof.
  unfold_op; intros. repeat eval_tac.
Qed.

Lemma a_op_red: forall M N P, sf_red (App (App (App a_op M) N) P) (App (App M N) P).
Proof.
  unfold a_op; intros. do 20 eval_tac.
  eapply2 preserves_app_sf_red.  eapply2 preserves_app_sf_red.
  all: repeat   eval_tac.
Qed.

Fixpoint A_k k :=
match k with
| 0 => i_op
| 1 => i_op
| 2 => a_op
| S k1 => App (App s_op (App k_op (App s_op (App k_op (A_k k1))))) a_op
end.

Lemma A_k_closed: forall k, maxvar (A_k k) = 0.
Proof.
induction k; intros. split_all.
induction k; intros. split_all.
clear IHk0. induction k; intros. split_all. clear IHk0.
unfold A_k in *; fold A_k in *.
repeat rewrite maxvar_app. simpl. rewrite IHk. auto.
Qed.

Lemma A_k_normal : forall k, normal (A_k k).
Proof.
induction k; split_all.
unfold_op; auto.
induction k; split_all.
induction k; split_all.
unfold_op; auto. repeat eapply2 star_opt_normal.
repeat eapply2 nf_compound.
unfold_op. repeat apply nf_compound; unfold_op; auto.
Qed.

Hint Resolve A_k_closed A_k_normal.

Ltac nf_out :=
  unfold a_op; unfold_op;
  match goal with
    | |- normal ?M =>
      match M with
        | star_opt _ => apply star_opt_normal; nf_out
        | A_k _ => apply A_k_normal; nf_out
        | app_comb _ _ => apply app_comb_normal; nf_out
          | App (App (Op _) _) _ => apply nf_compound; [| |auto]; nf_out
          | App (Op _) _ => apply nf_compound; [| |auto]; nf_out
          | _ => split_all
      end
    | _ => auto
        end.

(* fixpoints that wait *)

(* Y2 *)

Definition omega2 :=
 App
    (App (Op Sop)
       (App (App (Op Fop) (Op Fop))
          (App (Op Sop) (App (App (Op Sop) (App (Op Fop) (Op Fop))) (App (Op Fop) (Op Fop))))))
    (App
       (App (Op Sop)
          (App (App (Op Sop) (App (App (Op Fop) (Op Fop)) (Op Sop)))
             (App
                (App (Op Sop)
                   (App (App (Op Fop) (Op Fop)) (App (Op Sop) (App (App (Op Fop) (Op Fop)) (Op Sop)))))
                (App
                   (App (Op Sop)
                      (App (App (Op Sop) (App (App (Op Fop) (Op Fop)) (Op Sop)))
                         (App (App (Op Sop) (App (App (Op Fop) (Op Fop)) (App (Op Fop) (Op Fop))))
                            (App (App (Op Sop) (App (App (Op Fop) (Op Fop)) (Op Sop)))
                               (App (App (Op Sop) (App (App (Op Fop) (Op Fop)) (App (Op Fop) (Op Fop))))
                                  (App
                                     (App (Op Sop)
                                        (App (App (Op Sop) (App (App (Op Fop) (Op Fop)) (Op Sop)))
                                           (App
                                              (App (Op Sop)
                                                 (App
                                                    (App (Op Sop) (App (App (Op Fop) (Op Fop)) (Op Sop)))
                                                    (App (Op Fop) (Op Fop))))
                                              (App (Op Fop) (Op Fop)))))
                                     (App (App (Op Fop) (Op Fop))
                                        (App (App (Op Sop) (App (Op Fop) (Op Fop)))
                                           (App (Op Fop) (Op Fop))))))))))
                   (App (App (Op Fop) (Op Fop)) (App (Op Fop) (Op Fop)))))))
       (App (App (Op Fop) (Op Fop))
          (App (App (Op Fop) (Op Fop))
               (App (App (Op Sop) (App (Op Fop) (Op Fop))) (App (Op Fop) (Op Fop)))))).

Lemma omega2_val: omega2 = star_opt(star_opt (App (Ref 0) (app_comb (app_comb (Ref 1) (Ref 1)) (Ref 0)))).
Proof. unfold omega2, star_opt; unfold_op; unfold subst; simpl; auto. Qed.

Definition Y2 f := app_comb (app_comb omega2 omega2) f.

Lemma Y2_program: forall f, program f -> program (Y2 f).
Proof.
  unfold Y2, omega2; split_all; unfold program; split;
unfold subst, subst_rec; fold subst_rec; nf_out; try eapply2 H.
unfold subst, subst_rec; fold subst_rec; nf_out; try eapply2 H.
unfold maxvar; fold maxvar. simpl. rewrite max_zero; eapply2 H.
Qed.

Lemma omega2_omega2 :
forall f, sf_red (App (App omega2 omega2) f) (App f (Y2 f)).
Proof.
  intros; unfold omega2 at 1; unfold_op.
  do 5 eval_tac.  eapply2 preserves_app_sf_red.
  all:  unfold Y2; unfold_op;   repeat  eval_tac.
Qed.

Lemma Y2_fix: forall M N,
sf_red (App (Y2 M) N) (App (App M (Y2 M)) N).
Proof.
unfold Y2 at 1.  intros.
eapply transitive_red. eapply2 app_comb_red.
eapply transitive_red. eapply preserves_app_sf_red. eapply2 app_comb_red. auto.
eapply transitive_red. eapply preserves_app_sf_red. eapply2 omega2_omega2. all:auto.
Qed.

(* Y3 *)

Definition app_comb_eta f :=
  App
    (App (Op Sop)
       (App (App (Op Sop) (App (App (Op Fop) (Op Fop)) (Op Sop)))
          (App
             (App (Op Sop) (App (App (Op Fop) (Op Fop)) (App (Op Sop) (App (App (Op Fop) (Op Fop)) f))))
             (App (Op Fop) (Op Fop)))))
    (App (App (Op Fop) (Op Fop)) (App (App (Op Sop) (App (Op Fop) (Op Fop))) (App (Op Fop) (Op Fop)))).

(* true, but not needed
Lemma app_comb_eta_red : forall f, app_comb_eta f = star_opt (app_comb (lift 1 f) (Ref 0)).
Proof.
  intros; unfold app_comb.
  unfold_op.
  rewrite star_opt_occurs_true.
  3: discriminate.
  2: rewrite ! occurs_app. 2: simpl. 2: rewrite orb_true_r. 2: auto.
  rewrite star_opt_occurs_true.
  3: discriminate.
  2: rewrite ! occurs_app. 2: simpl. 2: rewrite orb_true_r. 2: auto.
  unfold star_opt at 1.
  rewrite star_opt_occurs_true.
  3: discriminate.
  2: rewrite ! occurs_app. 2: simpl. 2: rewrite orb_true_r. 2: auto.
  rewrite star_opt_occurs_false.
  2: simpl. 2: unfold lift; rewrite occurs_lift_rec_zero; auto.
  unfold_op; unfold subst, lift; simpl.
  rewrite subst_rec_lift_rec; try omega. rewrite lift_rec_null.
  unfold subst; simpl. unfold_op.
  auto.
Qed.
 *)

Definition Y3_aux w f  := app_comb_eta (app_comb (app_comb w w) f).

Definition omega3 :=
  star_opt(star_opt (app_comb_eta (app_comb (Ref 0) (Y3_aux (Ref 1) (Ref 0))))).

Definition Y3 f := Y3_aux omega3 f.

Lemma Y3_aux_program: forall w f, program w -> program f -> program (Y3_aux w f).
Proof.
  intros; unfold Y3_aux, app_comb_eta, program; split_all; split.
  nf_out. eapply2 H. eapply2 H. eapply2 H0.
  rewrite ! max_zero.
  assert(maxvar w = 0) by eapply2 H. rewrite ! H1. simpl. eapply2 H0.
Qed.

Lemma omega3_program: program omega3.
Proof. split; auto. unfold omega3, app_comb_eta; nf_out.  unfold Y3_aux, app_comb_eta; nf_out. Qed.

Lemma Y3_program: forall f, program f -> program (Y3 f).
Proof. intros.  unfold Y3. eapply2 Y3_aux_program. eapply2 omega3_program.  Qed.

Lemma omega3_omega3 :
forall f M N, sf_red (App (App (App (App omega3 omega3) f) M) N) (App (App (App f (Y3 f)) M) N).
Proof.
  intros; cbv; do 56 eval_tac.
  eapply2 preserves_app_sf_red. eapply2 preserves_app_sf_red.
  eapply2 preserves_app_sf_red.
  all: repeat eval_tac.
Qed.

Lemma Y3_fix: forall M N P,
sf_red (App (App (Y3 M) N) P) (App (App (App M (Y3 M)) N) P).
Proof.
  unfold Y3, Y3_aux, omega3, app_comb_eta; intros; cbv.
  do 73 eval_tac.
  eapply2 preserves_app_sf_red. eapply2 preserves_app_sf_red.
  eapply2 preserves_app_sf_red. all: repeat eval_tac.
Qed.

Definition omega_k k :=
star_opt(star_opt (App (Ref 0) (app_comb (app_comb (app_comb (A_k (S k)) (Ref 1)) (Ref 1))
                                    (Ref 0)))).

Definition Y_k k := app_comb (app_comb (A_k (S k)) (omega_k k)) (omega_k k).

Lemma omega_k_normal: forall k, normal (omega_k k).
Proof.
intros; unfold omega_k. repeat eapply2 star_opt_normal.
eapply2 nf_active.  repeat eapply2 app_comb_normal.
Qed.

Hint Resolve A_k_closed A_k_normal omega_k_normal.

Lemma omega_omega :
forall k M, sf_red (App (App (omega_k k) (omega_k k)) M) (App M (app_comb (Y_k k) M)).
Proof.
unfold omega_k at 1. intros.
eapply transitive_red. eapply2 star_opt_beta2.
unfold subst, subst_rec; fold subst_rec.
insert_Ref_out. unfold lift.  rewrite lift_rec_null.
rewrite subst_rec_lift_rec; try omega.
rewrite lift_rec_null. eapply2 preserves_app_sf_red.
repeat rewrite subst_rec_preserves_app_comb.
repeat rewrite (subst_rec_closed (A_k (S k))); try (rewrite A_k_closed; omega).
rewrite ! subst_rec_ref; insert_Ref_out. unfold pred.
rewrite ! subst_rec_ref; insert_Ref_out.
unfold lift. rewrite ! lift_rec_null.
rewrite subst_rec_lift_rec; try omega.  rewrite lift_rec_null. unfold Y_k. auto.
Qed.

Lemma Y_k_program: forall k, program (Y_k k).
Proof.
  unfold Y_k; split_all; unfold program; split; nf_out.
  (* 2 *)
  case k; intros.  nf_out.
unfold_op; unfold subst, subst_rec; fold subst_rec; case n; intros; nf_out.
  (* 1 *)
  rewrite ! maxvar_app. rewrite ! maxvar_op. unfold max; fold max.
unfold omega_k. rewrite ! maxvar_star_opt.
  rewrite ! maxvar_app. rewrite ! maxvar_app_comb.
  rewrite ! A_k_closed.  unfold maxvar; fold maxvar; unfold max; fold max.
unfold pred; rewrite ! max_zero.
case k; split_all. case n; split_all. rewrite max_zero.
induction n0; split_all. rewrite max_zero; auto.
Qed.

Lemma Y_k_normal: forall k, normal (Y_k k). Proof. eapply2 Y_k_program. Qed.
Lemma Y_k_closed: forall k, maxvar (Y_k k) = 0. Proof. eapply2 Y_k_program. Qed.

(*
Lemma Y2_fix: forall M N,
sf_red (App (App (Y_k 2) M) N) (App (App M (app_comb (Y_k 2) M)) N).
Proof.
unfold Y_k at 1.  intros.
eapply transitive_red. eapply preserves_app_sf_red. eapply2 app_comb_red. auto.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply2 app_comb_red. auto. auto.
unfold A_k; fold A_k. unfold_op.  eval_tac. eval_tac. eval_tac. eval_tac.
  eval_tac. eval_tac. eval_tac. eval_tac.   eval_tac. eval_tac. eval_tac. eval_tac.
  eval_tac. eval_tac. eval_tac. eval_tac.   eval_tac. eval_tac. eval_tac. eval_tac.
  eval_tac. eval_tac. eval_tac. eval_tac.   eval_tac. eval_tac. eval_tac. eval_tac.
  eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply preserves_app_sf_red.  eapply succ_red. eapply2 f_op_red. auto.
eval_tac. eval_tac. eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply omega_omega. eval_tac.
  eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply succ_red. eapply2 f_op_red. auto. auto. auto. auto. auto.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply succ_red. eapply2 f_op_red. auto. auto. auto.
eapply2 preserves_app_sf_red. eapply2 preserves_app_sf_red. unfold_op.
eapply2 preserves_app_sf_red. eapply2 preserves_app_sf_red.
eapply2 preserves_app_sf_red. eapply2 preserves_app_sf_red.
eval_tac. eval_tac.
Qed.

Lemma Y3_fix: forall M N P,
sf_red (App (App (App (Y_k 3) M) N) P) (App (App (App M (app_comb (Y_k 3) M)) N) P).
Proof.
unfold Y_k at 1.  intros.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply2 app_comb_red. auto. auto.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply preserves_app_sf_red. eapply2 app_comb_red. auto. auto. auto.
unfold A_k; fold A_k. unfold_op.  eval_tac. eval_tac. eval_tac. eval_tac.
  eval_tac. eval_tac. eval_tac. eval_tac.   eval_tac. eval_tac. eval_tac. eval_tac.
  eval_tac. eval_tac. eval_tac. eval_tac.   eval_tac. eval_tac. eval_tac. eval_tac.
  eval_tac. eval_tac. eval_tac. eval_tac.   eval_tac. eval_tac. eval_tac. eval_tac.
  eval_tac. eval_tac. eval_tac. eval_tac.   eval_tac. eval_tac. eval_tac. eval_tac.
  eval_tac. eval_tac. eval_tac. eval_tac.   eval_tac. eval_tac. eval_tac. eval_tac.
  eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply preserves_app_sf_red.  eapply preserves_app_sf_red.
eapply succ_red. eapply2 f_op_red. auto.
eval_tac. eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply succ_red. eapply2 f_op_red. auto.  auto.
eval_tac. eval_tac. eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply omega_omega.  eval_tac.   eval_tac. eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply preserves_app_sf_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply succ_red. eapply2 f_op_red. auto. auto. eval_tac.  auto. auto. auto.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
 eapply preserves_app_sf_red.
eapply succ_red. eapply2 f_op_red. auto. auto. auto. auto.
eapply2 preserves_app_sf_red. eapply2 preserves_app_sf_red. eapply2 preserves_app_sf_red.
unfold_op.
eapply2 preserves_app_sf_red. eapply2 preserves_app_sf_red.
eapply2 preserves_app_sf_red. eapply2 preserves_app_sf_red.
eval_tac. eval_tac.
Qed.

*)

Lemma Y4_fix: forall M N P Q,
sf_red (App (App (App (App (Y_k 4) M) N) P) Q) (App (App (App (App M (app_comb (Y_k 4) M)) N) P) Q).
Proof.
unfold Y_k at 1; unfold_op; intros; cbv.
do 112 eval_tac.
  eapply2 preserves_app_sf_red. eapply2 preserves_app_sf_red.
  eapply2 preserves_app_sf_red.  eapply2 preserves_app_sf_red.
  all: repeat eval_tac.
Qed.

(*
Lemma Y5_fix: forall M N P Q R,
sf_red (App (App (App (App (App (Y_k 5) M) N) P) Q) R)
       (App (App (App (App (App M (app_comb (Y_k 5) M)) N) P) Q) R).
Proof.
unfold Y_k at 1.  intros.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply2 app_comb_red. auto. auto. auto. auto.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
 eapply preserves_app_sf_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply2 app_comb_red. auto. auto. auto. auto. auto.
unfold A_k. unfold_op. eval_tac. eval_tac. eval_tac. eval_tac. eval_tac. eval_tac.
 eval_tac. eval_tac. eval_tac. eval_tac. eval_tac. eval_tac.
 eval_tac. eval_tac. eval_tac. eval_tac. eval_tac. eval_tac.
 eval_tac. eval_tac. eval_tac. eval_tac. eval_tac. eval_tac.
 eval_tac. eval_tac. eval_tac. eval_tac. eval_tac. eval_tac.
 eval_tac. eval_tac. eval_tac. eval_tac. eval_tac. eval_tac.
eval_tac. eval_tac. eval_tac. eval_tac. eval_tac. eval_tac.
eval_tac. eval_tac. eval_tac. eval_tac. eval_tac. eval_tac.
 eval_tac. eval_tac. eval_tac. eval_tac. eval_tac. eval_tac.
 eval_tac. eval_tac. eval_tac. eval_tac. eval_tac. eval_tac.
 eval_tac. eval_tac. eval_tac. eval_tac. eval_tac. eval_tac.
 eval_tac. eval_tac. eval_tac. eval_tac. eval_tac. eval_tac.
 eval_tac. eval_tac. eval_tac. eval_tac. eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply preserves_app_sf_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply preserves_app_sf_red. eapply succ_red. eapply2 f_op_red. auto.
eval_tac. eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
 eapply succ_red. eapply2 f_op_red. auto. auto. eval_tac. eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
 eapply succ_red. eapply2 f_op_red. auto. auto. eval_tac. eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
 eapply succ_red. eapply2 f_op_red. auto. auto. eval_tac. eval_tac. eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply2 omega_omega. eval_tac. eval_tac. eval_tac. eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply transitive_red. eval_tac.
eapply transitive_red. eapply preserves_app_sf_red. eapply preserves_app_sf_red.
eapply preserves_app_sf_red.
 eapply succ_red. eapply2 f_op_red. auto. auto. eval_tac. auto.
eapply transitive_red. eapply preserves_app_sf_red.
 eapply succ_red. eapply2 f_op_red. auto. auto. auto. auto. auto. auto. auto.
eapply2 preserves_app_sf_red. eapply2 preserves_app_sf_red.
eapply2 preserves_app_sf_red. eapply2 preserves_app_sf_red.
eapply2 preserves_app_sf_red. unfold_op. eapply2 preserves_app_sf_red.
eapply2 preserves_app_sf_red. eapply2 preserves_app_sf_red.
eapply2 preserves_app_sf_red. eval_tac. eval_tac.
Qed.

Set Printing Depth 10000.

(*
Definition Y2_comb_val := App
     (App (Op Sop)
        (App
           (App (Op Sop)
              (App (App (Op Fop) (Op Fop))
                 (App
                    (App (Op Sop)
                       (App
                          (App (Op Sop)
                             (App (App (Op Fop) (Op Fop))
                                (App
                                   (App (Op Sop)
                                      (App (App (Op Fop) (Op Fop))
                                         (App (Op Sop)
                                            (App (App (Op Fop) (Op Fop))
                                               (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop))))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop)))))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop))))))))))
                                   (App
                                      (App (Op Sop)
                                         (App
                                            (App (Op Sop)
                                               (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                            (App
                                               (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))))
                                               (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop))))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop)))))))))
                                      (App (App (Op Fop) (Op Fop))
                                         (App (App (Op Fop) (Op Fop))
                                            (App
                                               (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                               (App (Op Fop) (Op Fop)))))))))
                          (App (App (Op Fop) (Op Fop))
                             (App
                                (App (Op Sop)
                                   (App (App (Op Fop) (Op Fop))
                                      (App (Op Sop)
                                         (App
                                            (App (Op Sop)
                                               (App (Op Fop) (Op Fop)))
                                            (App (Op Fop) (Op Fop))))))
                                (App
                                   (App (Op Sop)
                                      (App
                                         (App (Op Sop)
                                            (App (App (Op Fop) (Op Fop))
                                               (Op Sop)))
                                         (App
                                            (App (Op Sop)
                                               (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))))
                                            (App
                                               (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop))))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop)))))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop))))))))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop))))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop)))))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop)))))))))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop)))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop))))))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop)))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop))))))))))
                                               (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop)))))))))
                                   (App (App (Op Fop) (Op Fop))
                                      (App (App (Op Fop) (Op Fop))
                                         (App
                                            (App (Op Sop)
                                               (App (Op Fop) (Op Fop)))
                                            (App (Op Fop) (Op Fop))))))))))
                    (App (App (Op Sop) (App (Op Fop) (Op Fop)))
                       (App (Op Fop) (Op Fop))))))
           (App (App (Op Fop) (Op Fop))
              (App
                 (App (Op Sop)
                    (App (App (Op Fop) (Op Fop))
                       (App (Op Sop)
                          (App (App (Op Sop) (App (Op Fop) (Op Fop)))
                             (App (Op Fop) (Op Fop))))))
                 (App
                    (App (Op Sop)
                       (App
                          (App (Op Sop)
                             (App (App (Op Fop) (Op Fop)) (Op Sop)))
                          (App
                             (App (Op Sop)
                                (App (App (Op Fop) (Op Fop))
                                   (App (Op Sop)
                                      (App (App (Op Fop) (Op Fop)) (Op Sop)))))
                             (App
                                (App (Op Sop)
                                   (App
                                      (App (Op Sop)
                                         (App (App (Op Fop) (Op Fop))
                                            (Op Sop)))
                                      (App
                                         (App (Op Sop)
                                            (App (App (Op Fop) (Op Fop))
                                               (App (Op Fop) (Op Fop))))
                                         (App
                                            (App (Op Sop)
                                               (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                            (App
                                               (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                               (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop))))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop)))))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop))))))))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (Op Sop)))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop))))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop)))))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop)))))))))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop)))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop))))))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App (Op Fop) (Op Fop))))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop)))))))
                                                  (App
                                                  (App (Op Fop) (Op Fop))
                                                  (App
                                                  (App
                                                  (Op Sop)
                                                  (App (Op Fop) (Op Fop)))
                                                  (App (Op Fop) (Op Fop))))))))))
                                (App (App (Op Fop) (Op Fop))
                                   (App
                                      (App (Op Sop)
                                         (App (App (Op Fop) (Op Fop))
                                            (App (Op Fop) (Op Fop))))
                                      (App
                                         (App (Op Sop)
                                            (App (Op Fop) (Op Fop)))
                                         (App (Op Fop) (Op Fop)))))))))
                    (App (App (Op Fop) (Op Fop))
                       (App (App (Op Fop) (Op Fop))
                          (App (App (Op Sop) (App (Op Fop) (Op Fop)))
                             (App (Op Fop) (Op Fop))))))))))
     (App (App (Op Sop) (App (Op Fop) (Op Fop))) (App (Op Fop) (Op Fop))).
*)

Fixpoint size M :=
match M with
| Ref _ => 1
| Op _ => 1
| App M1 M2 => S(size M2 + size M1)
end .

Lemma size_Y2: size(Y2_comb_val) = 1247.
  Proof. cbv. auto. Qed.

Notation "A ~ B" := (App A B) (at level 79, left associativity).
Notation S := (Op Sop).
Notation K := (App (Op Fop) (Op Fop)).
Notation I := (App (App (Op Sop) (App (Op Fop) (Op Fop))) (App (Op Fop) (Op Fop))).

Print Y2_comb_val.

Lemma Y2_val: Y_k 2 = Y2_comb_val.
Proof.  cbv. auto. Qed.

Definition a_op_val :=
 (S ~
    (S ~ (K ~ S) ~
     (S ~ (K ~ (S ~ (K ~ S))) ~
      (S ~ (S ~ (K ~ S) ~ (S ~ (K ~ K) ~ (S ~ (K ~ S) ~ (S ~ (K ~ K) ~ I)))) ~
         (K ~ (S ~ (K ~ K) ~ I))))) ~ (K ~ (K ~ I))).

Lemma a_op_value : a_op  = a_op_val.
Proof. cbv. auto. Qed.

Lemma a_op_size : size a_op_val = 113.
Proof. cbv. auto. Qed.

  *)