RecordSubSubtyping with Records

In this chapter, we combine two significant extensions of the pure STLC -- records (from chapter Records) and subtyping (from chapter Sub) -- and explore their interactions. Most of the concepts have already been discussed in those chapters, so the presentation here is somewhat terse. We just comment where things are nonstandard.

Module RecordSub.

Core Definitions

Syntax

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 ':' t₁ '::' t₂" := (Ty_RCons l t₁ t₂) (in custom stlc_ty at level 3, right associativity).
Notation " l := e₁ '::' e₂" := (tm_rcons l e₁ e₂) (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

The syntax of terms and types is a bit too loose, in the sense that it admits things like a record type whose final "tail" is Top or some arrow type rather than Nil. To avoid such cases, it is useful to assume that all the record types and terms that we see will obey some simple well-formedness conditions.

An interesting technical question is whether the basic properties of the system -- progress and preservation -- remain true if we drop these conditions. I believe they do, and I would encourage motivated readers to try to check this by dropping the conditions from the definitions of typing and subtyping and adjusting the proofs in the rest of the chapter accordingly. This is not a trivial exercise (or I'd have done it!), but it should not involve changing the basic structure of the proofs. If someone does do it, please let me know. --BCP 5/16.

Inductive record_ty : ty → Prop :=
  | RTnil :
        record_ty <{{ nil }}>
  | RTcons : ∀ i T₁ T₂,
        record_ty <{{ i : T₁ :: T₂ }}>.

Inductive record_tm : tm → Prop :=
  | rtnil :
        record_tm <{ nil }>
  | rtcons : ∀ i t₁ t₂,
        record_tm <{ i := t₁ :: t₂ }>.

Inductive well_formed_ty : ty → Prop :=
  | wfTop :
        well_formed_ty <{{ Top }}>
  | wfBase : ∀ (i : string),
        well_formed_ty <{{ Base i }}>
  | wfArrow : ∀ T₁ T₂,
        well_formed_ty T₁ →
        well_formed_ty T₂ →
        well_formed_ty <{{ T₁ → T₂ }}>
  | wfRNil :
        well_formed_ty <{{ nil }}>
  | wfRCons : ∀ i T₁ T₂,
        well_formed_ty T₁ →
        well_formed_ty T₂ →
        record_ty T₂ →
        well_formed_ty <{{ i : T₁ :: T₂ }}>.

Hint Constructors record_ty record_tm well_formed_ty : core.

Substitution

Substitution and reduction are as before.

Fixpoint subst (x : string) (s : tm) (t : tm) : tm :=
  match t with
  | tm_var y ⇒
      if eqb_string x y then s else t
  | <{\y:T, t₁}> ⇒
      if eqb_string x y then t else <{\y:T, [x:=s] t₁}>
  | <{t₁ t₂}> ⇒
      <{([x:=s] t₁) ([x:=s] t₂)}>
  | <{ t₁ --> i }> ⇒
      <{ ( [x := s] t₁) --> i }>
  | <{ nil }> ⇒
      <{ nil }>
  | <{ i := t₁ :: tr }> ⇒
     <{ i := [x := s] t₁ :: ( [x := s] tr) }>
  end

where "'[' x ':=' s ']' t" := (subst x s t) (in custom stlc).

Reduction

Inductive value : tm → Prop :=
  | v_abs : ∀ x T₂ t₁,
      value <{ \ x : T₂, t₁ }>
  | v_rnil : value <{ nil }>
  | v_rcons : ∀ i v₁ vr,
      value v₁ →
      value vr →
      value <{ i := v₁ :: vr }>.

Hint Constructors value : core.

Fixpoint Tlookup (i:string) (Tr:ty) : option ty :=
  match Tr with
  | <{{ i' : T :: Tr' }}> ⇒
      if eqb_string 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 eqb_string i i' then Some t else tlookup i tr'
  | _ ⇒ None
  end.

Reserved Notation "t '-->' t'" (at level 40).

Inductive step : tm → tm → Prop :=
  | ST_AppAbs : ∀ x T₂ t₁ v₂,
         value v₂ →
         <{(\x:T₂, t₁) v₂}> --> <{ [x:=v₂]t₁ }>
  | ST_App1 : ∀ t₁ t₁' t₂,
         t₁ --> t₁' →
         <{t₁ t₂}> --> <{t₁' t₂}>
  | ST_App2 : ∀ v₁ t₂ t₂',
         value v₁ →
         t₂ --> t₂' →
         <{v₁ t₂}> --> <{v₁ t₂'}>
  | ST_Proj1 : ∀ t₁ t₁' i,
        t₁ --> t₁' →
        <{ t₁ --> i }> --> <{ t₁' --> i }>
  | ST_ProjRcd : ∀ tr i vi,
        value tr →
        tlookup i tr = Some vi →
        <{ tr --> i }> --> vi
  | ST_Rcd_Head : ∀ i t₁ t₁' tr₂,
        t₁ --> t₁' →
        <{ i := t₁ :: tr₂ }> --> <{ i := t₁' :: tr₂ }>
  | ST_Rcd_Tail : ∀ i v₁ tr₂ tr₂',
        value v₁ →
        tr₂ --> tr₂' →
        <{ i := v₁ :: tr₂ }> --> <{ i := v₁ :: tr₂' }>

where "t '-->' t'" := (step t t').

Hint Constructors step : core.

Subtyping

Now we come to the interesting part, where the features we've added start to interact. We begin by defining the subtyping relation and developing some of its important technical properties.

Definition

The definition of subtyping is essentially just what we sketched in the discussion of record subtyping in chapter Sub, but we need to add well-formedness side conditions to some of the rules. Also, we replace the "n-ary" width, depth, and permutation subtyping rules by binary rules that deal with just the first field.

Reserved Notation "T '<:' U" (at level 40).

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 : ∀ S₁ S₂ T₁ T₂,
    T₁ <: S₁ →
    S₂ <: T₂ →
    <{{ S₁ → S₂ }}> <: <{{ T₁ → T₂ }}>
  (* Subtyping between record types *)
  | S_RcdWidth : ∀ i T₁ T₂,
    well_formed_ty <{{ i : T₁ :: T₂ }}> →
    <{{ i : T₁ :: T₂ }}> <: <{{ nil }}>
  | S_RcdDepth : ∀ i S₁ T₁ Sr₂ Tr₂,
    S₁ <: T₁ →
    Sr₂ <: Tr₂ →
    record_ty Sr₂ →
    record_ty Tr₂ →
    <{{ i : S₁ :: Sr₂ }}> <: <{{ i : T₁ :: Tr₂ }}>
  | S_RcdPerm : ∀ i₁ i₂ T₁ T₂ Tr₃,
    well_formed_ty <{{ i₁ : T₁ :: i₂ : T₂ :: Tr₃ }}> →
    i₁ ≠ i₂ →
       <{{ i₁ : T₁ :: i₂ : T₂ :: Tr₃ }}>
    <: <{{ i₂ : T₂ :: i₁ : T₁ :: Tr₃ }}>

where "T '<:' U" := (subtype T U).

Hint Constructors subtype : core.

Examples

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.

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.
☐

Exercise: 1 star, standard (subtyping_example_2)

Example subtyping_example_2 :
  <{{ Top → TRcd_kj }}> <:
          <{{ (C → C) → TRcd_j }}>.
Proof with eauto.
  (* FILL IN HERE *) Admitted.
☐

Exercise: 1 star, standard (subtyping_example_3)

Example subtyping_example_3 :
  <{{ nil → (j : A :: nil) }}> <:
          <{{ (k : B :: nil) → nil }}>.
(* {}->{j:A} <: {k:B}->{} *)
Proof with eauto.
  (* FILL IN HERE *) Admitted.
☐

Exercise: 2 stars, standard (subtyping_example_4)

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.
☐

End Examples.

Properties of Subtyping

Well-Formedness

To get started proving things about subtyping, we need a couple of technical lemmas that intuitively (1) allow us to extract the well-formedness assumptions embedded in subtyping derivations and (2) record the fact that fields of well-formed record types are themselves well-formed types.

Lemma subtype__wf : ∀ S T,
subtype S T →
well_formed_ty T ∧ well_formed_ty S.

Proof with eauto.
  intros S T Hsub.
  induction Hsub;
    intros; try (destruct IHHsub1; destruct IHHsub2)...
  - (* S_RcdPerm *)
    split... inversion H. subst. inversion H₅... Qed.

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.
  induction T; intros; try solve_by_invert.
  - (* RCons *)
    inversion H. subst. unfold Tlookup in H₀.
    destruct (eqb_string i s)... inversion H₀; subst... Qed.

Field Lookup

The record matching lemmas get a little more complicated in the presence of subtyping, for two reasons. First, record types no longer necessarily describe the exact structure of the corresponding terms. And second, reasoning by induction on typing derivations becomes harder in general, because typing is no longer syntax directed.

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.

Proof with (eauto using wf_rcd_lookup).
  intros S T i Ti Hsub Hget. generalize dependent Ti.
  induction Hsub; intros Ti Hget;
    try solve_by_invert.
  - (* S_Refl *)
    ∃ Ti...
  - (* S_Trans *)
    destruct (IHHsub2 Ti) as [Ui Hui]... destruct Hui.
    destruct (IHHsub1 Ui) as [Si Hsi]... destruct Hsi.
    ∃ Si...
  - (* S_RcdDepth *)
    rename i₀ into k.
    unfold Tlookup. unfold Tlookup in Hget.
    destruct (eqb_string i k)...
    + (* i = k -- we're looking up the first field *)
      inversion Hget. subst. ∃ S₁...
  - (* S_RcdPerm *)
    ∃ Ti. split.
    + (* lookup *)
      unfold Tlookup. unfold Tlookup in Hget.
      destruct (eqb_stringP i i₁)...
      × (* i = i₁ -- we're looking up the first field *)
        destruct (eqb_stringP i i₂)...
        (* i = i₂ -- contradictory *)
        destruct H₀.
        subst...
    + (* subtype *)
      inversion H. subst. inversion H₅. subst... Qed.

Exercise: 3 stars, standard (rcd_types_match_informal)

Write a careful informal proof of the rcd_types_match lemma.

(* FILL IN HERE *)
☐

Inversion Lemmas

Exercise: 3 stars, standard, optional (sub_inversion_arrow)

Lemma sub_inversion_arrow : ∀ U V₁ V₂,
     U <: <{{ V₁ → V₂ }}> →
     ∃ U₁ U₂,
       (U= <{{ U₁ → U₂ }}> ) ∧ (V₁ <: U₁) ∧ (U₂ <: V₂).

Proof with eauto.
  intros U V₁ V₂ Hs.
  remember <{{ V₁ → V₂ }}> as V.
  generalize dependent V₂. generalize dependent V₁.
  (* FILL IN HERE *) Admitted.
☐

Typing

Definition context := partial_map ty.

Reserved Notation "Gamma '⊢' t '∈' T" (at level 40,
t custom stlc at level 99, T custom stlc_ty at level 0).

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 T₁₁ T₁₂ t₁₂,
      well_formed_ty T₁₁ →
      (x ⊢> T₁₁; Gamma) ⊢ t₁₂ \in T₁₂ →
      Gamma ⊢ (\ x : T₁₁, t₁₂) \in (T₁₁ → T₁₂)
  | T_App : ∀ T₁ T₂ Gamma t₁ t₂,
      Gamma ⊢ t₁ \in (T₁ → T₂) →
      Gamma ⊢ t₂ \in T₁ →
      Gamma ⊢ t₁ t₂ \in T₂
  | 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.

Typing Examples

Module Examples2.
Import Examples.

Exercise: 1 star, standard (typing_example_0)

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} *)

Proof.
(* FILL IN HERE *) Admitted.
☐

Exercise: 2 stars, standard (typing_example_1)

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 *)

Proof with eauto.
(* FILL IN HERE *) Admitted.
☐

Exercise: 2 stars, standard, optional (typing_example_2)

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 *)

Proof with eauto.
(* FILL IN HERE *) Admitted.
☐

End Examples2.

Properties of Typing

Well-Formedness

Lemma has_type__wf : ∀ Gamma t T,
has_type Gamma t T → well_formed_ty T.

Proof with eauto.
  intros Gamma t T Htyp.
  induction Htyp...
  - (* T_App *)
    inversion IHHtyp1...
  - (* T_Proj *)
    eapply wf_rcd_lookup...
  - (* T_Sub *)
    apply subtype__wf in H.
    destruct H...
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; eauto.
Qed.

Field Lookup

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.

Proof with eauto.
  remember empty as Gamma.
  intros t T i Ti Hval Htyp. generalize dependent Ti.
  induction Htyp; intros; subst; try solve_by_invert.
  - (* T_Sub *)
    apply (rcd_types_match S) in H₀...
    destruct H₀ as [Si [HgetSi Hsub]].
    eapply IHHtyp in HgetSi...
    destruct HgetSi as [vi [Hget Htyvi]]...
  - (* T_RCons *)
    simpl in H₀. simpl. simpl in H₁.
    destruct (eqb_string i i₀).
    + (* i is first *)
      injection H₁ as H₁. subst. ∃ t...
    + (* i in tail *)
      eapply IHHtyp2 in H₁...
      inversion Hval... Qed.

Progress

Exercise: 3 stars, standard (canonical_forms_of_arrow_types)

Lemma canonical_forms_of_arrow_types : ∀ Gamma s T₁ T₂,
     Gamma ⊢ s \in (T₁ → T₂) →
     value s →
     ∃ x S₁ s₂,
        s = <{ \ x : S₁, s₂ }>.

Proof with eauto.
(* FILL IN HERE *) Admitted.
☐

Theorem progress : ∀ t T,
empty ⊢ t \in T →
value t ∨ ∃ t', t --> t'.

Proof with eauto.
  intros t T Ht.
  remember empty as Gamma.
  revert HeqGamma.
  induction Ht;
    intros HeqGamma; subst...
  - (* T_Var *)
    inversion H.
  - (* T_App *)
    right.
    destruct IHHt1; subst...
    + (* t₁ is a value *)
      destruct IHHt2; subst...
      × (* t₂ is a value *)
        destruct (canonical_forms_of_arrow_types empty t₁ T₁ T₂)
          as [x [S₁ [t₁₂ Heqt1]]]...
        subst. ∃ <{ [x:=t₂] t₁₂ }>...
      × (* t₂ steps *)
        destruct H₀ as [t₂' Hstp]. ∃ <{ t₁ t₂' }> ...
    + (* t₁ steps *)
      destruct H as [t₁' Hstp]. ∃ <{ t₁' t₂ }>...
  - (* T_Proj *)
    right. destruct IHHt...
    + (* rcd is value *)
      destruct (lookup_field_in_value t T i Ti)
        as [t' [Hget Ht']]...
    + (* rcd_steps *)
      destruct H₀ as [t' Hstp]. ∃ <{ t' --> i }>...
  - (* T_RCons *)
    destruct IHHt1...
    + (* head is a value *)
      destruct IHHt2...
      × (* tail steps *)
        right. destruct H₂ as [tr' Hstp].
        ∃ <{ i := t :: tr' }>...
    + (* head steps *)
      right. destruct H₁ as [t' Hstp].
      ∃ <{ i := t' :: tr}>... Qed.

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 t₁ t₂ and types T₁ T₂ such that t = t₁ t₂, T = T₂, empty ⊢ t₁ : T₁ → T₂ and empty ⊢ t₂ : T₁.

The induction hypotheses for these typing derivations yield that t₁ is a value or steps, and that t₂ is a value or steps.
- Suppose t₁ --> t₁' for some term t₁'. Then t₁ t₂ --> t₁' t₂ by ST_App1.
- Otherwise t₁ is a value.
  - Suppose t₂ --> t₂' for some term t₂'. Then t₁ t₂ --> t₁ t₂' by rule ST_App2 because t₁ is a value.
  - Otherwise, t₂ is a value. By Lemma canonical_forms_for_arrow_types, t₁ = \x:S₁.s2 for some x, S₁, and s₂. But then (\x:S₁.s2) t₂ --> [x:=t₂]s₂ by ST_AppAbs, since t₂ is a value.
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.

By the IH, either tr is a value or it steps. If tr --> tr' for some term tr', then tr.i --> tr'.i by rule ST_Proj1.

If tr is a value, then Lemma lookup_field_in_value yields that there is a term ti such that tlookup i tr = Some ti. It follows that tr.i --> ti by rule ST_ProjRcd.
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 t₁ tr, types T₁ Tr and a label t such that t = {i=t₁, tr}, T = {i:T₁, Tr}, record_ty tr, record_tm Tr, empty ⊢ t₁ : T₁ and empty ⊢ tr : Tr.

The induction hypotheses for these typing derivations yield that t₁ is a value or steps, and that tr is a value or steps. We consider each case:
- Suppose t₁ --> t₁' for some term t₁'. Then {i=t₁, tr} --> {i=t₁', tr} by rule ST_Rcd_Head.
- Otherwise t₁ is a value.
  - Suppose tr --> tr' for some term tr'. Then {i=t₁, tr} --> {i=t₁, tr'} by rule ST_Rcd_Tail, since t₁ is a value.
  - Otherwise, tr is also a value. So, {i=t₁, tr} is a value by v_rcons.

Inversion Lemma

Lemma typing_inversion_abs : ∀ Gamma x S₁ t₂ T,
     Gamma ⊢ \ x : S₁, t₂ \in T →
     (∃ S₂, <{{ S₁ → S₂ }}> <: T
              ∧ (x ⊢> S₁; Gamma) ⊢ t₂ \in S₂).

Proof with eauto.
  intros Gamma x S₁ t₂ T H.
  remember <{ \ x : S₁, t₂ }> as t.
  induction H;
    inversion Heqt; subst; intros; try solve_by_invert.
  - (* T_Abs *)
    assert (Hwf := has_type__wf _ _ _ H₀).
    ∃ T₁₂...
  - (* T_Sub *)
    destruct IHhas_type as [S₂ [Hsub Hty]]...
    Qed.

Lemma abs_arrow : ∀ x S₁ s₂ T₁ T₂,
  empty ⊢ \x : S₁, s₂ \in (T₁ → T₂) →
     T₁ <: S₁
  ∧ (x ⊢> S₁) ⊢ s₂ \in T₂.

Proof with eauto.
  intros x S₁ s₂ T₁ T₂ Hty.
  apply typing_inversion_abs in Hty.
  destruct Hty as [S₂ [Hsub Hty]].
  apply sub_inversion_arrow in Hsub.
  destruct Hsub as [U₁ [U₂ [Heq [Hsub1 Hsub2]]]].
  inversion Heq; subst... Qed.

Weakening

The weakening lemma is proved as in pure STLC.

Lemma weakening : ∀ Gamma Gamma' t T,
     inclusion 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 inclusion_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.

Preservation

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.

Proof.
  intros Gamma x U t v T Ht Hv.
  remember (x ⊢> U; Gamma) as Gamma'.
  generalize dependent Gamma.
  induction Ht; intros Gamma' G; simpl; eauto.
  - (* T_Var *)
    rename x₀ into y.
    destruct (eqb_stringP x y) as [Hxy|Hxy]; subst.
    + (* x = y *)
      rewrite update_eq in H.
      injection H as H. subst.
      apply weakening_empty. assumption.
    + (* x<>y *)
      apply T_Var; [|assumption].
      rewrite update_neq in H; assumption.
  - (* T_Abs *)
    rename x₀ into y. subst.
    destruct (eqb_stringP x y) as [Hxy|Hxy]; apply T_Abs; try assumption.
    + (* x=y *)
      subst. rewrite update_shadow in Ht. assumption.
    + (* x <> y *)
      subst. apply IHHt.
      rewrite update_permute; auto.
      - (* rcons *) (* <=== only new case compared to pure STLC *)
      apply T_RCons; eauto.
      inversion H₀; subst; simpl; auto.
Qed.

Theorem preservation : ∀ t t' T,
     empty ⊢ t \in T →
     t --> t' →
     empty ⊢ t' \in T.

Proof with eauto.
  intros t t' T HT. generalize dependent t'.
  remember empty as Gamma.
  induction HT;
       intros t' HE; subst;
       try solve [inversion HE; subst; eauto].
  - (* T_App *)
    inversion HE; subst...
    + (* ST_AppAbs *)
      destruct (abs_arrow _ _ _ _ _ HT₁) as [HA₁ HA₂].
      apply substitution_preserves_typing with T₀...
  - (* T_Proj *)
    inversion HE; subst...
    destruct (lookup_field_in_value _ _ _ _ H₂ HT H)
      as [vi [Hget Hty]].
    rewrite H₄ in Hget. inversion Hget. subst...
  - (* T_RCons *)
    inversion HE; subst...
    eauto using step_preserves_record_tm. Qed.

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 t₁ t₂ and types T₁ T₂ such that t = t₁ t₂, T = T₂, empty ⊢ t₁ : T₁ → T₂ and empty ⊢ t₂ : T₁.

By inspection of the definition of the step relation, there are three ways t₁ t₂ can step. Cases ST_App1 and ST_App2 follow immediately by the induction hypotheses for the typing subderivations and a use of T_App.

Suppose instead t₁ t₂ steps by ST_AppAbs. Then t₁ = \x:S.t12 for some type S and term t₁₂, and t' = [x:=t₂]t₁₂.

By Lemma abs_arrow, we have T₁ <: S and x:S₁ ⊢ s₂ : T₂. It then follows by lemma substitution_preserves_typing that empty ⊢ [x:=t₂] t₁₂ : T₂ as desired.
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.

The IH for the typing derivation gives us that, for any term tr', if tr --> tr' then empty ⊢ tr' Tr. Inspection of the definition of the step relation reveals that there are two ways a projection can step. Case ST_Proj1 follows immediately by the IH.

Instead suppose tr --> i steps by ST_ProjRcd. Then tr is a value and there is some term vi such that tlookup i tr = Some vi and t' = vi. But by lemma lookup_field_in_value, empty ⊢ vi : Ti as desired.
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 t₁ tr, types T₁ Tr and a label t such that t = i:=t₁ :: tr}, T = i:T₁ :: Tr, record_ty tr, record_tm Tr, empty ⊢ t₁ : T₁ and empty ⊢ tr : Tr.

By the definition of the step relation, t must have stepped by ST_Rcd_Head or ST_Rcd_Tail. In the first case, the result follows by the IH for t₁'s typing derivation and T_RCons. In the second case, the result follows by the IH for tr's typing derivation, T_RCons, and a use of the step_preserves_record_tm lemma.

End RecordSub.