Require Export Types.
(** * Announcement *)
(** A review session will be held on Monday from 3-4:30.
Location TBA. *)
(* ###################################################### *)
(** * Subtyping *)
(* ###################################################### *)
(** *** A motivating example *)
(** In the simply typed lamdba-calculus with records from the last
chapter, the term
<<
(\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.
But this is silly: we're passing the function a _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.
Looking at the same thing from another point of view, a record with
more fields is "at least as good in any context" as one with just a
subset of these fields, in the sense that any value belonging to
the longer record type can be used 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).
The general principle at work here is called 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 -- to
functions, pairs, etc. *)
(** *** Subtyping and object-oriented languages *)
(** The principle of subtyping plays a fundamental role in many
present-day programming languages -- in particular, it is closely
related to the notion of SUBCLASSING in object-oriented languages.
An 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].
The type of an object can be given as either a CLASS or an
INTERFACE. Both of these provide a description of which methods
and which data fields the object offers.
Classes and interfaces are related by the 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.
The fact that an object from a subclass (or subinterface) can be
used in place of one from a superclass (/superinterface) provides
a degree of flexibility that is is extremely handy for organizing
complex libraries. For example, a graphical user interface
toolkit like Java's AWT might define an abstract interface
[Component] that collects together the common fields and methods
of all objects having a graphical representation that can be
displayed on the screen and that can interact with the user.
Examples of such object would include the buttons, checkboxes, and
scrollbars of a typical GUI. A method that relies only on this
common interface can now be applied to any of these objects.
Of course, real object-oriented languages include many other
features besides these. Fields can be updated. Fields and
methods can be declared [private]. Classes also give _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.
To keep things simple, we won't deal with any of these issues, and
we won't even talk any more about objects or classes. (There is a
lot of discussion in Types and Programming Languages, for those
that are interested.) Instead, we'll study the "essential core" of
the subclass / subinterface relation in the stripped down setting
of the STLC. *)
(** *** The subsumption rule *)
(** Our goal for this chapter is to add subtyping to the simply typed
lambda-calculus with records. This involves two steps:
- 1. Defining subtyping as a binary relation between types.
- 2. 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 we can "forget" some of the information
that we know about a term. For example, we may know that [t] is a record
with two fields (e.g., [S = {x:A->A, y:B->B}] ], but choose to forget
about one of the fields ([T = {y:B->B}]) so that we can pass [t] to a
function that expects just a single-field record. *)
(** *** 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.
To begin with, we need to formalize the basic intuition about record
types that a longer record should be a subtype of a shorter one.
<<
for each jk in j1..jn, exists ip in i1..im with Sk <: Tp
-------------------------------------------------------- (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. For example:
<<
{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"
>>
Formally, our record types are presented in a "binary" form (with
constructors for nil and cons, rather than a single constructor
that assembles a whole multi-field record all at once), and so
we'll need to formulate subtyping in the same way. This can be
accomplished by replacing the single rule above with a combination
of three rules.
To state these rules, we need to begin by introducing informal
notations corresponding to the constructors [ty_rnil] and
[ty_rcons]. We'll write [ty_rnil] as [{}] (just like we have
been), and we'll write [ty_rcons k S T] as [k:S;T] (note the
semicolon).
So, for example, a record with three fields might be written
[j:A;k:B;l:C;{}]. However, since looks a bit awkward and nonstandard,
we'll introduce one final informal convention: in multi-field row
types like this expression, we'll pick up the left curly brace and
move it all the way to the left of the expression, changing the
semicolons to commas as we go. In other words the informal expressions
[[
j:A;k:B;l:C;{}
]]
and
[[
{j:A,k:B,l:C}
]]
will mean the very same thing -- they will both denote this formal record
type:
[[
ty_rcons j (ty_base A)
(ty_rcons k (ty_base B)
(ty_rcons l (ty_base C)
ty_rnil))
]]
With these notations in hand, we're ready to talk about the three
subtyping rules for records.
First, any row of record types is a subtype of the empty record type:
<<
-------- (S_RcdWidth)
Tr <: {}
>>
Second, we can apply subtyping inside the components of a compound row:
<<
S1 <: T1 Sr2 <: Tr2
---------------------------- (S_RcdDepth)
i1:S1; Sr2 <: i1:T1; Tr2
>>
We can use [S_RcdDepth] and [S_RcdWidth] together to drop later fields of
a multi-field record while keeping earlier fields, showing for example
that [{y:B->B, x:A->A} <: {y:B->B}]. We can also use [S_RcdDepth] and
[S_RcdWidth] together to show that [{y:{z:B->B}, x:A->A} <: {y:{}}].
The example we originally had in mind was [{x:A->A,y:B->B} <: {y:B->B}].
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. To
handle the original example, we also need to be able to reorder fields:
<<
i1 <> i2
------------------------------------------ (S_RcdPerm)
i1:T1; i2:T2; Tr3 <: i2:T2; i1:T1; Tr3
>>
For example, [{x:A->A,y:B->B}] <: [{y:B->B,x:A->A}].
We can also include a general 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
>>
This rule allows us to paste together the proofs we've
seen that [{x:A->A, y:B->B} <: {y:B->B, x:A->A}] (by [S_RcdPerm]) and
that [{y:B->B, x:A->A} <: {y:B->B}] (by [S_RcdDepth] and
[S_RcdWidth]), to yield a proof that [{x:A->A, y:B->B} <: {y:B->B}].
This completes the subtyping rules for records. To finish the
whole definition of subtyping, we need to consider how each of the
other type constructors behaves with respect to subtyping. Since
we're dealing with a very simple language with just arrows and
records, we have only arrows left to deal with. A variant of the
first example motivates the discussion.
Suppose we have two functions [f] and [g] with these types:
<<
f : C -> {x:A->A,y:B->B}
g : (C->{y:B->B}) -> D
>>
That is, [f] is a function that yields a record of type
[{x:A->A,y:B->B}], and [g] is a higher-order function that expects
its (function) argument to yield a record of type [{y:B->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.
This example suggests that the subtyping rule for arrow types
should say that two arrow types are in the subtype relation if
their results are:
<<
S2 <: T2
---------------- (S_Arrow)
S1->S2 <: S1->T2
>>
We can generalize this to allow the arguments of the two arrow
types to be in the subtype relation as well:
<<
T1 <: S1 S2 <: T2
-------------------- (S_Arrow)
S1->S2 <: T1->T2
>>
Notice, here, that the argument types are subtypes "the other way
round": in order to conclude that [S1->S2] to be a subtype of
[T1->T2], it must be the case that [T1] is a subtype of [S1]. The
arrow constructor is said to be _contravariant_ in its first
argument and _covariant_ in its second.
The intuition is that, if we have a function [f] of type [S1->S2],
then we know that [f] accepts elements of type [S1]; clearly, [f]
will also accept elements of any subtype [T1] of [S1]. The type of
[f] also tells us that it returns elements of type [S2]; we can
also view these results belonging to any supertype [T2] of
[S2]. That is, any function [f] of type [S1->S2] can also be viewed
as having type [T1->T2].
Finally, we add one last structural rule, which (together with
transitivity) ensures that the subtype relation is a preorder:
<<
------ (S_Refl)
T <: T
>>
We can stop here, if we like. But it is common practice to go one
further step and add 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[#].
Some more examples:
- [{}->{j:A} <: {k:B}->Top]
- [Top->{k:A->A,j:B->B} <: (C->C)->{j:B->B}]
*)
(** *** Variations *)
(** Real languages often 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 ("multiple inheritance"
of interfaces)
-- i.e., permutation is allowed for interfaces. *)
(* ###################################################### *)
(** * Core definitions *)
(** We've already sketched the significant extensions that we'll
need to make to the STLC: (1) add the subtype relation
and (2) extend the typing relation with the rule of
subsumption. To make everything work smoothly, we'll also
implement some technical improvements to the presentation
from the last chapter; in particular, we'll add "well
formedness" predicates for both terms and types that verify
that the record constructors are properly used. The rest of
the definitions -- in particular, the syntax and operational
semantics of the language -- are identical to what we saw in
the last chapter. Let's first do the identical bits. *)
(* ################################### *)
(** *** Syntax *)
(** There are just a couple of small technical differences here
from the previous system. (The way we formulate it here is a
little bit nicer -- the previous system should be changed
to match this one.)
- The [ty_rcd] constructor has been eliminated from this
presentation (and [tm_rcd] below). This is not
essential (it is easy to add them back in), but it
streamlines the development a little and we feel now that
it's a bit cleaner.
- The constructors [ty_rnil] and [ty_rcons] have been
renamed [ty_rnil] and [ty_rcons]. *)
Inductive ty : Set :=
(* proper types *)
| ty_top : ty
| ty_base : id -> ty
| ty_arrow : ty -> ty -> ty
(* type rows *)
| ty_rnil : ty
| ty_rcons : id -> ty -> ty -> ty.
Tactic Notation "ty_cases" tactic(first) tactic(c) :=
first;
[ c "ty_top" | c "ty_base" | c "ty_arrow" |
c "ty_rnil" | c "ty_rcons"
].
Inductive tm : Set :=
(* proper terms *)
| tm_var : id -> tm
| tm_app : tm -> tm -> tm
| tm_abs : id -> ty -> tm -> tm
| tm_proj : tm -> id -> tm
(* term rows *)
| tm_rnil : tm
| tm_rcons : id -> tm -> tm -> tm.
Tactic Notation "tm_cases" tactic(first) tactic(c) :=
first;
[ c "tm_var" | c "tm_app" | c "tm_abs" | c "tm_proj" |
c "tm_rnil" | c "tm_rcons" ].
(* ################################### *)
(** *** Well-formedness *)
(** Next, we slightly reformulate and generalize the
well-formedness condition [is_tmr] from the last
chapter. (Again, we feel the new version is cleaner and the
previous version should be rewritten to match this one.) *)
(** First, a type is a record type if it is built with either [ty_nil]
or [ty_cons]. *)
Inductive record_ty : ty -> Prop :=
| rty_nil :
record_ty ty_rnil
| rty_cons : forall i T1 T2,
record_ty (ty_rcons i T1 T2).
(** Note that [record_ty] is not recursive -- it just checks the
outermost constructor. The [well_formed_ty] predicate, on the
other hand, verifies that the whole type is well formed in the
sense that the tail of every record (the second argument to
[ty_rcons]) is a record. *)
Inductive well_formed_ty : ty -> Prop :=
| wfty_top :
well_formed_ty ty_top
| wfty_base : forall i,
well_formed_ty (ty_base i)
| wfty_arrow : forall T1 T2,
well_formed_ty T1
-> well_formed_ty T2
-> well_formed_ty (ty_arrow T1 T2)
| wfty_rnil :
well_formed_ty ty_rnil
| wfty_rcons : forall i T1 T2,
well_formed_ty T1
-> well_formed_ty T2
-> record_ty T2
-> well_formed_ty (ty_rcons i T1 T2).
(** The predicates [record_tm] and [well_formed_tm] are similar. *)
Inductive record_tm : tm -> Prop :=
| rtm_nil :
record_tm tm_rnil
| rtm_cons : forall i t1 t2,
record_tm (tm_rcons i t1 t2).
Inductive well_formed_tm : tm -> Prop :=
| wftm_var : forall x,
well_formed_tm (tm_var x)
| wftm_app : forall t1 t2,
well_formed_tm t1
-> well_formed_tm t2
-> well_formed_tm (tm_app t1 t2)
| wftm_abs : forall x T t,
well_formed_ty T
-> well_formed_tm t
-> well_formed_tm (tm_abs x T t)
| wftm_proj : forall t i,
well_formed_tm t
-> well_formed_tm (tm_proj t i)
| wftm_rnil :
well_formed_tm tm_rnil
| wftm_rcons : forall i t1 t2,
well_formed_tm t1
-> well_formed_tm t2
-> record_tm t2
-> well_formed_tm (tm_rcons i t1 t2).
Hint Constructors record_ty well_formed_ty.
Hint Constructors record_tm well_formed_tm.
(* ################################### *)
(** *** Substitution *)
(** The definition of substitution remains the same as for the
ordinary STLC with records. *)
Fixpoint subst (x:id) (s:tm) (t:tm) {struct t} : 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_proj t1 i => tm_proj (subst x s t1) i
| tm_rnil => tm_rnil
| tm_rcons i t1 tr2 => tm_rcons i (subst x s t1) (subst x s tr2)
end.
(* ################################### *)
(** *** Reduction *)
(** Likewise the definitions of the [value] predicate and the [step]
relation. *)
Inductive value : tm -> Prop :=
| v_abs : forall x T t,
value (tm_abs x T t)
| v_nil : value tm_rnil
| v_cons : forall i v vr,
value v ->
value vr ->
value (tm_rcons i v vr).
Hint Constructors value.
Fixpoint ty_lookup (i:id) (Tr:ty) {struct Tr} : option ty :=
match Tr with
| ty_rcons i' T Tr' => if beq_id i i' then Some T else ty_lookup i Tr'
| _ => None
end.
Fixpoint tm_lookup (i:id) (tr:tm) {struct tr} : option tm :=
match tr with
| tm_rcons i' t tr' => if beq_id i i' then Some t else tm_lookup i tr'
| _ => None
end.
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')
| ST_Proj1 : forall tr tr' i,
tr ~~> tr'
-> (tm_proj tr i) ~~> (tm_proj tr' i)
| ST_ProjRcd : forall tr i vi,
value tr
-> tm_lookup i tr = Some vi
-> (tm_proj tr i) ~~> vi
| ST_Rcd_Head : forall i t1 t1' tr2,
t1 ~~> t1'
-> (tm_rcons i t1 tr2) ~~> (tm_rcons i t1' tr2)
| ST_Rcd_Tail : forall i v1 tr2 tr2',
value v1
-> tr2 ~~> tr2'
-> (tm_rcons i v1 tr2) ~~> (tm_rcons i v1 tr2')
where "t1 '~~>' t2" := (step t1 t2).
Tactic Notation "step_cases" tactic(first) tactic(c) :=
first;
[ c "ST_AppAbs" | c "ST_App1" | c "ST_App2" |
c "ST_Proj1" | c "ST_ProjRcd" |
c "ST_Rcd" | c "ST_Rcd_Head" | c "ST_Rcd_Tail" ].
Hint Constructors step.
(* ###################################################################### *)
(** * Subtyping *)
(** Now we come to the interesting part. 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 motivating discussion, but we need to add well-formedness
side conditions to some of the rules. *)
Inductive subtype : ty -> ty -> Prop :=
(* Subtyping between proper types *)
| S_Refl : forall T,
well_formed_ty T ->
subtype T T
| S_Trans : forall S U T,
subtype S U ->
subtype U T ->
subtype S T
| S_Top : forall S,
well_formed_ty 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)
(* Subtyping between type rows *)
| S_RcdWidth : forall i T1 T2,
well_formed_ty (ty_rcons i T1 T2) ->
subtype (ty_rcons i T1 T2) ty_rnil
| S_RcdDepth : forall i S1 T1 Sr2 Tr2,
subtype S1 T1 ->
subtype Sr2 Tr2 ->
record_ty Sr2 ->
record_ty Tr2 ->
subtype (ty_rcons i S1 Sr2) (ty_rcons i T1 Tr2)
| S_RcdPerm : forall i1 i2 T1 T2 Tr3,
well_formed_ty (ty_rcons i1 T1 (ty_rcons i2 T2 Tr3)) ->
i1 <> i2 ->
subtype (ty_rcons i1 T1 (ty_rcons i2 T2 Tr3))
(ty_rcons i2 T2 (ty_rcons i1 T1 Tr3)).
Hint Constructors subtype.
Tactic Notation "subtype_cases" tactic(first) tactic(c) :=
first;
[ c "S_Refl" | c "S_Trans" | c "S_Top" | c "S_Arrow" |
c "S_RcdWidth" | c "S_RcdDepth" | c "S_RcdPerm" ].
(* ############################################### *)
(** ** Subtyping examples and exercises *)
Module Examples.
Notation x := (Loc 0).
Notation y := (Loc 1).
Notation z := (Loc 2).
Notation j := (Loc 3).
Notation k := (Loc 4).
Notation i := (Loc 5).
Notation A := (ty_base (Loc 6)).
Notation B := (ty_base (Loc 7)).
Notation C := (ty_base (Loc 8)).
Definition ty_rcd_j :=
(ty_rcons j (ty_arrow B B) ty_rnil). (* {j:B->B} *)
Definition ty_rcd_kj :=
ty_rcons k (ty_arrow A A) ty_rcd_j. (* {k:C->C,j:B->B} *)
Example subtyping_example_0 :
subtype (ty_arrow C ty_rcd_kj)
(ty_arrow C ty_rnil).
(* C->{k:A->A,j:B->B} <: C->{} *)
Proof.
apply S_Arrow.
apply S_Refl. auto.
unfold ty_rcd_kj, ty_rcd_j. apply S_RcdWidth; 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: 2 stars *)
Example subtyping_example_1 :
subtype ty_rcd_kj ty_rcd_j.
(* {k:A->A,j:B->B} <: {j:B->B} *)
Proof with eauto.
(* FILL IN HERE (and delete "Admitted") *) Admitted.
(** **** Exercise: 1 star *)
Example subtyping_example_2 :
subtype (ty_arrow ty_top ty_rcd_kj)
(ty_arrow (ty_arrow C C) ty_rcd_j).
(* Top->{k:A->A,j:B->B} <: (C->C)->{j:B->B} *)
Proof with eauto.
(* FILL IN HERE (and delete "Admitted") *) Admitted.
(** **** Exercise: 1 star *)
Example subtyping_example_3 :
subtype (ty_arrow ty_rnil (ty_rcons j A ty_rnil))
(ty_arrow (ty_rcons k B ty_rnil) ty_rnil).
(* {}->{j:A} <: {k:B}->{} *)
Proof with eauto.
(* FILL IN HERE (and delete "Admitted") *) Admitted.
(** **** Exercise: 2 stars *)
Example subtyping_example_4 :
subtype (ty_rcons x A (ty_rcons y B (ty_rcons z C ty_rnil)))
(ty_rcons z C (ty_rcons y B (ty_rcons x A ty_rnil))).
(* {x:A,y:B,z:C} <: {z:C,y:B,x:A} *)
Proof with eauto.
(* FILL IN HERE (and delete "Admitted") *) Admitted.
Definition tm_rcd_kj :=
(tm_rcons k (tm_abs z A (tm_var z))
(tm_rcons j (tm_abs z B (tm_var z))
tm_rnil)).
End Examples.
(** **** Exercise: 1 star (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)->{x:A->A,y:B->B} <: (C->C)->{y:B->B}]
- [ty_rnil -> ty_rnil <: {x:A} -> Top]
- [T->T->U <: S->S->V]
- [(T->T)->U <: (S->S)->V]
- [((T->S)->T)->U <: ((S->T)->S)->V]
- [{a:S, b:V} <: {a:T, b: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 <: {j:T1,k:T2}
-> exists S1 S2,
S = {j:S1,k: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 record type that is a subtype of every other
record type.
- There exists a record type that is a supertype of every other
record type.
- There exists an arrow type that is a subtype of every other
arrow type.
- There exists an arrow type that is a supertype 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
]]
*)
(** **** Exercise: 1 star (small_large_1) *)
(** -What is the *smallest* type [T] ("smallest" in the subtype
relation) that makes the following assertion true?
[[
empty |- (\r:{x:T}. r.x) {x=(\z:A.z)} : 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 |- (\r:{y:B->B, x:A->A}. r) {x=(\z:A.z), y=(\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 |- (\r:{x:A, T}. (r.y) (r.x)) {y=(\z:A.z), x=a} : A
]]
-What is the *largest* type [T] that makes the same assertion true?
*)
(** **** Exercise: 1 star (small_large_4) *)
(** -What is the *smallest* row type [Tr] that makes the following
assertion true?
[[
exists S,
empty |- (\r:(x:A;Tr). (r.y) (r.x)) : 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 |- (\r:{x:T}. (r.x) (r.x)) t : S
]]
*)
(** **** Exercise: 1 star (smallest_2) *)
(** What is the *smallest* type [T] that makes the following
assertion true?
[[
empty |- (\x:Top. x) {a=(\z:A.z), b=(\z:B.z)} : T
]]
*)
(** **** Exercise: 1 star (count_supertypes) *)
(** How many supertypes does the 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.)
*)
(* ###################################################################### *)
(** ** Properties of subtyping *)
(** *** Well-formedness *)
Lemma subtype__wf : forall S T,
subtype S T ->
well_formed_ty T /\ well_formed_ty S.
Proof with eauto.
intros S T Hsub.
(subtype_cases (induction Hsub) Case);
intros; try (destruct IHHsub1; destruct IHHsub2)...
Case "S_RcdPerm".
split... inversion H. subst. inversion H5... Qed.
Lemma wf_rcd_lookup : forall i T Ti,
well_formed_ty T ->
ty_lookup i T = Some Ti ->
well_formed_ty Ti.
Proof with eauto.
intros i T.
(ty_cases (induction T) Case); intros; try solve by inversion.
Case "ty_rcons".
inversion H. subst. unfold ty_lookup in H0.
remember (beq_id i i0) as b. destruct b; subst...
inversion H0. subst... Qed.
(** **** Exercise: 1 star (wf_variation) *)
(** The proof of the [subtype__wf] lemma goes by induction on the
derivation of [S <: T]. Suppose we change the statement of the
lemma to
<<
Lemma subtype__wf : forall S T,
S <: T
-> well_formed_ty T
>>
and again start the proof by induction on the derivation of [S <: T].
Will we succeed in completing it? Briefly explain.
*)
(** *** Field lookup *)
(** Our 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
corresponding terms. Second, reasoning by induction on
[has_type] derivations becomes harder in general, because
[has_type] is no longer syntax directed. *)
Lemma rcd_types_match : forall S T i Ti,
subtype S T ->
ty_lookup i T = Some Ti ->
exists Si, ty_lookup i S = Some Si /\ subtype Si Ti.
Proof with (eauto using wf_rcd_lookup).
intros S T i Ti Hsub Hget. generalize dependent Ti.
(subtype_cases (induction Hsub) Case); intros Ti Hget;
try solve by inversion.
Case "S_Refl".
exists Ti...
Case "S_Trans".
destruct (IHHsub2 Ti) as [Ui Hui]... destruct Hui.
destruct (IHHsub1 Ui) as [Si Hsi]... destruct Hsi.
exists Si...
Case "S_RcdDepth".
rename i0 into k.
unfold ty_lookup. unfold ty_lookup in Hget.
remember (beq_id i k) as b. destruct b...
SCase "i = k -- we're looking up the first field".
inversion Hget. subst. exists S1...
Case "S_RcdPerm".
exists Ti. split.
SCase "lookup".
unfold ty_lookup. unfold ty_lookup in Hget.
remember (beq_id i i1) as b. destruct b...
SSCase "i = i1 -- we're looking up the first field".
remember (beq_id i i2) as b. destruct b...
SSSCase "i = i2 - -contradictory".
destruct H0.
apply beq_id_eq in Heqb. apply beq_id_eq in Heqb0.
subst...
SCase "subtype".
inversion H. subst. inversion H5. subst... Qed.
(** **** Exercise: 3 stars *)
(** Write a careful informal proof of the [rcd_types_match] lemma. *)
(* FILL IN HERE *)
(** *** Inversion lemmas *)
(** **** Exercise: 3 stars (sub_inversion_arrow) *)
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 (and delete "Admitted") *) Admitted.
(* ###################################################################### *)
(** * Typing *)
(** Again, the typing relation is exactly the same, except for (a) the
rule of subsumption, [T_Sub], and (b) some well-formedness side
conditions. *)
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 :=
(* Rules for proper terms *)
| T_Var : forall Gamma x T,
Gamma x = Some T ->
well_formed_ty T ->
has_type Gamma (tm_var x) T
| T_Abs : forall Gamma x T11 T12 t12,
well_formed_ty T11 ->
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_Proj : forall Gamma i t T Ti,
has_type Gamma t T ->
ty_lookup i T = Some Ti ->
has_type Gamma (tm_proj t i) Ti
(* Subsumption *)
| T_Sub : forall Gamma t S T,
has_type Gamma t S ->
subtype S T ->
has_type Gamma t T
(* Rules for rows of terms *)
| T_RNil : forall Gamma,
has_type Gamma tm_rnil ty_rnil
| T_RCons : forall Gamma i t T tr Tr,
has_type Gamma t T ->
has_type Gamma tr Tr ->
record_ty Tr ->
record_tm tr ->
has_type Gamma (tm_rcons i t tr) (ty_rcons i T Tr).
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_Proj" |
c "T_Sub" | c "T_RNil" | c "T_RCons" ].
(* ############################################### *)
(** ** Typing examples *)
Module Examples2.
Import Examples.
(** **** Exercise: 1 star *)
Example typing_example_0 :
has_type empty
(tm_rcons k (tm_abs z A (tm_var z))
(tm_rcons j (tm_abs z B (tm_var z))
tm_rnil))
ty_rcd_kj.
(* empty |- {k=(\z:A.z), j=(\z:B.z)} : {k:A->A,j:B->B} *)
Proof.
(* FILL IN HERE (and delete "Admitted") *) Admitted.
(** **** Exercise: 2 stars *)
Example typing_example_1 :
has_type empty
(tm_app (tm_abs x ty_rcd_j (tm_proj (tm_var x) j))
(tm_rcd_kj))
(ty_arrow 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 (and delete "Admitted") *) Admitted.
(** **** Exercise: 2 stars, optional *)
Example typing_example_2 :
has_type empty
(tm_app (tm_abs z (ty_arrow (ty_arrow C C) ty_rcd_j)
(tm_proj (tm_app (tm_var z)
(tm_abs x C (tm_var x)))
j))
(tm_abs z (ty_arrow C C) tm_rcd_kj))
(ty_arrow 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 (and delete "Admitted") *) Admitted.
End Examples2.
(* ###################################################################### *)
(** ** Properties of typing *)
(** *** Well-formedness *)
Lemma has_type__wf : forall Gamma t T,
has_type Gamma t T ->
(well_formed_tm t) /\ (well_formed_ty T).
Proof with eauto.
intros Gamma t T Htyp.
(has_type_cases (induction Htyp) Case);
try (destruct IHHtyp); try (destruct IHHtyp1; destruct IHHtyp2)...
Case "T_App".
inversion H0...
Case "T_Proj".
split...
eapply wf_rcd_lookup...
Case "T_Sub".
apply subtype__wf in H.
destruct H...
Qed.
Lemma step_preserves_record_tm : forall 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 : forall v T i Ti,
value v ->
has_type empty v T ->
ty_lookup i T = Some Ti ->
exists vi, tm_lookup i v = Some vi /\ has_type empty vi Ti.
Proof with eauto.
remember empty as Gamma.
intros t T i Ti Hval Htyp. revert Ti HeqGamma Hval.
(has_type_cases (induction Htyp) Case); intros; subst; try solve by inversion.
Case "T_Sub".
apply (rcd_types_match S) in H0... destruct H0 as [Si [HgetSi Hsub]].
destruct (IHHtyp Si) as [vi [Hget Htyvi]]...
exists vi...
Case "T_RCons".
simpl in H0. simpl. simpl in H1.
remember (beq_id i i0) as b. destruct b.
SCase "i is first".
inversion H1. subst. exists t...
SCase "i in tail".
destruct (IHHtyp2 Ti) as [vi [get Htyvi]]...
inversion Hval... exists vi... Qed.
(* ########################################## *)
(** *** Progress *)
(** **** Exercise: 3 stars (canonical_forms_of_arrow_types) *)
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 (and delete "Admitted") *) Admitted.
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)...
Case "T_Proj".
right. destruct IHHt...
SCase "rcd is value".
destruct (lookup_field_in_value t T i Ti) as [t' [Hget Ht']]...
exists t'...
SCase "rcd_steps".
destruct H0 as [t' Hstp]. exists (tm_proj t' i)...
Case "T_RCons".
destruct IHHt1...
SCase "head is a value".
destruct IHHt2...
SSCase "tail steps".
right. destruct H2 as [tr' Hstp].
exists (tm_rcons i t tr')...
SCase "head steps".
right. destruct H1 as [t' Hstp].
exists (tm_rcons i t' tr)... Qed.
(* Informal proof of progress:
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 go
by induction on the typing derivation. Cases [T_Abs] and
[T_RNil] are immediate because abstractions and [{}] are always
values. Case [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 [t1] [t2] and types [T1] [T2] such that
[t = t1 t2], [T = T2], [empty |- t1 : T1 -> T2] and
[empty |- t2 : T1].
The induction hypotheses for these typing derivations yield
that [t1] is a value or steps, and that [t2] is a value or
steps. We consider each case:
-- Suppose [t1 ~~> t1'] for some term [t1']. Then
[t1 t2 ~~> t1' t2] by [ST_App1].
-- Otherwise [t1] is a value.
--- Suppose [t2 ~~> t2'] for some term [t2']. Then
[t1 t2 ~~> t1 t2'] by rule [ST_App2] because [t1] is a value.
--- Otherwise, [t2] is a value. By lemma
[canonical_forms_for_arrow_types], [t1 = \x:S1.s2] for some
[x], [S1], and [s2]. And [(\x:S1.s2) t2 ~~> [t2/x]s2] by
[ST_AppAbs], since [t2] is a value.
- If the last 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 [ty_lookup i Tr = Some T].
The IH for the typing subderivation gives us that either [tr]
is a value or it steps. If [tr ~~> tr'] for some term [tr'],
then [tr.i ~~> tr'.i] by rule [ST_Proj1].
Otherwise, [tr] is a value. In this case, lemma
[lookup_field_in_value] yields that there is a term [ti] such
that [tm_lookup 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 [t1] [tr], types [T1 Tr] and a label [t] such
that [t = {i=t1, tr}], [T = {i:T1, Tr}], [record_tm tr],
[record_tm Tr], [empty |- t1 : T1] and [empty |- tr : Tr].
The induction hypotheses for these typing derivations yield
that [t1] is a value or steps, and that [tr] is a value or
steps. We consider each case:
-- Suppose [t1 ~~> t1'] for some term [t1']. Then
[{i=t1, tr} ~~> {i=t1', tr}] by rule [ST_Rcd_Head].
-- Otherwise [t1] is a value.
--- Suppose [tr ~~> tr'] for some term [tr']. Then
[{i=t1, tr} ~~> {i=t1, tr'}] by rule [ST_Rcd_Tail],
since [t1] is a value.
--- Otherwise, [tr] is also a value. So, [{i=t1, tr}] is a
value by [v_cons]. *)
(* ########################################## *)
(** *** Inversion lemmas *)
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]]...
exists U... 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]]...
destruct (has_type__wf _ _ _ Hty2).
exists U1... Qed.
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".
destruct (has_type__wf _ _ _ H0).
exists T12...
Case "T_Sub".
destruct IHhas_type as [S2 [Hsub Hty]]...
exists S2... Qed.
(* An informal proof of typing_inversion_abs. Note that these
inversion lemmas weren't stated in previous files because
Coq's built in [inversion] tactic gave them to us for free.
But, in STLC with subtyping, there are multiple ways of
deriving [has_type] instances for any particular term, so
this is no longer the case.
THEOREM: 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.
We go by induction on the derivation of [Gamma |- \x:S1.t2 : T].
Cases [T_Var], [T_App], [T_Proj], [T_RNil] and [T_RCons] are
vacuous as those rules cannot be used to give a type to a
syntactic abstraction.
- If the last step of the derivation is by [T_Abs] then there is
a type [T12] such that [T = S1 -> T12] and
[Gamma, x:S1 |- t2 : T12]. Then picking [T12] for [S2]
satisfies the theorem: [S1 -> T12 <: S1 -> T12] follows
from [S_Refl] and the well-formedness theorem for [has_type].
- If the last step of the derivation is by [T_Sub] then there is
a type [S] such that [S <: T] and [Gamma |- \x:S1.t2 : S]. The
IH for the typing subderivation yields that there exists a type
[S2] such that [S1 -> S2 <: S] and [Gamma, x:S1 |- t2 : S2].
Picking type [S2] satisfies the theorem, with [S1 -> S2 <: T]
following by [S_Trans]. *)
Lemma typing_inversion_proj : forall Gamma i t1 Ti,
has_type Gamma (tm_proj t1 i) Ti ->
exists T, exists Si,
ty_lookup i T = Some Si /\ subtype Si Ti /\ has_type Gamma t1 T.
Proof with eauto.
intros Gamma i t1 Ti H.
remember (tm_proj t1 i) as t.
(has_type_cases (induction H) Case);
inversion Heqt; subst; intros; try solve by inversion.
Case "T_Proj".
assert (well_formed_ty Ti) as Hwf.
SCase "pf of assertion".
apply (wf_rcd_lookup i T Ti)...
apply has_type__wf in H. destruct H...
exists T. exists Ti...
Case "T_Sub".
destruct IHhas_type as [U [Ui [Hget [Hsub Hty]]]]...
exists U. exists Ui... Qed.
Lemma typing_inversion_rcons : forall Gamma i ti tr T,
has_type Gamma (tm_rcons i ti tr) T ->
exists Si, exists Sr,
subtype (ty_rcons i Si Sr) T /\ has_type Gamma ti Si /\
has_type Gamma tr Sr.
Proof with eauto.
intros Gamma i ti tr T Hty.
remember (tm_rcons i ti tr) as t.
(has_type_cases (induction Hty) Case);
inversion Heqt; subst...
Case "T_Sub".
apply IHHty in H0.
destruct H0 as [Ri [Rr [HsubRS [HtypRi HtypRr]]]].
exists Ri. exists Rr...
Case "T_RCons".
assert (well_formed_ty (ty_rcons i T Tr)) as Hwf.
SCase "pf of assertion".
destruct (has_type__wf _ _ _ Hty1).
destruct (has_type__wf _ _ _ Hty2)...
exists T. exists Tr... Qed.
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.
(* ########################################## *)
(** *** Context invariance *)
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)
| afi_proj : forall x t i,
appears_free_in x t ->
appears_free_in x (tm_proj t i)
| afir_head : forall x i t tr,
appears_free_in x t ->
appears_free_in x (tm_rcons i t tr)
| afir_tail : forall x i t tr,
appears_free_in x tr ->
appears_free_in x (tm_rcons i t tr).
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...
Case "T_RCons".
apply T_RCons... 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 Hty.
(has_type_cases (induction Hty) Case); subst; inversion Hafi; subst...
Case "T_Var".
exists T...
Case "T_Abs".
destruct (IHHty H5) as [T Hctx]. exists T.
unfold extend in Hctx. apply not_eq_false_beqid in H3.
rewrite <- H3 in Hctx... Qed.
(* ########################################## *)
(** *** Preservation *)
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 Hty Hv.
generalize dependent S. generalize dependent Gamma.
(tm_cases (induction t) Case); intros; simpl.
Case "tm_var".
rename i into y.
destruct (typing_inversion_var _ _ _ Hty) 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'.
SCase "x<>y".
destruct (subtype__wf _ _ Hsub)...
Case "tm_app".
destruct (typing_inversion_app _ _ _ _ Hty) as [T1 [Hty1 Hty2]].
eapply T_App...
Case "tm_abs".
rename i into y. rename t into T1.
destruct (typing_inversion_abs _ _ _ _ _ Hty)
as [T2 [Hsub Hty2]].
destruct (subtype__wf _ _ Hsub) as [Hwf1 Hwf2].
inversion Hwf2. subst.
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_proj".
destruct (typing_inversion_proj _ _ _ _ Hty)
as [T [Ti [Hget [Hsub Hty1]]]]...
Case "tm_rnil".
eapply context_invariance...
intros y Hcontra. inversion Hcontra.
Case "tm_rcons".
destruct (typing_inversion_rcons _ _ _ _ _ Hty) as
[Ti [Tr [Hsub [HtypTi HtypTr]]]].
apply T_Sub with (ty_rcons i Ti Tr)...
apply T_RCons...
SCase "record_ty Tr".
apply subtype__wf in Hsub. destruct Hsub. inversion H0...
SCase "record_tm (subst x v t2)".
destruct (has_type__wf _ _ _ Hty). inversion H. subst.
inversion H6; subst; simpl... Qed.
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...
Case "T_Proj".
destruct (lookup_field_in_value _ _ _ _ H2 HT H)
as [vi [Hget Hty]].
rewrite H4 in Hget. inversion Hget. subst...
Case "T_RCons".
eauto using step_preserves_record_tm. Qed.
(* Informal proof of [preservation]:
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 [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' = [t2/x]t12].
By Lemma [abs_arrow], we have [T1 <: S] and [x:S1 |- s2 : T2].
It then follows by lemma [substitution_preserves_typing] that
[empty |- [t2/x] t12 : T2] 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 [ty_lookup 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
[tm_lookup 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 [t1] [tr], types [T1 Tr] and a label [t] such
that [t = {i=t1, tr}], [T = {i:T1, Tr}], [record_tm tr],
[record_tm Tr], [empty |- t1 : T1] 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 [t1]'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. *)
(* ###################################################### *)
(** ** 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 records 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 <: S2 S2 <: S1 S2 <: T2
----------------------------------- (T_Funny1)
Gamma |- t : T1->T2
>>
- Suppose we add the following reduction rule:
<<
------------------ (ST_Funny21)
{} ~~> (\x:Top. x)
>>
- Suppose we add the following subtyping rule:
<<
-------------- (S_Funny3)
{} <: Top->Top
>>
- Suppose we add the following subtyping rule:
<<
-------------- (S_Funny4)
Top->Top <: {}
>>
- Suppose we add the following evaluation rule:
<<
----------------- (ST_Funny5)
({} t) ~~> (t {})
>>
- Suppose we add the same evaluation rule *and* a new typing rule:
<<
----------------- (ST_Funny5)
({} t) ~~> (t {})
---------------------- (T_Funny6)
empty |- {} : Top->Top
>>
- Suppose we *change* the arrow subtyping rule to:
<<
S1 <: T1 S2 <: T2
----------------------- (S_Arrow')
-> S1->S2 <: T1->T2
>>
*)
(* ###################################################################### *)
(** * The main exercise for the week: *)
(** **** 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.)
*)