# Subtyping: Subtyping

# Concepts

## A Motivating Example

(\r:{y:nat}. r.y + 1) {x=10,y=11}is not typable: it involves an application of a function that wants a one-field record to an argument that actually provides two fields, while the T_App rule demands that the domain type of the function being applied must match the type of the argument precisely.

*better*argument than it needs! The only thing the body of the function can possibly do with its record argument r is project the field y from it: nothing else is allowed by the type. So the presence or absence of an extra x field should make no difference at all. So, intuitively, it seems that this function should be applicable to any record value that has at least a y field.

*safely*in any context expecting the shorter record type. If the context expects something with the shorter type but we actually give it something with the longer type, nothing bad will happen (formally, the program will not get stuck).

*subtyping*. We say that "S is a subtype of T", informally written S <: T, if a value of type S can safely be used in any context where a value of type T is expected. The idea of subtyping applies not only to records, but to all of the type constructors in the language -- functions, pairs, etc.

## Subtyping and Object-Oriented Languages

*subclassing*in object-oriented languages.

*object*(in Java, C#, etc.) can be thought of as a record, some of whose fields are functions ("methods") and some of whose fields are 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.

*class*or an

*interface*. Both of these provide a description of which methods and which data fields the object offers.

*subclass*and

*subinterface*relations. An object belonging to a subclass (or subinterface) is required to provide all the methods and fields of one belonging to a superclass (or superinterface), plus possibly some more.

*code*that is used when constructing objects and implementing their methods, and the code in subclasses cooperate with code in superclasses via

*inheritance*. Classes can have static methods and fields, initializers, etc., etc.

## The Subsumption Rule

- Defining a binary
*subtype relation*between types. - Enriching the typing relation to take subtyping into account.

*rule of subsumption*:

Gamma |- t : S S <: T | (T_Sub) |

Gamma |- t : T |

## The Subtype Relation

### Products

S1 <: T1 S2 <: T2 | (S_Prod) |

S1*S2 <: T1*T2 |

### Arrows

f : C -> {x:A,y:B} g : (C->{y:B}) -> DThat is, f is a function that yields a record of type {x:A,y:B}, and g is a higher-order function that expects its (function) argument to yield a record of type {y:B}. (And suppose, even though we haven't yet discussed subtyping for records, that {x:A,y:B} is a subtype of {y:B}) Then the application g f is safe even though their types do not match up precisely, because the only thing g can do with f is to apply it to some argument (of type C); the result will actually be a two-field record, while g will be expecting only a record with a single field, but this is safe because the only thing g can then do is to project out the single field that it knows about, and this will certainly be among the two fields that are present.

S2 <: T2 | (S_Arrow2) |

S1->S2 <: S1->T2 |

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

S1->S2 <: T1->T2 |

*contravariant*in its first argument and

*covariant*in its second.

### Top

(S_Top) | |

S <: Top |

### Structural Rules

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

*reflexivity*:

(S_Refl) | |

T <: T |

### Records, Directly

for each jk in j1..jn, | |

exists ip in i1..im, such that | |

jk=ip and Sp <: Tk | (S_Rcd) |

{i1:S1...im:Sm} <: {j1:T1...jn:Tn} |

{x:nat,y:bool} <: {x:nat} "width subtyping" {x:nat} <: {} {x:nat,y:bool} <: {y:bool,x:nat} "permutation" {x:nat,y:bool} <: {y:bool} {a:{x:nat}} <: {a:{}} "depth subtyping"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.

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

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

- {x:A,y:B} <: {y:B,x:A}.
- {}->{j:A} <: {k:B}->Top
- Top->{k:A,j:B} <: C->{j:B}

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

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

### Records, via Products and Top

{a:Nat, b:Nat} ----> {Nat,Nat} i.e. (Nat,(Nat,Top)) {c:Nat, a:Nat} ----> {Nat,Top,Nat} i.e. (Nat,(Top,(Nat,Top)))The encoding of record values doesn't change at all. It is easy (and instructive) to check that the subtyping rules above are validated by the encoding.

# Core definitions

### Syntax

Inductive ty : Type :=

| ty_top : ty

| ty_base : id -> ty

| ty_arrow : ty -> ty -> ty

| ty_unit : ty

.

Tactic Notation "ty_cases" tactic(first) tactic(c) :=

first;

[ c "ty_top" | c "ty_base" | c "ty_arrow"

].

Inductive tm : Type :=

| tm_var : id -> tm

| tm_app : tm -> tm -> tm

| tm_abs : id -> ty -> tm -> tm

| tm_unit : tm

.

Tactic Notation "tm_cases" tactic(first) tactic(c) :=

first;

[ c "tm_var" | c "tm_app" | c "tm_abs" | c "tm_unit"

].

Fixpoint subst (x:id) (s:tm) (t:tm) : tm :=

match t with

| tm_var y => if beq_id x y then s else t

| tm_abs y T t1 => tm_abs y T (if beq_id x y then t1 else (subst x s t1))

| tm_app t1 t2 => tm_app (subst x s t1) (subst x s t2)

| tm_unit => tm_unit

end.

Inductive value : tm -> Prop :=

| v_abs : forall x T t,

value (tm_abs x T t)

| v_unit :

value tm_unit

.

Hint Constructors value.

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

Inductive step : tm -> tm -> Prop :=

| ST_AppAbs : forall x T t12 v2,

value v2 ->

(tm_app (tm_abs x T t12) v2) --> (subst x v2 t12)

| ST_App1 : forall t1 t1' t2,

t1 --> t1' ->

(tm_app t1 t2) --> (tm_app t1' t2)

| ST_App2 : forall v1 t2 t2',

value v1 ->

t2 --> t2' ->

(tm_app v1 t2) --> (tm_app v1 t2')

where "t1 '-->' t2" := (step t1 t2).

Tactic Notation "step_cases" tactic(first) tactic(c) :=

first;

[ c "ST_AppAbs" | c "ST_App1" | c "ST_App2" |

].

Hint Constructors step.

## Definition

Inductive subtype : ty -> ty -> Prop :=

| S_Refl : forall T,

subtype T T

| S_Trans : forall S U T,

subtype S U ->

subtype U T ->

subtype S T

| S_Top : forall S,

subtype S ty_top

| S_Arrow : forall S1 S2 T1 T2,

subtype T1 S1 ->

subtype S2 T2 ->

subtype (ty_arrow S1 S2) (ty_arrow T1 T2)

.

Hint Constructors subtype.

Tactic Notation "subtype_cases" tactic(first) tactic(c) :=

first;

[ c "S_Refl" | c "S_Trans" | c "S_Top" | c "S_Arrow"

].

Module Examples.

Notation x := (Id 0).

Notation y := (Id 1).

Notation z := (Id 2).

Notation A := (ty_base (Id 6)).

Notation B := (ty_base (Id 7)).

Notation C := (ty_base (Id 8)).

(* Let use some suggestive names for the basetypes *)

Notation STRING := (ty_base (Id 9)).

Notation FLOAT := (ty_base (Id 10)).

Notation INTEGER := (ty_base (Id 11)).

#### Exercise: 2 stars, optional (subtyping judgements)

Person := { name : STRING }

Student := { name : STRING ;

gpa : FLOAT }

Employee := { name : STRING ;

ssn : INTEGER }

Student := { name : STRING ;

gpa : FLOAT }

Employee := { name : STRING ;

ssn : INTEGER }

Definition Person : ty :=

(* FILL IN HERE *) admit.

Definition Student : ty :=

(* FILL IN HERE *) admit.

Definition Employee : ty :=

(* FILL IN HERE *) admit.

Example sub_student_person :

subtype Student Person.

Proof.

(* FILL IN HERE *) Admitted.

Example sub_employee_person :

subtype Employee Person.

Proof.

(* FILL IN HERE *) Admitted.

(* FILL IN HERE *) admit.

Definition Student : ty :=

(* FILL IN HERE *) admit.

Definition Employee : ty :=

(* FILL IN HERE *) admit.

Example sub_student_person :

subtype Student Person.

Proof.

(* FILL IN HERE *) Admitted.

Example sub_employee_person :

subtype Employee Person.

Proof.

(* FILL IN HERE *) Admitted.

☐

Example subtyping_example_0 :

subtype (ty_arrow C Person)

(ty_arrow C ty_top).

(* C->Person <: C->Top *)

Proof.

apply S_Arrow.

apply S_Refl. auto.

Qed.

The following facts are mostly easy to prove in Coq. To get
full benefit from the exercises, make sure you also
understand how to prove them on paper!

#### Exercise: 1 star, optional

Example subtyping_example_1 :

subtype (ty_arrow ty_top Student)

(ty_arrow (ty_arrow C C) Person).

(* Top->Student <: (C->C)->Person *)

Proof with eauto.

(* FILL IN HERE *) Admitted.

subtype (ty_arrow ty_top Student)

(ty_arrow (ty_arrow C C) Person).

(* Top->Student <: (C->C)->Person *)

Proof with eauto.

(* FILL IN HERE *) Admitted.

Example subtyping_example_2 :

subtype (ty_arrow ty_top Person)

(ty_arrow Person ty_top).

(* Top->Person <: Person->Top *)

Proof with eauto.

(* FILL IN HERE *) Admitted.

subtype (ty_arrow ty_top Person)

(ty_arrow Person ty_top).

(* Top->Person <: Person->Top *)

Proof with eauto.

(* FILL IN HERE *) Admitted.

☐

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

- T->S <: T->S
- Top->U <: S->Top
- (C->C)->(A*B) <: (C->C)->(Top*B)
- T->T->U <: S->S->V
- (T->T)->U <: (S->S)->V
- ((T->S)->T)->U <: ((S->T)->S)->V
- S*V <: T*U

#### Exercise: 1 star (subtype_instances_tf_2)

Which of the following statements are true? Write TRUE or FALSE after each one.
forall S T,

S <: T ->

S->S <: T->T

forall S T,

S <: A->A ->

exists T,

S = T->T /\ T <: A

forall S T1 T1,

S <: T1 -> T2 ->

exists S1 S2,

S = S1 -> S2 /\ T1 <: S1 /\ S2 <: T2

exists S,

S <: S->S

exists S,

S->S <: S

forall S T2 T2,

S <: T1*T2 ->

exists S1 S2,

S = S1*S2 /\ S1 <: T1 /\ S2 <: T2

☐
S <: T ->

S->S <: T->T

forall S T,

S <: A->A ->

exists T,

S = T->T /\ T <: A

forall S T1 T1,

S <: T1 -> T2 ->

exists S1 S2,

S = S1 -> S2 /\ T1 <: S1 /\ S2 <: T2

exists S,

S <: S->S

exists S,

S->S <: S

forall S T2 T2,

S <: T1*T2 ->

exists 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: 1 star (proper_subtypes)

Is the following statement true or false? Briefly explain your answer.
forall T,

~(exists n, T = ty_base n) ->

exists S,

S <: T /\ S <> T

☐
~(exists n, T = ty_base n) ->

exists S,

S <: T /\ S <> T

#### Exercise: 1 star (small_large_1)

- What is the
*smallest*type T ("smallest" in the subtype relation) that makes the following assertion true?empty |- (\p:T*Top. p.fst) ((\z:A.z), unit) : A->A - What is the
*largest*type T that makes the same assertion true?

#### Exercise: 1 star (small_large_2)

- What is the
*smallest*type T that makes the following assertion true?empty |- (\p:(A->A * B->B). p) ((\z:A.z), (\z:B.z)) : T - What is the
*largest*type T that makes the same assertion true?

#### Exercise: 1 star (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: 1 star (small_large_4)

- What is the
*smallest*type T that makes the following assertion true?exists S,

empty |- (\p:(A*T). (p.snd) (p.fst)) : S - What is the
*largest*type T that makes the same assertion true?

#### Exercise: 1 star (smallest_1)

What is the*smallest*type T that makes the following assertion true?

exists S, exists t,

empty |- (\x:T. x x) t : S

empty |- (\x:T. x x) t : S

#### Exercise: 1 star (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

#### Exercise: 3 stars, optional (count_supertypes)

How many supertypes does the record type {x:A, y:C->C} have? That is, how many different types T are there such that {x:A, y:C->C} <: T? (We consider two types to be different if they are written differently, even if each is a subtype of the other. For example, {x:A,y:B} and {y:B,x:A} are different.)# Typing

Definition context := id -> (option ty).

Definition empty : context := (fun _ => None).

Definition extend (Gamma : context) (x:id) (T : ty) :=

fun x' => if beq_id x x' then Some T else Gamma x'.

Inductive has_type : context -> tm -> ty -> Prop :=

| T_Var : forall Gamma x T,

Gamma x = Some T ->

has_type Gamma (tm_var x) T

| T_Abs : forall Gamma x T11 T12 t12,

has_type (extend Gamma x T11) t12 T12 ->

has_type Gamma (tm_abs x T11 t12) (ty_arrow T11 T12)

| T_App : forall T1 T2 Gamma t1 t2,

has_type Gamma t1 (ty_arrow T1 T2) ->

has_type Gamma t2 T1 ->

has_type Gamma (tm_app t1 t2) T2

| T_Unit : forall Gamma,

has_type Gamma tm_unit ty_unit

(* Subsumption *)

| T_Sub : forall Gamma t S T,

has_type Gamma t S ->

subtype S T ->

has_type Gamma t T.

Hint Constructors has_type.

Tactic Notation "has_type_cases" tactic(first) tactic(c) :=

first;

[ c "T_Var" | c "T_Abs" | c "T_App" |

c "T_Unit" |

c "T_Sub" ].

Do the following exercises after you have added product types to the langauage.
For each informal typing judgement, write it as a formal statement in Coq and
prove it.

#### Exercise: 1 star, optional

(* empty |- ((\z:A.z), (\z:B.z)) : (A->A * B->B) *)

(* FILL IN HERE *)

(* FILL IN HERE *)

(* empty |- (\x:(Top * B->B). x.snd) ((\z:A.z), (\z:B.z)) : B->B *)

(* FILL IN HERE *)

(* FILL IN HERE *)

(* empty |- (\z:(C->C)->(Top * B->B). (z (\x:C.x)).snd)

(\z:C->C. ((\z:A.z), (\z:B.z)))

: B->B *)

(* FILL IN HERE *)

(\z:C->C. ((\z:A.z), (\z:B.z)))

: B->B *)

(* FILL IN HERE *)

☐

# Properties

*statements*of these properties to take subtyping into account. However, their proofs do become a little bit more involved.

## Inversion Lemmas for Subtyping

*is*an arrow type.

#### Exercise: 3 stars

Lemma sub_inversion_arrow : forall U V1 V2,

subtype U (ty_arrow V1 V2) ->

exists U1, exists U2,

U = (ty_arrow U1 U2) /\ (subtype V1 U1) /\ (subtype U2 V2).

Proof with eauto.

intros U V1 V2 Hs.

remember (ty_arrow V1 V2) as V.

generalize dependent V2. generalize dependent V1.

(* FILL IN HERE *) Admitted.

subtype U (ty_arrow V1 V2) ->

exists U1, exists U2,

U = (ty_arrow U1 U2) /\ (subtype V1 U1) /\ (subtype U2 V2).

Proof with eauto.

intros U V1 V2 Hs.

remember (ty_arrow V1 V2) as V.

generalize dependent V2. generalize dependent V1.

(* FILL IN HERE *) Admitted.

☐
The proof of progress doesn't change too much: we just need one
small refinement. When we're considering the case where the term
in question is an application t1 t2 where both t1 and t2 are
values, we need to know that t1 has the
In the STLC with subtyping, this reasoning doesn't quite work
because there's another rule that can be used to show that a value
has a function type: subsumption. Fortunately, this possibility
doesn't change things much: if the last rule used to show Gamma
|- t1 : T11->T12 is subsumption, then there is some
This bit of reasoning is packaged up in the following lemma, which
tells us the possible "canonical forms" (i.e. values) of function
type.

## Progress

*form*of a lambda-abstraction, so that we can apply the ST_AppAbs reduction rule. In the ordinary STLC, this is obvious: we know that t1 has a function type T11->T12, and there is only one rule that can be used to give a function type to a value -- rule T_Abs -- and the form of the conclusion of this rule forces t1 to be an abstraction.*sub*-derivation whose subject is also t1, and we can reason by induction until we finally bottom out at a use of T_Abs.#### Exercise: 3 stars

Lemma canonical_forms_of_arrow_types : forall Gamma s T1 T2,

has_type Gamma s (ty_arrow T1 T2) ->

value s ->

exists x, exists S1, exists s2,

s = tm_abs x S1 s2.

Proof with eauto.

(* FILL IN HERE *) Admitted.

has_type Gamma s (ty_arrow T1 T2) ->

value s ->

exists x, exists S1, exists s2,

s = tm_abs x S1 s2.

Proof with eauto.

(* FILL IN HERE *) Admitted.

☐
The cases for T_Abs and T_Unit are immediate because
abstractions and unit are always values. The T_Var case is
vacuous because variables cannot be typed in the empty context.
The remaining cases are more interesting:

*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.- 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 --> [t2/x]s2 by ST_AppAbs, since t2 is a
value.

- Suppose t1 --> t1' for some term t1'. Then t1 t2 --> t1' t2
by ST_App1.
- 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 : forall t T,

has_type empty t T ->

value t \/ exists t', t --> t'.

Proof with eauto.

intros t T Ht.

remember empty as Gamma.

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. exists (subst x t2 t12)...

SSCase "t2 steps".

destruct H0 as [t2' Hstp]. exists (tm_app t1 t2')...

SCase "t1 steps".

destruct H as [t1' Hstp]. exists (tm_app t1' t2)...

Qed.

## Inversion Lemmas for Typing

*Lemma*: If Gamma |- \x:S1.t2 : T, then there is a type S2 such that Gamma, x:S1 |- t2 : S2 and S1 -> S2 <: T.

*Proof*: Let Gamma, x, S1, t2 and T be given as described. Proceed by induction on the derivation of Gamma |- \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 Gamma,
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 Gamma |- \x:S1.t2 : S. The IH for the typing subderivation tell us that there is some type S2 with S1 -> S2 <: S and Gamma, 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 : forall Gamma x S1 t2 T,

has_type Gamma (tm_abs x S1 t2) T ->

(exists S2, subtype (ty_arrow S1 S2) T

/\ has_type (extend Gamma x S1) t2 S2).

Proof with eauto.

intros Gamma x S1 t2 T H.

remember (tm_abs x S1 t2) as t.

(has_type_cases (induction H) Case);

inversion Heqt; subst; intros; try solve by inversion.

Case "T_Abs".

exists T12...

Case "T_Sub".

destruct IHhas_type as [S2 [Hsub Hty]]...

Qed.

Similarly...

Lemma typing_inversion_var : forall Gamma x T,

has_type Gamma (tm_var x) T ->

exists S,

Gamma x = Some S /\ subtype S T.

Proof with eauto.

intros Gamma x T Hty.

remember (tm_var x) as t.

(has_type_cases (induction Hty) Case); intros;

inversion Heqt; subst; try solve by inversion.

Case "T_Var".

exists T...

Case "T_Sub".

destruct IHHty as [U [Hctx HsubU]]... Qed.

Lemma typing_inversion_app : forall Gamma t1 t2 T2,

has_type Gamma (tm_app t1 t2) T2 ->

exists T1,

has_type Gamma t1 (ty_arrow T1 T2) /\

has_type Gamma t2 T1.

Proof with eauto.

intros Gamma t1 t2 T2 Hty.

remember (tm_app t1 t2) as t.

(has_type_cases (induction Hty) Case); intros;

inversion Heqt; subst; try solve by inversion.

Case "T_App".

exists T1...

Case "T_Sub".

destruct IHHty as [U1 [Hty1 Hty2]]...

Qed.

Lemma typing_inversion_unit : forall Gamma T,

has_type Gamma tm_unit T ->

subtype ty_unit T.

Proof with eauto.

intros Gamma T Htyp. remember tm_unit 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 "combo lemma" telling us
exactly what we'll actually require below.

Lemma abs_arrow : forall x S1 s2 T1 T2,

has_type empty (tm_abs x S1 s2) (ty_arrow T1 T2) ->

subtype T1 S1

/\ has_type (extend empty x S1) s2 T2.

Proof with eauto.

intros x S1 s2 T1 T2 Hty.

apply typing_inversion_abs in Hty.

destruct Hty as [S2 [Hsub Hty]].

apply sub_inversion_arrow in Hsub.

destruct Hsub as [U1 [U2 [Heq [Hsub1 Hsub2]]]].

inversion Heq; subst... Qed.

Inductive appears_free_in : id -> tm -> Prop :=

| afi_var : forall x,

appears_free_in x (tm_var x)

| afi_app1 : forall x t1 t2,

appears_free_in x t1 -> appears_free_in x (tm_app t1 t2)

| afi_app2 : forall x t1 t2,

appears_free_in x t2 -> appears_free_in x (tm_app t1 t2)

| afi_abs : forall x y T11 t12,

y <> x ->

appears_free_in x t12 ->

appears_free_in x (tm_abs y T11 t12)

.

Hint Constructors appears_free_in.

Lemma context_invariance : forall Gamma Gamma' t S,

has_type Gamma t S ->

(forall x, appears_free_in x t -> Gamma x = Gamma' x) ->

has_type Gamma' t 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 x0 Hafi.

unfold extend. remember (beq_id x x0) as e.

destruct e...

Case "T_App".

apply T_App with T1...

Qed.

Lemma free_in_context : forall x t T Gamma,

appears_free_in x t ->

has_type Gamma t T ->

exists T', Gamma x = Some T'.

Proof with eauto.

intros x t T Gamma Hafi Htyp.

(has_type_cases (induction Htyp) Case); subst; inversion Hafi; subst...

Case "T_Abs".

destruct (IHHtyp H4) as [T Hctx]. exists T.

unfold extend in Hctx. apply not_eq_beq_id_false in H2.

rewrite H2 in Hctx... Qed.

## Substitution

*substitution lemma*is proved along the same lines as for the pure STLC. However, there are several places where, instead of using the built-in inversion tactic, we need the inversion lemmas that we proved earlier to extract structural information from assumptions about the well-typedness of subterms.

Lemma substitution_preserves_typing : forall Gamma x U v t S,

has_type (extend Gamma x U) t S ->

has_type empty v U ->

has_type Gamma (subst x v t) S.

Proof with eauto.

intros Gamma x U v t S Htypt Htypv.

generalize dependent S. generalize dependent Gamma.

(tm_cases (induction t) Case); intros; simpl.

Case "tm_var".

rename i into y.

destruct (typing_inversion_var _ _ _ Htypt) as [T [Hctx Hsub]].

unfold extend in Hctx.

remember (beq_id x y) as e. destruct e...

SCase "x=y".

apply beq_id_eq in Heqe. 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 "tm_app".

destruct (typing_inversion_app _ _ _ _ Htypt) as [T1 [Htypt1 Htypt2]].

eapply T_App...

Case "tm_abs".

rename i into y. rename t into T1.

destruct (typing_inversion_abs _ _ _ _ _ Htypt)

as [T2 [Hsub Htypt2]].

apply T_Sub with (ty_arrow T1 T2)... apply T_Abs...

remember (beq_id x y) as e. destruct e.

SCase "x=y".

eapply context_invariance...

apply beq_id_eq in Heqe. subst.

intros x Hafi. unfold extend.

destruct (beq_id y x)...

SCase "x<>y".

apply IHt. eapply context_invariance...

intros z Hafi. unfold extend.

remember (beq_id y z) as e0. destruct e0...

apply beq_id_eq in Heqe0. subst.

rewrite <- Heqe...

Case "tm_unit".

assert (subtype ty_unit S) by apply (typing_inversion_unit _ _ Htypt)...

Qed.

## Preservation

*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 and T_Unit are vacuous because abstractions and unit don't step. Case T_Var is vacuous as well, since the context is empty.

- If the final step of the derivation is by T_App, then there
are terms t1 t2 and types T1 T2 such that t = t1 t2,
T = T2, empty |- t1 : T1 -> T2 and empty |- t2 : T1.
- If the final step of the derivation is by T_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 : forall t t' T,

has_type empty t T ->

t --> t' ->

has_type empty t' T.

Proof with eauto.

intros t t' T HT.

remember empty 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".

destruct (abs_arrow _ _ _ _ _ HT1) as [HA1 HA2].

apply substitution_preserves_typing with T...

Qed.

## Exercises on typing

#### Exercise: 2 stars, optional (variations)

Each part of this problem suggests a different way of changing the definition of the STLC with Unit and subtyping. (These changes are not cumulative: each part starts from the original language.) In each part, list which properties (Progress, Preservation, both, or neither) become false. If a property becomes false, give a counterexample.- Suppose we add the following typing rule:
Gamma |- t : S1->S2 S1 <: T1 T1 <: S1 S2 <: T2 (T_Funny1) Gamma |- t : T1->T2 - Suppose we add the following reduction rule:
(ST_Funny21) unit --> (\x:Top. x) - Suppose we add the following subtyping rule:
(S_Funny3) Unit <: Top->Top - Suppose we add the following subtyping rule:
(S_Funny4) Top->Top <: Unit - Suppose we add the following evaluation rule:
(ST_Funny5) (unit t) --> (t unit) - Suppose we add the same evaluation rule
*and*a new typing rule:(ST_Funny5) (unit t) --> (t unit) (T_Funny6) empty |- Unit : Top->Top - Suppose we
*change*the arrow subtyping rule to:S1 <: T1 S2 <: T2 (S_Arrow') S1->S2 <: T1->T2

### Exercise: Adding Products

#### Exercise: 4 stars (products)

Adding pairs, projections, and product types to the system we have defined is a relatively straightforward matter. Carry out this extension:- Add constructors for pairs, first and second projections, and
product types to the definitions of ty and tm. (Don't
forget to add corresponding cases to ty_cases and tm_cases.)
- Extend the well-formedness relation in the obvious way.
- Extend the operational semantics with the same reduction rules
as in the last chapter.
- Extend the subtyping relation with this rule:
S1 <: T1 S2 <: T2 (Sub_Prod) S1 * S2 <: T1 * T2 - Extend the typing relation with the same rules for pairs and
projections as in the last chapter.
- Extend the proofs of progress, preservation, and all their supporting lemmas to deal with the new constructs. (You'll also need to add some completely new lemmas.) ☐