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, the following 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.

Roughly, 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 a₁..an consists of projecting out the m field of o and applying it to a₁..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 and other visibility modifiers
method inheritance
static components
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:

Gamma ⊢ t ∈ S S <: T	(T_Sub)

Gamma ⊢ 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 (richer, safer) 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 certainly any type T is 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 a subtype of another if each of its components is.

S₁ <: T₁ S₂ <: T₂	(S_Prod)

S₁ * S₂ <: T₁ * T₂

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

T₁ <: S₁ S₂ <: T₂	(S_Arrow)

S₁ → S₂ <: T₁ → T₂

Suppose we have S <: T and U <: V. Which of the following subtyping assertions is false?

(1) S*U <: T*V

(2) T→U <: S→U

(3) (S→U) → (S*V) <: (S→U) → (T*U)

(4) (T*U) → V <: (S*U) → V

(5) S→U <: S→V

Suppose again that we have S <: T and U <: V. Which of the following is incorrect?

(1) (T→T)*U <: (S→T)*V

(2) T→U <: S→V

(3) (S→U) → (S→V) <: (T→U) → (T→V)

(4) (S→V) → V <: (T→U) → V

(5) S → (V→U) <: S → (U→U)

Records

What about subtyping for record types?

The basic intuition 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:

∀jk in j₁..jn,
∃ip in i₁..im, such that
jk=ip and Sp <: Tk	(S_Rcd)

{i₁:S₁...im:Sm} <: {j₁:T₁...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, so it is often decomposed 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)

{i₁:T₁...in:Tn} <: {i₁:T₁...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} <: {age:Nat}.

Second, subtyping can be applied inside the components of a compound record type:

S₁ <: T₁ ... Sn <: Tn	(S_RcdDepth)

{i₁:S₁...in:Sn} <: {i₁:T₁...in:Tn}

For example, we can use S_RcdDepth and S_RcdWidth together to show that {y:Student, x:Nat} <: {y:Person}.

Third, subtyping can reorder fields. For example, we want {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 add:

{i₁:S₁...in:Sn} is a permutation of {j₁:T₁...jn:Tn}	(S_RcdPerm)

{i₁:S₁...in:Sn} <: {j₁:T₁...jn:Tn}

It is worth noting that full-blown language designs may choose not to adopt all of these subtyping rules. For example, in Java:

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).
In early versions of Java, a subclass could 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).

Top

Finally, it is convenient to give the subtype relation a maximum 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 then...

adding a base type Top,
adding the rule of subsumption

Gamma ⊢ t ∈ S S <: T (T_Sub)

Gamma ⊢ 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

S₁ <: T₁    S₂ <: T₂ (S_Prod)

S₁ * S₂ <: T₁ * T₂

T₁ <: S₁    S₂ <: T₂ (S_Arrow)

S₁ → S₂ <: T₁ → T₂

n > m (S_RcdWidth)

{i₁:T₁...in:Tn} <: {i₁:T₁...im:Tm}

S₁ <: T₁  ...  Sn <: Tn (S_RcdDepth)

{i₁:S₁...in:Sn} <: {i₁:T₁...in:Tn}

{i₁:S₁...in:Sn} is a permutation of {j₁:T₁...jn:Tn} (S_RcdPerm)

{i₁:S₁...in:Sn} <: {j₁:T₁...jn:Tn}

Suppose we have S <: T and U <: V. Which of the following subtyping assertions is false?

(1) S*U <: Top

(2) {i₁:S,i₂:T}→U <: {i₁:S,i₂:T,i₃:V}→U

(3) (S→T) → (Top → Top) <: (S→T) → Top

(4) (Top → Top) → V <: Top → V

(5) S → {i₁:U,i₂:V} <: S → {i₂:V,i₁:U}

How about these?

(1) {i₁:Top} <: Top

(2) Top → (Top → Top) <: Top → Top

(3) {i₁:T} → {i₁:T} <: {i₁:T,i₂:S} → Top

(4) {i₁:T,i₂:V,i₃:V} <: {i₁:S,i₂:U} * {i₃:V}

(5) Top → {i₁:U,i₂:V} <: {i₁:S} → {i₂:V,i₁:V}

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

(1) Top

(2) A

(3) Top→Top

(4) Top→A

(5) A→A

(6) A→Top

What is the largest type T that makes the following assertion true?

a:A ⊢ (\p:(A*T). (p.snd) (p.fst)) (a, \z:A.z) ∈ A

(1) Top

(2) A

(3) Top→Top

(4) Top→A

(5) A→A

(6) A→Top

"The type Bool has no proper subtypes." (I.e., the only type smaller than Bool is Bool itself.)

(1) True

(2) False

"Suppose S, T₁, and T₂ are types with S <: T₁ → T₂. Then S itself is an arrow type — i.e., S = S₁ → S₂ for some S₁ and S₂ — with T₁ <: S₁ and S₂ <: T₂."

(1) True

(2) False

Formal Definitions

Most of the definitions needed to formalize what we've discussed above — 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

(* (Omitting records, to avoid dealing with ... stuff.) *)

Substitution

The definition of substitution remains exactly the same as for the pure STLC.

Fixpoint subst (x:string) (s:tm) (t:tm) : tm :=
  match t with
  | var y ⇒
      if eqb_string x y then s else t
  | abs y T t₁ ⇒
      abs y T (if eqb_string x y then t₁ else (subst x s t₁))
  | app t₁ t₂ ⇒
      app (subst x s t₁) (subst x s t₂)
  | tru ⇒
      tru
  | fls ⇒
      fls
  | test t₁ t₂ t₃ ⇒
      test (subst x s t₁) (subst x s t₂) (subst x s t₃)
  | unit ⇒
      unit
  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 (abs x T t)
  | v_true :
      value tru
  | v_false :
      value fls
  | v_unit :
      value unit
.

Hint Constructors value.

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

Inductive step : tm → tm → Prop :=
  | ST_AppAbs : ∀x T t₁₂ v₂,
         value v₂ →
         (app (abs x T t₁₂) v₂) --> [x:=v₂]t₁₂
  | ST_App1 : ∀t₁ t₁' t₂,
         t₁ --> t₁' →
         (app t₁ t₂) --> (app t₁' t₂)
  | ST_App2 : ∀v₁ t₂ t₂',
         value v₁ →
         t₂ --> t₂' →
         (app v₁ t₂) --> (app v₁ t₂')
  | ST_TestTrue : ∀t₁ t₂,
      (test tru t₁ t₂) --> t₁
  | ST_TestFalse : ∀t₁ t₂,
      (test fls t₁ t₂) --> t₂
  | ST_Test : ∀t₁ t₁' t₂ t₃,
      t₁ --> t₁' →
      (test t₁ t₂ t₃) --> (test t₁' t₂ t₃)
where "t₁ '-->' t₂" := (step t₁ t₂).

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 <: Top
  | S_Arrow : ∀S₁ S₂ T₁ T₂,
      T₁ <: S₁ →
      S₂ <: T₂ →
      (Arrow S₁ S₂) <: (Arrow T₁ T₂)
where "T '<:' U" := (subtype T U).

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

Hint Constructors subtype.

Typing

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

Definition context := partial_map ty.

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

Inductive has_type : context → tm → ty → Prop :=
  (* Same as before *)
  | T_Var : ∀Gamma x T,
      Gamma x = Some T →
      Gamma ⊢ var x ∈ T
  | T_Abs : ∀Gamma x T₁₁ T₁₂ t₁₂,
      (x ⊢> T₁₁ ; Gamma) ⊢ t₁₂ ∈ T₁₂ →
      Gamma ⊢ abs x T₁₁ t₁₂ ∈ Arrow T₁₁ T₁₂
  | T_App : ∀T₁ T₂ Gamma t₁ t₂,
      Gamma ⊢ t₁ ∈ Arrow T₁ T₂ →
      Gamma ⊢ t₂ ∈ T₁ →
      Gamma ⊢ app t₁ t₂ ∈ T₂
  | T_True : ∀Gamma,
       Gamma ⊢ tru ∈ Bool
  | T_False : ∀Gamma,
       Gamma ⊢ fls ∈ Bool
  | T_Test : ∀t₁ t₂ t₃ T Gamma,
       Gamma ⊢ t₁ ∈ Bool →
       Gamma ⊢ t₂ ∈ T →
       Gamma ⊢ t₃ ∈ T →
       Gamma ⊢ test t₁ t₂ t₃ ∈ T
  | T_Unit : ∀Gamma,
      Gamma ⊢ unit ∈ Unit
  (* New rule of subsumption *)
  | T_Sub : ∀Gamma t S T,
      Gamma ⊢ t ∈ S →
      S <: T →
      Gamma ⊢ t ∈ T

where "Gamma '⊢' t '∈' T" := (has_type Gamma t T).

Hint Constructors has_type.

The following hints help auto and eauto construct typing derivations. They are only used in a few places, but they give a nice illustration of what auto can do with a bit more programming. See chapter UseAuto for more on hints.

Hint Extern 2 (has_type _ (app _ _) _) ⇒
eapply T_App; auto.
Hint Extern 2 (_ = _) ⇒ compute; reflexivity.

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 establish a couple of critical structural properties of the subtype relation:

Bool is the only subtype of Bool, and
every subtype of an arrow type is itself an arrow type.

Formally:

Lemma sub_inversion_Bool : ∀U,
U <: Bool →
U = Bool.

Proof with auto.
  intros U Hs.
  remember Bool as V.
  (* FILL IN HERE *) Admitted.

☐
Lemma sub_inversion_arrow : ∀U V₁ V₂,
     U <: Arrow V₁ V₂ →
     ∃U₁ U₂,
     U = Arrow U₁ U₂ ∧ V₁ <: U₁ ∧ U₂ <: V₂.

Proof with eauto.
  intros U V₁ V₂ Hs.
  remember (Arrow V₁ V₂) as V.
  generalize dependent V₂. generalize dependent V₁.
  (* FILL IN HERE *) Admitted.

Canonical Forms

The proof of progress uses facts of the form "every value belonging to an arrow type is an abstraction."

In the pure STLC, such facts are "immediate from the definition" (we can directly use the inversion tactic).

With subtyping, they require real inductive proofs...

Lemma canonical_forms_of_arrow_types : ∀Gamma s T₁ T₂,
  Gamma ⊢ s ∈ Arrow T₁ T₂ →
  value s →
  ∃x S₁ s₂,
     s = abs x S₁ s₂.

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

Similarly, the canonical forms of type Bool are the constants tru and fls.

Lemma canonical_forms_of_Bool : ∀Gamma s,
  Gamma ⊢ s ∈ Bool →
  value s →
  s = tru ∨ s = fls.

Proof with eauto.
  intros Gamma s Hty Hv.
  remember Bool as T.
  induction Hty; try solve_by_invert...
  - (* 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, tru, and fls 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 t₁ t₂ and types T₁ and T₂ such that t = t₁ t₂, T = T₂, empty ⊢ t₁ ∈ T₁ → T₂, and empty ⊢ t₂ ∈ T₁. Moreover, by the induction hypothesis, either t₁ is a value or it steps, and either t₂ is a value or it steps. There are three possibilities to consider:
- Suppose t₁ --> t₁' for some term t₁'. Then t₁ t₂ --> t₁' t₂ by ST_App1.
- Suppose t₁ is a value and t₂ --> t₂' for some term t₂'. Then t₁ t₂ --> t₁ t₂' by rule ST_App2 because t₁ is a value.
- Finally, suppose t₁ and t₂ are both values. By the canonical forms lemma for arrow types, we know that t₁ has the form \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 final step of the derivation uses rule T_Test, then there are terms t₁, t₂, and t₃ such that t = test t₁ then t₂ else t₃, with empty ⊢ t₁ ∈ Bool and with empty ⊢ t₂ ∈ T and empty ⊢ t₃ ∈ T. Moreover, by the induction hypothesis, either t₁ is a value or it steps.
- If t₁ is a value, then by the canonical forms lemma for booleans, either t₁ = tru or t₁ = fls. In either case, t can step, using rule ST_TestTrue or ST_TestFalse.
- If t₁ can step, then so can t, by rule ST_Test.
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.

Formally:

Theorem progress : ∀t T,
empty ⊢ t ∈ 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 *)
        inversion H₀ as [t₂' Hstp]. ∃(app t₁ t₂')...
    + (* t₁ steps *)
      inversion H as [t₁' Hstp]. ∃(app t₁' t₂)...
  - (* T_Test *)
    right.
    destruct IHHt1.
    + (* t₁ is a value *) eauto.
    + assert (t₁ = tru ∨ t₁ = fls)
        by (eapply canonical_forms_of_Bool; eauto).
      inversion H₀; subst...
    + inversion H. rename x into t₁'. 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 Gamma ⊢ \x:S₁.t2 ∈ T, then there is a type S₂ such that x⊢>S₁; Gamma ⊢ t₂ ∈ S₂ and S₁ → S₂ <: T.

(Notice that the lemma does not say, "then T itself is an arrow type" — this is tempting, but false!)

Proof: Let Gamma, x, S₁, t₂ and T be given as described. Proceed by induction on the derivation of Gamma ⊢ \x:S₁.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 T₁₂ such that T = S₁ → T₁₂ and x:S₁; Gamma ⊢ t₂ ∈ T₁₂. Picking T₁₂ for S₂ gives us what we need: S₁ → T₁₂ <: S₁ → T₁₂ 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 Gamma ⊢ \x:S₁.t2 ∈ S. The IH for the typing subderivation tells us that there is some type S₂ with S₁ → S₂ <: S and x:S₁; Gamma ⊢ t₂ ∈ S₂. Picking type S₂ gives us what we need, since S₁ → S₂ <: T then follows by S_Trans.

Formally:

Lemma typing_inversion_abs : ∀Gamma x S₁ t₂ T,
     Gamma ⊢ (abs x S₁ t₂) ∈ T →
     ∃S₂,
       Arrow S₁ S₂ <: T
       ∧ (x ⊢> S₁ ; Gamma) ⊢ t₂ ∈ S₂.

Proof with eauto.
  intros Gamma x S₁ t₂ T H.
  remember (abs x S₁ t₂) as t.
  induction H;
    inversion Heqt; subst; intros; try solve_by_invert.
  - (* T_Abs *)
    ∃T₁₂...
  - (* T_Sub *)
    destruct IHhas_type as [S₂ [Hsub Hty]]...
  Qed.

Similarly...

Lemma typing_inversion_var : ∀Gamma x T,
  Gamma ⊢ (var x) ∈ T →
  ∃S,
    Gamma x = Some S ∧ S <: T.

Proof with eauto.
  intros Gamma x T Hty.
  remember (var x) as t.
  induction Hty; intros;
    inversion Heqt; subst; try solve_by_invert.
  - (* T_Var *)
    ∃T...
  - (* T_Sub *)
    destruct IHHty as [U [Hctx HsubU]]... Qed.

Lemma typing_inversion_app : ∀Gamma t₁ t₂ T₂,
  Gamma ⊢ (app t₁ t₂) ∈ T₂ →
  ∃T₁,
    Gamma ⊢ t₁ ∈ (Arrow T₁ T₂) ∧
    Gamma ⊢ t₂ ∈ T₁.

Proof with eauto.
  intros Gamma t₁ t₂ T₂ Hty.
  remember (app t₁ t₂) as t.
  induction Hty; intros;
    inversion Heqt; subst; try solve_by_invert.
  - (* T_App *)
    ∃T₁...
  - (* T_Sub *)
    destruct IHHty as [U₁ [Hty1 Hty2]]...
Qed.

Lemma typing_inversion_true : ∀Gamma T,
Gamma ⊢ tru ∈ T →
Bool <: T.

Proof with eauto.
  intros Gamma T Htyp. remember tru as tu.
  induction Htyp;
    inversion Heqtu; subst; intros...
Qed.

Lemma typing_inversion_false : ∀Gamma T,
Gamma ⊢ fls ∈ T →
Bool <: T.

Proof with eauto.
  intros Gamma T Htyp. remember fls as tu.
  induction Htyp;
    inversion Heqtu; subst; intros...
Qed.

Lemma typing_inversion_if : ∀Gamma t₁ t₂ t₃ T,
  Gamma ⊢ (test t₁ t₂ t₃) ∈ T →
  Gamma ⊢ t₁ ∈ Bool
  ∧ Gamma ⊢ t₂ ∈ T
  ∧ Gamma ⊢ t₃ ∈ T.

Proof with eauto.
  intros Gamma t₁ t₂ t₃ T Hty.
  remember (test t₁ t₂ t₃) as t.
  induction Hty; intros;
    inversion Heqt; subst; try solve_by_invert.
  - (* T_Test *)
    auto.
  - (* T_Sub *)
    destruct (IHHty H₀) as [H₁ [H₂ H₃]]...
Qed.

Lemma typing_inversion_unit : ∀Gamma T,
Gamma ⊢ unit ∈ T →
Unit <: T.

Proof with eauto.
  intros Gamma T Htyp. remember unit as tu.
  induction Htyp;
    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 S₁ s₂ T₁ T₂,
  empty ⊢ (abs x S₁ s₂) ∈ (Arrow T₁ T₂) →
     T₁ <: S₁
  ∧ (x ⊢> S₁ ; empty) ⊢ s₂ ∈ T₂.

Proof with eauto.
  intros x S₁ s₂ T₁ T₂ Hty.
  apply typing_inversion_abs in Hty.
  inversion Hty as [S₂ [Hsub Hty1]].
  apply sub_inversion_arrow in Hsub.
  inversion Hsub as [U₁ [U₂ [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 : string → tm → Prop :=
  | afi_var : ∀x,
      appears_free_in x (var x)
  | afi_app1 : ∀x t₁ t₂,
      appears_free_in x t₁ → appears_free_in x (app t₁ t₂)
  | afi_app2 : ∀x t₁ t₂,
      appears_free_in x t₂ → appears_free_in x (app t₁ t₂)
  | afi_abs : ∀x y T₁₁ t₁₂,
        y ≠ x →
        appears_free_in x t₁₂ →
        appears_free_in x (abs y T₁₁ t₁₂)
  | afi_test1 : ∀x t₁ t₂ t₃,
      appears_free_in x t₁ →
      appears_free_in x (test t₁ t₂ t₃)
  | afi_test2 : ∀x t₁ t₂ t₃,
      appears_free_in x t₂ →
      appears_free_in x (test t₁ t₂ t₃)
  | afi_test3 : ∀x t₁ t₂ t₃,
      appears_free_in x t₃ →
      appears_free_in x (test t₁ t₂ t₃)
.

Hint Constructors appears_free_in.

Lemma context_invariance : ∀Gamma Gamma' t S,
     Gamma ⊢ t ∈ S →
     (∀x, appears_free_in x t → Gamma x = Gamma' x) →
     Gamma' ⊢ t ∈ S.

Proof with eauto.
  intros. generalize dependent Gamma'.
  induction H;
    intros Gamma' Heqv...
  - (* T_Var *)
    apply T_Var... rewrite <- Heqv...
  - (* T_Abs *)
    apply T_Abs... apply IHhas_type. intros x₀ Hafi.
    unfold update, t_update. destruct (eqb_stringP x x₀)...
  - (* T_Test *)
    apply T_Test...
Qed.

Lemma free_in_context : ∀x t T Gamma,
   appears_free_in x t →
   Gamma ⊢ t ∈ T →
   ∃T', Gamma x = Some T'.

Proof with eauto.
  intros x t T Gamma Hafi Htyp.
  induction Htyp;
      subst; inversion Hafi; subst...
  - (* T_Abs *)
    destruct (IHHtyp H₄) as [T Hctx]. ∃T.
    unfold update, t_update in Hctx.
    rewrite <- eqb_string_false_iff in H₂.
    rewrite H₂ in Hctx... Qed.

Substitution

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

Lemma substitution_preserves_typing : ∀Gamma x U v t S,
     (x ⊢> U ; Gamma) ⊢ t ∈ S →
     empty ⊢ v ∈ U →
     Gamma ⊢ [x:=v]t ∈ S.

Proof with eauto.
  intros Gamma x U v t S Htypt Htypv.
  generalize dependent S. generalize dependent Gamma.
  induction t; intros; simpl.
  - (* var *)
    rename s into y.
    destruct (typing_inversion_var _ _ _ Htypt)
        as [T [Hctx Hsub]].
    unfold update, t_update in Hctx.
    destruct (eqb_stringP x y) as [Hxy|Hxy]; eauto;
    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'.
  - (* app *)
    destruct (typing_inversion_app _ _ _ _ Htypt)
        as [T₁ [Htypt1 Htypt2]].
    eapply T_App...
  - (* abs *)
    rename s into y. rename t into T₁.
    destruct (typing_inversion_abs _ _ _ _ _ Htypt)
      as [T₂ [Hsub Htypt2]].
    apply T_Sub with (Arrow T₁ T₂)... apply T_Abs...
    destruct (eqb_stringP x y) as [Hxy|Hxy].
    + (* x=y *)
      eapply context_invariance...
      subst.
      intros x Hafi. unfold update, t_update.
      destruct (eqb_string y x)...
    + (* x<>y *)
      apply IHt. eapply context_invariance...
      intros z Hafi. unfold update, t_update.
      destruct (eqb_stringP y z)...
      subst.
      rewrite <- eqb_string_false_iff in Hxy. rewrite Hxy...
  - (* tru *)
      assert (Bool <: S)
        by apply (typing_inversion_true _ _ Htypt)...
  - (* fls *)
      assert (Bool <: S)
        by apply (typing_inversion_false _ _ Htypt)...
  - (* test *)
    assert ((x ⊢> U ; Gamma) ⊢ t₁ ∈ Bool
         ∧ (x ⊢> U ; Gamma) ⊢ t₂ ∈ S
         ∧ (x ⊢> U ; Gamma) ⊢ t₃ ∈ S)
      by apply (typing_inversion_if _ _ _ _ _ Htypt).
    inversion H as [H₁ [H₂ H₃]].
    apply IHt1 in H₁. apply IHt2 in H₂. apply IHt3 in H₃.
    auto.
  - (* unit *)
    assert (Unit <: S)
      by apply (typing_inversion_unit _ _ Htypt)...
Qed.