SubSubtyping



Concepts


A Motivating Example

Suppose we are writing a program involving two record types defined as follows:
    Person  = {name:String, age:Nat}
    Student = {name:String, age:Nat, gpa:Nat}
Problem: In the pure STLC with records, this term is not typable:
    (λr:Person. (r.age)+1) {name="Pat",age=21,gpa=1}
This is a shame.
Idea: Introduce subtyping, formalizing the observation that "some types are better than others."
Safe substitution principle:
  • S is a subtype of T, written S <: T, if a value of type S can safely be used in any context where a value of type T is expected.

Subtyping and Object-Oriented Languages

Subtyping plays a fundamental role in OO programming languages.
An object can be thought of as a record of functions ("methods") and data values ("fields" or "instance variables").
  • Invoking a method m of an object o on some arguments a1..an consists of projecting out the m field of o and applying it to a1..an.
The type of an object is a class (or an interface).
Classes are related by the subclass relation.
  • An object belonging to a subclass must provide all the methods and fields of one belonging to a superclass, plus possibly some more.
  • Thus a subclass object can be used anywhere a superclass object is expected.
  • Very handy for organizing large libraries

Of course, real OO languages have lots of other features...
  • mutable fields
  • private
  • method inheritance
  • static fields
  • etc., etc.
We'll ignore all these and focus on core mechanisms.

The Subsumption Rule

Our goal for this chapter is to add subtyping to the simply typed lambda-calculus (with some of the basic extensions from MoreStlc). This involves two steps:
  • Defining a binary subtype relation between types.
  • Enriching the typing relation to take subtyping into account.
The second step is actually very simple. We add just a single rule to the typing relation: the so-called rule of subsumption:
Γ  t : S     S <: T (T_Sub)  

Γ  t : T
This rule says, intuitively, that it is OK to "forget" some of what we know about a term.

The Subtype Relation

The first step — the definition of the relation S <: T — is where all the action is. Let's look at each of the clauses of its definition.

Structural Rules

To start off, we impose two "structural rules" that are independent of any particular type constructor: a rule of transitivity, which says intuitively that, if S is better than U and U is better than T, then S is better than T...
S <: U    U <: T (S_Trans)  

S <: T
... and a rule of reflexivity, since any type T is always just as good as itself:
   (S_Refl)  

T <: T

Products

Now we consider the individual type constructors, one by one, beginning with product types. We consider one pair to be "better than" another if each of its components is.
S1 <: T1    S2 <: T2 (S_Prod)  

S1*S2 <: T1*T2

Arrows

Suppose we have functions f and g with these types:
       f : C -> Student 
       g : (C -> Person) -> D
Is it safe to allow the application g f?
Yes.
So we want:
      C->Student  <:  C->Person
I.e., arrow is covariant in its right-hand argument.

Now suppose we have:
       f : Person -> C
       g : (Student -> C) -> D
Is it safe to allow the application g f?
Again yes.
So we want:
      Person->C  <:  Student->C
I.e., arrow is contravariant in its left-hand argument.

Putting these together...
T1 <: S1    S2 <: T2 (S_Arrow)  

S1->S2 <: T1->T2

Suppose we have S <: T and U <: V. Which of the following subtyping assertions is false?
(1) S×U <: T×V
(2) TU <: SU
(3) (SU) (S×V) <: (SU) (T×U)
(4) (S×U) V <: (T×U) V
(5) SU <: SV

Suppose again that we have S <: T and U <: V. Which of the following is incorrect?
(1) (TTU <: (STV
(2) TU <: SV
(3) (SU)->(SV) <: (TU)->(TV)
(4) (SV)V <: (TU)V
(5) S->(VU) <: S->(UU)

Exercise: 2 stars (arrow_sub_wrong)

Suppose we had incorrectly defined subtyping as covariant on both the right and the left of arrow types:
S1 <: T1    S2 <: T2 (S_Arrow_wrong)  

S1->S2 <: T1->T2
Give a concrete example of functions f and g with types...
       f : Student -> Nat
       g : (Person -> Nat) -> Nat
... such that the application g f will get stuck during execution.

Records

What about subtyping for record types?

The basic intuition about subtyping for record types is that it is always safe to use a "bigger" record in place of a "smaller" one. That is, given a record type, adding extra fields will always result in a subtype. If some code is expecting a record with fields x and y, it is perfectly safe for it to receive a record with fields x, y, and z; the z field will simply be ignored. For example,
       {name:String, age:Nat, gpa:Nat} <: {name:String, age:Nat}
       {name:String, age:Nat} <: {name:String}
       {name:String} <: {}
This is known as "width subtyping" for records.

We can also create a subtype of a record type by replacing the type of one of its fields with a subtype. If some code is expecting a record with a field x of type T, it will be happy with a record having a field x of type S as long as S is a subtype of T. For example,
       {x:Student} <: {x:Person}
This is known as "depth subtyping".

Finally, although the fields of a record type are written in a particular order, the order does not really matter. For example,
       {name:String,age:Nat} <: {age:Nat,name:String}
This is known as "permutation subtyping".

We could formalize these requirements in a single subtyping rule for records as follows:
for each jk in j1..jn,
ip in i1..im, such that
jk=ip and Sp <: Tk (S_Rcd)  

{i1:S1...im:Sm} <: {j1:T1...jn:Tn}
That is, the record on the left should have all the field labels of the one on the right (and possibly more), while the types of the common fields should be in the subtype relation. However, this rule is rather heavy and hard to read. If we like, we can decompose it into three simpler rules, which can be combined using S_Trans to achieve all the same effects.

First, adding fields to the end of a record type gives a subtype:
n > m (S_RcdWidth)  

{i1:T1...in:Tn} <: {i1:T1...im:Tm}
We can use S_RcdWidth to drop later fields of a multi-field record while keeping earlier fields, showing for example that {age:Nat,name:String} <: {name:String}.

Second, we can apply subtyping inside the components of a compound record type:
S1 <: T1  ...  Sn <: Tn (S_RcdDepth)  

{i1:S1...in:Sn} <: {i1:T1...in:Tn}
For example, we can use S_RcdDepth and S_RcdWidth together to show that {y:Student, x:Nat} <: {y:Person}.

Third, we need to be able to reorder fields. For example, we might expect that {name:String, gpa:Nat, age:Nat} <: Person. We haven't quite achieved this yet: using just S_RcdDepth and S_RcdWidth we can only drop fields from the end of a record type. So we need:
{i1:S1...in:Sn} is a permutation of {i1:T1...in:Tn} (S_RcdPerm)  

{i1:S1...in:Sn} <: {i1:T1...in:Tn}

It is worth noting that full-blown language designs may choose not to adopt all of these subtyping rules. For example, in Java:
  • A subclass may not change the argument or result types of a method of its superclass (i.e., no depth subtyping or no arrow subtyping, depending how you look at it).
  • Each class has just one superclass ("single inheritance" of classes).
  • Each class member (field or method) can be assigned a single index, adding new indices "on the right" as more members are added in subclasses (i.e., no permutation for classes).
  • A class may implement multiple interfaces — so-called "multiple inheritance" of interfaces (i.e., permutation is allowed for interfaces).

Top

Finally, it is natural to give the subtype relation a maximal element — a type that lies above every other type and is inhabited by all (well-typed) values. We do this by adding to the language one new type constant, called Top, together with a subtyping rule that places it above every other type in the subtype relation:
   (S_Top)  

S <: Top
The Top type is an analog of the Object type in Java and C#.

Summary

In summary, we form the STLC with subtyping by starting with the pure STLC (over some set of base types) and...
  • adding a base type Top,
  • adding the rule of subsumption
    Γ  t : S     S <: T (T_Sub)  

    Γ  t : T
    to the typing relation, and
  • defining a subtype relation as follows:
    S <: U    U <: T (S_Trans)  

    S <: T
       (S_Refl)  

    T <: T
       (S_Top)  

    S <: Top
    S1 <: T1    S2 <: T2 (S_Prod)  

    S1*S2 <: T1*T2
    T1 <: S1    S2 <: T2 (S_Arrow)  

    S1->S2 <: T1->T2
    n > m (S_RcdWidth)  

    {i1:T1...in:Tn} <: {i1:T1...im:Tm}
    S1 <: T1  ...  Sn <: Tn (S_RcdDepth)  

    {i1:S1...in:Sn} <: {i1:T1...in:Tn}
    {i1:S1...in:Sn} is a permutation of {i1:T1...in:Tn} (S_RcdPerm)  

    {i1:S1...in:Sn} <: {i1:T1...in:Tn}

Suppose we have S <: T and U <: V. Which of the following subtyping assertions is false?
(1) S×U <: Top
(2) {i1:S,i2:T}U <: {i1:S,i2:T,i3:V}U
(3) (ST) (Top Top) <: (ST) Top
(4) (Top Top) V <: Top V
(5) S->{i1:U,i2:V} <: S->{i2:V,i1:U}

How about these?
(1) {i1:Top} <: Top
(2) Top (Top Top) <: Top Top
(3) {i1:T} {i1:T} <: {i1:T,i2:S} Top
(4) {i1:T,i2:V,i3:V} <: {i1:S,i2:U}*{i3:V}
(5) Top->{i1:U,i2:V} <: {i1:S}->{i2:V,i1:V}

Exercises

Exercise: 1 star, optional (subtype_instances_tf_1)

Suppose we have types S, T, U, and V with S <: T and U <: V. Which of the following subtyping assertions are then true? Write true or false after each one. (A, B, and C here are base types.)
  • TS <: TS
  • TopU <: STop
  • (CC) (A×B) <: (CC) (Top×B)
  • TTU <: SSV
  • (TT)U <: (SS)V
  • ((TS)T)U <: ((ST)S)V
  • S×V <: T×U

Exercise: 2 stars (subtype_order)

The following types happen to form a linear order with respect to subtyping:
  • Top
  • Top Student
  • Student Person
  • Student Top
  • Person Student
Write these types in order from the most specific to the most general.
Where does the type TopTopStudent fit into this order?

Exercise: 1 star (subtype_instances_tf_2)

Which of the following statements are true? Write true or false after each one.
      S T,
          S <: T  
          SS   <:  TT

      S,
           S <: AA 
           T,
              S = TT    T <: A

      S T1 T1,
           (S <: T1  T2
           S1 S2,
              S = S1  S2    T1 <: S1    S2 <: T2 

      S,
           S <: SS 

      S,
           SS <: S   

      S T2 T2,
           S <: T1×T2 
           S1 S2,
              S = S1×S2    S1 <: T1    S2 <: T2  

Exercise: 1 star (subtype_concepts_tf)

Which of the following statements are true, and which are false?
  • There exists a type that is a supertype of every other type.
  • There exists a type that is a subtype of every other type.
  • There exists a pair type that is a supertype of every other pair type.
  • There exists a pair type that is a subtype of every other pair type.
  • There exists an arrow type that is a supertype of every other arrow type.
  • There exists an arrow type that is a subtype of every other arrow type.
  • There is an infinite descending chain of distinct types in the subtype relation—-that is, an infinite sequence of types S0, S1, etc., such that all the Si's are different and each S(i+1) is a subtype of Si.
  • There is an infinite ascending chain of distinct types in the subtype relation—-that is, an infinite sequence of types S0, S1, etc., such that all the Si's are different and each S(i+1) is a supertype of Si.

Exercise: 2 stars (proper_subtypes)

Is the following statement true or false? Briefly explain your answer.
    T,
         ~(nT = TBase n
         S,
            S <: T    S ≠ T

Exercise: 2 stars (small_large_1)

  • What is the smallest type T ("smallest" in the subtype relation) that makes the following assertion true? (Assume we have Unit among the base types and unit as a constant of this type.)
      empty  (λp:T×Top. p.fst) ((λz:A.z), unit) : AA
  • What is the largest type T that makes the same assertion true?

Exercise: 2 stars (small_large_2)

  • What is the smallest type T that makes the following assertion true?
      empty  (λp:(AA × BB). p) ((λz:A.z), (λz:B.z)) : T
  • What is the largest type T that makes the same assertion true?

Exercise: 2 stars, optional (small_large_3)

  • What is the smallest type T that makes the following assertion true?
      a:A  (λp:(A×T). (p.snd) (p.fst)) (a , λz:A.z) : A
  • What is the largest type T that makes the same assertion true?

Exercise: 2 stars (small_large_4)

  • What is the smallest type T that makes the following assertion true?
      S,
        empty  (λp:(A×T). (p.snd) (p.fst)) : S
  • What is the largest type T that makes the same assertion true?

Exercise: 2 stars (smallest_1)

What is the smallest type T that makes the following assertion true?
      St
        empty  (λx:T. x xt : S

Exercise: 2 stars (smallest_2)

What is the smallest type T that makes the following assertion true?
      empty  (λx:Top. x) ((λz:A.z) , (λz:B.z)) : T

Formal Definitions

Most of the definitions — in particular, the syntax and operational semantics of the language — are identical to what we saw in the last chapter. We just need to extend the typing relation with the subsumption rule and add a new Inductive definition for the subtyping relation. Let's first do the identical bits.

Core Definitions


Syntax

For the sake of more interesting examples below, we'll allow an arbitrary set of additional base types like String, Float, etc. We won't bother adding any constants belonging to these types or any operators on them, but we could easily do so.

Inductive ty : Type :=
  | TTop : ty
  | TBool : ty
  | TBase : id ty
  | TArrow : ty ty ty
  | TUnit : ty
.

Tactic Notation "T_cases" tactic(first) ident(c) :=
  first;
  [ Case_aux c "TTop" | Case_aux c "TBool"
  | Case_aux c "TBase" | Case_aux c "TArrow"
  | Case_aux c "TUnit" |
  ].

Inductive tm : Type :=
  | tvar : id tm
  | tapp : tm tm tm
  | tabs : id ty tm tm
  | ttrue : tm
  | tfalse : tm
  | tif : tm tm tm tm
  | tunit : 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 "ttrue"
  | Case_aux c "tfalse" | Case_aux c "tif"
  | Case_aux c "tunit"
  ].

Substitution

The definition of substitution remains the same as for the ordinary STLC.

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)
  | ttrue
      ttrue
  | tfalse
      tfalse
  | tif t1 t2 t3
      tif (subst x s t1) (subst x s t2) (subst x s t3)
  | tunit
      tunit
  end.

Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20).

Reduction

Likewise the definitions of the value property and the step relation.

Inductive value : tm Prop :=
  | v_abs : x T t,
      value (tabs x T t)
  | v_true :
      value ttrue
  | v_false :
      value tfalse
  | v_unit :
      value tunit
.

Hint Constructors value.

Reserved Notation "t1 '' t2" (at level 40).

Inductive step : tm tm Prop :=
  | ST_AppAbs : x T t12 v2,
         value v2
         (tapp (tabs x T 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_IfTrue : t1 t2,
      (tif ttrue t1 t2) t1
  | ST_IfFalse : t1 t2,
      (tif tfalse t1 t2) t2
  | ST_If : t1 t1' t2 t3,
      t1 t1'
      (tif t1 t2 t3) (tif t1' t2 t3)
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_IfTrue"
  | Case_aux c "ST_IfFalse" | Case_aux c "ST_If"
  ].

Hint Constructors step.

Subtyping

The definition of subtyping is just what we sketched in the motivating discussion.

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

Inductive subtype : ty ty Prop :=
  | S_Refl : T,
    T <: T
  | S_Trans : S U T,
    S <: U
    U <: T
    S <: T
  | S_Top : S,
    S <: TTop
  | S_Arrow : S1 S2 T1 T2,
    T1 <: S1
    S2 <: T2
    (TArrow S1 S2) <: (TArrow T1 T2)
where "T '<:' U" := (subtype T U).

Note that we don't need any special rules for base types: they are automatically subtypes of themselves (by S_Refl) and Top (by S_Top), and that's all we want.

Hint Constructors subtype.

Tactic Notation "subtype_cases" tactic(first) ident(c) :=
  first;
  [ Case_aux c "S_Refl" | Case_aux c "S_Trans"
  | Case_aux c "S_Top" | Case_aux c "S_Arrow"
  ].

Typing

The only change to the typing relation is the addition of the rule of subsumption, T_Sub.

Definition context := id (option ty).
Definition empty : context := (fun _None).
Definition extend (Γ : context) (x:id) (T : ty) :=
  fun x'if eq_id_dec x x' then Some T else Γ x'.

Reserved Notation "Gamma '' t '∈' T" (at level 40).

Inductive has_type : context tm ty Prop :=
  (* Same as before *)
  | T_Var : Γ x T,
      Γ x = Some T
      Γ (tvar x) ∈ T
  | T_Abs : Γ x T11 T12 t12,
      (extend Γ x T11) t12T12
      Γ (tabs x T11 t12) ∈ (TArrow T11 T12)
  | T_App : T1 T2 Γ t1 t2,
      Γ t1 ∈ (TArrow T1 T2)
      Γ t2T1
      Γ (tapp t1 t2) ∈ T2
  | T_True : Γ,
       Γ ttrueTBool
  | T_False : Γ,
       Γ tfalseTBool
  | T_If : t1 t2 t3 T Γ,
       Γ t1TBool
       Γ t2T
       Γ t3T
       Γ (tif t1 t2 t3) ∈ T
  | T_Unit : Γ,
      Γ tunitTUnit
  (* New rule of subsumption *)
  | T_Sub : Γ t S T,
      Γ tS
      S <: T
      Γ tT

where "Gamma '' t '∈' T" := (has_type Γ 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_True"
  | Case_aux c "T_False" | Case_aux c "T_If"
  | Case_aux c "T_Unit"
  | Case_aux c "T_Sub" ].

Properties

We want the same properties as always: progress + preservation.
  • Statements of these theorems don't need to change, compared to pure STLC
  • But proofs are a bit more involved, to account for the additional flexibility in the typing relation

Inversion Lemmas for Subtyping

Before we look at the properties of the typing relation, we need to record a couple of critical structural properties of the subtype relation:
  • Bool is the only subtype of Bool
  • every subtype of an arrow type is an arrow type.

Lemma sub_inversion_Bool : U,
     U <: TBool
       U = TBool.
Proof with auto.
  intros U Hs.
  remember TBool as V.
  (* FILL IN HERE *) Admitted.

Lemma sub_inversion_arrow : U V1 V2,
     U <: (TArrow V1 V2)
     U1, U2,
       U = (TArrow U1 U2) (V1 <: U1) (U2 <: V2).
Proof with eauto.
  intros U V1 V2 Hs.
  remember (TArrow V1 V2) as V.
  generalize dependent V2. generalize dependent V1.
  (* FILL IN HERE *) Admitted.

Canonical Forms

The proof of progress uses facts of the form "every value of arrow type is an abstraction."y
In the pure STLC, such facts are "obvious from the definition."
With subtyping, they require real inductive proofs...

Lemma canonical_forms_of_arrow_types : Γ s T1 T2,
  Γ s ∈ (TArrow T1 T2)
  value s
  x, S1, s2,
     s = tabs x S1 s2.
Proof with eauto.
  (* FILL IN HERE *) Admitted.

Similarly, the canonical forms of type Bool are the constants true and false.

Lemma canonical_forms_of_Bool : Γ s,
  Γ sTBool
  value s
  (s = ttrue s = tfalse).
Proof with eauto.
  intros Γ s Hty Hv.
  remember TBool as T.
  has_type_cases (induction Hty) Case; try solve by inversion...
  Case "T_Sub".
    subst. apply sub_inversion_Bool in H. subst...
Qed.

Progress

Theorem (Progress): 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, with empty t : T. Proceed by induction on the typing derivation.
The cases for T_Abs, T_Unit, T_True and T_False are immediate because abstractions, unit, true, and false are already values. The T_Var case is vacuous because variables cannot be typed in the empty context. The remaining cases are more interesting:
  • If the last step in the typing derivation uses rule T_App, then there are terms t1 t2 and types T1 and T2 such that t = t1 t2, T = T2, empty t1 : T1 T2, and empty t2 : T1. Moreover, by the induction hypothesis, either t1 is a value or it steps, and either t2 is a value or it steps. There are three possibilities to consider:
    • Suppose t1 t1' for some term t1'. Then t1 t2 t1' t2 by ST_App1.
    • Suppose t1 is a value and t2 t2' for some term t2'. Then t1 t2 t1 t2' by rule ST_App2 because t1 is a value.
    • Finally, suppose t1 and t2 are both values. By Lemma canonical_forms_for_arrow_types, we know that t1 has the form λ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.
  • If the final step of the derivation uses rule T_If, then there are terms t1, t2, and t3 such that t = if t1 then t2 else t3, with empty t1 : Bool and with empty t2 : T and empty t3 : T. Moreover, by the induction hypothesis, either t1 is a value or it steps.
    • If t1 is a value, then by the canonical forms lemma for booleans, either t1 = true or t1 = false. In either case, t can step, using rule ST_IfTrue or ST_IfFalse.
    • If t1 can step, then so can t, by rule ST_If.
  • 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.

Theorem progress : t T,
     empty tT
     value t t', t t'.
Proof with eauto.
  intros t T Ht.
  remember empty as Γ.
  revert HeqGamma.
  has_type_cases (induction Ht) Case;
    intros HeqGamma; subst...
  Case "T_Var".
    inversion H.
  Case "T_App".
    right.
    destruct IHHt1; subst...
    SCase "t1 is a value".
      destruct IHHt2; subst...
      SSCase "t2 is a value".
        destruct (canonical_forms_of_arrow_types empty t1 T1 T2)
          as [x [S1 [t12 Heqt1]]]...
        subst. ([x:=t2]t12)...
      SSCase "t2 steps".
        inversion H0 as [t2' Hstp]. (tapp t1 t2')...
    SCase "t1 steps".
      inversion H as [t1' Hstp]. (tapp t1' t2)...
  Case "T_If".
    right.
    destruct IHHt1.
    SCase "t1 is a value"...
      assert (t1 = ttrue t1 = tfalse)
        by (eapply canonical_forms_of_Bool; eauto).
      inversion H0; subst...
      inversion H. rename x into t1'. eauto.

Qed.

Inversion Lemmas for Typing

We also need inversion lemmas for some structural facts about the typing relation that were "obvious from the definition" in pure STLC.
Lemma: If Γ λx:S1.t2 : T, then there is a type S2 such that Γ, x:S1 t2 : S2 and S1 S2 <: T.
(Notice that the lemma does not say, "then T itself is an arrow type" — this is tempting, but false!)
Proof: Let Γ, x, S1, t2 and T be given as described. Proceed by induction on the derivation of Γ λx:S1.t2 : T. Cases T_Var, T_App, are vacuous as those rules cannot be used to give a type to a syntactic abstraction.
  • If the last step of the derivation is a use of T_Abs then there is a type T12 such that T = S1 T12 and Γ, x:S1 t2 : T12. Picking T12 for S2 gives us what we need: S1 T12 <: S1 T12 follows from S_Refl.
  • If the last step of the derivation is a use of T_Sub then there is a type S such that S <: T and Γ λx:S1.t2 : S. The IH for the typing subderivation tell us that there is some type S2 with S1 S2 <: S and Γ, x:S1 t2 : S2. Picking type S2 gives us what we need, since S1 S2 <: T then follows by S_Trans.

Lemma typing_inversion_abs : Γ x S1 t2 T,
     Γ (tabs x S1 t2) ∈ T
     (S2, (TArrow S1 S2) <: T
               (extend Γ x S1) t2S2).
Proof with eauto.
  intros Γ x S1 t2 T H.
  remember (tabs x S1 t2) as t.
  has_type_cases (induction H) Case;
    inversion Heqt; subst; intros; try solve by inversion.
  Case "T_Abs".
    T12...
  Case "T_Sub".
    destruct IHhas_type as [S2 [Hsub Hty]]...
  Qed.

Similarly...

Lemma typing_inversion_var : Γ x T,
  Γ (tvar x) ∈ T
  S,
    Γ x = Some S S <: T.
Proof with eauto.
  intros Γ x T Hty.
  remember (tvar x) as t.
  has_type_cases (induction Hty) Case; intros;
    inversion Heqt; subst; try solve by inversion.
  Case "T_Var".
    T...
  Case "T_Sub".
    destruct IHHty as [U [Hctx HsubU]]... Qed.

Lemma typing_inversion_app : Γ t1 t2 T2,
  Γ (tapp t1 t2) ∈ T2
  T1,
    Γ t1 ∈ (TArrow T1 T2)
    Γ t2T1.
Proof with eauto.
  intros Γ t1 t2 T2 Hty.
  remember (tapp t1 t2) as t.
  has_type_cases (induction Hty) Case; intros;
    inversion Heqt; subst; try solve by inversion.
  Case "T_App".
    T1...
  Case "T_Sub".
    destruct IHHty as [U1 [Hty1 Hty2]]...
Qed.

Lemma typing_inversion_true : Γ T,
  Γ ttrueT
  TBool <: T.
Proof with eauto.
  intros Γ T Htyp. remember ttrue as tu.
  has_type_cases (induction Htyp) Case;
    inversion Heqtu; subst; intros...
Qed.

Lemma typing_inversion_false : Γ T,
  Γ tfalseT
  TBool <: T.
Proof with eauto.
  intros Γ T Htyp. remember tfalse as tu.
  has_type_cases (induction Htyp) Case;
    inversion Heqtu; subst; intros...
Qed.

Lemma typing_inversion_if : Γ t1 t2 t3 T,
  Γ (tif t1 t2 t3) ∈ T
  Γ t1TBool
   Γ t2T
   Γ t3T.
Proof with eauto.
  intros Γ t1 t2 t3 T Hty.
  remember (tif t1 t2 t3) as t.
  has_type_cases (induction Hty) Case; intros;
    inversion Heqt; subst; try solve by inversion.
  Case "T_If".
    auto.
  Case "T_Sub".
    destruct (IHHty H0) as [H1 [H2 H3]]...
Qed.

Lemma typing_inversion_unit : Γ T,
  Γ tunitT
    TUnit <: T.
Proof with eauto.
  intros Γ T Htyp. remember tunit as tu.
  has_type_cases (induction Htyp) Case;
    inversion Heqtu; subst; intros...
Qed.

The inversion lemmas for typing and for subtyping between arrow types can be packaged up as a useful "combination lemma" telling us exactly what we'll actually require below.

Lemma abs_arrow : x S1 s2 T1 T2,
  empty (tabs x S1 s2) ∈ (TArrow T1 T2)
     T1 <: S1
   (extend empty x S1) s2T2.
Proof with eauto.
  intros x S1 s2 T1 T2 Hty.
  apply typing_inversion_abs in Hty.
  inversion Hty as [S2 [Hsub Hty1]].
  apply sub_inversion_arrow in Hsub.
  inversion Hsub as [U1 [U2 [Heq [Hsub1 Hsub2]]]].
  inversion Heq; subst... Qed.

Context Invariance

The context invariance lemma follows the same pattern as in the pure STLC.

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,
        yx
        appears_free_in x t12
        appears_free_in x (tabs y T11 t12)
  | afi_if1 : x t1 t2 t3,
      appears_free_in x t1
      appears_free_in x (tif t1 t2 t3)
  | afi_if2 : x t1 t2 t3,
      appears_free_in x t2
      appears_free_in x (tif t1 t2 t3)
  | afi_if3 : x t1 t2 t3,
      appears_free_in x t3
      appears_free_in x (tif t1 t2 t3)
.

Hint Constructors appears_free_in.

Lemma context_invariance : Γ Γ' t S,
     Γ tS
     (x, appears_free_in x t Γ x = Γ' x)
     Γ' tS.
Proof with eauto.
  intros. generalize dependent Γ'.
  has_type_cases (induction H) Case;
    intros Γ' Heqv...
  Case "T_Var".
    apply T_Var... rewrite Heqv...
  Case "T_Abs".
    apply T_Abs... apply IHhas_type. intros x0 Hafi.
    unfold extend. destruct (eq_id_dec x x0)...

  Case "T_App".
    apply T_App with T1...
  Case "T_If".
    apply T_If...

Qed.

Lemma free_in_context : x t T Γ,
   appears_free_in x t
   Γ tT
   T', Γ x = Some T'.
Proof with eauto.
  intros x t T Γ Hafi Htyp.
  has_type_cases (induction Htyp) Case;
      subst; inversion Hafi; subst...
  Case "T_Abs".
    destruct (IHHtyp H4) as [T Hctx]. T.
    unfold extend in Hctx. rewrite neq_id in Hctx... Qed.

Substitution

The substitution lemma uses the inversion properties that we proved above.

Lemma substitution_preserves_typing : Γ x U v t S,
     (extend Γ x U) tS
     empty vU
     Γ ([x:=v]t) ∈ S.
Proof with eauto.
  intros Γ x U v t S Htypt Htypv.
  generalize dependent S. generalize dependent Γ.
  t_cases (induction t) Case; intros; simpl.
  Case "tvar".
    rename i into y.
    destruct (typing_inversion_var _ _ _ Htypt)
        as [T [Hctx Hsub]].
    unfold extend in Hctx.
    destruct (eq_id_dec x y)...
    SCase "x=y".
      subst.
      inversion Hctx; subst. clear Hctx.
      apply context_invariance with empty...
      intros x Hcontra.
      destruct (free_in_context _ _ S empty Hcontra)
          as [T' HT']...
      inversion HT'.
  Case "tapp".
    destruct (typing_inversion_app _ _ _ _ Htypt)
        as [T1 [Htypt1 Htypt2]].
    eapply T_App...
  Case "tabs".
    rename i into y. rename t into T1.
    destruct (typing_inversion_abs _ _ _ _ _ Htypt)
      as [T2 [Hsub Htypt2]].
    apply T_Sub with (TArrow T1 T2)... 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 "ttrue".
      assert (TBool <: S)
        by apply (typing_inversion_true _ _ Htypt)...
  Case "tfalse".
      assert (TBool <: S)
        by apply (typing_inversion_false _ _ Htypt)...
  Case "tif".
    assert ((extend Γ x U) t1TBool
             (extend Γ x U) t2S
             (extend Γ x U) t3S)
      by apply (typing_inversion_if _ _ _ _ _ Htypt).
    inversion H as [H1 [H2 H3]].
    apply IHt1 in H1. apply IHt2 in H2. apply IHt3 in H3.
    auto.
  Case "tunit".
    assert (TUnit <: S)
      by apply (typing_inversion_unit _ _ Htypt)...
Qed.

Preservation

The proof of preservation now proceeds pretty much as in earlier chapters, using the substitution lemma at the appropriate point and again using inversion lemmas from above to extract structural information from typing assumptions.
Theorem (Preservation): 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. The cases T_Abs, T_Unit, T_True, and T_False cases are vacuous because abstractions and constants 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.
    By inspection of the definition of the step relation, there are three ways t1 t2 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 t1 t2 steps by ST_AppAbs. Then t1 = λx:S.t12 for some type S and term t12, and t' = [x:=t2]t12.
    By lemma abs_arrow, we have T1 <: S and x:S1 s2 : T2. It then follows by the substitution lemma (substitution_preserves_typing) that empty [x:=t2] t12 : T2 as desired.
    • If the final step of the derivation uses rule T_If, then there are terms t1, t2, and t3 such that t = if t1 then t2 else t3, with empty t1 : Bool and with empty t2 : T and empty t3 : T. Moreover, by the induction hypothesis, if t1 steps to t1' then empty t1' : Bool. There are three cases to consider, depending on which rule was used to show t t'.
      • If t t' by rule ST_If, then t' = if t1' then t2 else t3 with t1 t1'. By the induction hypothesis, empty t1' : Bool, and so empty t' : T by T_If.
      • If t t' by rule ST_IfTrue or ST_IfFalse, then either t' = t2 or t' = t3, and empty t' : T follows by assumption.
  • 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.

Theorem preservation : t t' T,
     empty tT
     t t'
     empty t'T.
Proof with eauto.
  intros t t' T HT.
  remember empty as Γ. 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".
      destruct (abs_arrow _ _ _ _ _ HT1) as [HA1 HA2].
      apply substitution_preserves_typing with T...
Qed.