Library Records
Adding Records
t ::= Terms: | ... | {i1=t1, ..., in=tn} record | t.i projection v ::= Values: | ... | {i1=v1, ..., in=vn} record value T ::= Types: | ... | {i1:T1, ..., in:Tn} record typeReduction: ti ==> ti' (ST_Rcd)
{i1=v1, ..., im=vm, in=tn, ...} ==> {i1=v1, ..., im=vm, in=tn', ...}
(ST_Proj1) t1.i ==> t1'.i
(ST_ProjRcd) {..., i=vi, ...}.i ==> vi Typing: Gamma |- t1 : T1 ... Gamma |- tn : Tn
(T_Rcd) Gamma |- {i1=t1, ..., in=tn} : {i1:T1, ..., in:Tn}
(T_Proj) Gamma |- t.i : Ti
Syntax and Operational Semantics
Module FirstTry.
Definition alist (X : Type) := list (id × X).
Inductive ty : Type :=
| TBase : id → ty
| TArrow : ty → ty → ty
| TRcd : (alist ty) → ty.
Unfortunately, we encounter here a limitation in Coq: this type
does not automatically give us the induction principle we expect
the induction hypothesis in the TRcd case doesn't give us
any information about the ty elements of the list, making it
useless for the proofs we want to do.
It is possible to get a better induction principle out of Coq, but
the details of how this is done are not very pretty, and it is not
as intuitive to use as the ones Coq generates automatically for
simple Inductive definitions.
Fortunately, there is a different way of formalizing records that
is, in some ways, even simpler and more natural: instead of using
the existing list type, we can essentially include its
constructors ("nil" and "cons") in the syntax of types.
Inductive ty : Type :=
| TBase : id → ty
| TArrow : ty → ty → ty
| TRNil : ty
| TRCons : id → ty → ty → ty.
Tactic Notation "T_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "TBase" | Case_aux c "TArrow"
| Case_aux c "TRNil" | Case_aux c "TRCons" ].
Similarly, at the level of terms, we have constructors trnil
the empty record -- and trcons, which adds a single field to
the front of a list of fields.
Inductive tm : Type :=
| tvar : id → tm
| tapp : tm → tm → tm
| tabs : id → ty → tm → tm
| tproj : tm → id → tm
| trnil : tm
| trcons : id → tm → tm → tm.
Tactic Notation "t_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "tvar" | Case_aux c "tapp" | Case_aux c "tabs"
| Case_aux c "tproj" | Case_aux c "trnil" | Case_aux c "trcons" ].
Some variables, for examples...
Notation a := (Id 0).
Notation f := (Id 1).
Notation g := (Id 2).
Notation l := (Id 3).
Notation A := (TBase (Id 4)).
Notation B := (TBase (Id 5)).
Notation k := (Id 6).
Notation i1 := (Id 7).
Notation i2 := (Id 8).
Well-Formedness
where the "tail" of a record type is not actually a record type!
We'll structure our typing judgement so that no ill-formed types
like weird_type are assigned to terms. To support this, we
define record_ty and record_tm, which identify record types
and terms, and well_formed_ty which rules out the ill-formed
types.
First, a type is a record type if it is built with just TRNil
and TRCons at the outermost level.
Inductive record_ty : ty → Prop :=
| RTnil :
record_ty TRNil
| RTcons : ∀ i T1 T2,
record_ty (TRCons i T1 T2).
Inductive record_tm : tm → Prop :=
| rtnil :
record_tm trnil
| rtcons : ∀ i t1 t2,
record_tm (trcons i t1 t2).
Note that record_ty and record_tm are not recursive -- they
just check the outermost constructor. The well_formed_ty
property, on the other hand, verifies that the whole type is well
formed in the sense that the tail of every record (the second
argument to TRCons) is a record.
Of course, we should also be concerned about ill-formed terms, not
just types; but typechecking can rules those out without the help
of an extra well_formed_tm definition because it already
examines the structure of terms. LATER : should they fill in part of this as an exercise? We
didn't give rules for it above
Inductive well_formed_ty : ty → Prop :=
| wfTBase : ∀ i,
well_formed_ty (TBase i)
| wfTArrow : ∀ T1 T2,
well_formed_ty T1 →
well_formed_ty T2 →
well_formed_ty (TArrow T1 T2)
| wfTRNil :
well_formed_ty TRNil
| wfTRCons : ∀ i T1 T2,
well_formed_ty T1 →
well_formed_ty T2 →
record_ty T2 →
well_formed_ty (TRCons i T1 T2).
Hint Constructors record_ty record_tm well_formed_ty.
Fixpoint subst (x:id) (s:tm) (t:tm) : tm :=
match t with
| tvar y ⇒ if eq_id_dec x y then s else t
| tabs y T t1 ⇒ tabs y T (if eq_id_dec x y then t1 else (subst x s t1))
| tapp t1 t2 ⇒ tapp (subst x s t1) (subst x s t2)
| tproj t1 i ⇒ tproj (subst x s t1) i
| trnil ⇒ trnil
| trcons i t1 tr1 ⇒ trcons i (subst x s t1) (subst x s tr1)
end.
Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20).
Inductive value : tm → Prop :=
| v_abs : ∀ x T11 t12,
value (tabs x T11 t12)
| v_rnil : value trnil
| v_rcons : ∀ i v1 vr,
value v1 →
value vr →
value (trcons i v1 vr).
Hint Constructors value.
Utility functions for extracting one field from record type or
term:
Fixpoint Tlookup (i:id) (Tr:ty) : option ty :=
match Tr with
| TRCons i' T Tr' ⇒ if eq_id_dec i i' then Some T else Tlookup i Tr'
| _ ⇒ None
end.
Fixpoint tlookup (i:id) (tr:tm) : option tm :=
match tr with
| trcons i' t tr' ⇒ if eq_id_dec i i' then Some t else tlookup i tr'
| _ ⇒ None
end.
The step function uses the term-level lookup function (for the
projection rule), while the type-level lookup is needed for
has_type.
Reserved Notation "t1 '==>' t2" (at level 40).
Inductive step : tm → tm → Prop :=
| ST_AppAbs : ∀ x T11 t12 v2,
value v2 →
(tapp (tabs x T11 t12) v2) ==> ([x:=v2]t12)
| ST_App1 : ∀ t1 t1' t2,
t1 ==> t1' →
(tapp t1 t2) ==> (tapp t1' t2)
| ST_App2 : ∀ v1 t2 t2',
value v1 →
t2 ==> t2' →
(tapp v1 t2) ==> (tapp v1 t2')
| ST_Proj1 : ∀ t1 t1' i,
t1 ==> t1' →
(tproj t1 i) ==> (tproj t1' i)
| ST_ProjRcd : ∀ tr i vi,
value tr →
tlookup i tr = Some vi →
(tproj tr i) ==> vi
| ST_Rcd_Head : ∀ i t1 t1' tr2,
t1 ==> t1' →
(trcons i t1 tr2) ==> (trcons i t1' tr2)
| ST_Rcd_Tail : ∀ i v1 tr2 tr2',
value v1 →
tr2 ==> tr2' →
(trcons i v1 tr2) ==> (trcons i v1 tr2')
where "t1 '==>' t2" := (step t1 t2).
Tactic Notation "step_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1" | Case_aux c "ST_App2"
| Case_aux c "ST_Proj1" | Case_aux c "ST_ProjRcd"
| Case_aux c "ST_Rcd_Head" | Case_aux c "ST_Rcd_Tail" ].
Notation multistep := (multi step).
Notation "t1 '==>*' t2" := (multistep t1 t2) (at level 40).
Hint Constructors step.
Next we define the typing rules. These are nearly direct
transcriptions of the inference rules shown above. The only major
difference is the use of well_formed_ty. In the informal
presentation we used a grammar that only allowed well formed
record types, so we didn't have to add a separate check.
We'd like to set things up so that that whenever has_type Gamma t
T holds, we also have well_formed_ty T. That is, has_type
never assigns ill-formed types to terms. In fact, we prove this
theorem below.
However, we don't want to clutter the definition of has_type
with unnecessary uses of well_formed_ty. Instead, we place
well_formed_ty checks only where needed - where an inductive
call to has_type won't already be checking the well-formedness
of a type.
For example, we check well_formed_ty T in the T_Var case,
because there is no inductive has_type call that would
enforce this. Similarly, in the T_Abs case, we require a
proof of well_formed_ty T11 because the inductive call to
has_type only guarantees that T12 is well-formed.
In the rules you must write, the only necessary well_formed_ty
check comes in the tnil case.
Reserved Notation "Gamma '|-' t '\in' T" (at level 40).
Inductive has_type : context → tm → ty → Prop :=
| T_Var : ∀ Gamma x T,
Gamma x = Some T →
well_formed_ty T →
Gamma |- (tvar x) \in T
| T_Abs : ∀ Gamma x T11 T12 t12,
well_formed_ty T11 →
(extend Gamma x T11) |- t12 \in T12 →
Gamma |- (tabs x T11 t12) \in (TArrow T11 T12)
| T_App : ∀ T1 T2 Gamma t1 t2,
Gamma |- t1 \in (TArrow T1 T2) →
Gamma |- t2 \in T1 →
Gamma |- (tapp t1 t2) \in T2
| T_Proj : ∀ Gamma i t Ti Tr,
Gamma |- t \in Tr →
Tlookup i Tr = Some Ti →
Gamma |- (tproj t i) \in Ti
| T_RNil : ∀ Gamma,
Gamma |- trnil \in TRNil
| T_RCons : ∀ Gamma i t T tr Tr,
Gamma |- t \in T →
Gamma |- tr \in Tr →
record_ty Tr →
record_tm tr →
Gamma |- (trcons i t tr) \in (TRCons i T Tr)
where "Gamma '|-' t '\in' T" := (has_type Gamma t T).
Hint Constructors has_type.
Tactic Notation "has_type_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "T_Var" | Case_aux c "T_Abs" | Case_aux c "T_App"
| Case_aux c "T_Proj" | Case_aux c "T_RNil" | Case_aux c "T_RCons" ].
Examples
Exercise: 2 stars (examples)
Finish the proofs.Lemma typing_example_2 :
empty |-
(tapp (tabs a (TRCons i1 (TArrow A A)
(TRCons i2 (TArrow B B)
TRNil))
(tproj (tvar a) i2))
(trcons i1 (tabs a A (tvar a))
(trcons i2 (tabs a B (tvar a))
trnil))) \in
(TArrow B B).
Proof.
Admitted.
Before starting to prove this fact (or the one above!), make sure
you understand what it is saying.
Example typing_nonexample :
¬ ∃ T,
(extend empty a (TRCons i2 (TArrow A A)
TRNil)) |-
(trcons i1 (tabs a B (tvar a)) (tvar a)) \in
T.
Proof.
Admitted.
Example typing_nonexample_2 : ∀ y,
¬ ∃ T,
(extend empty y A) |-
(tapp (tabs a (TRCons i1 A TRNil)
(tproj (tvar a) i1))
(trcons i1 (tvar y) (trcons i2 (tvar y) trnil))) \in
T.
Proof.
Admitted.
Properties of Typing
Lemma wf_rcd_lookup : ∀ i T Ti,
well_formed_ty T →
Tlookup i T = Some Ti →
well_formed_ty Ti.
Proof with eauto.
intros i T.
T_cases (induction T) Case; intros; try solve by inversion.
Case "TRCons".
inversion H. subst. unfold Tlookup in H0.
destruct (eq_id_dec i i0)...
inversion H0. subst... Qed.
Lemma step_preserves_record_tm : ∀ tr tr',
record_tm tr →
tr ==> tr' →
record_tm tr'.
Proof.
intros tr tr' Hrt Hstp.
inversion Hrt; subst; inversion Hstp; subst; auto.
Qed.
Lemma has_type__wf : ∀ Gamma t T,
Gamma |- t \in T → well_formed_ty T.
Proof with eauto.
intros Gamma t T Htyp.
has_type_cases (induction Htyp) Case...
Case "T_App".
inversion IHHtyp1...
Case "T_Proj".
eapply wf_rcd_lookup...
Qed.
Field Lookup
Lemma lookup_field_in_value : ∀ v T i Ti,
value v →
empty |- v \in T →
Tlookup i T = Some Ti →
∃ ti, tlookup i v = Some ti ∧ empty |- ti \in Ti.
Proof with eauto.
intros v T i Ti Hval Htyp Hget.
remember (@empty ty) as Gamma.
has_type_cases (induction Htyp) Case; subst; try solve by inversion...
Case "T_RCons".
simpl in Hget. simpl. destruct (eq_id_dec i i0).
SCase "i is first".
simpl. inversion Hget. subst.
∃ t...
SCase "get tail".
destruct IHHtyp2 as [vi [Hgeti Htypi]]...
inversion Hval... Qed.
Theorem progress : ∀ t T,
empty |- t \in T →
value t ∨ ∃ t', t ==> t'.
Proof with eauto.
intros t T Ht.
remember (@empty ty) as Gamma.
generalize dependent HeqGamma.
has_type_cases (induction Ht) Case; intros HeqGamma; subst.
Case "T_Var".
inversion H.
Case "T_Abs".
left...
Case "T_App".
right.
destruct IHHt1; subst...
SCase "t1 is a value".
destruct IHHt2; subst...
SSCase "t2 is a value".
inversion H; subst; try (solve by inversion).
∃ ([x:=t2]t12)...
SSCase "t2 steps".
destruct H0 as [t2' Hstp]. ∃ (tapp t1 t2')...
SCase "t1 steps".
destruct H as [t1' Hstp]. ∃ (tapp t1' t2)...
Case "T_Proj".
right. destruct IHHt...
SCase "rcd is value".
destruct (lookup_field_in_value _ _ _ _ H0 Ht H) as [ti [Hlkup _]].
∃ ti...
SCase "rcd_steps".
destruct H0 as [t' Hstp]. ∃ (tproj t' i)...
Case "T_RNil".
left...
Case "T_RCons".
destruct IHHt1...
SCase "head is a value".
destruct IHHt2; try reflexivity.
SSCase "tail is a value".
left...
SSCase "tail steps".
right. destruct H2 as [tr' Hstp].
∃ (trcons i t tr')...
SCase "head steps".
right. destruct H1 as [t' Hstp].
∃ (trcons i t' tr)... Qed.
Inductive appears_free_in : id → tm → Prop :=
| afi_var : ∀ x,
appears_free_in x (tvar x)
| afi_app1 : ∀ x t1 t2,
appears_free_in x t1 → appears_free_in x (tapp t1 t2)
| afi_app2 : ∀ x t1 t2,
appears_free_in x t2 → appears_free_in x (tapp t1 t2)
| afi_abs : ∀ x y T11 t12,
y ≠ x →
appears_free_in x t12 →
appears_free_in x (tabs y T11 t12)
| afi_proj : ∀ x t i,
appears_free_in x t →
appears_free_in x (tproj t i)
| afi_rhead : ∀ x i ti tr,
appears_free_in x ti →
appears_free_in x (trcons i ti tr)
| afi_rtail : ∀ x i ti tr,
appears_free_in x tr →
appears_free_in x (trcons i ti tr).
Hint Constructors appears_free_in.
Lemma context_invariance : ∀ Gamma Gamma' t S,
Gamma |- t \in S →
(∀ x, appears_free_in x t → Gamma x = Gamma' x) →
Gamma' |- t \in S.
Proof with eauto.
intros. generalize dependent Gamma'.
has_type_cases (induction H) Case;
intros Gamma' Heqv...
Case "T_Var".
apply T_Var... rewrite <- Heqv...
Case "T_Abs".
apply T_Abs... apply IHhas_type. intros y Hafi.
unfold extend. destruct (eq_id_dec x y)...
Case "T_App".
apply T_App with T1...
Case "T_RCons".
apply T_RCons... Qed.
Lemma free_in_context : ∀ x t T Gamma,
appears_free_in x t →
Gamma |- t \in T →
∃ T', Gamma x = Some T'.
Proof with eauto.
intros x t T Gamma Hafi Htyp.
has_type_cases (induction Htyp) Case; inversion Hafi; subst...
Case "T_Abs".
destruct IHHtyp as [T' Hctx]... ∃ T'.
unfold extend in Hctx.
rewrite neq_id in Hctx...
Qed.
Lemma substitution_preserves_typing : ∀ Gamma x U v t S,
(extend Gamma x U) |- t \in S →
empty |- v \in U →
Gamma |- ([x:=v]t) \in S.
Proof with eauto.
intros Gamma x U v t S Htypt Htypv.
generalize dependent Gamma. generalize dependent S.
t_cases (induction t) Case;
intros S Gamma Htypt; simpl; inversion Htypt; subst...
Case "tvar".
simpl. rename i into y.
destruct (eq_id_dec x y).
SCase "x=y".
subst.
unfold extend in H0. rewrite eq_id in H0.
inversion H0; subst. clear H0.
eapply context_invariance...
intros x Hcontra.
destruct (free_in_context _ _ S empty Hcontra) as [T' HT']...
inversion HT'.
SCase "x<>y".
apply T_Var... unfold extend in H0. rewrite neq_id in H0...
Case "tabs".
rename i into y. rename t into T11.
apply T_Abs...
destruct (eq_id_dec x y).
SCase "x=y".
eapply context_invariance...
subst.
intros x Hafi. unfold extend.
destruct (eq_id_dec y x)...
SCase "x<>y".
apply IHt. eapply context_invariance...
intros z Hafi. unfold extend.
destruct (eq_id_dec y z)...
subst. rewrite neq_id...
Case "trcons".
apply T_RCons... inversion H7; subst; simpl...
Qed.
Theorem preservation : ∀ t t' T,
empty |- t \in T →
t ==> t' →
empty |- t' \in T.
Proof with eauto.
intros t t' T HT.
remember (@empty ty) as Gamma. generalize dependent HeqGamma.
generalize dependent t'.
has_type_cases (induction HT) Case;
intros t' HeqGamma HE; subst; inversion HE; subst...
Case "T_App".
inversion HE; subst...
SCase "ST_AppAbs".
apply substitution_preserves_typing with T1...
inversion HT1...
Case "T_Proj".
destruct (lookup_field_in_value _ _ _ _ H2 HT H)
as [vi [Hget Htyp]].
rewrite H4 in Hget. inversion Hget. subst...
Case "T_RCons".
apply T_RCons... eapply step_preserves_record_tm...
Qed.
☐