Require Import Arith.
Require Import List.
Require Import Relations.
Require Import Wellfounded.
Require Import list_util.
Require Import ModEq.
Require Import Peano_LQ.

Set Implicit Arguments.

Hint Resolve le_plus_r le_plus_l in_or_app.

Theorem Var_Eq_sym: forall x y l, Inf l (#x==#y) -> Inf l (#y==#x). Proof. intros. apply IMp with (#x==#x); auto. apply IMp with (#x==#y); auto. apply IAx. apply PAE2 with (S(max x y)) (#S(max x y)) (#x); auto; apply nVT_SubTerm; intros C; apply VT_var in C; absurd (x<x); auto; rewrite <- C at 2; auto. Qed.
Theorem Var_Eq_trans: forall x y z l, Inf l (#x==#y) -> Inf l (#y==#z) -> Inf l (#x==#z). Proof. intros. apply IMp with (#y==#z); auto. apply IMp with (#y==#x); [|apply Var_Eq_sym]; auto. apply IAx. apply PAE2 with (S z) (#S z) (#z); auto; apply nVT_SubTerm; intros C; apply VT_var in C. Qed.
Theorem Term_Eq_refl: forall t l, Inf l (t==t). Proof. intros. apply Inf_incl with nil; auto. apply Ui with (#0==#0) 0 t; auto. Qed.
Theorem Term_Eq_sym: forall t u l, Inf l (t==u) -> Inf l (u==t). Proof. intros. apply IMP with (t==u) nil l; auto. remember (newVar nil (u::nil) nil) as v. apply Ui with (#v==u==>u==#v) v t; auto. apply Ug; auto. apply Ui with (#v==#S v==>#S v==#v) (S v) u; auto. apply Ug; auto. apply Ded. apply Var_Eq_sym; auto. subst v. apply TFFSub_Imp; apply TFFSub_Eq; auto; apply nVT_SubTerm; eapply newVar_nVT; eauto. Qed.
Theorem Term_Eq_trans: forall s t u l, Inf l (s==t) -> Inf l (t==u) -> Inf l (s==u). Proof. intros. apply IMp with (t==u); auto. apply IMP with (s==t) nil l; auto. remember (newVar nil (s::t::u::nil) nil) as v. apply Ui with (s==t==>t==(#v)==>s==(#v)) v u; auto. apply Ug; auto. apply Ui with (s==(#S v)==>(#S v)==(#v)==>s==(#v)) (S v) t; auto. apply Ug; auto. apply Ui with (#S (S v)==#S v==>#S v==#v==>#S (S v)==#v) (S(S v)) s; auto. apply Ug; auto. apply Ded. apply Ded. apply Var_Eq_trans with (S v); auto. repeat apply TFFSub_Imp; auto; apply TFFSub_Eq; auto; apply nVT_SubTerm; intros C; inversion C; contradict H3; clear -v; induction v; auto. repeat apply TFFSub_Imp; apply TFFSub_Eq; auto; apply nVT_SubTerm; subst v; eapply newVar_nVT; eauto. repeat apply TFFSub_Imp; apply TFFSub_Eq; auto; apply nVT_SubTerm; subst v; eapply newVar_nVT; eauto. Qed.
Theorem Var_Eq_SubTerm: forall v x y t tx ty l, Inf l (#x==#y) -> SubTerm v (#x) t tx -> SubTerm v (#y) t ty -> Inf l (tx==ty). Proof. intros. remember (newVar (x::nil) (t::nil) nil) as z. destruct (subTerm_sig v (#z) t) as [t' H2 H3]. assert (Hz:~VarTerm z t). subst z; eapply newVar_nVT; eauto. assert (SubTerm z (#x) t' tx). apply SubTerm_via with v t; auto. assert (SubTerm z (#y) t' ty). apply SubTerm_via with v t; auto. apply IMp with (tx==tx). apply IMp with (#x==#y); auto. apply IAx. apply PAE2 with z tx t'; auto; apply nVT_SubTerm; apply SubTerm_nVT2 with v (#x) t; auto; intros C; apply VT_var in C; subst z; absurd (In x (x::nil)); auto; rewrite <-C at 1; eapply newVar_nVar; eauto. apply Term_Eq_refl. Qed.
Theorem Term_Eq_SubTerm: forall t u l v f ft fu, Inf l (t==u) -> SubTerm v t f ft -> SubTerm v u f fu -> Inf l (ft==fu). Proof. intros. apply IMP with (t==u) nil l; auto. remember (newVar nil (u::f::nil) nil) as x. apply Ui with (#x==u==>subTerm v (#x) f==fu) x t. apply Ug; auto. apply Ui with (#x==#S x==>subTerm v (#x) f==subTerm v (#S x) f) (S x) u; auto. apply Ug; auto. apply Ded. apply Var_Eq_SubTerm with v x (S x) f; auto. apply TFFSub_Imp; apply TFFSub_Eq; auto. apply nVT_SubTerm. intros C. apply SubTerm_or with (v:=v) (s:=f) (t:=#x) in C; auto. destruct C. inversion H2. contradict H5; auto. contradict H2. apply newVar_nVT with nil (u::f::nil) nil; subst x; auto. apply SubTerm_via with v f; auto. apply newVar_nVT with nil (u::f::nil) nil; subst x; auto.
  apply TFFSub_Imp; apply TFFSub_Eq; auto. apply nVT_SubTerm. subst x; eapply newVar_nVT; eauto. apply SubTerm_via with v f; auto. subst x; eapply newVar_nVT; eauto. apply nVT_SubTerm. intros C. apply SubTerm_or with (v:=v) (t:=u) (s:=f) in C; auto. destruct C; contradict H2; subst x; eapply newVar_nVT; eauto. Qed.
Hint Resolve Var_Eq_sym Var_Eq_trans Term_Eq_refl Term_Eq_sym Term_Eq_trans Var_Eq_SubTerm Term_Eq_SubTerm.

Theorem Term_Eq_Succ: forall t u l, Inf l (t==u) -> Inf l (Succ t==Succ u). Proof. intros. apply Term_Eq_SubTerm with t u 0 (Succ (#0)); auto; unfold Succ; apply ST_Func; auto. Qed.
Theorem Term_Eq_Succ_inv: forall t u l, Inf l (Succ t==Succ u) -> Inf l (t==u). Proof. intros. apply IMP with (Succ t==Succ u) nil l; auto. remember (newVar nil (t::nil) nil) as v. apply Ui with (Succ t==Succ (#v)==>t==(#v)) v u. apply Ug; auto. apply Ui with (Succ (#S v)==Succ (#v)==>#S v==#v) (S v) t; auto. apply TFFSub_Imp; apply TFFSub_Eq; auto; apply ST_Func; auto. apply TFFSub_Imp; apply TFFSub_Eq; auto. apply nVT_SubTerm. intros C. inversion C. apply In_one in H4. subst t0. contradict H3. subst v; eapply newVar_nVT; eauto. unfold Succ; auto. apply nVT_SubTerm. subst v; eapply newVar_nVT; eauto. Qed.
Theorem Neq_sym: forall t u l, Inf l (t!=u) -> Inf l (u!=t). Proof. intros. apply Contra with (t==u); auto. Qed.
Theorem Term_Eq_args: forall f ts us l, MapR (fun x y=>Inf l (x==y)) ts us -> Inf l (FuncT f ts==FuncT f us). Proof. intros. remember (length ts) as a. assert (Heqb:a = length us). subst a. apply MapR_length in H; auto. remember (newVar nil (ts++us) l) as v. assert (forall i t, v<=i->In t ts->~VarTerm i t). intros. apply newVar_nVT with nil (ts++us) l; subst v; auto; apply in_or_app; auto. assert (forall i t, v<=i->In t us->~VarTerm i t). intros. apply newVar_nVT with nil (ts++us) l; subst v; auto; apply in_or_app; auto. cut (forall j, j<=a -> Inf l (FuncT f (firstn j ts++map Var (seq (j+v) (a-j)))==FuncT f (firstn j us++map Var (seq (j+v) (a-j))))). intros. assert (a<=a); auto. apply H2 in H3. rewrite <- minus_n_n in H3. simpl in H3. rewrite Heqa in H3 at 1. rewrite Heqb in H3. repeat rewrite firstn_all in H3. repeat rewrite app_nil_r in H3; auto. induction j; intros. simpl. auto. assert (j<=a); auto. apply IHj in H3. clear IHj. repeat rewrite firstn_S with (d:=Zero); auto.
  replace (a-j) with (S(a-S j)) in H3. rewrite <- cons_seq in H3. simpl in H3. repeat rewrite <- app_assoc. simpl. assert (Ha:forall t, MapR (SubTerm (j + v) t) (firstn j ts) (firstn j ts)). intros. apply MapR_refl. intros. apply nVT_SubTerm. apply H0; auto. rewrite <- firstn_skipn with (n:=j); auto. assert (Hb:forall t, MapR (SubTerm (j + v) t) (firstn j us) (firstn j us)). intros. apply MapR_refl. intros. apply nVT_SubTerm. apply H1; auto. rewrite <- firstn_skipn with (n:=j); auto. assert (Hc:forall t, MapR (SubTerm (j + v) t) (map Var (seq (S (j + v)) (a - S j))) (map Var (seq (S (j + v)) (a - S j)))). intros. apply MapR_refl. intros. apply in_map_iff in H4. destruct H4 as [y [H4 H5]]. subst x. apply in_seq in H5. destruct H5. apply nVT_SubTerm. contradict H4; inversion H4; auto.
  apply Term_Eq_trans with (FuncT f ((firstn j ts++nth j us Zero::map Var (seq (S (j+v)) (a-S j))))). apply Term_Eq_SubTerm with (v:=j+v) (t:=nth j ts Zero) (u:=nth j us Zero) (f:=FuncT f ((firstn j ts++(#j+v)::map Var (seq (S (j+v)) (a-S j))))). apply MapR_nth with (i:=j) (dt:=Zero) (du:=Zero) in H; auto. rewrite <- Heqa; auto. apply ST_Func. apply MapR_app; auto. apply ST_Func. apply MapR_app; auto. eapply Ui with (v:=j+v) (t:=nth j us Zero). eapply Ug. eapply H3. intros. intros C. apply FreeVar__VarFormula in C. contradict C. apply newVar_nVF with nil (ts++us) l; auto. rewrite <- Heqv; auto. apply TFFSub_Eq; apply ST_Func; apply MapR_app; auto. rewrite minus_Sn_m; auto. rewrite <- Heqb; auto. rewrite <- Heqa; auto. Qed.
Hint Resolve Term_Eq_Succ Term_Eq_Succ_inv Neq_sym.

(* convert nat to Term *)
Fixpoint n2t (i:nat) : Term := match i with 0 => Zero |S i'=>Succ (n2t i') end.
Theorem n2t_neq: forall i j l, i<>j -> Inf l (n2t i != n2t j). Proof. induction i; intros. simpl. destruct j. contradict H; auto. simpl. apply Ui with (Zero!=Succ (#0)) 0 (n2t j). apply Inf_incl with nil; auto. apply TFFSub_Neg. apply TFFSub_Eq; auto. apply nVT_SubTerm. intros C; inversion C. destruct H4. apply ST_Func; auto. destruct j. simpl. apply Ui with (Succ (#0)!=Zero) 0 (n2t i); auto. apply TFFSub_Neg. apply TFFSub_Eq; auto. apply ST_Func; auto. apply nVT_SubTerm. intros C; inversion C. destruct H4. simpl. apply Contra with (n2t i==n2t j). apply IMp with (Succ (n2t i)==Succ (n2t j)); auto. apply Inf_incl'. apply IHi. contradict H; auto. Qed.

(* fun y x=>f(x,y) *)
Definition FSwap (f:Func) : Func := FComp f (FProj 1::FProj 0::nil).
Definition FPlus : Func := FRecu (FProj 0) (FComp FSucc (FProj 0::nil)).
Definition FPred: Func := FRecu FZero (FProj 1).
Definition FMinus: Func := FSwap (FRecu (FProj 0) (FComp FPred (FProj 0::nil))).
Definition FMult : Func := FRecu (FComp FZero nil) (FComp FPlus (FProj 0::FProj 2::nil)).
Definition FPow : Func := FSwap (FRecu (FComp FSucc (FComp FZero nil::nil)) (FComp FMult (FProj 0::FProj 2::nil))).
Definition FMax : Func := FComp FPlus (FMinus::FProj 1::nil).
Definition FMin : Func := FComp FMinus (FProj 0::FMinus::nil).
Definition FAbs : Func := FComp FPlus (FMinus::FSwap FMinus::nil).
(* Predicate functions *)
(* If input is 0, then output is 0, otherwise output is 1 *)
Definition FSign : Func := FRecu FZero (FComp FSucc (FComp FZero nil::nil)).
(* If input is 0, then outout is 1, otherwise output is 0 *)
Definition FNeg : Func := FRecu (FComp FSucc (FZero::nil)) (FComp FZero nil).
Definition FEq: Func := FComp FNeg (FAbs::nil).
Definition FNEq: Func := FComp FNeg (FEq::nil).
Definition FLe : Func := FComp FNeg (FMinus::nil).
(* Logical functions *)
Definition FLand : Func := FComp FSign (FMult::nil).
Definition FLor : Func := FComp FSign (FPlus::nil).
(* If exists x<z, f x <> 0, then output is 1, otherwise 0 *)
Definition FEx n f : Func := FRecu (FComp FZero nil) (FComp FLor (FProj 0::(FComp f (FProj 1::map FProj (seq 2 n))::nil))).

(* Remain (in case of 0 div, Remain x 0 = x) *)
Definition FRem : Func := FRecu (FComp FZero nil) (FComp FMult ((FComp FSucc (FProj 0::nil))::(FComp FNEq (FProj 2::FComp FSucc (FProj 0::nil)::nil))::nil)).

Theorem FSwap_WFF: forall f, WFFunc 2 f -> WFFunc 2 (FSwap f). Proof. intros. apply WFF_Comp; auto. apply Forall_forall. intros. destruct H0. subst x; auto. destruct H0. subst x; auto. destruct H0. Qed.
Theorem FPlus_WFF: WFFunc 2 FPlus. Proof. apply WFF_Recu; auto. apply WFF_Comp; auto. Qed.
Theorem FPred_WFF: WFFunc 1 FPred. Proof. apply WFF_Recu; auto. Qed.
Theorem FMinus_WFF: WFFunc 2 FMinus. Proof. apply FSwap_WFF. apply WFF_Recu; auto. apply WFF_Comp; auto. apply FPred_WFF. Qed.
Theorem FMult_WFF: WFFunc 2 FMult. Proof. apply WFF_Recu; auto. apply WFF_Comp; auto. apply FPlus_WFF. Qed.
Theorem FPow_WFF: WFFunc 2 FPow. Proof. apply FSwap_WFF. apply WFF_Recu; auto. apply WFF_Comp; auto. apply FMult_WFF. Qed.
Hint Resolve FSwap FPlus FPred FMinus FMult FSwap_WFF FPlus_WFF FPred_WFF FMinus_WFF FMult_WFF FPow_WFF.
Theorem FMax_WFF: WFFunc 2 FMax. Proof. apply WFF_Comp; auto. Qed.
Theorem FMin_WFF: WFFunc 2 FMin. Proof. apply WFF_Comp; auto. Qed.
Theorem FAbs_WFF: WFFunc 2 FAbs. Proof. apply WFF_Comp; auto. Qed.
Theorem FSign_WFF: WFFunc 1 FSign. Proof. apply WFF_Recu; auto. Qed.
Theorem FNeg_WFF: WFFunc 1 FNeg. Proof. apply WFF_Recu; auto. Qed.
Theorem FEq_WFF: WFFunc 2 FEq. Proof. apply WFF_Comp; auto. apply FNeg_WFF. apply Forall_cons; auto. apply FAbs_WFF. Qed.
Theorem FNEq_WFF: WFFunc 2 FNEq. Proof. apply WFF_Comp; auto. apply FNeg_WFF. apply Forall_cons; auto. apply FEq_WFF. Qed.
Theorem FLe_WFF: WFFunc 2 FLe. Proof. apply WFF_Comp. apply FNeg_WFF. apply Forall_cons; auto. Qed.
Theorem FLand_WFF: WFFunc 2 FLand. Proof. apply WFF_Comp; auto. apply FSign_WFF. Qed.
Theorem FLor_WFF: WFFunc 2 FLor. Proof. apply WFF_Comp; auto. apply FSign_WFF. Qed.
Theorem FEx_WFF: forall n f, WFFunc (S n) f -> WFFunc (S n) (FEx n f). Proof. intros. apply WFF_Recu; auto. apply WFF_Comp. apply FLor_WFF. apply Forall_cons; auto. apply Forall_cons; auto. apply WFF_Comp; simpl; auto. rewrite map_length. rewrite seq_length; auto. apply Forall_cons; auto. apply Forall_forall. intros. apply in_map_iff in H0. destruct H0 as [y [H1 H2]]. subst x. apply in_seq in H2. destruct H2. apply WFF_Proj. auto. Qed.
Theorem FRem_WFF: WFFunc 2 FRem. Proof. intros. apply WFF_Recu; auto. apply WFF_Comp; auto. apply Forall_cons; auto. apply WFF_Comp; auto. apply Forall_cons; auto. apply WFF_Comp; auto. apply FNEq_WFF. apply Forall_cons; auto. apply Forall_cons; auto. apply WFF_Comp; auto. Qed.
Hint Resolve FMax_WFF FMin_WFF FAbs_WFF FSign_WFF FNeg_WFF FEq_WFF FNEq_WFF FLe_WFF FLand_WFF FLor_WFF FEx_WFF FRem_WFF.

Theorem Zero_WFT: WFTerm Zero. Proof. intros. unfold Zero; auto. Qed.
Theorem Succ_WFT: forall t, WFTerm t->WFTerm (Succ t). Proof. intros. unfold Succ; auto. Qed.
Hint Resolve Zero_WFT Succ_WFT.

Theorem n2t_nVT: forall i v, ~VarTerm v (n2t i). Proof. induction i; simpl; intros; intros C; inversion C. destruct H3. apply In_one in H3. subst t. contradict H2; auto. Qed.
Hint Resolve n2t_nVT.

Theorem SubTerm_Zero: forall v t, SubTerm v t Zero Zero. Proof. intros. apply ST_Func; auto. Qed.
Theorem SubTerm_Succ: forall v t s u, SubTerm v t s u -> SubTerm v t (Succ s) (Succ u). Proof. intros. apply ST_Func. auto. Qed.
Hint Resolve SubTerm_Zero SubTerm_Succ.

Theorem FProj_spec: forall i t args l, i<length args -> nth i args Zero = t -> Inf l (FuncT (FProj i) args==t). Proof. intros. apply Inf_incl with nil; auto. clear l. remember (newVar nil args nil) as v. assert (forall a i, v<=i->In a args->~VarTerm i a). intros. subst v. apply newVar_nVT with nil args nil; auto. clear Heqv. cut (forall j, j<=length args->Inf nil (FuncT (FProj i) (firstn j args++map Var (seq (j+v) (length args-j))) == if (le_dec j i) then #i+v else t)). intros. replace t with (if le_dec (length args) i then #i+v else t). replace args with (firstn (length args) args++map Var (seq (length args+v) (length args-length args))) at 1. apply H2; auto. rewrite firstn_all. rewrite <- minus_n_n. simpl. rewrite app_nil_r; auto. destruct (le_dec (length args) i); auto. contradict H; auto.  induction j; intros. simpl. rewrite <- minus_n_O; auto.
  assert (j<=length args). apply lt_le_weak; auto. apply IHj in H3. clear IHj. rewrite firstn_S with (d:=Zero); auto. rewrite <- app_assoc. simpl. replace (length args - j) with (S(length args - S j)) in H3. rewrite <- cons_seq in H3. simpl in H3. apply Ui with (FuncT (FProj i) (firstn j args++(#j+v)::map Var (seq (S (j+v)) (length args-S j))) == (if le_dec j i then #i+v else t)) (j+v) (nth j args Zero). apply Ug; auto. apply TFFSub_Eq. apply ST_Func. apply MapR_app. apply MapR_refl. intros. apply nVT_SubTerm. apply H1. apply le_plus_r. rewrite <- firstn_skipn with (n:=j); auto. apply MapR_cons. apply MapR_refl. intros. apply nVT_SubTerm. apply in_map_iff in H4. destruct H4 as [y [H4 H5]]. subst x. apply in_seq in H5. intros C. inversion C. subst i0 y. destruct H5. contradict H4; auto. auto.
  destruct (le_dec (S j) i); destruct (le_dec j i). apply nVT_SubTerm. intros C. inversion C. apply plus_reg_r in H6. subst j. contradict l; auto. contradict n; auto. assert (j=i). apply le_antisym; auto. destruct (le_lt_dec i j); auto. contradiction. subst j. rewrite H0; auto. apply nVT_SubTerm. apply H1. apply le_plus_r. subst t. apply nth_In; auto. rewrite minus_Sn_m; auto. Qed.
Theorem FComp_spec: forall n f fs args ts l, WFFunc n (FComp f fs) -> length args = n -> MapR (fun f t=> Inf l (FuncT f args==t)) fs ts -> Inf l (FuncT (FComp f fs) args == FuncT f ts). Proof. intros. assert (Hf:length fs=length ts). apply MapR_length in H1; auto. cut (Inf l (Imps (map (fun p=>snd p==FuncT (fst p) args) (combine fs ts)) (FuncT (FComp f fs) args == FuncT f ts))). intros. eapply Imps_imply. eapply H2. intros g Hg. apply in_map_iff in Hg. destruct Hg as [[g' t'] [H3 H4]]. simpl in H3. subst g. apply Term_Eq_sym. apply MapR_combine with (l:=fs) (m:=ts) (x:=g') (y:=t'); auto. remember (newVar nil (ts++args) nil) as v. assert (forall i t, v<=i->In t args->~VarTerm i t). intros. subst v; apply newVar_nVT with nil (ts++args) nil; auto. assert (forall i t, v<=i->In t ts->~VarTerm i t). intros. subst v; apply newVar_nVT with nil (ts++args) nil; auto. apply Inf_incl with nil; auto. clear Heqv H1 l.
  cut (forall j, j<=n->Inf nil (Imps (map (fun p=>snd p==FuncT (fst p) (firstn j args++map Var (seq (j+v) (n-j)))) (combine fs ts)) (FuncT (FComp f fs) (firstn j args++map Var (seq (j+v) (n-j))) == FuncT f ts))). intros. replace args with (firstn n args++map Var (seq (n+v) (n-n))); auto. subst n. rewrite firstn_all. rewrite <- minus_n_n. rewrite app_nil_r; auto. induction j; intros. rewrite <- minus_n_O. simpl.
  cut (forall j, j<=length ts-> Inf nil (Imps (map (fun p=>snd p==FuncT (fst p) (map Var (seq v n))) (combine fs (firstn j ts++map Var (seq (j+n+v) (length ts-j))))) (FuncT (FComp f fs) (map Var (seq v n))==FuncT f (firstn j ts++map Var (seq (j+n+v) (length ts-j)))))). intros. replace ts with (firstn (length ts) ts++map Var (seq (length ts+n+v) (length ts-length ts))); auto. rewrite firstn_all. rewrite <- minus_n_n. rewrite app_nil_r; auto. induction j; intros. rewrite <- minus_n_O. simpl. replace (map (fun p=>snd p==FuncT (fst p) (map Var (seq v n))) (combine fs (map Var (seq (n+v) (length ts))))) with (map (fun p=>#snd p+n+v==FuncT (fst p) (map Var (seq v n))) (with_idx fs)). rewrite <- Hf. auto. rewrite <- Hf. clear -fs. unfold with_idx. cut (forall i, map (fun p=>#snd p+n+v==FuncT (fst p) (map Var (seq v n))) (with_idx' fs i)=map (fun p=>snd p==FuncT (fst p) (map Var (seq v n))) (combine fs (map Var (seq (i+(n+v)) (length fs))))). intros; apply H. induction fs; simpl; intros; auto.
  f_equal; auto. f_equal. f_equal. rewrite plus_assoc; auto. apply IHfs. assert (j<=length ts). apply lt_le_weak; auto. apply IHj in H5. clear IHj. rewrite firstn_S with (d:=Zero); auto. rewrite <- app_assoc; auto. replace (length ts-j) with (S(length ts-S j)) in H5. rewrite <- cons_seq in H5. simpl in H5. eapply Ui with (v:=j+n+v) (t:=nth j ts Zero). apply Ug. eapply H5. auto. apply TFFSub_Imps. simpl. apply MapR_map2. rewrite <- firstn_skipn with Func j fs. repeat rewrite combine_app. apply MapR_app. apply MapR_refl. intros. destruct x as [g t]. assert (In t ts). apply in_combine_r in H6. rewrite <- firstn_skipn with (n:=j); auto. simpl. apply TFFSub_Eq; auto. apply ST_Func. apply MapR_refl. intros. apply nVT_SubTerm. apply in_map_iff in H8. destruct H8 as [y [H8 H9]]. subst x. apply in_seq in H9. destruct H9. contradict H9; inversion H9. apply le_not_lt. rewrite plus_comm. rewrite <- plus_assoc; auto. rewrite skipn_S with (n0:=j) (l:=fs) (t:=FZero); auto. repeat rewrite combine_cons.
  apply MapR_cons; auto. apply MapR_refl. intros. destruct x as [g t]. apply in_combine_r in H6. simpl. apply TFFSub_Eq. apply in_map_iff in H6. destruct H6 as [y [H6 H7]]. subst t. apply in_seq in H7. destruct H7. apply nVT_SubTerm. contradict H6; inversion H6; auto. apply ST_Func. apply MapR_refl. intros. apply nVT_SubTerm. apply in_map_iff in H7. destruct H7 as [y [H7 H8]]. subst x. apply in_seq in H8. destruct H8. contradict H8. inversion H8. apply le_not_lt. rewrite plus_comm. rewrite <- plus_assoc; auto. simpl. apply TFFSub_Eq; auto. apply ST_Func. apply MapR_refl. intros. apply nVT_SubTerm. apply in_map_iff in H6. destruct H6 as [y [H6 H7]]. subst x. apply in_seq in H7. destruct H7. contradict H7. inversion H7. apply le_not_lt. rewrite plus_comm. rewrite <- plus_assoc; auto. rewrite Hf; auto. repeat rewrite firstn_length. rewrite Hf; auto. repeat rewrite firstn_length. rewrite Hf; auto.
  apply TFFSub_Eq. apply ST_Func. apply MapR_refl. intros. apply nVT_SubTerm. apply in_map_iff in H6. destruct H6 as [y [H6 H7]]. subst x. apply in_seq in H7. destruct H7. contradict H7. inversion H7. apply le_not_lt. rewrite plus_comm. rewrite <- plus_assoc; auto. apply ST_Func. apply MapR_app. apply MapR_refl. intros. apply nVT_SubTerm. apply H3; auto. rewrite <- firstn_skipn with (n:=j); auto. apply MapR_cons. apply MapR_refl. intros. apply in_map_iff in H6. destruct H6 as [y [H6 H7]]. subst x. apply in_seq in H7. destruct H7. apply nVT_SubTerm. contradict H6; inversion H6; auto. auto. rewrite minus_Sn_m; auto.
  assert (forall x, In x (firstn j args)->In x args). intros. rewrite <- firstn_skipn with (n:=j); auto. rewrite firstn_S with (d:=Zero). rewrite <- app_assoc. simpl. assert (j<=n). apply lt_le_weak; auto. apply IHj in H5. clear IHj. replace (n-j) with (S(n-S j)) in H5. rewrite <- cons_seq in H5. simpl in H5. eapply Ui with (v:=j+v) (t:=nth j args Zero). apply Ug. eapply H5. auto. apply TFFSub_Imps. apply MapR_map. intros. destruct x as [g t]. simpl. assert (In g fs). apply in_combine_l in H6; auto. assert (In t ts). apply in_combine_r in H6; auto. apply TFFSub_Eq; auto. apply ST_Func. apply MapR_app. apply MapR_refl. intros; auto. apply MapR_cons; auto. apply MapR_refl. intros. apply nVT_SubTerm. apply in_map_iff in H9. destruct H9 as [y [H9 H10]]. subst x. apply in_seq in H10. destruct H10. contradict H9; inversion H9; auto. apply TFFSub_Eq. apply ST_Func. apply MapR_app; auto. apply MapR_cons; auto.
  apply MapR_refl. intros. apply nVT_SubTerm. apply in_map_iff in H6. destruct H6 as [y [H6 H7]]. subst x. apply in_seq in H7. destruct H7. contradict H6; inversion H6; auto. apply nVT_SubTerm. intros C. inversion C. contradict H9. auto. rewrite minus_Sn_m; auto. subst n; auto. Qed.
Theorem FRecu_Zero_spec: forall f g args l, WFFunc (S (length args)) (FRecu f g) -> Inf l (FuncT (FRecu f g) (Zero::args) == FuncT f args). Proof. intros. revert H. intros Hf. remember (newVar nil args nil) as v. assert (forall i a, v<=i->In a args->~VarTerm i a). intros. subst v. apply newVar_nVT with nil args nil; auto. clear Heqv. apply Inf_incl with nil; auto. cut (forall j, j<=length args->Inf nil (FuncT (FRecu f g) (Zero::firstn j args++map Var (seq (j+v) (length args-j)))==FuncT f (firstn j args++map Var (seq (j+v) (length args-j))))). intros. replace args with (firstn (length args) args++map Var (seq (length args+v) (length args-length args))). apply H0; auto. rewrite firstn_all. rewrite <- minus_n_n. rewrite app_nil_r. auto. induction j. intros. simpl. rewrite <- minus_n_O; auto.
  intros. rewrite firstn_S with (d:=Zero); auto. rewrite <- app_assoc. simpl. assert (j<=length args). apply lt_le_weak; auto. apply IHj in H1. clear IHj. replace (length args -j) with (S(length args - S j)) in H1. rewrite <- cons_seq in H1. simpl in H1. eapply Ui with (v:=j+v) (t:=nth j args Zero). apply Ug. eapply H1. auto. apply TFFSub_Eq; apply ST_Func. apply MapR_cons. apply MapR_app. apply MapR_refl. intros. apply nVT_SubTerm. apply H. apply le_plus_r. rewrite <- firstn_skipn with (n:=j); auto. apply MapR_cons; auto. apply MapR_refl. intros. apply nVT_SubTerm. apply in_map_iff in H2. destruct H2 as [y [H3 H4]]. subst x. apply in_seq in H4. destruct H4. contradict H2. inversion H2. subst i y. auto. apply nVT_SubTerm. intros C. inversion C. destruct H6. apply MapR_app. apply MapR_refl. intros. apply nVT_SubTerm. apply H. apply le_plus_r. rewrite <- firstn_skipn with (n:=j); auto.
  apply MapR_cons. apply MapR_refl. intros. apply in_map_iff in H2. destruct H2 as [y [H3 H4]]. subst x. apply in_seq in H4. destruct H4. apply nVT_SubTerm. contradict H2. inversion H2. subst i y; auto. auto. rewrite minus_Sn_m; auto. Qed.
Theorem FRecu_Succ_spec: forall f g args ti ty l, WFFunc (S (length args)) (FRecu f g) -> Inf l (FuncT (FRecu f g) (ti::args) == ty) -> Inf l (FuncT (FRecu f g) (Succ ti::args) == FuncT g (ty::ti::args)). Proof. intros. remember (newVar nil (ti::ty::args) nil) as v. assert (forall i a, v<=i->In a args->~VarTerm i a). intros. eapply newVar_nVT. subst v; eauto. right; right; auto. assert (forall i, v<=i->~VarTerm i ti). intros. subst v. eapply newVar_nVT; eauto. assert (forall i, v<=i->~VarTerm i ty). intros. subst v. eapply newVar_nVT; eauto. apply IMP with (FuncT (FRecu f g) (ti::args)==ty) nil l; auto. clear H0 Heqv l. remember (length args) as n. apply Ui with (FuncT (FRecu f g) ((#n+v)::args) == ty ==> FuncT (FRecu f g) (Succ (#n+v)::args) == FuncT g (ty::(#n+v)::args)) (n+v) ti. apply Ug; auto. apply Ui with (FuncT (FRecu f g) ((#n+v)::args) == (#S(n+v)) ==> FuncT (FRecu f g) (Succ (#n+v)::args) == FuncT g ((#S(n+v))::(#n+v)::args)) (S(n+v)) ty. apply Ug; auto.
  cut (forall j, j<=n->Inf nil (FuncT (FRecu f g) ((#n+v)::firstn j args++map Var (seq (j+v) (n-j))) == #S(n+v)==>FuncT (FRecu f g) (Succ (#n+v)::firstn j args++map Var (seq (j+v) (n-j)))==FuncT g ((#S(n+v))::(#n+v)::firstn j args++map Var (seq (j+v) (n-j))))). intros. replace args with (firstn n args++map Var (seq (n+v) (n-n))); auto. subst n. rewrite firstn_all. rewrite <- minus_n_n. rewrite app_nil_r; auto. induction j; intros. rewrite <- minus_n_O; simpl; auto. rewrite firstn_S with (d:=Zero); auto. rewrite <- app_assoc. simpl. assert (j<=n). apply lt_le_weak; auto. apply IHj in H4. replace (n-j) with (S(n-S j)) in H4. rewrite <- cons_seq in H4. simpl in H4. eapply Ui with (v:=j+v) (t:=nth j args Zero). apply Ug. eapply H4. auto.
  assert (forall x, In x (firstn j args)->In x args). intros. rewrite <- firstn_skipn with (n:=j). apply in_or_app; auto. apply TFFSub_Imp; apply TFFSub_Eq; try apply ST_Func; auto. apply MapR_cons. apply MapR_app. apply MapR_refl. intros. apply nVT_SubTerm. apply H1; auto. apply MapR_cons; auto. apply MapR_refl. intros. apply nVT_SubTerm. apply in_map_iff in H6. destruct H6 as [y [H6 H7]]. subst x. apply in_seq in H7. destruct H7. contradict H6. inversion H6. auto. apply nVT_SubTerm. intros C. inversion C. apply plus_reg_r in H8. subst j. contradict H0; auto. apply nVT_SubTerm. intros C; inversion C. absurd (j+v<n+v). apply le_not_lt. rewrite H8; auto. apply plus_lt_compat_r; auto. apply MapR_cons. apply MapR_app. apply MapR_refl. intros. auto. apply MapR_cons; auto. apply MapR_refl. intros. apply nVT_SubTerm. apply in_map_iff in H6. destruct H6 as [y [H6 H7]]. subst x. apply in_seq in H7. destruct H7. contradict H6. inversion H6. auto. apply SubTerm_Succ.
  apply nVT_SubTerm. intros C. inversion C. apply plus_reg_r in H8. subst j; contradict H0; auto. apply MapR_cons. apply MapR_cons. apply MapR_app. apply MapR_refl. intros. auto. apply MapR_cons; auto. apply MapR_refl. intros. apply in_map_iff in H6. destruct H6 as [y [H6 H7]]. subst x. apply in_seq in H7. destruct H7. apply nVT_SubTerm. contradict H6; inversion H6; auto. apply nVT_SubTerm. intros C. inversion C. apply plus_reg_r in H8. subst j; contradict H0; auto. apply nVT_SubTerm. intros C; inversion C. absurd (j+v<n+v). apply le_not_lt. rewrite H8; auto. apply plus_lt_compat_r; auto. rewrite minus_Sn_m; auto. subst n; auto.
  apply TFFSub_Imp; apply TFFSub_Eq; auto; apply ST_Func. apply MapR_refl. intros. apply nVT_SubTerm. destruct H0; auto. subst x. intros C; inversion C; contradict H5; auto. apply MapR_refl. intros. apply nVT_SubTerm. destruct H0; auto. subst x. intros C; inversion C. apply In_one in H7; subst t. inversion H6. contradict H9; auto. apply MapR_cons; auto. apply MapR_refl. intros. apply nVT_SubTerm. destruct H0; auto. subst x. intros C; inversion C. contradict H5; auto. apply TFFSub_Imp; apply TFFSub_Eq; auto; apply ST_Func; try repeat apply MapR_cons; auto; apply MapR_refl; intros; apply nVT_SubTerm; apply H1; auto. Qed.
Hint Resolve FProj_spec FComp_spec FRecu_Zero_spec FRecu_Succ_spec.

(* Expression theorem *)
Definition Func_function: forall F a, WFFunc a F -> {f: forall (l:list nat), length l=a -> nat|forall p l (H:length l=a), Inf p (FuncT F (map n2t l)==n2t (f l H))}. intros F. apply (Fix (well_founded_ltof Func funcDepth)) with (P:=fun F=>forall a, WFFunc a F-> {f|forall p l (H:length l=a), Inf p (FuncT F (map n2t l)==n2t (f l H))}). clear F. intros F IH a H. destruct F. exists (fun _ _=>0). intros. inversion H. subst a. destruct l. auto. inversion H1.
  exists (fun l _=> match l with |nil=>0 |a::l' => (S a) end). intros. inversion H. subst a. destruct l. inversion H1. inversion H1. destruct l. simpl. auto. inversion H2.
  exists (fun l _=> nth n l 0). intros. apply FProj_spec. rewrite map_length. rewrite H0. inversion H; auto. replace Zero with (n2t 0); auto. apply map_nth.
  destruct (IH F) with (a:=length l) as [fc Hc]. unfold ltof. simpl. auto. inversion H; auto. destruct (MapR_build (T:=Func) (U:=forall l:list nat, length l=a->nat)) with (l:=l) (R:=fun (G:Func) f=>forall p (l:list nat) (H:length l=a), Inf p (FuncT G (map n2t l)==n2t (f l H))) as [fs Hf]. intros. apply IH. unfold ltof. simpl. apply le_n_S. apply le_trans with (maxl (map funcDepth l)); auto. apply maxl_le. apply in_map_iff; exists x; auto. inversion H. apply Forall_forall with (x:=x) in H5; auto. assert (forall f, length (A:=nat) (map f fs)=length l). intros. rewrite map_length. apply MapR_length in Hf. auto. exists (fun a Ha => fc (map (fun f=>f a Ha) fs) (H0 (fun f=>f a Ha))). intros. apply Term_Eq_trans with (FuncT F (map n2t (map (fun f=>f l0 H1) fs))); auto. apply FComp_spec with a; auto. rewrite map_length; auto. rewrite map_map. replace l with (map id l); auto. apply MapR_map2. eapply MapR_trans; [|eapply Hf]. intros. apply H4. rewrite map_id; auto.
  destruct a. exfalso. inversion H. destruct (IH F1) with (a:=a) as [f1 Hf1]. unfold ltof. simpl; auto. inversion H; auto. destruct (IH F2) with (a:=S (S a)) as [f2 Hf2]. unfold ltof; simpl; auto. inversion H; auto. assert (decons:forall n (l:list nat), length l=S n->{e:nat & {m|l=e::m & length m=n}}). intros. destruct l. inversion H0. exists n0. exists l; auto. assert (Hi:forall (x y:nat) n l, length l=n->length (x::y::l) = (S (S n))). intros; simpl; auto. exists (fun args (Ha:length args=S a) => match decons a args Ha with existT _ i (exist2 _ _ arg _ Hb) => (fix rec (n:nat) : nat := match n with |O=>f1 arg Hb |S i'=> f2 (rec i'::i'::arg) (Hi (rec i') i' a arg Hb) end) i end). intros. destruct (decons a l H0) as [i [m H1 H2]]. subst l. clear H0. induction i. simpl. apply Term_Eq_trans with (FuncT F1 (map n2t m)). apply FRecu_Zero_spec; auto. rewrite map_length. rewrite H2; auto. apply Hf1.
  simpl. remember ((fix rec n:=match n with |0=>f1 m H2|S i'=>f2 (rec i'::i'::m) (Hi (rec i') i' a m H2) end) i) as y. apply Term_Eq_trans with (FuncT F2 (n2t y::n2t i::map n2t m)). apply FRecu_Succ_spec; auto. rewrite map_length. rewrite H2; auto. replace (n2t y::n2t i::map n2t m) with (map n2t (y::i::m)); auto. Defined.
Theorem Expression_theorem: forall F a args l, WFFunc a F -> length args=a -> Forall (fun arg=>exists n, Inf l (arg == n2t n)) args -> exists n, Inf l (FuncT F args == n2t n). Proof. intros. destruct (Func_function H) as [f Hf]. assert (exists nl, MapR (fun x y=>Inf l (y==n2t x)) nl args). clear H0. induction args. exists nil. auto. inversion H1. apply IHargs in H4. destruct H4 as [nl H5]. destruct H3 as [b H6]. exists (b::nl). auto. clear H1. destruct H2 as [nl H2]. assert (length nl=a). subst a. apply MapR_length in H2; auto. exists (f nl H1).  apply Term_Eq_trans with (FuncT F (map n2t nl)); auto. apply Term_Eq_sym. apply Term_Eq_args. replace args with (map id args). apply MapR_map2. eapply MapR_trans; [|eapply H2]. intros. simpl in H5. apply Term_Eq_sym; auto. apply map_id. Qed.

Theorem FSwap_spec: forall t u l f, WFFunc 2 f -> Inf l (FuncT (FSwap f) (t::u::nil) == FuncT f (u::t::nil)). Proof. intros. unfold FSwap. apply FComp_spec with (n:=2); auto. apply WFF_Comp; auto. apply Forall_cons; auto. apply MapR_cons. apply MapR_cons; auto. apply FProj_spec; auto. Qed.
Theorem FPlus_spec: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> Inf l (FuncT FPlus (t::u::nil) == n2t (i+j)). Proof. intros. remember (newVar nil (u::t::nil) nil) as v. assert (~VarTerm v u). subst v; eapply newVar_nVT; eauto. apply Term_Eq_trans with (FuncT FPlus (n2t i::u::nil)). apply Term_Eq_SubTerm with t (n2t i) v (FuncT FPlus ((#v)::u::nil)); auto. apply Term_Eq_trans with (FuncT FPlus (n2t i::n2t j::nil)). apply Term_Eq_SubTerm with u (n2t j) 0 (FuncT FPlus (n2t i::(#0)::nil)); auto. apply Inf_incl with nil; auto. clear l H H0 Heqv. induction i. simpl. apply Term_Eq_trans with (FuncT (FProj 0) (n2t j::nil)). apply FRecu_Zero_spec; auto. apply FProj_spec; auto.
  simpl. apply Term_Eq_trans with (FuncT (FComp FSucc (FProj 0::nil)) (n2t(i+j)::n2t i::n2t j::nil)). apply FRecu_Succ_spec; auto. apply FComp_spec with (n:=3); auto. apply WFF_Comp; auto. apply MapR_cons; auto. apply FProj_spec; simpl; auto. Qed.
Theorem FMult_spec: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> Inf l (FuncT FMult (t::u::nil) == n2t (i*j)). Proof. intros. remember (newVar nil (u::t::nil) nil) as v. assert (~VarTerm v u). subst v; eapply newVar_nVT; eauto. apply Term_Eq_trans with (FuncT FMult (n2t i::u::nil)). apply Term_Eq_SubTerm with t (n2t i) v (FuncT FMult ((#v)::u::nil)); auto. apply Term_Eq_trans with (FuncT FMult (n2t i::n2t j::nil)). apply Term_Eq_SubTerm with u (n2t j) 0 (FuncT FMult (n2t i::(#0)::nil)); auto. apply Inf_incl with nil; auto. clear l H H0 Heqv. induction i. simpl. apply Term_Eq_trans with (FuncT (FComp FZero nil) (n2t j::nil)). apply FRecu_Zero_spec; auto. apply FComp_spec with 1; auto.
  simpl. apply Term_Eq_trans with (FuncT (FComp FPlus (FProj 0::FProj 2::nil)) (n2t(i*j)::n2t i::n2t j::nil)). apply FRecu_Succ_spec; auto. apply Term_Eq_trans with (FuncT FPlus (n2t (i*j)::n2t j::nil)). apply FComp_spec with (n:=3); auto. apply WFF_Comp; auto. apply MapR_cons; auto. apply FProj_spec; simpl; auto. rewrite plus_comm. apply FPlus_spec; auto. Qed.
Theorem FPow_spec: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> Inf l (FuncT FPow (t::u::nil) == n2t (pow i j)). Proof. intros. remember (newVar nil (u::nil) nil) as v. assert (Hu:~VarTerm v u). subst v; eapply newVar_nVT; eauto. apply Term_Eq_trans with (FuncT FPow (n2t i::u::nil)). apply Term_Eq_SubTerm with t (n2t i) v (FuncT FPow ((#v)::u::nil)); auto. apply Term_Eq_trans with (FuncT FPow (n2t i::n2t j::nil)). apply Term_Eq_SubTerm with u (n2t j) 0 (FuncT FPow (n2t i::(#0)::nil)); auto. apply Inf_incl with nil; auto. unfold FPow. eapply Term_Eq_trans. eapply FSwap_spec. apply WFF_Recu; auto. apply WFF_Comp; auto. clear l H H0 Heqv v Hu.
  induction j; simpl. apply Term_Eq_trans with (FuncT (FComp FSucc (FComp FZero nil::nil)) (n2t i::nil)). apply FRecu_Zero_spec. apply WFF_Recu; auto. apply WFF_Comp; auto. apply FComp_spec with 1; auto. apply MapR_cons; auto. apply FComp_spec with 1; auto. apply Term_Eq_trans with (FuncT (FComp FMult (FProj 0::FProj 2::nil)) (n2t (pow i j)::n2t j::n2t i::nil)). apply FRecu_Succ_spec; auto. apply WFF_Recu; auto. apply WFF_Comp; auto. apply Term_Eq_trans with (FuncT FMult (n2t (pow i j)::n2t i::nil)). apply FComp_spec with 3; simpl; auto. apply WFF_Comp; auto. apply MapR_cons; auto. apply FProj_spec; simpl; auto. rewrite mult_comm. apply FMult_spec; auto. Qed.
Theorem FPred_spec: forall i t l, Inf l (t==n2t i) -> Inf l (FuncT FPred (t::nil) == n2t(pred i)). Proof. intros. apply Term_Eq_trans with (FuncT FPred (n2t i::nil)). apply Term_Eq_SubTerm with t (n2t i) 0 (FuncT FPred ((#0)::nil)); auto. clear H. apply Inf_incl with nil; auto. induction i. simpl. apply Term_Eq_trans with (FuncT FZero nil); auto. apply FRecu_Zero_spec; auto. simpl. apply Term_Eq_trans with (FuncT (FProj 1) ((FuncT FPred (n2t i::nil))::n2t i::nil)). apply FRecu_Succ_spec; auto. apply FProj_spec; auto. Qed.
Theorem FMinus_spec: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> Inf l (FuncT FMinus (t::u::nil) == n2t (i-j)). Proof. intros. remember (newVar nil (u::nil) nil) as v. assert (Hu:~VarTerm v u). subst v; eapply newVar_nVT; eauto. apply Term_Eq_trans with (FuncT FMinus (n2t i::u::nil)). apply Term_Eq_SubTerm with t (n2t i) v (FuncT FMinus ((#v)::u::nil)); auto. apply Term_Eq_trans with (FuncT FMinus (n2t i::n2t j::nil)). apply Term_Eq_SubTerm with u (n2t j) 0 (FuncT FMinus (n2t i::(#0)::nil)); auto. apply Inf_incl with nil; auto. unfold FMinus. apply Term_Eq_trans with (FuncT (FRecu (FProj 0) (FComp FPred (FProj 0::nil))) (n2t j::n2t i::nil)). apply FSwap_spec. apply WFF_Recu; auto. apply WFF_Comp; auto. clear l H H0 Heqv v Hu.
  induction j. simpl. rewrite <- minus_n_O. apply Term_Eq_trans with (FuncT (FProj 0) (n2t i::nil)); auto. apply FRecu_Zero_spec. simpl. apply WFF_Recu; auto. apply WFF_Comp; auto. apply Term_Eq_trans with (FuncT (FComp FPred (FProj 0::nil)) (n2t (i-j)::n2t j::n2t i::nil)). apply FRecu_Succ_spec; auto. apply WFF_Recu; auto. apply WFF_Comp; auto. apply Term_Eq_trans with (FuncT FPred (n2t (i-j)::nil)). apply FComp_spec with (n:=3); auto. apply WFF_Comp; auto. apply MapR_cons; auto. apply FProj_spec; auto. simpl; auto. replace (i-S j) with (pred (i-j)). apply FPred_spec; auto. clear IHj. revert j. induction i; intros. auto. simpl. destruct j. simpl. rewrite <- minus_n_O; auto. auto. Qed.
Theorem FMax_spec: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> Inf l (FuncT FMax (t::u::nil) == n2t (max i j)). Proof. intros. unfold FMax. apply Term_Eq_trans with (FuncT FPlus (n2t (i-j)::n2t j::nil)). apply FComp_spec with 2; auto. apply MapR_cons. apply MapR_cons; auto. apply Term_Eq_trans with u; auto. apply FMinus_spec; auto. replace (max i j) with (i-j+j). apply FPlus_spec; auto. destruct (le_lt_dec i j). rewrite max_r; auto. apply Nat.sub_0_le in l0. rewrite l0; auto. rewrite max_l; auto. rewrite plus_comm. symmetry. apply le_plus_minus; auto. Qed.
Theorem FMin_spec: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> Inf l (FuncT FMin (t::u::nil) == n2t (min i j)). Proof. intros. unfold FMin. apply Term_Eq_trans with (FuncT FMinus (n2t i::n2t (i-j)::nil)). apply FComp_spec with 2; auto. apply MapR_cons. apply MapR_cons; auto. apply FMinus_spec; auto. apply Term_Eq_trans with t; auto. replace (min i j) with (i-(i-j)). apply FMinus_spec; auto. destruct (le_lt_dec i j). rewrite min_l; auto. apply Nat.sub_0_le in l0. rewrite l0. rewrite <- minus_n_O; auto. rewrite min_r; auto. replace (i-(i-j)) with (j+(i-j)-(i-j)). apply Nat.add_sub. f_equal. rewrite <- le_plus_minus; auto. Qed.
Theorem FAbs_spec: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> Inf l (FuncT FAbs (t::u::nil) == n2t (if le_lt_dec i j then j-i else i-j)). Proof. intros. unfold FAbs. replace (if le_lt_dec i j then j-i else i-j) with ((i-j)+(j-i)). apply Term_Eq_trans with (FuncT FPlus (n2t (i-j)::n2t (j-i)::nil)). apply FComp_spec with 2; auto. apply MapR_cons. apply MapR_cons; auto. apply Term_Eq_trans with (FuncT FMinus (u::t::nil)). apply FSwap_spec; auto. apply FMinus_spec; auto. apply FMinus_spec; auto. apply FPlus_spec; auto. destruct (le_lt_dec i j). apply Nat.sub_0_le in l0. rewrite l0. auto. replace (j-i) with 0. rewrite plus_comm; auto. apply lt_le_weak in l0. apply Nat.sub_0_le in l0. auto. Qed.
Theorem FSign_spec: forall i t l, Inf l (t==n2t i) -> Inf l (FuncT FSign (t::nil) == n2t(if nat_eq_dec i 0 then 0 else 1)). Proof. intros. apply Term_Eq_trans with (FuncT FSign (n2t i::nil)). apply Term_Eq_SubTerm with t (n2t i) 0 (FuncT FSign ((#0)::nil)); auto. induction i; simpl. apply FRecu_Zero_spec; auto. apply Term_Eq_trans with (FuncT (FComp FSucc (FComp FZero nil::nil)) (FuncT FSign (n2t i::nil)::n2t i::nil)). apply FRecu_Succ_spec; auto. apply FComp_spec with (n:=2); simpl; auto. apply MapR_cons; auto. apply FComp_spec with 2; auto. Qed.
Theorem FSign_spec1: forall i t l, Inf l (t==n2t i) -> i<> 0 -> Inf l (FuncT FSign (t::nil) == n2t 1). Proof. intros. replace 1 with (if nat_eq_dec i 0 then 0 else 1). apply FSign_spec; auto. destruct (nat_eq_dec i 0); auto; contradiction. Qed.
Theorem FSign_spec2: forall t l, Inf l (t==n2t 0) -> Inf l (FuncT FSign (t::nil) == n2t 0). Proof. intros. replace 0 with (if nat_eq_dec 0 0 then 0 else 1). apply FSign_spec; auto. auto. Qed.
Theorem FNeg_spec: forall i t l, Inf l (t==n2t i) -> Inf l (FuncT FNeg (t::nil) == n2t(if nat_eq_dec i 0 then 1 else 0)). Proof. intros. apply Term_Eq_trans with (FuncT FNeg (n2t i::nil)). apply Term_Eq_SubTerm with t (n2t i) 0 (FuncT FNeg ((#0)::nil)); auto. apply Inf_incl with nil; auto. clear H l. induction i; simpl. apply Term_Eq_trans with (FuncT (FComp FSucc (FZero::nil)) nil). apply FRecu_Zero_spec; auto. apply FComp_spec with 0; auto. apply Term_Eq_trans with (FuncT (FComp FZero nil) (FuncT FNeg (n2t i::nil)::n2t i::nil)). apply FRecu_Succ_spec; auto. apply FComp_spec with (n:=2); simpl; auto. Qed.
Theorem FNeg_spec1: forall t l, Inf l (t==n2t 0) -> Inf l (FuncT FNeg (t::nil) == n2t 1). Proof. intros. replace 1 with (if nat_eq_dec 0 0 then 1 else 0); auto. apply FNeg_spec; auto. Qed.
Theorem FNeg_spec2: forall i t l, Inf l (t==n2t i) -> i<>0 -> Inf l (FuncT FNeg (t::nil) == n2t 0). Proof. intros. replace 0 with (if nat_eq_dec i 0 then 1 else 0); auto. apply FNeg_spec; auto. destruct (nat_eq_dec i 0); auto; contradiction. Qed.
Theorem FEq_spec: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> Inf l (FuncT FEq (t::u::nil) == n2t (if nat_eq_dec i j then 1 else 0)). Proof. intros. unfold FEq. apply Term_Eq_trans with (FuncT FNeg (n2t (if le_lt_dec i j then j-i else i-j)::nil)). apply FComp_spec with 2; auto. apply MapR_cons; auto. apply FAbs_spec; auto. destruct (le_lt_dec i j). replace (if nat_eq_dec i j then 1 else 0) with (if nat_eq_dec (j-i) 0 then 1 else 0). apply FNeg_spec; auto. destruct (nat_eq_dec (j-i) 0); destruct (nat_eq_dec i j); auto. contradict n. apply le_antisym; auto. apply Nat.sub_0_le; auto. contradict n. subst j. rewrite <- minus_n_n; auto. replace (if nat_eq_dec i j then 1 else 0) with (if nat_eq_dec (i-j) 0 then 1 else 0). apply FNeg_spec; auto. destruct (nat_eq_dec (i-j) 0); destruct (nat_eq_dec i j); auto. contradict l0. apply le_not_lt. apply Nat.sub_0_le; auto. contradict l0; subst j; auto. Qed.
Theorem FEq_spec1: forall i t u l, Inf l (t==n2t i) -> Inf l (u==n2t i) -> Inf l (FuncT FEq (t::u::nil) == n2t 1). Proof. intros. replace 1 with (if nat_eq_dec i i then 1 else 0). apply FEq_spec; auto. destruct (nat_eq_dec i i); auto. contradict n; auto. Qed.
Theorem FEq_spec2: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> i<>j -> Inf l (FuncT FEq (t::u::nil) == n2t 0). Proof. intros. replace 0 with (if nat_eq_dec i j then 1 else 0). apply FEq_spec; auto. destruct (nat_eq_dec i j); auto; contradiction. Qed.
Theorem FNEq_spec1: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> i<>j -> Inf l (FuncT FNEq (t::u::nil) == n2t 1). Proof. intros. unfold FNEq. apply Term_Eq_trans with (FuncT FNeg (n2t 0::nil)). apply FComp_spec with 2; auto. apply MapR_cons; auto. apply FEq_spec2 with i j; auto. apply FNeg_spec1; auto. Qed.
Theorem FNEq_spec2: forall i t u l, Inf l (t==n2t i) -> Inf l (u==n2t i) -> Inf l (FuncT FNEq (t::u::nil) == n2t 0). Proof. intros. unfold FNEq. apply Term_Eq_trans with (FuncT FNeg (n2t 1::nil)). apply FComp_spec with 2; auto. apply MapR_cons; auto. apply FEq_spec1 with i; auto. apply FNeg_spec2 with 1; auto. Qed.
Hint Resolve FPlus_spec FMult_spec FPow_spec FPred_spec FSwap_spec FMinus_spec FMax_spec FMin_spec FAbs_spec FSign_spec FSign_spec1 FSign_spec2 FNeg_spec FNeg_spec1 FNeg_spec2 FEq_spec FEq_spec1 FEq_spec2 FNEq_spec1 FNEq_spec2.

Theorem FLe_spec1: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> i<= j -> Inf l (FuncT FLe (t::u::nil) == n2t 1). Proof. intros. unfold FLe. apply Term_Eq_trans with (FuncT FNeg (n2t (i-j)::nil)). apply FComp_spec with 2; auto. apply FNeg_spec1. replace (i-j) with 0; auto. apply Nat.sub_0_le in H1; auto. Qed.
Theorem FLe_spec2: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> j < i -> Inf l (FuncT FLe (t::u::nil) == n2t 0). Proof. intros. unfold FLe. apply Term_Eq_trans with (FuncT FNeg (n2t (i-j)::nil)). apply FComp_spec with 2; auto. apply FNeg_spec2 with (i-j); auto. contradict H1. apply Nat.sub_0_le in H1; auto. Qed.
Theorem FLand_spec1: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> i<>0 -> j<>0 -> Inf l (FuncT FLand (t::u::nil) == n2t 1). Proof. intros. unfold FLand. apply Term_Eq_trans with (FuncT FSign (n2t (i*j)::nil)). apply FComp_spec with 2; auto. apply FSign_spec1 with (i*j); auto. intros C. apply mult_is_O in C. destruct C; contradiction. Qed.
Theorem FLand_spec2: forall j t u l, Inf l (t==n2t 0) -> Inf l (u==n2t j) -> Inf l (FuncT FLand (t::u::nil) == n2t 0). Proof. intros. unfold FLand. apply Term_Eq_trans with (FuncT FSign (n2t (0*j)::nil)). apply FComp_spec with 2; auto. apply FSign_spec2; auto. Qed.
Theorem FLand_spec3: forall i t u l, Inf l (t==n2t i) -> Inf l (u==n2t 0) -> Inf l (FuncT FLand (t::u::nil) == n2t 0). Proof. intros. unfold FLand. apply Term_Eq_trans with (FuncT FSign (n2t (i*0)::nil)). apply FComp_spec with 2; auto. rewrite mult_0_r. apply FSign_spec2; auto. Qed.
Theorem FLor_spec1: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> i<>0 -> Inf l (FuncT FLor (t::u::nil) == n2t 1). Proof. intros. unfold FLor. apply Term_Eq_trans with (FuncT FSign (n2t (i+j)::nil)). apply FComp_spec with 2; auto. apply FSign_spec1 with (i+j); auto. contradict H1. destruct i; auto. inversion H1. Qed.
Theorem FLor_spec2: forall i j t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> j<>0 -> Inf l (FuncT FLor (t::u::nil) == n2t 1). Proof. intros. unfold FLor. apply Term_Eq_trans with (FuncT FSign (n2t (i+j)::nil)). apply FComp_spec with 2; auto. apply FSign_spec1 with (i+j); auto. contradict H1. destruct j; auto. rewrite <- plus_n_Sm in H1. inversion H1. Qed.
Theorem FLor_spec3: forall t u l, Inf l (t==n2t 0) -> Inf l (u==n2t 0) -> Inf l (FuncT FLor (t::u::nil) == n2t 0). Proof. intros. unfold FLor. apply Term_Eq_trans with (FuncT FSign (n2t (0+0)::nil)). apply FComp_spec with 2; auto. apply FSign_spec2; auto. Qed.
Hint Resolve FLe_spec1 FLe_spec2 FLand_spec1 FLand_spec2 FLand_spec3 FLor_spec1 FLor_spec2 FLor_spec3.

Theorem FEx_spec1: forall a nl args f l, WFFunc (S a) f -> length nl=a -> MapR (fun k a=>Inf l (a==n2t k)) nl args -> forall i t j, Inf l (t==n2t i) -> j<>0 -> Inf l (FuncT f (t::args) == n2t j) -> forall n u, i<n -> Inf l (u==n2t n) -> Inf l (FuncT (FEx a f) (u::args) == n2t 1). Proof. intros. assert (Hl:length args=a). apply MapR_length in H1; subst a; auto. remember (newVar nil (t::u::args) nil) as v. apply Term_Eq_trans with (FuncT (FEx a f) (n2t n::args)). apply Term_Eq_SubTerm with u (n2t n) v (FuncT (FEx a f) ((#v)::args)); auto; apply ST_Func; apply MapR_cons; auto; apply MapR_refl; intros; apply nVT_SubTerm; eapply newVar_nVT; subst v; eauto. unfold FEx. clear H6. assert (Hw:WFFunc (S (S a)) (FComp f (FProj 1 :: map FProj (seq 2 a)))). apply WFF_Comp; auto. simpl. rewrite map_length. rewrite seq_length; auto. apply Forall_cons. auto. apply Forall_forall. intros. apply in_map_iff in H6. destruct H6 as [y [H6 H7]]. subst x. apply in_seq in H7. destruct H7. apply WFF_Proj; auto.
  induction n. inversion H5. apply le_S_n in H5. apply le_lt_or_eq in H5. destruct H5. simpl. apply Term_Eq_trans with (FuncT (FComp FLor (FProj 0::FComp f (FProj 1::map FProj (seq 2 a))::nil)) (n2t 1::n2t n::args)). apply FRecu_Succ_spec; auto. apply WFF_Recu; auto. rewrite Hl; auto. apply WFF_Comp; auto. apply Term_Eq_trans with (FuncT FLor (n2t 1::FuncT f (n2t n::args)::nil)). apply FComp_spec with (S(S a)); auto. apply WFF_Comp; auto. simpl; auto. apply MapR_cons; auto. apply MapR_cons; auto. apply FComp_spec with (S(S a)); simpl; auto. apply MapR_cons. apply combine_MapR. rewrite map_length; rewrite seq_length; auto. apply Forall_forall. intros. destruct x as [g arg]. apply In_nth with (d:=(FProj 0, Zero)) in H6. destruct H6 as [idx [H6 H7]]. rewrite combine_length in H6. rewrite min_r in H6. rewrite combine_nth in H7. inversion  H7. subst g arg. simpl. clear H7. rewrite map_nth. rewrite seq_nth. simpl. apply FProj_spec.  simpl; auto. simpl; auto. rewrite <- Hl; auto. rewrite map_length; rewrite seq_length; auto. rewrite map_length; rewrite seq_length; rewrite Hl; auto.
  apply FProj_spec; simpl; auto. apply FProj_spec; simpl; auto. assert (exists k, Inf l (FuncT f (n2t n::args)==n2t k)). apply Expression_theorem with (S a); auto. simpl; auto. apply Forall_cons. exists n; auto. apply Forall_forall. intros arg Ha. apply In_nth with (d:=Zero) in Ha. destruct Ha as [idx [Ha Hb]]. subst arg. exists (nth idx nl 0). apply MapR_nth with (i:=idx) (dt:=0) (du:=Zero) in H1; auto. subst a. rewrite <- Hl; auto. destruct H6 as [k H6]. apply FLor_spec1 with 1 k; auto.
  (* i=n *) subst i. clear IHn. assert (exists k, Inf l (FuncT (FRecu (FComp FZero nil) (FComp FLor (FProj 0::FComp f (FProj 1::map FProj (seq 2 a))::nil))) (n2t n::args) == n2t k)). apply Expression_theorem with (S a); auto. apply WFF_Recu; auto. apply WFF_Comp; auto. simpl; auto. apply Forall_cons; auto. exists n; auto. apply Forall_forall. intros. apply In_nth with (d:=Zero) in H5. destruct H5 as [idx [H5 H6]]. subst x. exists (nth idx nl 0). apply MapR_nth with (i:=idx) (du:=Zero) (dt:=0) in H1; auto. subst a. rewrite <- Hl; auto.
  simpl. destruct H5 as [k H5]. apply Term_Eq_trans with (FuncT (FComp FLor (FProj 0::FComp f (FProj 1::map FProj (seq 2 a))::nil)) (n2t k::n2t n::args)). apply FRecu_Succ_spec; auto. rewrite Hl. apply WFF_Recu; auto. apply WFF_Comp; auto. apply Term_Eq_trans with (FuncT FLor (n2t k::FuncT f (n2t n::args)::nil)). apply FComp_spec with (S(S a)). apply WFF_Comp; auto. simpl; auto. apply MapR_cons. apply MapR_cons; auto. apply FComp_spec with (S (S a)); auto. simpl; auto. apply MapR_cons; auto. apply combine_MapR. rewrite map_length; rewrite seq_length; auto. apply Forall_forall. intros. destruct x as [g arg]. apply In_nth with (d:=(FProj 0,Zero)) in H6. destruct H6 as [idx [H6 H7]]. rewrite combine_length in H6. rewrite min_r in H6. rewrite combine_nth in H7. inversion H7. subst g arg. clear H7. simpl. rewrite map_nth. rewrite seq_nth. simpl. apply FProj_spec; auto. simpl; auto. rewrite <- Hl; auto. rewrite map_length; rewrite seq_length; auto. rewrite map_length; rewrite seq_length; rewrite Hl; auto.
  apply FProj_spec; auto. simpl; auto. apply FProj_spec; auto. simpl; auto. apply FLor_spec2 with k j; auto. apply Term_Eq_trans with (FuncT f (t::args)); auto. apply Term_Eq_args. apply MapR_cons. apply MapR_refl; auto. apply Term_Eq_sym; auto. Qed.
Theorem FEx_spec2: forall a nl args f l, WFFunc (S a) f -> length nl=a -> MapR (fun k a=>Inf l (a==n2t k)) nl args -> forall n t, Inf l (t==n2t n) -> (forall i, i<n -> Inf l (FuncT f (n2t i::args) == n2t 0)) -> Inf l (FuncT (FEx a f) (t::args) == n2t 0). Proof. intros. assert (Hl:length args=a). apply MapR_length in H1; subst a; auto. remember (newVar nil (t::args) nil) as v. apply Term_Eq_trans with (FuncT (FEx a f) (n2t n::args)). apply Term_Eq_SubTerm with t (n2t n) v (FuncT (FEx a f) ((#v)::args)); auto; apply ST_Func; apply MapR_cons; auto; apply MapR_refl; intros; apply nVT_SubTerm; eapply newVar_nVT; subst v; eauto. unfold FEx. clear H2. assert (Hw:WFFunc (S (S a)) (FComp f (FProj 1 :: map FProj (seq 2 a)))). apply WFF_Comp; auto. simpl. rewrite map_length. rewrite seq_length; auto. apply Forall_cons. auto. apply Forall_forall. intros. apply in_map_iff in H2. destruct H2 as [y [H2 H4]]. subst x. apply in_seq in H4. destruct H4. apply WFF_Proj; auto.
  induction n. simpl. apply Term_Eq_trans with (FuncT (FComp FZero nil) args). apply FRecu_Zero_spec; auto. apply WFF_Recu; auto. rewrite Hl. apply WFF_Comp; auto. apply FComp_spec with (n:=a); auto. simpl. apply Term_Eq_trans with (FuncT (FComp FLor (FProj 0::FComp f (FProj 1::map FProj (seq 2 a))::nil)) (n2t 0::n2t n::args)). apply FRecu_Succ_spec; auto. apply WFF_Recu; auto. rewrite Hl. apply WFF_Comp; auto. apply Term_Eq_trans with (FuncT FLor (n2t 0::FuncT f (n2t n::args)::nil)). apply FComp_spec with (S(S a)); auto. apply WFF_Comp; auto. simpl; auto. apply MapR_cons. apply MapR_cons; auto. apply FComp_spec with (S(S a)); auto. simpl; auto. apply MapR_cons. apply combine_MapR. rewrite map_length; rewrite seq_length; auto. apply Forall_forall. intros. apply In_nth with (d:=(FProj 0,Zero)) in H2. destruct x as [g arg]. simpl. destruct H2 as [idx [H4 H5]]. rewrite combine_nth in H5. inversion H5. subst g arg. clear H5. rewrite combine_length in H4. rewrite min_r in H4.
  rewrite map_nth. rewrite seq_nth. simpl. apply FProj_spec; auto. simpl; auto. rewrite <- Hl; auto. rewrite Hl. rewrite map_length; rewrite seq_length; auto. rewrite map_length; rewrite seq_length; auto. apply FProj_spec; auto. simpl; auto. apply FProj_spec; simpl; auto. apply FLor_spec3; auto. Qed.
Hint Resolve FEx_spec1 FEx_spec2.

Theorem FRem_spec1: forall i j (nz:j<>0) t u l, Inf l (t==n2t i) -> Inf l (u==n2t j) -> Inf l (FuncT FRem (t::u::nil) == n2t (modN nz i)). Proof. intros. apply Term_Eq_trans with (FuncT FRem (n2t i::n2t j::nil)). apply Term_Eq_args; auto. clear H H0. unfold FRem. induction i. simpl. apply Term_Eq_trans with (FuncT (FComp FZero nil) (n2t j::nil)). apply FRecu_Zero_spec; auto. replace (modN nz 0) with 0. apply FComp_spec with 1; auto. unfold modN. destruct (divmod j 0) as [[q [r [H1 H2] H3]]|H1]. destruct r; auto. rewrite plus_comm in H1; inversion H1. contradiction. simpl. apply Term_Eq_trans with (FuncT (FComp FMult (FComp FSucc (FProj 0::nil)::FComp FNEq (FProj 2::FComp FSucc (FProj 0::nil)::nil)::nil)) (n2t (modN nz i)::n2t i::n2t j::nil)). apply FRecu_Succ_spec; auto. apply Term_Eq_trans with (FuncT FMult (n2t (S(modN nz i))::FuncT FNEq (n2t j::n2t (S(modN nz i))::nil)::nil)). apply FComp_spec with 3; auto. apply WFF_Comp; auto. apply Forall_cons; auto. apply WFF_Comp; auto. apply Forall_cons; auto. apply WFF_Comp; auto. apply Forall_cons; auto. apply Forall_cons; auto. apply WFF_Comp; auto.
  apply MapR_cons. apply MapR_cons; auto. apply FComp_spec with 3; auto. apply WFF_Comp; auto. apply Forall_cons; auto. apply Forall_cons; auto. apply WFF_Comp; auto. apply MapR_cons. apply MapR_cons; auto. apply Term_Eq_trans with (FuncT FSucc (n2t (modN nz i)::nil)). apply FComp_spec with 3; auto. apply WFF_Comp; auto. apply MapR_cons; auto. apply FProj_spec; simpl; auto. auto. apply FProj_spec; auto. apply Term_Eq_trans with (FuncT FSucc (n2t (modN nz i)::nil)); simpl; auto. apply FComp_spec with 3; auto. apply WFF_Comp; auto. apply MapR_cons; auto. apply FProj_spec; simpl; auto. destruct (nat_eq_dec j (S (modN nz i))) as [Hn|Hn]. rewrite <- Hn. apply Term_Eq_trans with (FuncT FMult (n2t j::n2t 0::nil)). apply Term_Eq_args. apply MapR_cons; auto. apply MapR_cons; auto. apply FNEq_spec2 with j; auto. replace (modN nz (S i)) with 0. replace 0 with (j*0) at 2; auto. unfold modN. destruct (divmod j (S i)) as [[q [r [H1 H2] H3]]|H1]; [|contradiction]. unfold modN in Hn. destruct (divmod j i) as [[q' [r' [H4 H5] H6]]|H4]; [|contradiction]. assert (S i=S (q'*j+r')). subst i; auto. rewrite plus_n_Sm in H. rewrite <- Hn in H.
 replace (q'*j+j) with ((S q')*j+0) in H. apply H3 in H; auto. destruct H; auto. rewrite plus_comm; simpl; auto. apply Term_Eq_trans with (FuncT FMult (n2t (S (modN nz i))::n2t 1::nil)). apply Term_Eq_args. apply MapR_cons; auto. apply MapR_cons; auto. apply FNEq_spec1 with j (S (modN nz i)); auto. replace (modN nz (S i)) with (S (modN nz i)*1); auto. rewrite mult_1_r. unfold modN. unfold modN in Hn. destruct (divmod j i) as [[q [r [H1 H2] H3]]|H1]; [|contradiction]. destruct (divmod j (S i)) as [[q' [r' [H4 H5] H6]]|H4]; [|contradiction]. assert (S i=S(q*j+r)). subst i; auto. rewrite plus_n_Sm in H. apply H6 in H. destruct H; auto. apply le_lt_or_eq in H2. destruct H2; auto. contradict Hn; auto. Qed.
Theorem FRem_spec2: forall i t u l, Inf l (t==n2t i) -> Inf l (u==n2t 0) -> Inf l (FuncT FRem (t::u::nil) == n2t i).  Proof. intros. apply Term_Eq_trans with (FuncT FRem (n2t i::n2t 0::nil)). apply Term_Eq_args; auto. clear H H0. unfold FRem. induction i. simpl. apply Term_Eq_trans with (FuncT (FComp FZero nil) (Zero::nil)). apply FRecu_Zero_spec; auto. apply FComp_spec with 1; auto. simpl. apply Term_Eq_trans with (FuncT (FComp FMult (FComp FSucc (FProj 0::nil)::FComp FNEq (FProj 2::FComp FSucc (FProj 0::nil)::nil)::nil)) (n2t i::n2t i::n2t 0::nil)). apply FRecu_Succ_spec; auto. apply Term_Eq_trans with (FuncT FMult (n2t (S i)::FuncT FNEq (n2t 0::n2t (S i)::nil)::nil)). apply FComp_spec with 3; auto. apply WFF_Comp; auto. apply Forall_cons; auto. apply WFF_Comp; auto. apply Forall_cons; auto. apply WFF_Comp; auto. apply Forall_cons; auto. apply Forall_cons; auto. apply WFF_Comp; auto.
  apply MapR_cons. apply MapR_cons; auto. apply FComp_spec with 3; auto. apply WFF_Comp; auto. apply Forall_cons; auto. apply Forall_cons; auto. apply WFF_Comp; auto. apply MapR_cons; auto. apply MapR_cons; auto. simpl. apply FComp_spec with 3; auto. apply WFF_Comp; auto. apply MapR_cons; auto. apply FProj_spec; simpl; auto. simpl. apply FComp_spec with 3; auto. apply WFF_Comp; auto. apply MapR_cons; auto. apply FProj_spec; simpl; auto. apply Term_Eq_trans with (FuncT FMult (n2t (S i)::n2t 1::nil)). apply Term_Eq_args. apply MapR_cons; auto. apply MapR_cons; auto. apply FNEq_spec1 with 0 (S i); auto. replace (Succ (n2t i)) with (n2t ((S i)*1)); auto. rewrite mult_1_r; auto. Qed.
Hint Resolve FRem_spec1 FRem_spec2.


Require Export Iron.Language.SystemF2Data.Exp.
Require Export Iron.Language.SystemF2Data.Step.Context.
Require Export Iron.Language.SystemF2Data.Step.Step.

(********************************************************************)
(* Multi-step evaluation
   A sequence of small step transitions.
   As opposed to STEPSL, this version has an append constructor
   EsAppend that makes it easy to join two evaluations together.
   We use this when converting big-step evaluations to small-step. *)
Inductive STEPS : exp -> exp -> Prop :=

 (* After no steps, we get the same exp.
    We need this constructor to match the EVDone constructor
    in the big-step evaluation, so we can convert between big-step
    and multi-step evaluations. *)
 | EsNone
   :  forall x1
   ,  STEPS x1 x1

 (* Take a single step. *)
 | EsStep
   :  forall x1 x2
   ,  STEP  x1 x2
   -> STEPS x1 x2

 (* Combine two evaluations into a third. *)
 | EsAppend
   :  forall x1 x2 x3
   ,  STEPS x1 x2 -> STEPS x2 x3
   -> STEPS x1 x3.

Hint Constructors STEPS.

(********************************************************************)
(* Multi-step evaluating a wnf doesn't change it. *)
Lemma steps_wnfX
 :  forall x v
 ,  wnfX x -> STEPS x v -> v = x.
Proof.
 intros x v HW HS.
 induction HS; auto.
  Case "EsStep".
   apply step_wnfX; auto.

  Case "EsAppend".
   have (x2 = x1).
   subst. auto.
Qed.

(********************************************************************)
(* Multi-step evaluation in a context. *)
Lemma steps_context
 :  forall C x1 x1'
 ,  exp_ctx C
 -> STEPS x1 x1'
 -> STEPS (C x1) (C x1').
Proof.
 intros C x1 x1' HC HS.
 induction HS; eauto.
Qed.

(********************************************************************)
(* Multi-step evaluation of a data constructor argument. *)
Lemma steps_context_XCon
 :  forall C x v dc ts
 ,  exps_ctx wnfX C
 -> STEPS x v
 -> STEPS (XCon dc ts (C x)) (XCon dc ts (C v)).
Proof.
 intros C x v dc ts HC HS.
 induction HS; auto.
 - lets D: EsContext XcCon; eauto.
 - eauto.
Qed.

Lemma steps_in_XCon
 :  forall xs ts vs dc
 ,  Forall2 STEPS xs vs
 -> Forall wnfX vs
 -> STEPS (XCon dc ts xs) (XCon dc ts vs).
Proof.
 intros xs ts vs dc HS HW.
 lets HC: make_chain HS HW.
 - eapply steps_wnfX.
 - clear HS. clear HW.
   induction HC; auto.
   eapply (EsAppend (XCon dc ts (C x)) (XCon dc ts (C v))); auto.
   eapply steps_context_XCon; auto.
Qed.

(********************************************************************)
(* Multi-step evaluation of a primitive operator argument. *)
Lemma steps_context_XPrim
 :  forall C x v p
 ,  exps_ctx wnfX C
 -> STEPS x v
 -> STEPS (XPrim p (C x)) (XPrim p (C v)).
Proof.
 intros C x v p HC HS.
 induction HS; auto.
 - lets D: EsContext XcPrim; eauto.
 - eauto.
Qed.

Lemma steps_in_XPrim
 :  forall xs vs p
 ,  Forall2 STEPS xs vs
 -> Forall wnfX vs
 -> STEPS (XPrim p xs) (XPrim p vs).
Proof.
 intros xs vs p HS HW.
 lets HC: make_chain HS HW.
 - eapply steps_wnfX.
 - clear HS. clear HW.
   induction HC; auto.
   eapply (EsAppend (XPrim p (C x)) (XPrim p (C v))); auto.
   eapply steps_context_XPrim; auto.
Qed.


Set Primitive Projections.
From Equations Require Import Equations.
From OGS Require Import Utils Ctx EventD CatD ITreeD EqD AngelicD LCD.

(*********************************************)
(* Notations for equivalence of lassen trees *)

Definition eqv_lassen {Γ : neg_ctx} {x} : term Γ x -> term Γ x -> Prop :=
  fun u v => eval_lassen u ≈ eval_lassen v.

Infix "≈L" := eqv_lassen (at level 40).

(****************************************)
(* various proofs on eager normal forms *)

Equations e_plug {Γ x y} : e_ctx Γ y x -> term Γ x -> term Γ y :=
  e_plug EHole         t := t ;
  e_plug (EApp_r E u)  t := e_plug E (App u t) ;
  e_plug (EApp_l E u)  t := e_plug E (App t u) ;
  e_plug (EPair_r E u) t := e_plug E (Pair u t) ;
  e_plug (EPair_l E u) t := e_plug E (Pair t u) ;
  e_plug (EPMatch E u) t := e_plug E (PMatch t u) ;
  e_plug (EInl E)      t := e_plug E (Inl t) ;
  e_plug (EInr E)      t := e_plug E (Inr t) ;
  e_plug (ESMatch E u v) t := e_plug E (SMatch t u v) .

Equations t_of_red {Γ x y} : term Γ x -> e_redex Γ x y -> term Γ y :=
  t_of_red e (RApp v) := App e (t_of_val v) ;
  t_of_red e (RPMatch u) := PMatch e u ;
  t_of_red e (RSMatch u v) := SMatch e u v .

Equations t_of_e_term {Γ x} : e_term Γ x -> term Γ x :=
  t_of_e_term (EVal v) := t_of_val v ;
  t_of_e_term (ERed E v r) := e_plug E (t_of_red (t_of_val v) r) .

Equations t_of_e_nf {Γ x} : e_nf Γ x -> term Γ x :=
  t_of_e_nf (NVal v) := t_of_val v ;
  t_of_e_nf (NRed E i r) := e_plug E (t_of_red (Var i) r).

(* WIP from here (other interesting stuff are at the end of the file)

Lemma e_split_correct {Γ x y} (E : e_ctx Γ x y) (t : term Γ y) : t_of_e_term (e_focus (EA E t)) = e_plug E t.
  funelim (e_focus (EA E t)); intros.

Lemma e_split_val {Γ x} (v : e_val Γ x) : e_focus' EHole (t_of_val v) = EVal v.
  induction v; auto.
  unfold e_focus' in *; simpl in *.
  rewrite focus_aux.focus_aux_equation_5.

  rewrite
  destruct v; auto.
  unfold e_focus'. simpl. Search (focus_aux.focus_aux _ (inl (Pair _ _))).
  Search (focus_aux.focus_aux (EPair_l _ _) _).
  destruct (v1); auto.
  rewrite focus_aux.focus_aux_equation_13.

Qed.

Lemma e_split_correct {Γ x} (t : term Γ x) : t_of_e_term (e_split t) = t.
  funelim (e_split t); intros; cbn in *.
  + f_equal.
  + f_equal.
  + rewrite Heq in Hind. rewrite Heq, <-Hind. reflexivity.
  + rewrite Heq0; cbn; rewrite Heq.
    rewrite Heq in Hind; rewrite Heq0 in Hind0.
    rewrite <-Hind, <-Hind0. reflexivity.
  + rewrite Heq0; cbn; rewrite Heq.
    rewrite Heq in Hind; rewrite Heq0 in Hind0.
    rewrite <-Hind, <-Hind0. reflexivity.
Qed.

Lemma e_split_coherent {Γ x} (t : e_term Γ x) : e_split (t_of_e_term t) = t.
  funelim (t_of_e_term t).
  + destruct e; auto.
  + revert e1 e2; induction e0; intros; cbn.
    - destruct (e_split (t_of_val e2)) eqn:H; cbn;
        rewrite (e_split_val e2) in H;
        try discriminate H;
        injection H as ->.
      destruct (e_split (t_of_val e1)) eqn:H; cbn;
        rewrite (e_split_val e1) in H;
        try discriminate H;
        injection H as ->.
      reflexivity.
    - cbn in IHe0; rewrite (IHe0 e1 e2); reflexivity.
    - destruct (e_split (t_of_val e)) eqn:H; cbn;
        rewrite (e_split_val e) in H;
        try discriminate H;
        injection H as ->.
      cbn in IHe0; rewrite (IHe0 e1 e2); reflexivity.
Qed.

Lemma e_split_unique {Γ x} {a : term Γ x} {b} : a = t_of_e_term b <-> e_split a = b.
  econstructor; intro p.
  rewrite<- (e_split_coherent b); f_equal; exact p.
  rewrite<- (e_split_correct a); f_equal; exact p.
Qed.

Lemma e_split_inj {Γ a} {x y : term Γ a} (p : e_split x = e_split y) : x = y.
  rewrite<- e_split_correct, e_split_unique.
  exact p.
Qed.
*)

(**********************************)
(* various proofs on lassen trees *)

Equations eq_fin1 (x : Fin.fin 1) : x = Fin.F0 :=
  eq_fin1 (Fin.F0) := eq_refl.

Equations eq_neg {Γ : neg_ctx} {a b : ty} (i : (Γ : ctx) ∋ (a → b)%ty) : neg_var i = @NArr a b :=
  eq_neg i with neg_var i := { | NArr := eq_refl } .

From Paco Require Import paco.

Definition unfold_iter {I} {E : event I I} {X Y : I -> Type} (body : X ⇒ᵢ itree E (X +ᵢ Y))
           {i} (x : X i)
           : observe (RecD.iter body i x) = observe (ITreeD.bind (body i x) (fun _ y => match y with
                             | inl x' => Tau (RecD.iter body _ x')
                             | inr y => Ret y
                             end)).
  reflexivity.
  Qed.

Definition unfold_iterₐ {I} {E : event I I} {X Y i} (body : X -> itreeₐ E i i (X + Y)) (x : X)
  : observe (iterₐ body x)
    = observe (body x !>= fun r => match r with
                             | inl x => tauₐ (iterₐ body x)
                             | inr y => retₐ y
              end).
  Proof. reflexivity. Qed.

(*
Definition subst_ret_obs {I} {E : event I I} {X Y} (f : X ⇒ᵢ itree E Y) {i} (x : X i)
        : observe (subst f (Ret x)) = observe (f i x) := eq_refl.

Definition subst_ret {I} {E : event I I} {X Y} (f : X ⇒ᵢ itree E Y) {i} (x : X i)
        : subst f (Ret x) = f i x := eq_refl.

  lazy delta beta.
  lazy iota.
  replace (Ret x) with ({| _observe := RetF x : itreeF E _ _ i |}).
Definition subst {I} {E : event I I} {X Y} (f : X ⇒ᵢ itree E Y)
                 : itree E X ⇒ᵢ itree E Y :=
*)

Theorem lassen_eta {Γ : neg_ctx} {a b} (i : (Γ : ctx) ∋ (a → b)%ty)
  : Var i ≈L Lam (App (Var (pop i)) (Var top)).

  (* 1. step *)
  apply paco3.paco3_fold.
  unfold eqit_; cbn.
  econstructor.
  intros [x v]; revert v.
  rewrite (eq_fin1 x). cbn. clear x. intro v.

  (* 2. step *)
  left. apply paco3.paco3_fold.
  cbn. econstructor. left.
  cbn [ r_shift has_case ]. cbn.
  pose (j := @r_concat_l' Γ (a_cext v) (a → b) i). fold j.
  unfold eval_lassen'.

  (* 3. step *)
  apply paco3.paco3_fold.
  rewrite 2 unfold_iter.
  destruct v.
  +
    cbn [ t_of_a fst snd ].
    unfold eval_enf, bindₐ, sub, MonadItree.
    cbv [ bind RecD.emb_comp iterₐ ].
    unfold bindₐ.
    unfold sub.
    unfold MonadItree.
    cbn.
    rewrite 2 unfold_iterₐ.
    cbn [ eval_enf ].

  (* expand lots of stuff (too much) *)
  lazy beta delta [RecD.iter ].
  cbn [ fst snd
         MonadItree Basics.compose pin
         observe _observe
         bind subst sub
         ret AngelicD.retₐ tau AngelicD.tauₐ fiber_into
         RecD.iter RecD.emb_comp RecD.translate_fwd
         eval_enf
         AngelicD.bindₐ AngelicD.iterₐ AngelicD.ret₀
         e_focus
         ].

  (** Left branch **)
  (* compute through focus_aux *)
  rewrite focus_aux.focus_aux_equation_4,
          focus_aux.focus_aux_equation_1,
          focus_aux.focus_aux_equation_11,
          focus_aux.focus_aux_equation_1,
          focus_aux.focus_aux_equation_12.

  (* compute through eval_aux *)
  rewrite eval_aux_equation_2,
          lassen_enf_equation_2,
          (eq_neg j),  (* unstuck trivial proof *)
          lassen_enf_clause_2_equation_1.

  (** Right branch **)
  rewrite focus_aux.focus_aux_equation_4.
  rewrite focus_aux.focus_aux_equation_2.
  rewrite focus_aux.focus_aux_equation_11.
  rewrite focus_aux.focus_aux_equation_1.
  rewrite focus_aux.focus_aux_equation_12.
  rewrite eval_aux_equation_3.
  cbn.
  fold (@focus_aux.focus_aux Γ).
  econstructor; auto.
  econstructor.

  Locate "/ₛ".
  unfold t_subst1.
  unfold t_subst1_clause_1_f.
  simpl t_subst.
  Search eval_aux.
                         eval_aux
                           (ERed EHole (VLam (App (Var (pop j)) (Var top)))
                              (RApp (VVar top)))
  rewrite eval_aux_equation_1.
  rewrite lassen_enf_equation_2.

                           (focus_aux.focus_aux EHole
                              (inl
                                 (App (Lam (App (Var (pop j)) (Var top))) (Var top))))
  change (neg_var j) with (@NArr (a → b0) b).
  simpl lassen_enf.
  cbn.
  Search lassen_enf_clause_2
  Search "focus_aux".
  (focus_aux.focus_aux EHole (inl (App (Var j) (Var top))))
                                 Subterm.FixWf Fix Fix_F wellfounded
                                 Telescopes.wf_tele_measure Subterm.lt_wf Wf.measure_wf ].
  unfold eval_enf.

  RecD.emb_comp RecD.translate_fwd
                         AngelicD.bindₐ AngelicD.iterₐ AngelicD.ret₀
                         AngelicD.tauₐ tau AngelicD.retₐ
                         ret tau vis
                         eval_enf
                         fiber_into
                         MonadItree Basics.compose pin
                         e_focus focus_aux.focus_aux ].
  lazy iota beta delta [ observe _observe
                         bind subst sub
                         RecD.iter RecD.emb_comp RecD.translate_fwd
                         AngelicD.bindₐ AngelicD.iterₐ AngelicD.ret₀
                         AngelicD.tauₐ tau AngelicD.retₐ
                         ret tau vis
                         eval_enf
                         fiber_into
                         MonadItree Basics.compose pin
                         e_focus focus_aux.focus_aux ].
  cbn.
  unfold lassen_enf_clause_2.
  lazy iota beta.
  lazy iota beta delta [ r_concat_l' r_concat_l eq_rect_r ].
  unfold r_concat_l'.
  Search "lassen_enf_clause_2".
  lazy delta [ eval_enf ].
  Locate "=<<".
  Check sub.

  cbn.
  lazy iota beta delta [ eval_enf ].
  lazy iota beta delta [ observe ].
.  lazy iota beta delta -[ observe RecD.iter subst fiber_into RecD.emb_comp ].
  lazy iota beta zeta delta [ r_shift has_case apply_noConfusion noConfusion_retr noConfusion_inv noConfusion NoConfusion ].
  lazy iota beta zeta delta [ observe RecD.iter ].
  lazy iota beta delta [ observe RecD.iter ].
  unfold observe.
  cbn.
  destruct v.
  unfold t_of_a.
  unfold eval_enf.
  cbn.
  unfold r_shift.
  lazy iota beta delta [ has_case ].
  cbn.
  cbn.

  Locate (_ \/)
  apply paco3.upaco3_mon_bot.
  Search paco3.upaco3.
  unfold lassen_val, subst.
  cbn.
  repeat lazy cofix.
  lazy beta match cofix.
  simpl.
  lazy.
  lazy beta iota.

  Print go.
  Print
  replace (Ret (inl (EA EHole (apply_obs (VVar i) v)))) with ({| _observe := RetF (inl (EA EHole (apply_obs (VVar i) v))) |} : lassen (eval_arg' +ᵢ ∅ᵢ) _).
  compute.
  vm_compute.
  unfold lassen_val.
  unfold subst.
  unfold observe.

  unfold subst.
  cbn.
  cbn
  cbn in v.
  destruct v.
  cbn.
  destruct x.
  case x.
  unfold enf_k_rsp in v.

  destruct x.
  cbn in v.
  destruct (u_rsp enf_e (LVal (@AArr Γ a b) : u_qry enf_e (_ , _))).
  Check subst
  cbn in v.
  edestruct v as [n x].
  cbn.
  destruct n.
  cbn in x.
  cbn in k.
  destruct x.
  destruct x.
  unfold id.
  Search paco3.upaco3.
  cbn in v.

  From Coq Require Import Morphisms.
  Check eqitF.
  Check (Proper _ )


Load LFindLoad.
From lfind Require Import LFind.
From adtind Require Import goal80.

Set Printing Depth 1000.
Definition lfind_eval  y:=
append y Nil.

Compute lfind_eval  (Cons (Succ Zero) Nil).

Compute lfind_eval  (Cons Zero (Cons (Succ Zero) (Cons (Succ (Succ Zero)) Nil))).

Compute lfind_eval  (Cons Zero Nil).

Compute lfind_eval  (Cons Zero (Cons (Succ (Succ Zero)) Nil)).

Compute lfind_eval  (Cons (Succ (Succ (Succ Zero))) (Cons Zero (Cons Zero Nil))).

Compute lfind_eval  (Cons (Succ (Succ Zero)) (Cons Zero Nil)).

Compute lfind_eval  (Cons (Succ (Succ Zero)) Nil).

Compute lfind_eval  (Nil).


(* TODO: Split facts (and equality?) into submodules *)

Set Implicit Arguments.
Unset Strict Implicit.

Require Fin.

Fixpoint vec (A : Type) (n : nat) : Type :=
  match n with
  | 0   => unit
  | S m => A * vec A m
  end.

Definition cast {A m} (xs : vec A m) : forall n, m = n -> vec A n.
Proof. intros; subst; assumption. Defined.

Definition nil  {A} : vec A 0 := tt.
Definition cons {A n} : A -> vec A n -> vec A (S n) := pair.

Definition hd {A n} : vec A (S n) -> A := fst.
Definition tl {A n} : vec A (S n) -> vec A n := snd.

Definition last {A n} (xs : vec A (S n)) : A.
Proof.
  induction n.
  - refine (hd xs).
  - refine (IHn (tl xs)).
Defined.

Definition const {A n} (x : A) : vec A n :=
  nat_rect _ nil (fun _ acc => cons x acc) _.

Definition nth {A n} (xs : vec A n) (i : Fin.t n) : A.
Proof.
  induction i.
  - refine (hd xs).
  - refine (IHi (tl xs)).
Defined.

Definition replace {A n} (xs : vec A n) (i : Fin.t n) (new : A) : vec A n.
Proof.
  induction i.
  - refine (cons new (tl xs)).
  - refine (cons (hd xs) (IHi (tl xs))).
Defined.

Definition append {A m n} (xs : vec A m) (ys : vec A n) : vec A (m + n).
Proof.
  induction m.
  - refine ys.
  - refine (cons (hd xs) (IHm (tl xs))).
Defined.

Definition rev {A n} (xs : vec A n) : vec A n.
Proof.
  induction n as [| n rev ].
  - refine nil.
  - destruct xs as [x xs].
    (* FIXME: Can we do better? *)
    refine (cast (append (rev xs) (cons x nil)) _).
    apply PeanoNat.Nat.add_1_r.
Defined.

Compute (rev (cons 1 (cons 2 (cons 3 (cons 5 (cons 6 nil)))))).
(* BAD! Does not reduce well. *)

Fixpoint map {A B n} (f : A -> B) (xs : vec A n) : vec B n :=
  match n as m return vec A m -> vec B m with
  | 0   => fun _   => nil
  | S _ => fun xs' => cons (f (hd xs')) (map f (tl xs'))
  end xs.

Fixpoint zip {A B n} (xs : vec A n) (ys : vec B n) : vec (A * B) n :=
  match n as m return vec A m -> vec B m -> vec (A * B) m with
  | 0   => fun _ _     => nil
  | S _ => fun xs' ys' => cons (hd xs', hd ys') (zip (tl xs') (tl ys'))
  end xs ys.

Lemma eq_dec {A n} (Hdec : forall a b : A, {a = b} + {a <> b}) (xs ys : vec A n) : {xs = ys} + {xs <> ys}.
Proof.
  induction n.
  - destruct xs, ys; auto.
  - destruct xs as [x xs], ys as [y ys].
    destruct (Hdec x y).
    + destruct (IHn xs ys).
      * subst; auto.
      * right; congruence.
    + right; congruence.
Defined.

Lemma eq_nth_iff {A n} (xs ys : vec A n) : (forall i, nth xs i = nth ys i) <-> xs = ys.
Proof.
  split; intros.
  - induction n.
    + now destruct xs, ys.
    + destruct xs as [x xs], ys as [y ys]; f_equal.
      * specialize (H Fin.F1); eauto.
      * apply IHn.
        intros i.
        apply (H (Fin.R 1 i)).
  - now subst.
Qed.

Lemma eq_nth_iff' {A n} (xs ys : vec A n) : (forall i j, i = j -> nth xs i = nth ys j) <-> xs = ys.
Proof.
  split; intros.
  - induction n.
    + now destruct xs, ys.
    + destruct xs as [x xs], ys as [y ys]; f_equal.
      * specialize (H Fin.F1 _ eq_refl); eauto.
      * apply IHn.
        intros i j H0.
        eapply (H _ _ (f_equal (Fin.R 1) H0)).
  - now subst.
Qed.

Lemma map_comp {A B C n} (f : A -> B) (g : B -> C) (xs : vec A n) :
  map g (map f xs) = map (fun x => g (f x)) xs.
Proof.
  induction n.
  - now destruct xs.
  - now destruct xs as [x xs]; cbn; rewrite IHn.
Qed.

Require List.

Fixpoint of_list {A} (xs : list A) : vec A (length xs) :=
  match xs with
  | List.nil         => nil
  | List.cons x rest => cons x (of_list rest)
  end.

Definition to_list {A n} (xs : vec A n) : { ys : list A | length ys = n }.
Proof.
  induction n.
  - now exists List.nil.
  - destruct xs as [x xs], (IHn xs) as [ys proof].
    exists (List.cons x ys).
    now cbn; rewrite proof.
Defined.

Require Vector.

Fixpoint of_vector {A n} (xs : Vector.t A n) : vec A n :=
  match xs with
  | Vector.nil _       => nil
  | Vector.cons _ x _ xs => cons x (of_vector xs)
  end.

Fixpoint to_vector {A n} (xs : vec A n) : Vector.t A n :=
  match n as m return vec A m -> Vector.t A m with
  | 0   => fun _   => Vector.nil _
  | S _ => fun xs' => let (h, t) := xs'
                       in Vector.cons _ h _ (to_vector t)
  end xs.
(*
Proof.
  induction n; [ constructor | ].
  destruct xs as [x xs].
  constructor; auto.
Defined.
*)

Module VectorNotations.
  Delimit Scope vector_scope with vector.

  Notation "[ ]":=
    nil (format "[ ]") : vector_scope.
  Notation "h :: t" :=
    (cons h t) (at level 60, right associativity) : vector_scope.
  Notation "[ x ]" :=
    (cons x nil) : vector_scope.
  Notation "[ x ; y ; .. ; z ]" :=
    (cons x (cons y .. (cons z nil) ..)) : vector_scope.
  Notation "v [@ p ]" :=
    (nth v p) (at level 1, format "v [@ p ]") : vector_scope.

  Open Scope vector_scope.
End VectorNotations.

Import VectorNotations.


Require Import Utf8 ssreflect ssrfun Classical FinFun Bool.

Set Implicit Arguments.

Unset Strict Implicit.

Unset Printing Implicit Defensive.

Module a.

Section a.

Variable G:Type.

Variable f:G → G → G.

Definition unit e:=
 ∀a,f e a = a ∧ f a e = a.

Variable e1 e2:G.

Goal unit e1 ∧ unit e2 → e1 = e2.
Proof.
intro.
destruct H.
red in H,H0.
specialize(H e2).
specialize(H0 e1).
destruct H,H0.
clear H1 H0.
congruence.
Qed.

End a.

End a.

Module l.

Section a.

Variable U:Type.

Variable f:U → U → U.

Variable e1 e2:U.

Hypothesis left:∀a,f e1 a = a.

Hypothesis right:∀a,f a e2 = a.

Goal e1 = e2.
Proof.
specialize(left e2).
specialize(right e1).
congruence.
Qed.

End a.

End l.

Module d.

Section a.

Variable G:Type.

Variable f:G → G → G.

Hypothesis aso:
 ∀a b c,f a (f b c) = f (f a b) c.

Variable e:G.

Hypothesis unit:∀a,f e a = a ∧ f a e = a.

Definition inv a b:=
 f a b = e ∧ f b a = e.

Goal ∀a b1 b2,
 inv a b1 ∧ inv a b2 → b1 = b2.
Proof.
intros.
destruct H.
red in H,H0.
destruct H,H0.
destruct(unit b1).
destruct(unit b2).
clear H4 H6 H2 unit.
rewrite <-H3.
rewrite<-H5.
clear H3 H5.
rewrite<-H1.
rewrite<-aso,<-aso.
f_equal.
rewrite<-H in H0.
congruence.
Qed.

End a.

End d.

Module g.

Section a.

Variable G:Type.

Variable f:G → G → G.

Hypothesis aso:
 ∀a b c,f a (f b c) = f (f a b) c.

Definition epi a:=∀b c,f a b = f a c → b = c.

Goal ∀x y,epi x → epi y → epi(f x y).
Proof.
intros.
red.
intros.
red in H,H0.
apply H0.
apply H.
repeat rewrite aso.
apply H1.
Qed.

End a.

End g.

Module k.

Section a.

Variable U:Type.

Variable f :U → U → U.

Definition op (f:U → U → U) a b := f b a.

Goal op(op f) = f.
Proof.
unfold op at 2.
unfold op.
split.
Qed.

End a.

End k.

Module j.

Section a.

Variable U:Type.

Definition aso f:=
 ∀a b c:U,f a (f b c) = f (f a b) c.

Definition op (f:U → U → U) a b := f b a.

Variable f:U → U → U.

Goal aso f → aso(op f).
Proof.
intro.
red.
intros.
cbv.
red in H.
rewrite H.
split.
Qed.

End a.

End j.

Module n.

Section a.

Variable U:Type.

Definition op (f:U → U → U) a b := f b a.

Definition left f (e:U) :=
 ∀a:U,f e a = a.

Definition right f (e:U) :=
 ∀a:U,f a e = a.

Variable f:U → U → U.

Goal left (op f) = right f.
Proof.
cbv.
split.
Qed.

End a.

End n.

Module b.

Section a.

Variable U:Type.

Variable hom:U → U → Type.

Variable comp:∀a b c,hom a b → hom b c → hom a c.

Definition is_id(id:∀{a},hom a a):=
 ∀a b (f:hom a b),comp id f = f ∧ comp f id = f.

Variable id1 id2:∀a,hom a a.

Hypothesis H1:is_id id1.

Hypothesis H2:is_id id2.

Goal ∀a,id1 a = id2 a.
Proof.
intro.
red in H1 ,H2.
specialize(H1 (id2 a)).
destruct H1.
specialize(H2(id1 a)).
destruct H2.
clear H1 H2.
rewrite H in H4.
auto.
Qed.

End a.

End b.

Module c.

Section a.

Variable U:Type.

Variable hom:U → U → Type.

Variable comp:∀a b c,hom a b → hom b c → hom a c.

Definition is_id x id:=
 ∀ a b (f:hom a x)(g:hom x b),
  comp f id = f ∧ comp id g = g.

Variable a:U.

Variable id1 id2:hom a a.

Hypothesis H1:is_id id1.

Hypothesis H2:is_id id2.

Goal id1 = id2.
Proof.
red in H1,H2.
specialize(H1 id2 id2).
specialize(H2 id1 id1).
destruct H1,H2.
clear H1 H2 H H4.
congruence.
Qed.

End a.

End c.

Module e.

Section a.

Variable U:Type.

Variable hom:U → U → Type.

Variable comp:∀a b c,hom a b → hom b c → hom a c.

Variable id:∀{a},hom a a.

Hypothesis ID:
 ∀a b (f:hom a b),comp id f = f ∧ comp f id = f.

Definition inv a b (f:hom a b)(g:hom b a):=
 comp f g = id ∧ comp g f = id.

Hypothesis aso:
 ∀a b c d (f:hom a b)(g:hom b c)(h:hom c d),
  comp f (comp g h) = comp (comp f g) h.

Variable a b:U.

Variable f:hom a b.

Variable g1 g2:hom b a.

Goal inv f g1 → inv f g2 → g1 = g2.
Proof.
intros.
red in H,H0.
destruct H,H0.
destruct(ID g1),(ID g2).
clear ID.
rewrite<-H3.
rewrite <-H5.
clear H3 H5 H4 H6.
rewrite<-H1.
repeat rewrite <-aso.
rewrite H H0.
reflexivity.
Qed.

End a.

End e.

Goal ∀(A B C D:Type)(f:A → B)(g:B → C)(h:C → D),
 f\;g\;h = (f\;g)\;h.
Proof.
intros.
cbv.
split.
Qed.

Goal ∀(A B C:Type)(f:A → B)(g:B → C),
 Injective f → Injective g → Injective(f\;g).
Proof.
intros.
red.
intros.
red in H,H0.
cbv in H1.
eapply H.
eapply H0.
auto.
Qed.

Goal ∀(A B C:Type)(f:A → B)(g:B → C),
 Surjective f → Surjective g → Surjective(f\;g).
Proof.
intros.
red.
intro.
red in H,H0.
cbv.
specialize(H0 y).
destruct H0.
destruct(H x).
exists x0.
rewrite H1.
auto.
Qed.

Goal ∀(A B C:Type)(f:A → B)(g:B → C),
 Injective(f\;g) → Injective f.
Proof.
intros.
red.
intros.
red in H.
cbv in H.
apply H.
f_equal.
auto.
Qed.

Goal ∀(A B C:Type)(f:A → B)(g:B → C),
 Surjective(f\;g) → Surjective g.
Proof.
intros.
red.
intros.
red in H.
cbv in H.
destruct(H y).
exists (f x).
auto.
Qed.

Module f.

Section a.

Variable U:Type.

Variable hom:U → U → Type.

Variable comp:∀a b c,hom a b → hom b c → hom a c.

Hypothesis aso:
 ∀a b c d (f:hom a b)(g:hom b c)(h:hom c d),
  comp f (comp g h) = comp (comp f g) h.

Definition mono a b (f:hom a b):=
 ∀c (g h:hom c a),comp g f = comp h f → g = h.

Goal ∀a b c (f:hom a b)(g:hom b c),
 mono f → mono g → mono(comp f g).
Proof.
intros.
red.
intros.
rename g0 into h1,h into h2,c0 into x.
red in H,H0.
specialize(H x h1 h2).
specialize(H0 x (comp h1 f)(comp h2 f)).
apply H.
apply H0.
clear H H0.
congruence.
Qed.

Goal ∀a b c (f:hom a b)(g:hom b c),
 mono(comp f g) → mono f.
Proof.
intros.
red.
intros.
rename g0 into h1,h into h2.
red in H.
specialize(H c0 h1 h2).
apply H.
repeat rewrite aso.
rewrite H0.
split.
Qed.

End a.

End f.

Module i.

Section a.

Variable U:Type.

Variable f :U → U → U.

Definition op (f:U → U → U) a b := f b a.

Definition mono(f:U → U → U) a:=
 ∀b c,f b a = f c a → b = c.

Definition epi(f:U → U → U) a:=
 ∀b c,f a b = f a c → b = c.

Goal mono (op f) = epi f.
Proof.
cbv.
split.
Qed.

End a.

End i.

Module m.

Section a.

Variable U:Type.

Variable R:U → U → Prop.

Definition op(R:U → U → Prop)(a b:U):=R b a.

Definition tran(R:U → U → Prop):=
 ∀a b c,R a b → R b c → R a c.

Goal tran R → tran(op R).
Proof.
intro.
red.
intros.
red.
red in H0,H1.
red in H.
eapply H.
apply H1.
apply H0.
Qed.

End a.

End m.

Module o.

Section a.

Variable U:Type.

Variable e:U.

Variable f:U → U → U.

Definition inv f (a b:U) :=
 f a b = e ∧ f b a = e.

Variable a b:U.

Definition op (f:U → U → U) a b := f b a.

Goal inv f a b → inv (op f) a b.
Proof.
cbv.
intro.
tauto.
Qed.

End a.

End o.

Module p.

Section a.

Variable U:Type.

Variable hom:U → U → Type.

Variable comp:∀a b c,hom a b → hom b c → hom a c.

Variable op:∀a b,hom a b → hom b a.

Definition Op (comp:∀{a b c},hom a b → hom b c → hom a c)
 a b c (f:hom a b) (g:hom b c) := op(comp(op g)(op f)).

Hypothesis H1:∀a b (f:hom a b),op(op f) = f.

Goal ∀a b c (f:hom a b) (g:hom b c),
 Op(Op comp) f g = comp f g.
Proof.
intros.
cbv.
repeat rewrite H1.
split.
Qed.

End a.

End p.

Module q.

Section a.

Variable U:Type.

Variable hom:U → U → Type.

Variable comp:∀a b c,hom a b → hom b c → hom a c.

Variable op:∀a b,hom a b → hom b a.

Definition Op (comp:∀{a b c},hom a b → hom b c → hom a c)
 a b c (f:hom a b) (g:hom b c) := op(comp(op g)(op f)).

Hypothesis H1:∀a b (f:hom a b),op(op f) = f.

Definition aso(comp:∀{a b c},hom a b → hom b c → hom a c):=
 ∀a b c d (f:hom a b)(g:hom b c)(h:hom c d),
  comp f (comp g h) = comp (comp f g) h.

Goal aso comp → aso(Op comp).
Proof.
intro.
red.
intros.
cbv.
repeat rewrite H1.
red in H.
f_equal.
rewrite H.
split.
Qed.

End a.

End q.

Module r.

Section a.

Variable U:Type.

Variable hom:U → U → Type.

Variable comp:∀a b c,hom a b → hom b c → hom a c.

Variable op:∀a b,hom a b → hom b a.

Definition Op (comp:∀{a b c},hom a b → hom b c → hom a c)
 a b c (f:hom a b) (g:hom b c) := op(comp(op g)(op f)).

Hypothesis H1:∀a b (f:hom a b),op(op f) = f.

Goal ∀a b c(f:hom a b)(g:hom b c),
 Op comp(op g)(op f) = op(comp f g).
Proof.
intros.
cbv.
repeat rewrite H1.
split.
Qed.

End a.

End r.

Module s.

Section a.

Definition hom A B (fa:A → A → A) (fb:B → B → B) F :=
 ∀a1 a2,F(fa a1 a2) = fb(F a1)(F a2).

Variable A B C:Type.

Variable fa:A → A → A.

Variable fb:B → B → B.

Variable fc:C → C → C.

Variable F1:A → B.

Variable F2:B → C.

Goal hom fa fb F1 → hom fb fc F2 → hom fa fc (F1\;F2).
Proof.
intros.
red.
intros.
cbv.
red in H,H0.
specialize(H a1 a2).
specialize(H0(F1 a1)(F1 a2)).
rewrite <-H0.
rewrite <- H.
split.
Qed.

End a.

End s.

Module t.

Section a.

Definition unit(U:Type)(f:U → U → U)(e:U):=
 ∀a:U,f e a = a ∧ f a e = a.

Definition hom(A B:Type)(fa:A → A → A)(fb:B → B → B)(F:A → B):=
 ∀e:A,unit fa e → unit fb (F e).

Variable A B C:Type.

Variable fa:A → A → A.

Variable fb:B → B → B.

Variable fc:C → C → C.

Variable F1:A → B.

Variable F2:B → C.

Goal hom fa fb F1 → hom fb fc F2 → hom fa fc (F1\;F2).
Proof.
intros.
red.
intros.
red.
intros.
cbv.
red in H,H0,H1.
cbv in H,H0.
specialize(H e).
specialize(H H1).
specialize(H0 (F1 e)).
specialize(H0 H).
apply H0.
Qed.

End a.

End t.

Module u.

Section a.

Definition left(U1 U2:Type)(f:U1 → U2 → U2)(e:U1):=
 ∀a:U2,f e a = a.

Definition hom(A1 A2 B1 B2:Type)(fa:A1 → A2 → A2)
(fb:B1 → B2 → B2)
 (F:A1 → B1):=
  ∀e:A1,left fa e → left fb (F e).

Variable A1 A2 B1 B2 C1 C2:Type.

Variable fa:A1 → A2 → A2.

Variable fb:B1 → B2 → B2.

Variable fc:C1 → C2 → C2.

Variable F1:A1 → B1.

Variable F2:B1 → C1.

Goal hom fa fb F1 → hom fb fc F2 → hom fa fc (F1\;F2).
Proof.
intros.
red.
intros.
red.
intros.
cbv.
red in H,H0,H1.
cbv in H,H0.
specialize(H e).
specialize(H H1).
specialize(H0 (F1 e)).
specialize(H0 H).
apply H0.
Qed.

End a.

End u.

Goal ∀n:nat,0+n = n.
Proof.
intro.
simpl.
split.
Qed.

Goal ∀n:nat,n+0 = n.
Proof.
intro.
induction n.
simpl.
split.
simpl.
rewrite IHn.
split.
Qed.

Goal ∀n:nat,1*n = n.
Proof.
intro.
simpl.
auto.
Qed.

Goal ∀n:nat,n*1 = n.
Proof.
intro.
induction n.
simpl.
split.
simpl.
rewrite IHn.
split.
Qed.

Goal ∀a b c:nat,a+b+c = a+(b+c).
Proof.
intros.
induction a.
simpl.
split.
simpl.
rewrite IHa.
split.
Qed.

Goal ∀a:bool,false||a = a.
Proof.
intro.
simpl.
split.
Qed.

Goal ∀a:bool,a||false = a.
Proof.
intro.
destruct a.
simpl.
split.
simpl.
split.
Qed.

Module v.

Section a.

Variable U:Type.

Variable R:U → U → Prop.

Hypothesis antsym:∀x y:U,R x y → R y x → x = y.

Definition min(x:U):=∀a:U,R x a.

Variable x1 x2:U.

Goal min x1 → min x2 → x1 = x2.
Proof.
intros.
red in H,H0.
specialize(H x2).
specialize(H0 x1).
specialize(antsym H H0).
apply antsym.
Qed.

End a.

End v.

Module w.

Section a.

Variable U:Type.

Definition op(R:U → U → Prop)(a b:U):=R b a.

Definition min(R:U → U → Prop)(x:U):=
 ∀a:U,R x a.

Definition max(R:U → U → Prop)(x:U):=
 ∀a:U,R a x.

Variable R:U → U → Prop.

Variable x:U.

Goal min R x → max (op R) x.
Proof.
intro.
red.
intro.
red.
red in H.
apply H.
Qed.

End a.

End w.

Module x.

Section a.

Variable U1 U2:Type.

Definition op(R:U1 → U2 → Prop)(a:U2)(b:U1):=R b a.

Definition min(R:U → U → Prop)(x:U):=
 ∀a:U,R x a.

Definition max(R:U → U → Prop)(x:U):=
 ∀a:U,R a x.

Variable R:U → U → Prop.

Variable x:U.

Goal min R x → max (op R) x.
Proof.
intro.
red.
intro.
red.
red in H.
apply H.
Qed.

End a.

End w.