RecordSubSubtyping with Records
Set Warnings "-notation-overridden,-parsing,-deprecated-hint-without-locality".
From Coq Require Import Strings.String.
From PLF Require Import Maps.
From PLF Require Import Smallstep.
Module RecordSub.
From Coq Require Import Strings.String.
From PLF Require Import Maps.
From PLF Require Import Smallstep.
Module RecordSub.
Inductive ty : Type :=
(* proper types *)
| Ty_Top : ty
| Ty_Base : string → ty
| Ty_Arrow : ty → ty → ty
(* record types *)
| Ty_RNil : ty
| Ty_RCons : string → ty → ty → ty.
Inductive tm : Type :=
(* proper terms *)
| tm_var : string → tm
| tm_app : tm → tm → tm
| tm_abs : string → ty → tm → tm
| tm_rproj : tm → string → tm
(* record terms *)
| tm_rnil : tm
| tm_rcons : string → tm → tm → tm.
Declare Custom Entry stlc.
Declare Custom Entry stlc_ty.
Notation "<{ e }>" := e (e custom stlc at level 99).
Notation "<{{ e }}>" := e (e custom stlc_ty at level 99).
Notation "( x )" := x (in custom stlc, x at level 99).
Notation "( x )" := x (in custom stlc_ty, x at level 99).
Notation "x" := x (in custom stlc at level 0, x constr at level 0).
Notation "x" := x (in custom stlc_ty at level 0, x constr at level 0).
Notation "S -> T" := (Ty_Arrow S T) (in custom stlc_ty at level 50, right associativity).
Notation "x y" := (tm_app x y) (in custom stlc at level 1, left associativity).
Notation "\ x : t , y" :=
(tm_abs x t y) (in custom stlc at level 90, x at level 99,
t custom stlc_ty at level 99,
y custom stlc at level 99,
left associativity).
Coercion tm_var : string >-> tm.
Notation "{ x }" := x (in custom stlc at level 1, x constr).
Notation "'Base' x" := (Ty_Base x) (in custom stlc_ty at level 0).
Notation " l ':' t1 '::' t2" := (Ty_RCons l t1 t2) (in custom stlc_ty at level 3, right associativity).
Notation " l := e1 '::' e2" := (tm_rcons l e1 e2) (in custom stlc at level 3, right associativity).
Notation "'nil'" := (Ty_RNil) (in custom stlc_ty).
Notation "'nil'" := (tm_rnil) (in custom stlc).
Notation "o --> l" := (tm_rproj o l) (in custom stlc at level 0).
Notation "'Top'" := (Ty_Top) (in custom stlc_ty at level 0).
(* proper types *)
| Ty_Top : ty
| Ty_Base : string → ty
| Ty_Arrow : ty → ty → ty
(* record types *)
| Ty_RNil : ty
| Ty_RCons : string → ty → ty → ty.
Inductive tm : Type :=
(* proper terms *)
| tm_var : string → tm
| tm_app : tm → tm → tm
| tm_abs : string → ty → tm → tm
| tm_rproj : tm → string → tm
(* record terms *)
| tm_rnil : tm
| tm_rcons : string → tm → tm → tm.
Declare Custom Entry stlc.
Declare Custom Entry stlc_ty.
Notation "<{ e }>" := e (e custom stlc at level 99).
Notation "<{{ e }}>" := e (e custom stlc_ty at level 99).
Notation "( x )" := x (in custom stlc, x at level 99).
Notation "( x )" := x (in custom stlc_ty, x at level 99).
Notation "x" := x (in custom stlc at level 0, x constr at level 0).
Notation "x" := x (in custom stlc_ty at level 0, x constr at level 0).
Notation "S -> T" := (Ty_Arrow S T) (in custom stlc_ty at level 50, right associativity).
Notation "x y" := (tm_app x y) (in custom stlc at level 1, left associativity).
Notation "\ x : t , y" :=
(tm_abs x t y) (in custom stlc at level 90, x at level 99,
t custom stlc_ty at level 99,
y custom stlc at level 99,
left associativity).
Coercion tm_var : string >-> tm.
Notation "{ x }" := x (in custom stlc at level 1, x constr).
Notation "'Base' x" := (Ty_Base x) (in custom stlc_ty at level 0).
Notation " l ':' t1 '::' t2" := (Ty_RCons l t1 t2) (in custom stlc_ty at level 3, right associativity).
Notation " l := e1 '::' e2" := (tm_rcons l e1 e2) (in custom stlc at level 3, right associativity).
Notation "'nil'" := (Ty_RNil) (in custom stlc_ty).
Notation "'nil'" := (tm_rnil) (in custom stlc).
Notation "o --> l" := (tm_rproj o l) (in custom stlc at level 0).
Notation "'Top'" := (Ty_Top) (in custom stlc_ty at level 0).
Well-Formedness
Inductive record_ty : ty → Prop :=
| RTnil :
record_ty <{{ nil }}>
| RTcons : ∀ i T1 T2,
record_ty <{{ i : T1 :: T2 }}>.
Inductive record_tm : tm → Prop :=
| rtnil :
record_tm <{ nil }>
| rtcons : ∀ i t1 t2,
record_tm <{ i := t1 :: t2 }>.
Inductive well_formed_ty : ty → Prop :=
| wfTop :
well_formed_ty <{{ Top }}>
| wfBase : ∀ (i : string),
well_formed_ty <{{ Base i }}>
| wfArrow : ∀ T1 T2,
well_formed_ty T1 →
well_formed_ty T2 →
well_formed_ty <{{ T1 → T2 }}>
| wfRNil :
well_formed_ty <{{ nil }}>
| wfRCons : ∀ i T1 T2,
well_formed_ty T1 →
well_formed_ty T2 →
record_ty T2 →
well_formed_ty <{{ i : T1 :: T2 }}>.
Hint Constructors record_ty record_tm well_formed_ty : core.
| RTnil :
record_ty <{{ nil }}>
| RTcons : ∀ i T1 T2,
record_ty <{{ i : T1 :: T2 }}>.
Inductive record_tm : tm → Prop :=
| rtnil :
record_tm <{ nil }>
| rtcons : ∀ i t1 t2,
record_tm <{ i := t1 :: t2 }>.
Inductive well_formed_ty : ty → Prop :=
| wfTop :
well_formed_ty <{{ Top }}>
| wfBase : ∀ (i : string),
well_formed_ty <{{ Base i }}>
| wfArrow : ∀ T1 T2,
well_formed_ty T1 →
well_formed_ty T2 →
well_formed_ty <{{ T1 → T2 }}>
| wfRNil :
well_formed_ty <{{ nil }}>
| wfRCons : ∀ i T1 T2,
well_formed_ty T1 →
well_formed_ty T2 →
record_ty T2 →
well_formed_ty <{{ i : T1 :: T2 }}>.
Hint Constructors record_ty record_tm well_formed_ty : core.
Reserved Notation "'[' x ':=' s ']' t" (in custom stlc at level 20, x constr).
Fixpoint subst (x : string) (s : tm) (t : tm) : tm :=
match t with
| tm_var y ⇒
if String.eqb x y then s else t
| <{\y:T, t1}> ⇒
if String.eqb x y then t else <{\y:T, [x:=s] t1}>
| <{t1 t2}> ⇒
<{([x:=s] t1) ([x:=s] t2)}>
| <{ t1 --> i }> ⇒
<{ ( [x := s] t1) --> i }>
| <{ nil }> ⇒
<{ nil }>
| <{ i := t1 :: tr }> ⇒
<{ i := [x := s] t1 :: ( [x := s] tr) }>
end
where "'[' x ':=' s ']' t" := (subst x s t) (in custom stlc).
Fixpoint subst (x : string) (s : tm) (t : tm) : tm :=
match t with
| tm_var y ⇒
if String.eqb x y then s else t
| <{\y:T, t1}> ⇒
if String.eqb x y then t else <{\y:T, [x:=s] t1}>
| <{t1 t2}> ⇒
<{([x:=s] t1) ([x:=s] t2)}>
| <{ t1 --> i }> ⇒
<{ ( [x := s] t1) --> i }>
| <{ nil }> ⇒
<{ nil }>
| <{ i := t1 :: tr }> ⇒
<{ i := [x := s] t1 :: ( [x := s] tr) }>
end
where "'[' x ':=' s ']' t" := (subst x s t) (in custom stlc).
Inductive value : tm → Prop :=
| v_abs : ∀ x T2 t1,
value <{ \ x : T2, t1 }>
| v_rnil : value <{ nil }>
| v_rcons : ∀ i v1 vr,
value v1 →
value vr →
value <{ i := v1 :: vr }>.
Hint Constructors value : core.
Fixpoint Tlookup (i:string) (Tr:ty) : option ty :=
match Tr with
| <{{ i' : T :: Tr' }}> ⇒
if String.eqb i i' then Some T else Tlookup i Tr'
| _ ⇒ None
end.
Fixpoint tlookup (i:string) (tr:tm) : option tm :=
match tr with
| <{ i' := t :: tr' }> ⇒
if String.eqb i i' then Some t else tlookup i tr'
| _ ⇒ None
end.
Inductive step : tm → tm → Prop :=
| ST_AppAbs : ∀ x T2 t1 v2,
value v2 →
<{(\x:T2, t1) v2}> --> <{ [x:=v2]t1 }>
| ST_App1 : ∀ t1 t1' t2,
t1 --> t1' →
<{t1 t2}> --> <{t1' t2}>
| ST_App2 : ∀ v1 t2 t2',
value v1 →
t2 --> t2' →
<{v1 t2}> --> <{v1 t2'}>
| ST_Proj1 : ∀ t1 t1' i,
t1 --> t1' →
<{ t1 --> i }> --> <{ t1' --> i }>
| ST_ProjRcd : ∀ tr i vi,
value tr →
tlookup i tr = Some vi →
<{ tr --> i }> --> vi
| ST_Rcd_Head : ∀ i t1 t1' tr2,
t1 --> t1' →
<{ i := t1 :: tr2 }> --> <{ i := t1' :: tr2 }>
| ST_Rcd_Tail : ∀ i v1 tr2 tr2',
value v1 →
tr2 --> tr2' →
<{ i := v1 :: tr2 }> --> <{ i := v1 :: tr2' }>
where "t '-->' t'" := (step t t').
Hint Constructors step : core.
| v_abs : ∀ x T2 t1,
value <{ \ x : T2, t1 }>
| v_rnil : value <{ nil }>
| v_rcons : ∀ i v1 vr,
value v1 →
value vr →
value <{ i := v1 :: vr }>.
Hint Constructors value : core.
Fixpoint Tlookup (i:string) (Tr:ty) : option ty :=
match Tr with
| <{{ i' : T :: Tr' }}> ⇒
if String.eqb i i' then Some T else Tlookup i Tr'
| _ ⇒ None
end.
Fixpoint tlookup (i:string) (tr:tm) : option tm :=
match tr with
| <{ i' := t :: tr' }> ⇒
if String.eqb i i' then Some t else tlookup i tr'
| _ ⇒ None
end.
Inductive step : tm → tm → Prop :=
| ST_AppAbs : ∀ x T2 t1 v2,
value v2 →
<{(\x:T2, t1) v2}> --> <{ [x:=v2]t1 }>
| ST_App1 : ∀ t1 t1' t2,
t1 --> t1' →
<{t1 t2}> --> <{t1' t2}>
| ST_App2 : ∀ v1 t2 t2',
value v1 →
t2 --> t2' →
<{v1 t2}> --> <{v1 t2'}>
| ST_Proj1 : ∀ t1 t1' i,
t1 --> t1' →
<{ t1 --> i }> --> <{ t1' --> i }>
| ST_ProjRcd : ∀ tr i vi,
value tr →
tlookup i tr = Some vi →
<{ tr --> i }> --> vi
| ST_Rcd_Head : ∀ i t1 t1' tr2,
t1 --> t1' →
<{ i := t1 :: tr2 }> --> <{ i := t1' :: tr2 }>
| ST_Rcd_Tail : ∀ i v1 tr2 tr2',
value v1 →
tr2 --> tr2' →
<{ i := v1 :: tr2 }> --> <{ i := v1 :: tr2' }>
where "t '-->' t'" := (step t t').
Hint Constructors step : core.
Subtyping
Definition
Inductive subtype : ty → ty → Prop :=
(* Subtyping between proper types *)
| S_Refl : ∀ T,
well_formed_ty T →
T <: T
| S_Trans : ∀ S U T,
S <: U →
U <: T →
S <: T
| S_Top : ∀ S,
well_formed_ty S →
S <: <{{ Top }}>
| S_Arrow : ∀ S1 S2 T1 T2,
T1 <: S1 →
S2 <: T2 →
<{{ S1 → S2 }}> <: <{{ T1 → T2 }}>
(* Subtyping between record types *)
| S_RcdWidth : ∀ i T1 T2,
well_formed_ty <{{ i : T1 :: T2 }}> →
<{{ i : T1 :: T2 }}> <: <{{ nil }}>
| S_RcdDepth : ∀ i S1 T1 Sr2 Tr2,
S1 <: T1 →
Sr2 <: Tr2 →
record_ty Sr2 →
record_ty Tr2 →
<{{ i : S1 :: Sr2 }}> <: <{{ i : T1 :: Tr2 }}>
| S_RcdPerm : ∀ i1 i2 T1 T2 Tr3,
well_formed_ty <{{ i1 : T1 :: i2 : T2 :: Tr3 }}> →
i1 ≠ i2 →
<{{ i1 : T1 :: i2 : T2 :: Tr3 }}>
<: <{{ i2 : T2 :: i1 : T1 :: Tr3 }}>
where "T '<:' U" := (subtype T U).
Hint Constructors subtype : core.
Module Examples.
Open Scope string_scope.
Notation x := "x".
Notation y := "y".
Notation z := "z".
Notation j := "j".
Notation k := "k".
Notation i := "i".
Notation A := <{{ Base "A" }}>.
Notation B := <{{ Base "B" }}>.
Notation C := <{{ Base "C" }}>.
Definition TRcd_j :=
<{{ j : (B → B) :: nil }}>. (* {j:B->B} *)
Definition TRcd_kj :=
<{{ k : (A → A) :: TRcd_j }}>. (* {k:C->C,j:B->B} *)
Example subtyping_example_0 :
<{{ C → TRcd_kj }}> <: <{{ C → nil }}>.
Proof.
apply S_Arrow.
apply S_Refl. auto.
unfold TRcd_kj, TRcd_j. apply S_RcdWidth; auto.
Qed.
Open Scope string_scope.
Notation x := "x".
Notation y := "y".
Notation z := "z".
Notation j := "j".
Notation k := "k".
Notation i := "i".
Notation A := <{{ Base "A" }}>.
Notation B := <{{ Base "B" }}>.
Notation C := <{{ Base "C" }}>.
Definition TRcd_j :=
<{{ j : (B → B) :: nil }}>. (* {j:B->B} *)
Definition TRcd_kj :=
<{{ k : (A → A) :: TRcd_j }}>. (* {k:C->C,j:B->B} *)
Example subtyping_example_0 :
<{{ C → TRcd_kj }}> <: <{{ C → nil }}>.
Proof.
apply S_Arrow.
apply S_Refl. auto.
unfold TRcd_kj, TRcd_j. apply S_RcdWidth; auto.
Qed.
The following facts are mostly easy to prove in Coq. To get full
benefit, make sure you also understand how to prove them on
paper!
Exercise: 2 stars, standard (subtyping_example_1)
Example subtyping_example_1 :
TRcd_kj <: TRcd_j.
(* {k:A->A,j:B->B} <: {j:B->B} *)
Proof with eauto.
(* FILL IN HERE *) Admitted.
☐
TRcd_kj <: TRcd_j.
(* {k:A->A,j:B->B} <: {j:B->B} *)
Proof with eauto.
(* FILL IN HERE *) Admitted.
☐
Example subtyping_example_2 :
<{{ Top → TRcd_kj }}> <:
<{{ (C → C) → TRcd_j }}>.
Proof with eauto.
(* FILL IN HERE *) Admitted.
☐
<{{ Top → TRcd_kj }}> <:
<{{ (C → C) → TRcd_j }}>.
Proof with eauto.
(* FILL IN HERE *) Admitted.
☐
Example subtyping_example_3 :
<{{ nil → (j : A :: nil) }}> <:
<{{ (k : B :: nil) → nil }}>.
(* {}->{j:A} <: {k:B}->{} *)
Proof with eauto.
(* FILL IN HERE *) Admitted.
☐
<{{ nil → (j : A :: nil) }}> <:
<{{ (k : B :: nil) → nil }}>.
(* {}->{j:A} <: {k:B}->{} *)
Proof with eauto.
(* FILL IN HERE *) Admitted.
☐
Example subtyping_example_4 :
<{{ x : A :: y : B :: z : C :: nil }}> <:
<{{ z : C :: y : B :: x : A :: nil }}>.
Proof with eauto.
(* FILL IN HERE *) Admitted.
☐
<{{ x : A :: y : B :: z : C :: nil }}> <:
<{{ z : C :: y : B :: x : A :: nil }}>.
Proof with eauto.
(* FILL IN HERE *) Admitted.
☐
Properties of Subtyping
Well-Formedness
Lemma subtype__wf : ∀ S T,
subtype S T →
well_formed_ty T ∧ well_formed_ty S.
Lemma wf_rcd_lookup : ∀ i T Ti,
well_formed_ty T →
Tlookup i T = Some Ti →
well_formed_ty Ti.
subtype S T →
well_formed_ty T ∧ well_formed_ty S.
Lemma wf_rcd_lookup : ∀ i T Ti,
well_formed_ty T →
Tlookup i T = Some Ti →
well_formed_ty Ti.
Field Lookup
Lemma rcd_types_match : ∀ S T i Ti,
subtype S T →
Tlookup i T = Some Ti →
∃ Si, Tlookup i S = Some Si ∧ subtype Si Ti.
subtype S T →
Tlookup i T = Some Ti →
∃ Si, Tlookup i S = Some Si ∧ subtype Si Ti.
Exercise: 3 stars, standard (rcd_types_match_informal)
Write a careful informal proof of the rcd_types_match lemma.
(* FILL IN HERE *)
(* Do not modify the following line: *)
Definition manual_grade_for_rcd_types_match_informal : option (nat×string) := None.
☐
(* Do not modify the following line: *)
Definition manual_grade_for_rcd_types_match_informal : option (nat×string) := None.
☐
Lemma sub_inversion_arrow : ∀ U V1 V2,
U <: <{{ V1 → V2 }}> →
∃ U1 U2,
(U= <{{ U1 → U2 }}> ) ∧ (V1 <: U1) ∧ (U2 <: V2).
U <: <{{ V1 → V2 }}> →
∃ U1 U2,
(U= <{{ U1 → U2 }}> ) ∧ (V1 <: U1) ∧ (U2 <: V2).
Definition context := partial_map ty.
Inductive has_type : context → tm → ty → Prop :=
| T_Var : ∀ Gamma (x : string) T,
Gamma x = Some T →
well_formed_ty T →
Gamma |-- x \in T
| T_Abs : ∀ Gamma x T11 T12 t12,
well_formed_ty T11 →
(x ⊢> T11; Gamma) |-- t12 \in T12 →
Gamma |-- (\ x : T11, t12) \in (T11 → T12)
| T_App : ∀ T1 T2 Gamma t1 t2,
Gamma |-- t1 \in (T1 → T2) →
Gamma |-- t2 \in T1 →
Gamma |-- t1 t2 \in T2
| T_Proj : ∀ Gamma i t T Ti,
Gamma |-- t \in T →
Tlookup i T = Some Ti →
Gamma |-- t --> i \in Ti
(* Subsumption *)
| T_Sub : ∀ Gamma t S T,
Gamma |-- t \in S →
subtype S T →
Gamma |-- t \in T
(* Rules for record terms *)
| T_RNil : ∀ Gamma,
Gamma |-- nil \in nil
| T_RCons : ∀ Gamma i t T tr Tr,
Gamma |-- t \in T →
Gamma |-- tr \in Tr →
record_ty Tr →
record_tm tr →
Gamma |-- i := t :: tr \in (i : T :: Tr)
where "Gamma '|--' t '∈' T" := (has_type Gamma t T).
Hint Constructors has_type : core.
Inductive has_type : context → tm → ty → Prop :=
| T_Var : ∀ Gamma (x : string) T,
Gamma x = Some T →
well_formed_ty T →
Gamma |-- x \in T
| T_Abs : ∀ Gamma x T11 T12 t12,
well_formed_ty T11 →
(x ⊢> T11; Gamma) |-- t12 \in T12 →
Gamma |-- (\ x : T11, t12) \in (T11 → T12)
| T_App : ∀ T1 T2 Gamma t1 t2,
Gamma |-- t1 \in (T1 → T2) →
Gamma |-- t2 \in T1 →
Gamma |-- t1 t2 \in T2
| T_Proj : ∀ Gamma i t T Ti,
Gamma |-- t \in T →
Tlookup i T = Some Ti →
Gamma |-- t --> i \in Ti
(* Subsumption *)
| T_Sub : ∀ Gamma t S T,
Gamma |-- t \in S →
subtype S T →
Gamma |-- t \in T
(* Rules for record terms *)
| T_RNil : ∀ Gamma,
Gamma |-- nil \in nil
| T_RCons : ∀ Gamma i t T tr Tr,
Gamma |-- t \in T →
Gamma |-- tr \in Tr →
record_ty Tr →
record_tm tr →
Gamma |-- i := t :: tr \in (i : T :: Tr)
where "Gamma '|--' t '∈' T" := (has_type Gamma t T).
Hint Constructors has_type : core.
Definition trcd_kj :=
<{ k := (\z : A, z) :: j := (\z : B, z) :: nil }>.
Example typing_example_0 :
empty |-- trcd_kj \in TRcd_kj.
(* empty |-- {k=(\z:A.z), j=(\z:B.z)} : {k:A->A,j:B->B} *)
<{ k := (\z : A, z) :: j := (\z : B, z) :: nil }>.
Example typing_example_0 :
empty |-- trcd_kj \in TRcd_kj.
(* empty |-- {k=(\z:A.z), j=(\z:B.z)} : {k:A->A,j:B->B} *)
Example typing_example_1 :
empty |-- (\x : TRcd_j, x --> j) trcd_kj \in (B → B).
(* empty |-- (\x:{k:A->A,j:B->B}, x.j)
{k=(\z:A,z), j=(\z:B,z)}
: B->B *)
empty |-- (\x : TRcd_j, x --> j) trcd_kj \in (B → B).
(* empty |-- (\x:{k:A->A,j:B->B}, x.j)
{k=(\z:A,z), j=(\z:B,z)}
: B->B *)
Example typing_example_2 :
empty |-- (\ z : (C → C) → TRcd_j, (z (\ x : C, x) ) --> j )
( \z : (C → C), trcd_kj ) \in (B → B).
(* empty |-- (\z:(C->C)->{j:B->B}, (z (\x:C,x)).j)
(\z:C->C, {k=(\z:A,z), j=(\z:B,z)})
: B->B *)
End Examples2.
empty |-- (\ z : (C → C) → TRcd_j, (z (\ x : C, x) ) --> j )
( \z : (C → C), trcd_kj ) \in (B → B).
(* empty |-- (\z:(C->C)->{j:B->B}, (z (\x:C,x)).j)
(\z:C->C, {k=(\z:A,z), j=(\z:B,z)})
: B->B *)
End Examples2.
Lemma has_type__wf : ∀ Gamma t T,
has_type Gamma t T → well_formed_ty T.
Lemma step_preserves_record_tm : ∀ tr tr',
record_tm tr →
tr --> tr' →
record_tm tr'.
has_type Gamma t T → well_formed_ty T.
Lemma step_preserves_record_tm : ∀ tr tr',
record_tm tr →
tr --> tr' →
record_tm tr'.
Lemma lookup_field_in_value : ∀ v T i Ti,
value v →
empty |-- v \in T →
Tlookup i T = Some Ti →
∃ vi, tlookup i v = Some vi ∧ empty |-- vi \in Ti.
value v →
empty |-- v \in T →
Tlookup i T = Some Ti →
∃ vi, tlookup i v = Some vi ∧ empty |-- vi \in Ti.
Lemma canonical_forms_of_arrow_types : ∀ Gamma s T1 T2,
Gamma |-- s \in (T1 → T2) →
value s →
∃ x S1 s2,
s = <{ \ x : S1, s2 }>.
Theorem progress : ∀ t T,
empty |-- t \in T →
value t ∨ ∃ t', t --> t'.
Gamma |-- s \in (T1 → T2) →
value s →
∃ x S1 s2,
s = <{ \ x : S1, s2 }>.
Theorem progress : ∀ t T,
empty |-- t \in T →
value t ∨ ∃ t', t --> t'.
Theorem : For any term t and type T, if empty |-- t : T
then t is a value or t --> t' for some term t'.
Proof: Let t and T be given such that empty |-- t : T. We
proceed by induction on the given typing derivation.
- The cases where the last step in the typing derivation is
T_Abs or T_RNil are immediate because abstractions and
{} are always values. The case for T_Var is vacuous
because variables cannot be typed in the empty context.
- If the last step in the typing derivation is by T_App, then
there are terms t1 t2 and types T1 T2 such that t =
t1 t2, T = T2, empty |-- t1 : T1 → T2 and empty |-- t2 :
T1.
- Suppose t1 --> t1' for some term t1'. Then t1 t2 -->
t1' t2 by ST_App1.
- Otherwise t1 is a value.
- Suppose t2 --> t2' for some term t2'. Then t1 t2 -->
t1 t2' by rule ST_App2 because t1 is a value.
- Otherwise, t2 is a value. By Lemma
canonical_forms_for_arrow_types, t1 = \x:S1,s2 for
some x, S1, and s2. But then (\x:S1,s2) t2 -->
[x:=t2]s2 by ST_AppAbs, since t2 is a value.
- Suppose t2 --> t2' for some term t2'. Then t1 t2 -->
t1 t2' by rule ST_App2 because t1 is a value.
- Suppose t1 --> t1' for some term t1'. Then t1 t2 -->
t1' t2 by ST_App1.
- If the last step of the derivation is by T_Proj, then there
are a term tr, a type Tr, and a label i such that t =
tr.i, empty |-- tr : Tr, and Tlookup i Tr = Some T.
- If the final step of the derivation is by T_Sub, then there
is a type S such that S <: T and empty |-- t : S. The
desired result is exactly the induction hypothesis for the
typing subderivation.
- If the final step of the derivation is by T_RCons, then
there exist some terms t1 tr, types T1 Tr and a label
t such that t = {i=t1, tr}, T = {i:T1, Tr}, record_ty
tr, record_tm Tr, empty |-- t1 : T1 and empty |-- tr :
Tr.
- Suppose t1 --> t1' for some term t1'. Then {i=t1, tr}
--> {i=t1', tr} by rule ST_Rcd_Head.
- Otherwise t1 is a value.
- Suppose tr --> tr' for some term tr'. Then {i=t1,
tr} --> {i=t1, tr'} by rule ST_Rcd_Tail, since t1 is
a value.
- Otherwise, tr is also a value. So, {i=t1, tr} is a value by v_rcons.
- Suppose tr --> tr' for some term tr'. Then {i=t1,
tr} --> {i=t1, tr'} by rule ST_Rcd_Tail, since t1 is
a value.
- Suppose t1 --> t1' for some term t1'. Then {i=t1, tr}
--> {i=t1', tr} by rule ST_Rcd_Head.
Lemma typing_inversion_abs : ∀ Gamma x S1 t2 T,
Gamma |-- \ x : S1, t2 \in T →
(∃ S2, <{{ S1 → S2 }}> <: T
∧ (x ⊢> S1; Gamma) |-- t2 \in S2).
Lemma abs_arrow : ∀ x S1 s2 T1 T2,
empty |-- \x : S1, s2 \in (T1 → T2) →
T1 <: S1
∧ (x ⊢> S1) |-- s2 \in T2.
Gamma |-- \ x : S1, t2 \in T →
(∃ S2, <{{ S1 → S2 }}> <: T
∧ (x ⊢> S1; Gamma) |-- t2 \in S2).
Lemma abs_arrow : ∀ x S1 s2 T1 T2,
empty |-- \x : S1, s2 \in (T1 → T2) →
T1 <: S1
∧ (x ⊢> S1) |-- s2 \in T2.
Lemma weakening : ∀ Gamma Gamma' t T,
includedin Gamma Gamma' →
Gamma |-- t \in T →
Gamma' |-- t \in T.
Proof.
intros Gamma Gamma' t T H Ht.
generalize dependent Gamma'.
induction Ht; eauto using includedin_update.
Qed.
Lemma weakening_empty : ∀ Gamma t T,
empty |-- t \in T →
Gamma |-- t \in T.
Proof.
intros Gamma t T.
eapply weakening.
discriminate.
Qed.
includedin Gamma Gamma' →
Gamma |-- t \in T →
Gamma' |-- t \in T.
Proof.
intros Gamma Gamma' t T H Ht.
generalize dependent Gamma'.
induction Ht; eauto using includedin_update.
Qed.
Lemma weakening_empty : ∀ Gamma t T,
empty |-- t \in T →
Gamma |-- t \in T.
Proof.
intros Gamma t T.
eapply weakening.
discriminate.
Qed.
Lemma substitution_preserves_typing : ∀ Gamma x U t v T,
(x ⊢> U ; Gamma) |-- t \in T →
empty |-- v \in U →
Gamma |-- [x:=v]t \in T.
Proof.
Theorem preservation : ∀ t t' T,
empty |-- t \in T →
t --> t' →
empty |-- t' \in T.
(x ⊢> U ; Gamma) |-- t \in T →
empty |-- v \in U →
Gamma |-- [x:=v]t \in T.
Proof.
Theorem preservation : ∀ t t' T,
empty |-- t \in T →
t --> t' →
empty |-- t' \in T.
Theorem: If t, t' are terms and T is a type such that
empty |-- t : T and t --> t', then empty |-- t' : T.
Proof: Let t and T be given such that empty |-- t : T. We go
by induction on the structure of this typing derivation, leaving
t' general. Cases T_Abs and T_RNil are vacuous because
abstractions and {} don't step. Case T_Var is vacuous as well,
since the context is empty.
- If the final step of the derivation is by T_App, then there
are terms t1 t2 and types T1 T2 such that t = t1 t2,
T = T2, empty |-- t1 : T1 → T2 and empty |-- t2 : T1.
- If the final step of the derivation is by T_Proj, then there
is a term tr, type Tr and label i such that t = tr.i,
empty |-- tr : Tr, and Tlookup i Tr = Some T.
- If the final step of the derivation is by T_Sub, then there
is a type S such that S <: T and empty |-- t : S. The
result is immediate by the induction hypothesis for the typing
subderivation and an application of T_Sub.
- If the final step of the derivation is by T_RCons, then there
exist some terms t1 tr, types T1 Tr and a label t such
that t = i:=t1 :: tr}, T = i:T1 :: Tr, record_ty tr,
record_tm Tr, empty |-- t1 : T1 and empty |-- tr : Tr.