SubSubtyping
Set Warnings "-notation-overridden,-parsing".
From Coq Require Import Strings.String.
From PLF Require Import Maps.
From PLF Require Import Types.
From PLF Require Import Smallstep.
From Coq Require Import Strings.String.
From PLF Require Import Maps.
From PLF Require Import Types.
From PLF Require Import Smallstep.
Concepts
A Motivating Example
Person = {name:String, age:Nat} Student = {name:String, age:Nat, gpa:Nat}
(\r:Person. (r.age)+1) {name="Pat",age=21,gpa=1}is not typable, since it applies a function that wants a two-field record to an argument that actually provides three fields, while the T_App rule demands that the domain type of the function being applied must match the type of the argument precisely.
- 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
The Subsumption Rule
- Defining a binary subtype relation between types.
- Enriching the typing relation to take subtyping into account.
Gamma ⊢ t ∈ S S <: T | (T_Sub) |
Gamma ⊢ t ∈ T |
The Subtype Relation
Structural Rules
S <: U U <: T | (S_Trans) |
S <: T |
(S_Refl) | |
T <: T |
Products
S1 <: T1 S2 <: T2 | (S_Prod) |
S1 * S2 <: T1 * T2 |
Arrows
f : C → Student
g : (C→Person) → D
That is, f is a function that yields a record of type Student,
and g is a (higher-order) function that expects its argument to be
a function yielding a record of type Person. Also suppose that
Student is a subtype of Person. 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 Student,
while g will be expecting a Person, but this is safe because
the only thing g can then do is to project out the two fields
that it knows about (name and age), and these will certainly
be among the fields that are present.
g : (C→Person) → D
S2 <: T2 | (S_Arrow_Co) |
S1 → S2 <: S1 → T2 |
T1 <: S1 S2 <: T2 | (S_Arrow) |
S1 → S2 <: T1 → T2 |
f : Person → C
g : (Student → C) → D
The application g f is safe, because the only thing the body of
g can do with f is to apply it to some argument of type
Student. Since f requires records having (at least) the
fields of a Person, this will always work. So Person → C is a
subtype of Student → C since Student is a subtype of
Person.
g : (Student → C) → D
Records
{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.
{name:String, age:Nat} <: {name:String}
{name:String} <: {}
{x:Student} <: {x:Person}
This is known as "depth subtyping".
{name:String,age:Nat} <: {age:Nat,name:String}
This is known as "permutation subtyping".
∀jk in j1..jn, | |
∃ip in i1..im, such that | |
jk=ip and Sp <: Tk | (S_Rcd) |
{i1:S1...im:Sm} <: {j1:T1...jn:Tn} |
n > m | (S_RcdWidth) |
{i1:T1...in:Tn} <: {i1:T1...im:Tm} |
S1 <: T1 ... Sn <: Tn | (S_RcdDepth) |
{i1:S1...in:Sn} <: {i1:T1...in:Tn} |
{i1:S1...in:Sn} is a permutation of {j1:T1...jn:Tn} | (S_RcdPerm) |
{i1:S1...in:Sn} <: {j1:T1...jn:Tn} |
- 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).
Exercise: 2 stars, standard, recommended (arrow_sub_wrong)
Suppose we had incorrectly defined subtyping as covariant on both the right and the left of arrow types:S1 <: T1 S2 <: T2 | (S_Arrow_wrong) |
S1 → S2 <: T1 → T2 |
f : Student → Nat
g : (Person → Nat) → Nat
... such that the application g f will get stuck during
execution. (Use informal syntax. No need to prove formally that
the application gets stuck.)
g : (Person → Nat) → Nat
(* Do not modify the following line: *)
Definition manual_grade_for_arrow_sub_wrong : option (nat*string) := None.
☐
Definition manual_grade_for_arrow_sub_wrong : option (nat*string) := None.
Top
(S_Top) | |
S <: Top |
Summary
- adding a base type Top,
- adding the rule of subsumption
to the typing relation, andGamma ⊢ t ∈ S S <: T (T_Sub) Gamma ⊢ t ∈ T - defining a subtype relation as follows:
S <: U U <: T (S_Trans) S <: T (S_Refl) T <: T (S_Top) S <: Top S1 <: T1 S2 <: T2 (S_Prod) S1 * S2 <: T1 * T2 T1 <: S1 S2 <: T2 (S_Arrow) S1 → S2 <: T1 → T2 n > m (S_RcdWidth) {i1:T1...in:Tn} <: {i1:T1...im:Tm} S1 <: T1 ... Sn <: Tn (S_RcdDepth) {i1:S1...in:Sn} <: {i1:T1...in:Tn} {i1:S1...in:Sn} is a permutation of {j1:T1...jn:Tn} (S_RcdPerm) {i1:S1...in:Sn} <: {j1:T1...jn:Tn}
Exercises
Exercise: 1 star, standard, optional (subtype_instances_tf_1)
Suppose we have types S, T, U, and V with S <: T and U <: V. Which of the following subtyping assertions are then true? Write true or false after each one. (A, B, and C here are base types like Bool, Nat, etc.)- 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: 2 stars, standard (subtype_order)
The following types happen to form a linear order with respect to subtyping:- Top
- Top → Student
- Student → Person
- Student → Top
- Person → Student
(* Do not modify the following line: *)
Definition manual_grade_for_subtype_order : option (nat*string) := None.
☐
Definition manual_grade_for_subtype_order : option (nat*string) := None.
Exercise: 1 star, standard (subtype_instances_tf_2)
Which of the following statements are true? Write true or false after each one.
∀S T,
S <: T →
S→S <: T→T
∀S,
S <: A→A →
∃T,
S = T→T ∧ T <: A
∀S T1 T2,
(S <: T1 → T2) →
∃S1 S2,
S = S1 → S2 ∧ T1 <: S1 ∧ S2 <: T2
∃S,
S <: S→S
∃S,
S→S <: S
∀S T1 T2,
S <: T1*T2 →
∃S1 S2,
S = S1*S2 ∧ S1 <: T1 ∧ S2 <: T2
S <: T →
S→S <: T→T
∀S,
S <: A→A →
∃T,
S = T→T ∧ T <: A
∀S T1 T2,
(S <: T1 → T2) →
∃S1 S2,
S = S1 → S2 ∧ T1 <: S1 ∧ S2 <: T2
∃S,
S <: S→S
∃S,
S→S <: S
∀S T1 T2,
S <: T1*T2 →
∃S1 S2,
S = S1*S2 ∧ S1 <: T1 ∧ S2 <: T2
(* Do not modify the following line: *)
Definition manual_grade_for_subtype_instances_tf_2 : option (nat*string) := None.
☐
Definition manual_grade_for_subtype_instances_tf_2 : option (nat*string) := None.
Exercise: 1 star, standard (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.
(* Do not modify the following line: *)
Definition manual_grade_for_subtype_concepts_tf : option (nat*string) := None.
☐
Definition manual_grade_for_subtype_concepts_tf : option (nat*string) := None.
Exercise: 2 stars, standard (proper_subtypes)
Is the following statement true or false? Briefly explain your answer. (Here Base n stands for a base type, where n is a string standing for the name of the base type. See the Syntax section below.)
∀T,
~(T = Bool ∨ ∃n, T = Base n) →
∃S,
S <: T ∧ S ≠ T
~(T = Bool ∨ ∃n, T = Base n) →
∃S,
S <: T ∧ S ≠ T
(* Do not modify the following line: *)
Definition manual_grade_for_proper_subtypes : option (nat*string) := None.
☐
Definition manual_grade_for_proper_subtypes : option (nat*string) := None.
Exercise: 2 stars, standard (small_large_1)
- What is the smallest type T ("smallest" in the subtype
relation) that makes the following assertion true? (Assume we
have Unit among the base types and unit as a constant of this
type.)
empty ⊢ (\p:T*Top. p.fst) ((\z:A.z), unit) ∈ A→A
- What is the largest type T that makes the same assertion true?
(* Do not modify the following line: *)
Definition manual_grade_for_small_large_1 : option (nat*string) := None.
☐
Definition manual_grade_for_small_large_1 : option (nat*string) := None.
Exercise: 2 stars, standard (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?
(* Do not modify the following line: *)
Definition manual_grade_for_small_large_2 : option (nat*string) := None.
☐
Definition manual_grade_for_small_large_2 : option (nat*string) := None.
Exercise: 2 stars, standard, optional (small_large_3)
- What is the smallest type T that makes the following
assertion true?
a:A ⊢ (\p:(A*T). (p.snd) (p.fst)) (a, \z:A.z) ∈ A
- What is the largest type T that makes the same assertion true?
Exercise: 2 stars, standard (small_large_4)
- What is the smallest type T that makes the following
assertion true?
∃S,
empty ⊢ (\p:(A*T). (p.snd) (p.fst)) ∈ S - What is the largest type T that makes the same assertion true?
(* Do not modify the following line: *)
Definition manual_grade_for_small_large_4 : option (nat*string) := None.
☐
Definition manual_grade_for_small_large_4 : option (nat*string) := None.
Exercise: 2 stars, standard (smallest_1)
What is the smallest type T that makes the following assertion true?
∃S t,
empty ⊢ (\x:T. x x) t ∈ S
empty ⊢ (\x:T. x x) t ∈ S
(* Do not modify the following line: *)
Definition manual_grade_for_smallest_1 : option (nat*string) := None.
☐
Definition manual_grade_for_smallest_1 : option (nat*string) := None.
Exercise: 2 stars, standard (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
(* Do not modify the following line: *)
Definition manual_grade_for_smallest_2 : option (nat*string) := None.
☐
Definition manual_grade_for_smallest_2 : option (nat*string) := None.
Exercise: 3 stars, standard, 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.)Exercise: 2 stars, standard (pair_permutation)
The subtyping rule for product typesS1 <: T1 S2 <: T2 | (S_Prod) |
S1*S2 <: T1*T2 |
T1*T2 <: T2*T1 |
(* Do not modify the following line: *)
Definition manual_grade_for_pair_permutation : option (nat*string) := None.
☐
Definition manual_grade_for_pair_permutation : option (nat*string) := None.
Formal Definitions
Syntax
Inductive ty : Type :=
| Top : ty
| Bool : ty
| Base : string → ty
| Arrow : ty → ty → ty
| Unit : ty
.
Inductive tm : Type :=
| var : string → tm
| app : tm → tm → tm
| abs : string → ty → tm → tm
| tru : tm
| fls : tm
| test : tm → tm → tm → tm
| unit : tm
.
| Top : ty
| Bool : ty
| Base : string → ty
| Arrow : ty → ty → ty
| Unit : ty
.
Inductive tm : Type :=
| var : string → tm
| app : tm → tm → tm
| abs : string → ty → tm → tm
| tru : tm
| fls : tm
| test : tm → tm → tm → tm
| unit : tm
.
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 t1 ⇒
abs y T (if eqb_string x y then t1 else (subst x s t1))
| app t1 t2 ⇒
app (subst x s t1) (subst x s t2)
| tru ⇒
tru
| fls ⇒
fls
| test t1 t2 t3 ⇒
test (subst x s t1) (subst x s t2) (subst x s t3)
| unit ⇒
unit
end.
Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20).
match t with
| var y ⇒
if eqb_string x y then s else t
| abs y T t1 ⇒
abs y T (if eqb_string x y then t1 else (subst x s t1))
| app t1 t2 ⇒
app (subst x s t1) (subst x s t2)
| tru ⇒
tru
| fls ⇒
fls
| test t1 t2 t3 ⇒
test (subst x s t1) (subst x s t2) (subst x s t3)
| unit ⇒
unit
end.
Notation "'[' x ':=' s ']' t" := (subst x s t) (at level 20).
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 "t1 '-->' t2" (at level 40).
Inductive step : tm → tm → Prop :=
| ST_AppAbs : ∀x T t12 v2,
value v2 →
(app (abs x T t12) v2) --> [x:=v2]t12
| ST_App1 : ∀t1 t1' t2,
t1 --> t1' →
(app t1 t2) --> (app t1' t2)
| ST_App2 : ∀v1 t2 t2',
value v1 →
t2 --> t2' →
(app v1 t2) --> (app v1 t2')
| ST_TestTrue : ∀t1 t2,
(test tru t1 t2) --> t1
| ST_TestFalse : ∀t1 t2,
(test fls t1 t2) --> t2
| ST_Test : ∀t1 t1' t2 t3,
t1 --> t1' →
(test t1 t2 t3) --> (test t1' t2 t3)
where "t1 '-->' t2" := (step t1 t2).
Hint Constructors step.
| 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 "t1 '-->' t2" (at level 40).
Inductive step : tm → tm → Prop :=
| ST_AppAbs : ∀x T t12 v2,
value v2 →
(app (abs x T t12) v2) --> [x:=v2]t12
| ST_App1 : ∀t1 t1' t2,
t1 --> t1' →
(app t1 t2) --> (app t1' t2)
| ST_App2 : ∀v1 t2 t2',
value v1 →
t2 --> t2' →
(app v1 t2) --> (app v1 t2')
| ST_TestTrue : ∀t1 t2,
(test tru t1 t2) --> t1
| ST_TestFalse : ∀t1 t2,
(test fls t1 t2) --> t2
| ST_Test : ∀t1 t1' t2 t3,
t1 --> t1' →
(test t1 t2 t3) --> (test t1' t2 t3)
where "t1 '-->' t2" := (step t1 t2).
Hint Constructors step.
Subtyping
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 : ∀S1 S2 T1 T2,
T1 <: S1 →
S2 <: T2 →
(Arrow S1 S2) <: (Arrow T1 T2)
where "T '<:' U" := (subtype T U).
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 : ∀S1 S2 T1 T2,
T1 <: S1 →
S2 <: T2 →
(Arrow S1 S2) <: (Arrow T1 T2)
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.
Module Examples.
Open Scope string_scope.
Notation x := "x".
Notation y := "y".
Notation z := "z".
Notation A := (Base "A").
Notation B := (Base "B").
Notation C := (Base "C").
Notation String := (Base "String").
Notation Float := (Base "Float").
Notation Integer := (Base "Integer").
Example subtyping_example_0 :
(Arrow C Bool) <: (Arrow C Top).
(* C->Bool <: C->Top *)
Proof. auto. Qed.
Module Examples.
Open Scope string_scope.
Notation x := "x".
Notation y := "y".
Notation z := "z".
Notation A := (Base "A").
Notation B := (Base "B").
Notation C := (Base "C").
Notation String := (Base "String").
Notation Float := (Base "Float").
Notation Integer := (Base "Integer").
Example subtyping_example_0 :
(Arrow C Bool) <: (Arrow C Top).
(* C->Bool <: C->Top *)
Proof. auto. Qed.
Exercise: 2 stars, standard, optional (subtyping_judgements)
(Leave this exercise Admitted until after you have finished adding product types to the language — see exercise products — at least up to this point in the file).
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
(* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
Definition Student : ty
(* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
Definition Employee : ty
(* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
(* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
Definition Student : ty
(* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
Definition Employee : ty
(* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.
Now use the definition of the subtype relation to prove the following:
Example sub_student_person :
Student <: Person.
Proof.
(* FILL IN HERE *) Admitted.
Example sub_employee_person :
Employee <: Person.
Proof.
(* FILL IN HERE *) Admitted.
☐
Student <: Person.
Proof.
(* FILL IN HERE *) Admitted.
Example sub_employee_person :
Employee <: Person.
Proof.
(* FILL IN HERE *) Admitted.
Exercise: 1 star, standard, optional (subtyping_example_1)
Example subtyping_example_1 :
(Arrow Top Student) <: (Arrow (Arrow C C) Person).
(* Top->Student <: (C->C)->Person *)
Proof with eauto.
(* FILL IN HERE *) Admitted.
☐
(Arrow Top Student) <: (Arrow (Arrow C C) Person).
(* Top->Student <: (C->C)->Person *)
Proof with eauto.
(* FILL IN HERE *) Admitted.
Example subtyping_example_2 :
(Arrow Top Person) <: (Arrow Person Top).
(* Top->Person <: Person->Top *)
Proof with eauto.
(* FILL IN HERE *) Admitted.
☐
(Arrow Top Person) <: (Arrow Person Top).
(* Top->Person <: Person->Top *)
Proof with eauto.
(* FILL IN HERE *) Admitted.
End Examples.
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 T11 T12 t12,
(x ⊢> T11 ; Gamma) ⊢ t12 ∈ T12 →
Gamma ⊢ abs x T11 t12 ∈ Arrow T11 T12
| T_App : ∀T1 T2 Gamma t1 t2,
Gamma ⊢ t1 ∈ Arrow T1 T2 →
Gamma ⊢ t2 ∈ T1 →
Gamma ⊢ app t1 t2 ∈ T2
| T_True : ∀Gamma,
Gamma ⊢ tru ∈ Bool
| T_False : ∀Gamma,
Gamma ⊢ fls ∈ Bool
| T_Test : ∀t1 t2 t3 T Gamma,
Gamma ⊢ t1 ∈ Bool →
Gamma ⊢ t2 ∈ T →
Gamma ⊢ t3 ∈ T →
Gamma ⊢ test t1 t2 t3 ∈ 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.
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 T11 T12 t12,
(x ⊢> T11 ; Gamma) ⊢ t12 ∈ T12 →
Gamma ⊢ abs x T11 t12 ∈ Arrow T11 T12
| T_App : ∀T1 T2 Gamma t1 t2,
Gamma ⊢ t1 ∈ Arrow T1 T2 →
Gamma ⊢ t2 ∈ T1 →
Gamma ⊢ app t1 t2 ∈ T2
| T_True : ∀Gamma,
Gamma ⊢ tru ∈ Bool
| T_False : ∀Gamma,
Gamma ⊢ fls ∈ Bool
| T_Test : ∀t1 t2 t3 T Gamma,
Gamma ⊢ t1 ∈ Bool →
Gamma ⊢ t2 ∈ T →
Gamma ⊢ t3 ∈ T →
Gamma ⊢ test t1 t2 t3 ∈ 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.
Module Examples2.
Import Examples.
eapply T_App; auto.
Hint Extern 2 (_ = _) ⇒ compute; reflexivity.
Module Examples2.
Import Examples.
Do the following exercises after you have added product types to
the language. For each informal typing judgement, write it as a
formal statement in Coq and prove it.
Exercise: 1 star, standard, optional (typing_example_0)
(* empty ⊢ ((\z:A.z), (\z:B.z))
∈ (A->A * B->B) *)
(* FILL IN HERE *)
☐
∈ (A->A * B->B) *)
(* FILL IN HERE *)
(* empty ⊢ (\x:(Top * B->B). x.snd) ((\z:A.z), (\z:B.z))
∈ B->B *)
(* FILL IN HERE *)
☐
∈ B->B *)
(* 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 *)
End Examples2.
Properties
Inversion Lemmas for Subtyping
- Bool is the only subtype of Bool, and
- every subtype of an arrow type is itself an arrow type.
Exercise: 2 stars, standard, optional (sub_inversion_Bool)
Lemma sub_inversion_Bool : ∀U,
U <: Bool →
U = Bool.
U <: Bool →
U = Bool.
Proof with auto.
intros U Hs.
remember Bool as V.
(* FILL IN HERE *) Admitted.
☐
intros U Hs.
remember Bool as V.
(* FILL IN HERE *) Admitted.
Lemma sub_inversion_arrow : ∀U V1 V2,
U <: Arrow V1 V2 →
∃U1 U2,
U = Arrow U1 U2 ∧ V1 <: U1 ∧ U2 <: V2.
☐
U <: Arrow V1 V2 →
∃U1 U2,
U = Arrow U1 U2 ∧ V1 <: U1 ∧ U2 <: V2.
Proof with eauto.
intros U V1 V2 Hs.
remember (Arrow V1 V2) as V.
generalize dependent V2. generalize dependent V1.
(* FILL IN HERE *) Admitted.
intros U V1 V2 Hs.
remember (Arrow V1 V2) as V.
generalize dependent V2. generalize dependent V1.
(* FILL IN HERE *) Admitted.
Canonical Forms
Exercise: 3 stars, standard, optional (canonical_forms_of_arrow_types)
Lemma canonical_forms_of_arrow_types : ∀Gamma s T1 T2,
Gamma ⊢ s ∈ Arrow T1 T2 →
value s →
∃x S1 s2,
s = abs x S1 s2.
☐
Gamma ⊢ s ∈ Arrow T1 T2 →
value s →
∃x S1 s2,
s = abs x S1 s2.
Proof with eauto.
(* FILL IN HERE *) Admitted.
(* FILL IN HERE *) Admitted.
Lemma canonical_forms_of_Bool : ∀Gamma s,
Gamma ⊢ s ∈ Bool →
value s →
s = tru ∨ s = fls.
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.
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
- 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 the
canonical forms lemma for arrow types, we know that t1 has the
form \x:S1.s2 for some x, S1, and s2. But then
(\x:S1.s2) t2 --> [x:=t2]s2 by ST_AppAbs, since t2 is a
value.
- Suppose t1 --> t1' for some term t1'. Then t1 t2 --> t1' t2
by ST_App1.
- If the final step of the derivation uses rule T_Test, then there
are terms t1, t2, and t3 such that t = test t1 then t2 else
t3, with empty ⊢ t1 ∈ Bool and with empty ⊢ t2 ∈ T and
empty ⊢ t3 ∈ T. Moreover, by the induction hypothesis,
either t1 is a value or it steps.
- If t1 is a value, then by the canonical forms lemma for
booleans, either t1 = tru or t1 = fls. In either
case, t can step, using rule ST_TestTrue or ST_TestFalse.
- If t1 can step, then so can t, by rule ST_Test.
- If t1 is a value, then by the canonical forms lemma for
booleans, either t1 = tru or t1 = fls. In either
case, t can step, using rule ST_TestTrue or ST_TestFalse.
- If the final step of the derivation is by T_Sub, then there is a type S such that S <: T and empty ⊢ t ∈ S. The desired result is exactly the induction hypothesis for the typing subderivation.
Theorem progress : ∀t T,
empty ⊢ t ∈ T →
value t ∨ ∃t', 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...
+ (* t1 is a value *)
destruct IHHt2; subst...
* (* t2 is a value *)
destruct (canonical_forms_of_arrow_types empty t1 T1 T2)
as [x [S1 [t12 Heqt1]]]...
subst. ∃([x:=t2]t12)...
* (* t2 steps *)
inversion H0 as [t2' Hstp]. ∃(app t1 t2')...
+ (* t1 steps *)
inversion H as [t1' Hstp]. ∃(app t1' t2)...
- (* T_Test *)
right.
destruct IHHt1.
+ (* t1 is a value *) eauto.
+ assert (t1 = tru ∨ t1 = fls)
by (eapply canonical_forms_of_Bool; eauto).
inversion H0; subst...
+ inversion H. rename x into t1'. eauto.
Qed.
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...
+ (* t1 is a value *)
destruct IHHt2; subst...
* (* t2 is a value *)
destruct (canonical_forms_of_arrow_types empty t1 T1 T2)
as [x [S1 [t12 Heqt1]]]...
subst. ∃([x:=t2]t12)...
* (* t2 steps *)
inversion H0 as [t2' Hstp]. ∃(app t1 t2')...
+ (* t1 steps *)
inversion H as [t1' Hstp]. ∃(app t1' t2)...
- (* T_Test *)
right.
destruct IHHt1.
+ (* t1 is a value *) eauto.
+ assert (t1 = tru ∨ t1 = fls)
by (eapply canonical_forms_of_Bool; eauto).
inversion H0; subst...
+ inversion H. rename x into t1'. eauto.
Qed.
Inversion Lemmas for Typing
- If the last step of the derivation is a use of T_Abs then there is a type T12 such that T = S1 → T12 and x:S1; Gamma ⊢ 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 tells us that there is some type S2 with S1 → S2 <: S and x:S1; Gamma ⊢ t2 ∈ S2. Picking type S2 gives us what we need, since S1 → S2 <: T then follows by S_Trans.
Lemma typing_inversion_abs : ∀Gamma x S1 t2 T,
Gamma ⊢ (abs x S1 t2) ∈ T →
∃S2,
Arrow S1 S2 <: T
∧ (x ⊢> S1 ; Gamma) ⊢ t2 ∈ S2.
Gamma ⊢ (abs x S1 t2) ∈ T →
∃S2,
Arrow S1 S2 <: T
∧ (x ⊢> S1 ; Gamma) ⊢ t2 ∈ S2.
Proof with eauto.
intros Gamma x S1 t2 T H.
remember (abs x S1 t2) as t.
induction H;
inversion Heqt; subst; intros; try solve_by_invert.
- (* T_Abs *)
∃T12...
- (* T_Sub *)
destruct IHhas_type as [S2 [Hsub Hty]]...
Qed.
intros Gamma x S1 t2 T H.
remember (abs x S1 t2) as t.
induction H;
inversion Heqt; subst; intros; try solve_by_invert.
- (* T_Abs *)
∃T12...
- (* T_Sub *)
destruct IHhas_type as [S2 [Hsub Hty]]...
Qed.
Similarly...
Lemma typing_inversion_var : ∀Gamma x T,
Gamma ⊢ (var x) ∈ T →
∃S,
Gamma x = Some S ∧ S <: T.
Lemma typing_inversion_app : ∀Gamma t1 t2 T2,
Gamma ⊢ (app t1 t2) ∈ T2 →
∃T1,
Gamma ⊢ t1 ∈ (Arrow T1 T2) ∧
Gamma ⊢ t2 ∈ T1.
Lemma typing_inversion_true : ∀Gamma T,
Gamma ⊢ tru ∈ T →
Bool <: T.
Lemma typing_inversion_false : ∀Gamma T,
Gamma ⊢ fls ∈ T →
Bool <: T.
Lemma typing_inversion_if : ∀Gamma t1 t2 t3 T,
Gamma ⊢ (test t1 t2 t3) ∈ T →
Gamma ⊢ t1 ∈ Bool
∧ Gamma ⊢ t2 ∈ T
∧ Gamma ⊢ t3 ∈ T.
Lemma typing_inversion_unit : ∀Gamma T,
Gamma ⊢ unit ∈ T →
Unit <: 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.
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 t1 t2 T2,
Gamma ⊢ (app t1 t2) ∈ T2 →
∃T1,
Gamma ⊢ t1 ∈ (Arrow T1 T2) ∧
Gamma ⊢ t2 ∈ T1.
Proof with eauto.
intros Gamma t1 t2 T2 Hty.
remember (app t1 t2) as t.
induction Hty; intros;
inversion Heqt; subst; try solve_by_invert.
- (* T_App *)
∃T1...
- (* T_Sub *)
destruct IHHty as [U1 [Hty1 Hty2]]...
Qed.
intros Gamma t1 t2 T2 Hty.
remember (app t1 t2) as t.
induction Hty; intros;
inversion Heqt; subst; try solve_by_invert.
- (* T_App *)
∃T1...
- (* T_Sub *)
destruct IHHty as [U1 [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.
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.
intros Gamma T Htyp. remember fls as tu.
induction Htyp;
inversion Heqtu; subst; intros...
Qed.
Lemma typing_inversion_if : ∀Gamma t1 t2 t3 T,
Gamma ⊢ (test t1 t2 t3) ∈ T →
Gamma ⊢ t1 ∈ Bool
∧ Gamma ⊢ t2 ∈ T
∧ Gamma ⊢ t3 ∈ T.
Proof with eauto.
intros Gamma t1 t2 t3 T Hty.
remember (test t1 t2 t3) as t.
induction Hty; intros;
inversion Heqt; subst; try solve_by_invert.
- (* T_Test *)
auto.
- (* T_Sub *)
destruct (IHHty H0) as [H1 [H2 H3]]...
Qed.
intros Gamma t1 t2 t3 T Hty.
remember (test t1 t2 t3) as t.
induction Hty; intros;
inversion Heqt; subst; try solve_by_invert.
- (* T_Test *)
auto.
- (* T_Sub *)
destruct (IHHty H0) as [H1 [H2 H3]]...
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.
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 S1 s2 T1 T2,
empty ⊢ (abs x S1 s2) ∈ (Arrow T1 T2) →
T1 <: S1
∧ (x ⊢> S1 ; empty) ⊢ s2 ∈ T2.
empty ⊢ (abs x S1 s2) ∈ (Arrow T1 T2) →
T1 <: S1
∧ (x ⊢> S1 ; empty) ⊢ s2 ∈ T2.
Proof with eauto.
intros x S1 s2 T1 T2 Hty.
apply typing_inversion_abs in Hty.
inversion Hty as [S2 [Hsub Hty1]].
apply sub_inversion_arrow in Hsub.
inversion Hsub as [U1 [U2 [Heq [Hsub1 Hsub2]]]].
inversion Heq; subst... Qed.
intros x S1 s2 T1 T2 Hty.
apply typing_inversion_abs in Hty.
inversion Hty as [S2 [Hsub Hty1]].
apply sub_inversion_arrow in Hsub.
inversion Hsub as [U1 [U2 [Heq [Hsub1 Hsub2]]]].
inversion Heq; subst... Qed.
Inductive appears_free_in : string → tm → Prop :=
| afi_var : ∀x,
appears_free_in x (var x)
| afi_app1 : ∀x t1 t2,
appears_free_in x t1 → appears_free_in x (app t1 t2)
| afi_app2 : ∀x t1 t2,
appears_free_in x t2 → appears_free_in x (app t1 t2)
| afi_abs : ∀x y T11 t12,
y ≠ x →
appears_free_in x t12 →
appears_free_in x (abs y T11 t12)
| afi_test1 : ∀x t1 t2 t3,
appears_free_in x t1 →
appears_free_in x (test t1 t2 t3)
| afi_test2 : ∀x t1 t2 t3,
appears_free_in x t2 →
appears_free_in x (test t1 t2 t3)
| afi_test3 : ∀x t1 t2 t3,
appears_free_in x t3 →
appears_free_in x (test t1 t2 t3)
.
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.
Lemma free_in_context : ∀x t T Gamma,
appears_free_in x t →
Gamma ⊢ t ∈ T →
∃T', Gamma x = Some T'.
| afi_var : ∀x,
appears_free_in x (var x)
| afi_app1 : ∀x t1 t2,
appears_free_in x t1 → appears_free_in x (app t1 t2)
| afi_app2 : ∀x t1 t2,
appears_free_in x t2 → appears_free_in x (app t1 t2)
| afi_abs : ∀x y T11 t12,
y ≠ x →
appears_free_in x t12 →
appears_free_in x (abs y T11 t12)
| afi_test1 : ∀x t1 t2 t3,
appears_free_in x t1 →
appears_free_in x (test t1 t2 t3)
| afi_test2 : ∀x t1 t2 t3,
appears_free_in x t2 →
appears_free_in x (test t1 t2 t3)
| afi_test3 : ∀x t1 t2 t3,
appears_free_in x t3 →
appears_free_in x (test t1 t2 t3)
.
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 x0 Hafi.
unfold update, t_update. destruct (eqb_stringP x x0)...
- (* T_Test *)
apply T_Test...
Qed.
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 x0 Hafi.
unfold update, t_update. destruct (eqb_stringP x x0)...
- (* 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 H4) as [T Hctx]. ∃T.
unfold update, t_update in Hctx.
rewrite <- eqb_string_false_iff in H2.
rewrite H2 in Hctx... Qed.
intros x t T Gamma Hafi Htyp.
induction Htyp;
subst; inversion Hafi; subst...
- (* T_Abs *)
destruct (IHHtyp H4) as [T Hctx]. ∃T.
unfold update, t_update in Hctx.
rewrite <- eqb_string_false_iff in H2.
rewrite H2 in Hctx... Qed.
Substitution
Lemma substitution_preserves_typing : ∀Gamma x U v t S,
(x ⊢> U ; Gamma) ⊢ t ∈ S →
empty ⊢ v ∈ U →
Gamma ⊢ [x:=v]t ∈ S.
(* Mon Mar 25 14:39:38 EDT 2019 *)
(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 [T1 [Htypt1 Htypt2]].
eapply T_App...
- (* abs *)
rename s into y. rename t into T1.
destruct (typing_inversion_abs _ _ _ _ _ Htypt)
as [T2 [Hsub Htypt2]].
apply T_Sub with (Arrow T1 T2)... 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) ⊢ t1 ∈ Bool
∧ (x ⊢> U ; Gamma) ⊢ t2 ∈ S
∧ (x ⊢> U ; Gamma) ⊢ t3 ∈ S)
by apply (typing_inversion_if _ _ _ _ _ Htypt).
inversion H as [H1 [H2 H3]].
apply IHt1 in H1. apply IHt2 in H2. apply IHt3 in H3.
auto.
- (* unit *)
assert (Unit <: S)
by apply (typing_inversion_unit _ _ Htypt)...
Qed.
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 [T1 [Htypt1 Htypt2]].
eapply T_App...
- (* abs *)
rename s into y. rename t into T1.
destruct (typing_inversion_abs _ _ _ _ _ Htypt)
as [T2 [Hsub Htypt2]].
apply T_Sub with (Arrow T1 T2)... 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) ⊢ t1 ∈ Bool
∧ (x ⊢> U ; Gamma) ⊢ t2 ∈ S
∧ (x ⊢> U ; Gamma) ⊢ t3 ∈ S)
by apply (typing_inversion_if _ _ _ _ _ Htypt).
inversion H as [H1 [H2 H3]].
apply IHt1 in H1. apply IHt2 in H2. apply IHt3 in H3.
auto.
- (* unit *)
assert (Unit <: S)
by apply (typing_inversion_unit _ _ Htypt)...
Qed.
(* Mon Mar 25 14:39:38 EDT 2019 *)