Commit 111b9de7 authored by Gaspard Ferey's avatar Gaspard Ferey

WIP

parent 4cb8ff35
......@@ -95,12 +95,7 @@ Notation "Σ ',' t '≡' u" := (SRel t u Σ) (at level 50, t at level 25, u at l
Definition local_context : Set := list term.
Definition context : Set := signature * local_context.
Notation "Σ ',' T" := (cons T Σ) (at level 50, T at level 25).
(*
Notation "Σ ';' Γ" := (pair Σ Γ) (at level 35, Γ at level 25).
*)
Definition pop_context (Γ:local_context) : local_context := List.tl Γ.
......@@ -111,14 +106,14 @@ Fixpoint defined_symb (Σ:signature) : list Var :=
| SRel _ _ Σ => (defined_symb Σ)
end.
Reserved Notation "x ':' A '∈' Σ" (at level 80, A at level 80, Σ at level 80).
Reserved Notation "x ':' A '∈' Σ" (at level 85, A at level 25, Σ at level 50).
Inductive InCtx : signature -> Var -> term -> Prop :=
| INow : forall Σ x A, x : A (Σ, x : A)
| IAfterV : forall Σ A x y B, x : A Σ -> x <> y -> x : A (Σ, y : B)
| IAfterR : forall Σ A x t u, x : A Σ -> x : A (Σ, t u)
where "x ':' A ∈ Σ" := (InCtx Σ x A).
Reserved Notation "t '≡' u '∈' Σ" (at level 80, u at level 80, Σ at level 80).
Reserved Notation "t '≡' u '∈' Σ" (at level 85, u at level 25, Σ at level 50).
Inductive InRelCtx : signature -> term -> term -> Prop :=
| IRNow : forall Σ t u, t u (Σ, t u)
| IRAfterV : forall Σ t u y B, t u Σ -> t u (Σ, y : B)
......@@ -128,8 +123,8 @@ where "t '≡' u ∈ Σ" := (InRelCtx Σ t u).
Definition Defined_var Σ v := exists T, v : T Σ.
Definition Fresh_var Σ v := ~ (Defined_var Σ v).
Notation "x '∈' Σ" := (Defined_var Σ x) (at level 90, Σ at level 90).
Notation "x '∉' Σ" := (Fresh_var Σ x) (at level 90, Σ at level 90).
Notation "x '∈' Σ" := (Defined_var Σ x) (at level 85, Σ at level 50).
Notation "x '∉' Σ" := (Fresh_var Σ x) (at level 85, Σ at level 50).
Theorem defined_eq : forall Σ v, Defined_var Σ v <-> In v (defined_symb Σ).
Proof.
......@@ -152,7 +147,7 @@ Qed.
(* ************ Substitution ************ *)
Reserved Notation "t '▷' u" (at level 70, u at level 25).
Reserved Notation "t '▷' u" (at level 85, u at level 25).
Inductive R_Subterm : term -> term -> Prop :=
| HSubRefl : forall x , x x
| HSubPi1 : forall x A B, A x -> (Π A ~ B) x
......@@ -163,19 +158,74 @@ Inductive R_Subterm : term -> term -> Prop :=
| HSubApp2 : forall x t u, u x -> (t @ u) x
where "t '▷' u" := (R_Subterm t u).
Lemma ST_trans : forall t u v, t u -> u v -> t v.
Proof.
intros. generalize dependent v. induction H; subst; intros.
- easy.
- apply HSubPi1. apply IHR_Subterm. easy.
- apply HSubPi2. apply IHR_Subterm. easy.
- apply HSubAbs1. apply IHR_Subterm. easy.
- apply HSubAbs2. apply IHR_Subterm. easy.
- apply HSubApp1. apply IHR_Subterm. easy.
- apply HSubApp2. apply IHR_Subterm. easy.
Qed.
Definition close (t:term) : Prop := forall u k, t u -> u <> TBound k.
Theorem close_subterm_comp : forall t u, t u -> close t -> close u.
Proof. intros. intro. intros. apply H0. apply (ST_trans _ _ _ H H1). Qed.
Fixpoint shift (k:nat) (t:term) :=
match t with
| TBound n => TBound (n + k)
| TApp l r => TApp (shift k l) (shift k r)
| TAbs ty te => TAbs (shift k ty) (shift (S k) te)
| TPi ty te => TPi (shift k ty) (shift (S k) te)
| _ => t
end.
Theorem close_shift : forall t, close t -> forall k, shift k t = t.
Proof.
intro. intro. induction t; intros; simpl; try easy.
- contradict H. intro. apply (H (? n) n (HSubRefl (? n))). easy.
- erewrite (IHt1 _ _). erewrite (IHt2 _ _). easy.
- erewrite (IHt1 _ _). erewrite (IHt2 _ _). easy.
- erewrite (IHt1 _ _). erewrite (IHt2 _ _). easy.
Unshelve.
eapply (close_subterm_comp _ _ _ H).
eapply (close_subterm_comp _ _ _ H).
eapply (close_subterm_comp _ _ _ H).
eapply (close_subterm_comp _ _ _ H).
eapply (close_subterm_comp _ _ _ H).
eapply (close_subterm_comp _ _ _ H).
Unshelve.
apply HSubPi1 ; apply HSubRefl.
apply HSubPi2 ; apply HSubRefl.
apply HSubAbs1; apply HSubRefl.
apply HSubAbs2; apply HSubRefl.
apply HSubApp1; apply HSubRefl.
apply HSubApp2; apply HSubRefl.
Qed.
Theorem ST_shift_r : forall t u k, close u -> t u -> shift k t u.
Proof.
Admitted.
Theorem ST_shift_l : forall t u k, close u -> shift k t u -> t u.
Proof.
Admitted.
Fixpoint subst_k (t u : term) (k : nat) :=
match t with
| TKind => t
| TType => t
| TSymb _ => t
| TBound i => if Nat.eqb k i then u else t
| TBound i => if Nat.eqb k i then shift k u else t
| TApp l r => TApp (subst_k l u k) (subst_k r u k )
| TAbs ty te => TAbs (subst_k ty u k) (subst_k te u (S k))
| TPi ty te => TPi (subst_k ty u k) (subst_k te u (S k))
| _ => t
end.
Notation "t '[' k '<-' u ']'" := (subst_k t u k) (at level 24).
Definition subst (t u : term) := t [ 0 <- u ].
Notation "t '[' v ']'" := (subst t v) (at level 24).
......@@ -187,7 +237,7 @@ Proof.
- inversion H.
- inversion H; subst. left. easy.
- destruct (k =? n) eqn:H3; subst.
+ right. simpl in H. rewrite H3 in H. easy.
+ right. simpl in H. rewrite H3 in H. eapply ST_shift_l. intro. intros. inversion H0. easy. apply H.
+ simpl in H. rewrite H3 in H. inversion H.
- inversion H; subst.
+ pose proof (IHt1 _ _ _ H3).
......@@ -223,19 +273,17 @@ Qed.
Fixpoint close_k (t : term) (k : nat) (z : Var) : term :=
match t with
| TKind => t
| TType => t
| TBound i => t
| TSymb x => if var_dec x z then TBound k else t
| TApp l r => TApp (close_k l k z) (close_k r k z)
| TAbs ty te => TAbs (close_k ty k z) (close_k te (S k) z)
| TPi ty te => TPi (close_k ty k z) (close_k te (S k) z)
| _ => t
end.
Definition close (t : term) (z : Var) : term := close_k t 0 z.
Definition subst_symb (t : term) (z : Var) : term := close_k t 0 z.
Notation "'λ' x ':' A '~' B" := (TPi A (close B x)) (at level 22, A at level 21, right associativity).
Notation "'Π' x ':' A '=>' B" := (TAbs A (close B x)) (at level 22, A at level 21, right associativity).
Notation "'λ' x ':' A '~' B" := (TPi A (subst_symb B x)) (at level 22, A at level 21, right associativity).
Notation "'Π' x ':' A '=>' B" := (TAbs A (subst_symb B x)) (at level 22, A at level 21, right associativity).
Definition ConvScheme := signature -> term -> term -> Prop.
......@@ -288,17 +336,18 @@ Notation "Σ '⊢' t '≡βΓ' u" := ((RSTClosure RW_Beta_Gamma) Σ t u) (at le
Notation "Σ '⊢' t '≡' u" := (Σ t ≡βΓ u) (at level 40, t at level 25).
Reserved Notation "Σ ';' Γ '⊢' t ':' A" (at level 40, Γ at level 30, t at level 25, A at level 25).
Reserved Notation "Σ 'WF'" (at level 40).
Reserved Notation "Σ '+' Γ ✓" (at level 41).
Reserved Notation "Σ ';' Γ '✓'" (at level 40, Γ at level 30).
Inductive typing : signature -> local_context -> term -> term -> Prop :=
| TyAxiom : forall Σ Γ x A, Σ + Γ -> (x : A Σ) -> (Σ ; Γ (# x) : A)
| TyType : forall Σ Γ, Σ + Γ -> Σ;Γ type : kind
| TyPi : forall Σ Γ A B s,
Σ;Γ A : type -> Σ;(Γ,A) B : s -> Σ;Γ Π A ~ B : s
| TyAbs : forall Σ Γ A B t s,
Σ;Γ A : type -> Σ;(Γ,A) B : s -> Σ;(Γ,A) t : B -> Σ;Γ λ A ~ t : Π A ~ B
| TyAxiom : forall Σ Γ x A, Σ;Γ -> x : A Σ -> Σ;Γ (# x) : A
| TyBoundH : forall Σ Γ A , Σ;Γ,A -> Σ;(Γ,A) (? 0) : A
| TyBoundN : forall Σ Γ n T A, Σ;Γ,A -> Σ ; Γ (? n) : T -> Σ;(Γ,A) (? (S n)) : T
| TyType : forall Σ Γ , Σ;Γ -> Σ;Γ type : kind
| TyPi : forall Σ Γ A B s , Σ;Γ A : type -> Σ;(Γ,A) B : s -> Σ;Γ Π A ~ B : s
| TyAbs : forall Σ Γ A B t s, Σ;Γ A : type -> Σ;(Γ,A) B : s ->
Σ;(Γ,A) t : B -> Σ;Γ λ A ~ t : Π A ~ B
| TyApp : forall Σ Γ t u A B, Σ;Γ t : Π A ~ B -> Σ;Γ u : A -> Σ;Γ t @ u : B [0 <- u]
| TyConv : forall Σ Γ t A B s, Σ;Γ t : A -> Σ;Γ B : s -> (Σ A B) -> Σ;Γ t : B
| TyConv : forall Σ Γ t A B s, Σ;Γ t : A -> Σ;Γ B : s -> Σ A B -> Σ;Γ t : B
where "Σ ';' Γ '⊢' t ':' A" := (typing Σ Γ t A)
with well_formed : signature -> Prop :=
| WFEmpty : [ ] WF
......@@ -307,6 +356,6 @@ with well_formed : signature -> Prop :=
| WFRel : forall Σ A s t u, Σ;nil A : s -> Σ;nil t : A -> Σ;nil u : A -> Σ WF -> Σ, t u WF
where "Σ 'WF'" := (well_formed Σ)
with cwell_formed : signature -> local_context -> Prop :=
| CWFEmpty : forall Σ, Σ WF -> Σ + nil
| CWFLVar : forall Σ Γ A, Σ;Γ A : type -> Σ + Γ -> Σ + (Γ,A)
where "Σ '+' Γ ✓" := (cwell_formed Σ Γ).
| CWFEmpty : forall Σ, Σ WF -> Σ;nil
| CWFLVar : forall Σ Γ A, Σ;Γ A : type -> Σ;Γ -> Σ;Γ,A
where "Σ ';' Γ '✓'" := (cwell_formed Σ Γ).
......@@ -10,11 +10,11 @@ Proof.
induction H; inversion HeqΣ2; subst; easy.
Qed.
Lemma context_WF : forall Σ Γ, Σ + Γ -> Σ WF.
Lemma context_WF : forall Σ Γ, Σ;Γ -> Σ WF.
Proof. intros. induction H; easy. Qed.
Lemma loccontext_WF : forall Σ Γ t u, Σ;Γ t : u -> Σ + Γ .
Lemma loccontext_WF : forall Σ Γ t u, Σ;Γ t : u -> Σ;Γ .
Proof. intros. induction H; easy. Qed.
Lemma types_WF : forall Σ Γ t u, Σ;Γ t : u -> Σ WF.
......@@ -58,6 +58,8 @@ Proof.
induction H0; intros.
- inversion H; subst. repeat eexists. econstructor. apply H0. apply H1.
- inversion H; subst. repeat eexists. econstructor. apply H0.
- inversion H; subst. repeat eexists. econstructor. apply H0. apply H1.
- inversion H; subst. repeat eexists. econstructor. apply H0.
- inversion H; subst.
+ repeat eexists. econstructor. apply H0_. apply H0_0.
+ apply IHtyping1. easy.
......@@ -197,12 +199,14 @@ Proof.
apply weak_comp_hΓ.
Qed.
Theorem weak_typ_ : forall Σ Σ' Γ t u, Σ;Γ t : u -> Σ Σ' -> Σ' WF -> Σ' + Γ -> Σ';Γ t : u.
Theorem weak_typ_ : forall Σ Σ' Γ t u, Σ;Γ t : u -> Σ Σ' -> Σ' WF -> Σ';Γ -> Σ';Γ t : u.
Proof.
intros.
generalize dependent Σ'.
induction H; intros.
- apply TyAxiom. easy. eapply subset_var_decl. apply H1. easy.
- apply TyBoundH. easy.
- apply TyBoundN. easy. apply IHtyping. easy. easy. inversion H3; subst; easy.
- apply TyType. easy.
- eapply TyPi.
+ apply IHtyping1. easy. easy. easy.
......@@ -220,7 +224,7 @@ Proof.
+ eapply weak_conv. apply H1. easy. easy.
Qed.
Theorem weak_checked : forall Σ Σ' Γ, Σ + Γ -> Σ Σ' -> Σ' WF -> Σ' + Γ .
Theorem weak_checked : forall Σ Σ' Γ, Σ;Γ -> Σ Σ' -> Σ' WF -> Σ';Γ .
Proof.
intros.
induction Γ.
......@@ -243,10 +247,10 @@ Proof.
repeat eexists. eapply weak_typ. apply H3. easy. easy.
Qed.
Theorem checked_WF : forall Σ Γ, Σ + Γ -> Σ WF.
Theorem checked_WF : forall Σ Γ, Σ;Γ -> Σ WF.
Proof. intros. induction Γ; inversion H; subst; try apply IHΓ; try easy. Qed.
Lemma vd_context_typ : forall Σ Γ t u, Σ; Γ t : u -> forall x A, (Σ, x : A) + Γ -> (Σ, x : A);Γ t : u.
Lemma vd_context_typ : forall Σ Γ t u, Σ; Γ t : u -> forall x A, (Σ, x : A);Γ -> (Σ, x : A);Γ t : u.
Proof.
intros.
eapply weak_typ.
......@@ -256,10 +260,10 @@ Proof.
- eapply checked_WF. apply H0.
Qed.
Lemma loc_context_cheked : forall Σ Γ A, Σ + (Γ, A) -> Σ + Γ .
Lemma loc_context_checked : forall Σ Γ A, Σ;(Γ, A) -> Σ;Γ .
Proof. intros. inversion H; subst. easy. Qed.
Lemma vd_context_WF : forall Σ Γ x A, Σ + Γ -> (Σ, x : A) WF -> (Σ, x : A) + Γ .
Lemma vd_context_WF : forall Σ Γ x A, Σ;Γ -> (Σ, x : A) WF -> (Σ, x : A);Γ .
Proof.
intros.
eapply weak_checked. apply H. econstructor. inversion H0; subst; easy. easy.
......@@ -343,25 +347,34 @@ Qed.
Definition inhabitable (Σ:signature) (T:term) : Prop := exists Γ t, Σ;Γ t : T.
Lemma bound_var_nontypable : forall Σ n T, ~ Σ;nil (? n) : T.
Proof.
Admitted.
Lemma abs_equiv : forall Σ Γ a A b B, Σ;Γ a : A -> Σ;(Γ,A) b : B -> Σ;Γ b[0 <- a] : B.
Proof.
intros.
generalize dependent H.
remember (Γ, A) as Γ'.
pose proof (ex_intro (fun x => Γ'=Γ,x) A HeqΓ').
generalize dependent HeqΓ'.
generalize dependent Γ.
induction H0; intros; simpl; subst.
- econstructor. exact (loc_context_cheked _ _ _ H). easy.
- econstructor. exact (loc_context_cheked _ _ _ H).
- econstructor.
+ apply IHtyping1. easy. easy.
generalize dependent a.
generalize dependent A.
induction H0; intros.
- simpl. subst. econstructor. exact (loc_context_checked _ _ _ H). easy.
- inversion HeqΓ'; subst. easy.
- inversion HeqΓ'; subst. induction Γ0; subst.
+ contradict H0. apply bound_var_nontypable.
+ eapply TyBoundN.
* eapply loccontext_WF. apply H2.
* apply IHtyping1. easy. easy.
Admitted.
Theorem FV_decl_u : forall Σ u, inhabitable Σ u -> (u = kind \/ typable Σ u).
Proof.
intros. do 2 destruct H.
induction H.
- right. eapply vardecl_typable2. eapply weak_WF. apply H. apply H0.
- right. eapply vardecl_typable2. eapply checked_WF. apply H. apply H0.
- left. easy.
- exact IHtyping2.
- right. repeat eexists. econstructor. apply H. apply H0.
......
(** Start to implement lambda pi modulo with pretty printing.
TODO:
- Have a better pretty printing for binders
- no substitution
- Try a localy nameless representation, but not implemented
*)
Require Import PeanoNat.
Require Import List.
......@@ -35,6 +29,29 @@ Definition type : term := TType.
Definition kind : term := TKind.
Reserved Notation "t '▷' u" (at level 70, u at level 25).
Inductive R_Subterm : term -> term -> Prop :=
| HSubRefl : forall x , x x
| HSubPi1 : forall x A B, A x -> (Π A ~ B) x
| HSubPi2 : forall x A B, B x -> (Π A ~ B) x
| HSubAbs1 : forall x A t, A x -> (λ A ~ t) x
| HSubAbs2 : forall x A t, t x -> (λ A ~ t) x
| HSubApp1 : forall x t u, t x -> (t @ u) x
| HSubApp2 : forall x t u, u x -> (t @ u) x
where "t '▷' u" := (R_Subterm t u).
Lemma ST_trans : forall t u v, t u -> u v -> t v.
Proof.
intros. generalize dependent v. induction H; subst; intros.
- easy.
- apply HSubPi1. apply IHR_Subterm. easy.
- apply HSubPi2. apply IHR_Subterm. easy.
- apply HSubAbs1. apply IHR_Subterm. easy.
- apply HSubAbs2. apply IHR_Subterm. easy.
- apply HSubApp1. apply IHR_Subterm. easy.
- apply HSubApp2. apply IHR_Subterm. easy.
Qed.
(* ************ Free variables ************ *)
Fixpoint FV (t:term) : list Var :=
......@@ -48,45 +65,59 @@ Fixpoint FV (t:term) : list Var :=
| TApp t u => (FV t) ++ (FV u)
end.
Definition FV_free (t:term) := forall x, ~ t #x.
Fixpoint free_var_free (t:term) := match t with
| TKind => True
| TType => True
| TFree v => False
| TBound _ => True
| TPi A B => (free_var_free A) /\ (free_var_free B)
| TAbs A B => (free_var_free A) /\ (free_var_free B)
| TApp t u => (free_var_free t) /\ (free_var_free u)
end.
Lemma FV_free_st : forall t u, t u -> FV_free t -> FV_free u.
Proof. intros. intro. intro. exact (H0 _ (ST_trans _ _ _ H H1)). Qed.
Theorem closed_FV : forall t, (free_var_free t) <-> (FV t) = nil.
Theorem FV_are_subterms : forall t v, In v (FV t) <-> (t #v).
Proof.
intro. split ; intros.
- induction t ; intros ; try easy.
+ destruct H. simpl.
assert (FV t1 = nil); auto.
assert (FV t2 = nil); auto.
rewrite H1. rewrite H2. easy.
+ destruct H. simpl.
assert (FV t1 = nil); auto.
assert (FV t2 = nil); auto.
rewrite H1. rewrite H2. easy.
+ destruct H. simpl.
assert (FV t1 = nil); auto.
assert (FV t2 = nil); auto.
rewrite H1. rewrite H2. easy.
- induction t ; try easy.
+ econstructor.
* apply IHt1. apply (proj1 (app_eq_nil (FV t1) (FV t2) H)).
* apply IHt2. apply (proj2 (app_eq_nil (FV t1) (FV t2) H)).
+ econstructor.
* apply IHt1. apply (proj1 (app_eq_nil (FV t1) (FV t2) H)).
* apply IHt2. apply (proj2 (app_eq_nil (FV t1) (FV t2) H)).
+ econstructor.
* apply IHt1. apply (proj1 (app_eq_nil (FV t1) (FV t2) H)).
* apply IHt2. apply (proj2 (app_eq_nil (FV t1) (FV t2) H)).
- induction t; try easy.
+ destruct H; subst.
* constructor.
* destruct H.
+ cbn in H. destruct (in_app_or _ _ _ H).
* apply HSubPi1. apply IHt1. easy.
* apply HSubPi2. apply IHt2. easy.
+ cbn in H. destruct (in_app_or _ _ _ H).
* apply HSubAbs1. apply IHt1. easy.
* apply HSubAbs2. apply IHt2. easy.
+ cbn in H. destruct (in_app_or _ _ _ H).
* apply HSubApp1. apply IHt1. easy.
* apply HSubApp2. apply IHt2. easy.
- induction t; try easy.
+ inversion H; subst. left. easy.
+ simpl. apply in_or_app. inversion H; subst.
* left; apply IHt1; easy.
* right; apply IHt2; easy.
+ simpl. apply in_or_app. inversion H; subst.
* left; apply IHt1; easy.
* right; apply IHt2; easy.
+ simpl. apply in_or_app. inversion H; subst.
* left; apply IHt1; easy.
* right; apply IHt2; easy.
Qed.
Theorem closed_FV : forall t, (FV_free t) <-> (FV t) = nil.
Proof.
intro. split ; intros.
- induction t ; intros ; try easy.
+ pose proof (H v). contradiction H0. constructor.
+ epose proof (FV_free_st _ t1 _ H).
epose proof (FV_free_st _ t2 _ H).
simpl. rewrite (IHt1 H0). rewrite (IHt2 H1). easy.
+ epose proof (FV_free_st _ t1 _ H).
epose proof (FV_free_st _ t2 _ H).
simpl. rewrite (IHt1 H0). rewrite (IHt2 H1). easy.
+ epose proof (FV_free_st _ t1 _ H).
epose proof (FV_free_st _ t2 _ H).
simpl. rewrite (IHt1 H0). rewrite (IHt2 H1). easy.
- intro. intro.
destruct (FV_are_subterms t x).
pose proof (H2 H0).
rewrite -> H in H3. inversion H3.
Admitted.
......@@ -156,6 +187,7 @@ Qed.
(* ************ Locally nameless representation ************ *)
Fixpoint open_k (t u : term) (k : nat) :=
match t with
| TKind => t
......@@ -170,37 +202,40 @@ Notation "t '[' k '<-' u ']'" := (open_k t u k) (at level 24).
Definition open (t u : term) := t [ 0 <- u ].
Theorem open_k_FV : forall t u x k, In x (FV (open_k t u k)) -> In x (FV t) \/ In x (FV u).
Theorem open_k_FV : forall t u x k, open_k t u k #x -> t #x \/ u #x.
Proof.
intro. intro. intro. induction t.
- intros. contradict H.
- intros. contradict H.
- intros. destruct H. rewrite H. left. left. easy. contradict H.
- intros. destruct (Nat.eq_dec k n); subst.
intro. induction t; intros.
- inversion H.
- inversion H.
- inversion H; subst. left. constructor.
- destruct (Nat.eq_dec k n); subst.
+ right. assert ((n =? n) = true).
eapply Nat.eqb_eq ; easy.
cbn in H. rewrite H0 in H. easy.
+ cbn in H. assert (~ (k =? n) = true).
* intro. apply n0. eapply Nat.eqb_eq. easy.
* pose proof (Bool.not_true_is_false (k =? n) H0). cbn in H. rewrite H1 in H. left. easy.
- intros. simpl.
pose proof (in_app_or (FV (t1 [k <- u])) (FV (t2 [S k <- u])) x H). destruct H0.
+ simpl. pose proof (IHt1 k H0). destruct H1.
left. apply in_or_app. left. easy. right. easy.
+ simpl. pose proof (IHt2 (S k) H0). destruct H1.
left. apply in_or_app. right. easy. right. easy.
- intros. simpl. cbn in H.
pose proof (in_app_or (FV (t1 [k <- u])) (FV (t2 [S k <- u])) x H). destruct H0.
+ simpl. pose proof (IHt1 k H0). destruct H1.
left. apply in_or_app. left. easy. right. easy.
+ simpl. pose proof (IHt2 (S k) H0). destruct H1.
left. apply in_or_app. right. easy. right. easy.
- intros. simpl. cbn in H.
pose proof (in_app_or (FV (t1 [k <- u])) (FV (t2 [k <- u])) x H). destruct H0.
+ simpl. pose proof (IHt1 k H0). destruct H1.
left. apply in_or_app. left. easy. right. easy.
+ simpl. pose proof (IHt2 k H0). destruct H1.
left. apply in_or_app. right. easy. right. easy.
- inversion H; subst.
+ destruct (IHt1 _ _ _ H3).
* left. apply HSubPi1. easy.
* right. easy.
+ destruct (IHt2 _ _ _ H3).
* left. apply HSubPi2. easy.
* right. easy.
- inversion H; subst.
+ destruct (IHt1 _ _ _ H3).
* left. apply HSubAbs1. easy.
* right. easy.
+ destruct (IHt2 _ _ _ H3).
* left. apply HSubAbs2. easy.
* right. easy.
- inversion H; subst.
+ destruct (IHt1 _ _ _ H3).
* left. apply HSubApp1. easy.
* right. easy.
+ destruct (IHt2 _ _ _ H3).
* left. apply HSubApp2. easy.
* right. easy.
Qed.
......@@ -208,12 +243,11 @@ Qed.
Definition open_v (t : term) (v : Var) := t [0 <- # v].
Notation "t '[' v ']'" := (open_v t v) (at level 24).
Theorem open_FV : forall t v x, In x (FV (open_v t v)) -> x = v \/ In x (FV t).
Theorem open_FV : forall t v x, t[v] #x -> x = v \/ t #x.
Proof.
intros. cbn in H.
destruct (open_k_FV t (# v) x 0 H).
intros. destruct (open_k_FV t (# v) x 0 H).
+ right. easy.
+ left. destruct H0 ; easy.
+ left. inversion H0. easy.
Qed.
......@@ -319,4 +353,3 @@ with well_formed : context -> Prop :=
| WFVarK : forall Γ x A, x Γ -> Γ A : kind -> Γ, x : A
| WFRel : forall Γ A s t u, Γ A : s -> Γ t : A -> Γ u : A -> Γ -> Γ, t u
where "Γ ✓" := (well_formed Γ).
......@@ -4,6 +4,10 @@ Require Import List.
Require Import LPTerm.
Definition typable (Γ:context) (t:term) : Prop := exists T, Γ t : T.
Definition inhabitable (Γ:context) (T:term) : Prop := exists t, Γ t : T.
Lemma types_WF : forall Γ t u, Γ t : u -> Γ .
Proof. intros. induction H; easy. Qed.
......@@ -41,6 +45,42 @@ Qed.
Theorem lemma_open_FV : forall x B t, In x (FV B) -> In x (FV (B[t])).
Proof. intros. exact (lemma_open_k_FV x B (# t) H 0). Qed.
Theorem lemma_open_k_FV2 : forall x B t k, In x (FV (B[k <- t])) -> In x (FV B) \/ In x (FV t).
Proof.
intros.
generalize dependent k.
induction B; intros; try inversion H.
- left. left. easy.
- inversion H0.
- cbn in H. destruct (k =? n); subst; try (right; easy); try (left; easy).
- cbn in H. destruct (in_app_or _ _ _ H).
+ destruct (IHB1 _ H0).
* left. simpl. apply in_or_app. left. easy.
* right. easy.
+ destruct (IHB2 _ H0).
* left. simpl. apply in_or_app. right. easy.
* right. easy.
- cbn in H. destruct (in_app_or _ _ _ H).
+ destruct (IHB1 _ H0).
* left. simpl. apply in_or_app. left. easy.
* right. easy.
+ destruct (IHB2 _ H0).
* left. simpl. apply in_or_app. right. easy.
* right. easy.
- cbn in H. destruct (in_app_or _ _ _ H).
+ destruct (IHB1 _ H0).
* left. simpl. apply in_or_app. left. easy.
* right. easy.
+ destruct (IHB2 _ H0).
* left. simpl. apply in_or_app. right. easy.
* right. easy.
Qed.
Theorem lemma_open_FV2 : forall x B t, In x (FV (B[t])) -> In x (FV B) \/ x = t.
Proof.
intros. pose proof (lemma_open_k_FV2 x B (# t) 0 H). destruct H0; [left|right]; try destruct H0; easy.
Qed.
Theorem FV_decl_t : forall Γ t u, Γ t : u -> forall v, In v (FV t) -> v Γ.
Proof.
intros.
......@@ -186,6 +226,7 @@ Proof.
apply weak_comp_hΓ.
Qed.
Theorem weak_typ : forall Γ Γ' t u, Γ t : u -> Γ Γ' -> Γ' -> Γ' t : u.
Proof.
intros.
......@@ -228,6 +269,26 @@ Proof.
+ eapply weak_conv. apply H1. easy. easy.
Qed.
Theorem weak_typable : forall Γ Γ' t, Γ' -> Γ Γ' -> typable Γ t -> typable Γ' t.
Proof.
intros. destruct H1.
eexists. eapply weak_typ.
apply H1. easy. easy.
Qed.
Lemma vardecl_typable : forall Γ x A, Γ -> x : A Γ -> typable Γ A.
Proof.
intros.
induction H0.
- inversion H; subst.
+ eapply weak_typable. easy. apply WeakVarDecl. easy. eexists. apply H4.
+ eapply weak_typable. easy. apply WeakVarDecl. easy. eexists. apply H4.
- eapply weak_typable. easy. apply WeakVarDecl. inversion H. easy. easy.
apply IHInCtx. eapply vardecl_WF. apply H.
- eapply weak_typable. easy. apply WeakRulDecl.
apply IHInCtx. eapply ruldecl_WF. apply H.
Qed.
Theorem not_in_not_eq {A:Type} : forall (x v : A) l, ~ (In x (v::l)) -> x <> v.
Proof. intros. intro. apply H. now left. Qed.
......@@ -295,6 +356,124 @@ Proof.
* right. easy.
Qed.
Theorem perm_FV_WF : forall Γ x A y B, ~(In x (FV B)) -> (Γ, x : A, y : B) -> (Γ, y : B, x : A) .
Proof.
intros.
inversion H0; subst.
-
Admitted.
Theorem perm_FV_typ : forall Γ x A y B t T, ~(In x (FV B)) -> (Γ, x : A, y : B) t : T -> (Γ, y : B, x : A) t : T.
Proof.
intros.
remember (Γ, x : A, y : B) as Γ1.
generalize dependent H.
induction H0; intros; inversion HeqΓ1; subst.
- econstructor.
Admitted.
Inductive extra_var : context -> context -> Var -> Prop :=
| EVNow : forall Γ x A, x Γ -> extra_var Γ (Γ, x : A) x
| EVNextVD : forall Γ Γ' x y B, extra_var Γ Γ' x -> extra_var (Γ, y : B) (Γ', y : B) x
| EVNextRD : forall Γ Γ' x t u, extra_var Γ Γ' x -> extra_var (Γ, t u) (Γ', t u) x.
Theorem EV_imp_weaker : forall Γ Γ' x, extra_var Γ Γ' x -> Γ Γ'.
Proof. intros. induction H; subst; econstructor; easy. Qed.
Lemma EV_equiv : forall Γ Γ' x, extra_var Γ Γ' x -> forall y B, y : B Γ' -> (y : B Γ) \/ y = x.
Proof.
intros.
induction H.
- inversion H0; inversion H1; subst; try (right; easy); try (left; easy).
- inversion H0; subst.
+ left. econstructor.
+ destruct (IHextra_var H6).
* left. econstructor. easy. easy.