NormNormalization of STLC
(* Chapter written and maintained by Andrew Tolmach *)
Set Warnings "-notation-overridden,-parsing,-deprecated-hint-without-locality".
From Stdlib Require Import List.
From Stdlib Require Import Strings.String.
From PLF Require Import Maps.
From PLF Require Import Smallstep.
Hint Constructors multi : core.
Set Warnings "-notation-overridden,-parsing,-deprecated-hint-without-locality".
From Stdlib Require Import List.
From Stdlib Require Import Strings.String.
From PLF Require Import Maps.
From PLF Require Import Smallstep.
Hint Constructors multi : core.
This optional chapter is based on [Pierce 2002] Chapter 12,
and [Ahmed 2015]. It may be useful to look at those
references, since they include some explanations and informal
proofs that are not repeated here.
In this chapter, we consider another fundamental theoretical
property of the simply typed lambda-calculus: the fact that the
evaluation of a well-typed program is guaranteed to halt in a
finite number of steps---i.e., every well-typed term is
normalizable.
Unlike the type-safety properties we have considered so far, the
normalization property does not extend to full-blown programming
languages, because these languages nearly always include features,
such as general recursion (see the MoreStlc chapter) or
recursive types, that can be used to write nonterminating
programs. However, the issue of normalization reappears at the
level of types when we consider the metatheory of polymorphic
versions of the lambda calculus such as System F-omega: in this
system, the language of types effectively contains a copy of the
simply typed lambda-calculus, and the termination of the
typechecking algorithm thus hinges on the fact that a
"normalization" operation on type expressions is guaranteed to
terminate.
Another reason for studying normalization proofs is that they are
some of the most beautiful---and mind-blowing---mathematics to be
found in the type theory literature, often (as here) involving the
fundamental proof technique of logical relations. To give
readers more exposure to this proof technique, we also use it to
develop an alternative proof of type safety at the end of this
chapter.
The calculus we shall consider here is the simply typed
lambda-calculus over a single base type bool and with
pairs. We'll give most details of the development for the basic
lambda-calculus terms treating bool as an uninterpreted base
type, and leave the extension to the boolean operators and pairs
to the reader. Even for the base calculus, normalization is not
trivial to prove, since each reduction of a term can duplicate
redexes in subterms.
Exercise: 2 stars, standard (norm_fail)
Where do we fail if we attempt to prove normalization by a straightforward induction on the size of a well-typed term?
(* FILL IN HERE *)
(* Do not modify the following line: *)
Definition manual_grade_for_norm_fail : option (nat×string) := None.
☐
(* Do not modify the following line: *)
Definition manual_grade_for_norm_fail : option (nat×string) := None.
☐
Language
(* A handy tactic. *)
Ltac inv H := inversion H; subst; clear H.
Open Scope string.
Inductive ty : Type :=
| Ty_Bool : ty
| Ty_Arrow : ty → ty → ty
| Ty_Prod : ty → ty → ty.
Inductive tm : Type :=
(* pure STLC *)
| tm_var : string → tm
| tm_app : tm → tm → tm
| tm_abs : string → ty → tm → tm
(* booleans *)
| tm_true : tm
| tm_false : tm
| tm_if : tm → tm → tm → tm
(* pairs *)
| tm_pair : tm → tm → tm
| tm_fst : tm → tm
| tm_snd : tm → tm.
Declare Custom Entry stlc.
Notation "<{ e }>" := e (e custom stlc at level 99).
Notation "( x )" := x (in custom stlc, x at level 99).
Notation "x" := x (in custom stlc at level 0, x constr at level 0).
Notation "S -> T" := (Ty_Arrow S T) (in custom stlc at level 50, right associativity).
Notation "x y" := (tm_app x y) (in custom stlc at level 1, left associativity).
Notation "\ x : t , y" :=
(tm_abs x t y) (in custom stlc at level 90, x at level 99,
t custom stlc at level 99,
y custom stlc at level 99,
left associativity).
Coercion tm_var : string >-> tm.
Notation "{ x }" := x (in custom stlc at level 1, x constr).
Notation "'Bool'" := Ty_Bool (in custom stlc at level 0).
Notation "'if' x 'then' y 'else' z" :=
(tm_if x y z) (in custom stlc at level 89,
x custom stlc at level 99,
y custom stlc at level 99,
z custom stlc at level 99,
left associativity).
Notation "'true'" := true (at level 1).
Notation "'true'" := tm_true (in custom stlc at level 0).
Notation "'false'" := false (at level 1).
Notation "'false'" := tm_false (in custom stlc at level 0).
Notation "X * Y" :=
(Ty_Prod X Y) (in custom stlc at level 2, X custom stlc, Y custom stlc at level 0).
Notation "( x ',' y )" := (tm_pair x y) (in custom stlc at level 0,
x custom stlc at level 99,
y custom stlc at level 99).
Notation "t '.fst'" := (tm_fst t) (in custom stlc at level 1).
Notation "t '.snd'" := (tm_snd t) (in custom stlc at level 1).
| Ty_Bool : ty
| Ty_Arrow : ty → ty → ty
| Ty_Prod : ty → ty → ty.
Inductive tm : Type :=
(* pure STLC *)
| tm_var : string → tm
| tm_app : tm → tm → tm
| tm_abs : string → ty → tm → tm
(* booleans *)
| tm_true : tm
| tm_false : tm
| tm_if : tm → tm → tm → tm
(* pairs *)
| tm_pair : tm → tm → tm
| tm_fst : tm → tm
| tm_snd : tm → tm.
Declare Custom Entry stlc.
Notation "<{ e }>" := e (e custom stlc at level 99).
Notation "( x )" := x (in custom stlc, x at level 99).
Notation "x" := x (in custom stlc at level 0, x constr at level 0).
Notation "S -> T" := (Ty_Arrow S T) (in custom stlc at level 50, right associativity).
Notation "x y" := (tm_app x y) (in custom stlc at level 1, left associativity).
Notation "\ x : t , y" :=
(tm_abs x t y) (in custom stlc at level 90, x at level 99,
t custom stlc at level 99,
y custom stlc at level 99,
left associativity).
Coercion tm_var : string >-> tm.
Notation "{ x }" := x (in custom stlc at level 1, x constr).
Notation "'Bool'" := Ty_Bool (in custom stlc at level 0).
Notation "'if' x 'then' y 'else' z" :=
(tm_if x y z) (in custom stlc at level 89,
x custom stlc at level 99,
y custom stlc at level 99,
z custom stlc at level 99,
left associativity).
Notation "'true'" := true (at level 1).
Notation "'true'" := tm_true (in custom stlc at level 0).
Notation "'false'" := false (at level 1).
Notation "'false'" := tm_false (in custom stlc at level 0).
Notation "X * Y" :=
(Ty_Prod X Y) (in custom stlc at level 2, X custom stlc, Y custom stlc at level 0).
Notation "( x ',' y )" := (tm_pair x y) (in custom stlc at level 0,
x custom stlc at level 99,
y custom stlc at level 99).
Notation "t '.fst'" := (tm_fst t) (in custom stlc at level 1).
Notation "t '.snd'" := (tm_snd t) (in custom stlc at level 1).
Reserved Notation "'[' x ':=' s ']' t" (in custom stlc at level 20, x constr).
Fixpoint subst (x : string) (s : tm) (t : tm) : tm :=
match t with
| tm_var y ⇒
if x =? y then s else t
| <{ \ y : T, t1 }> ⇒
if x =? y then t else <{ \y:T, [x:=s] t1 }>
| <{t1 t2}> ⇒
<{ ([x:=s]t1) ([x:=s]t2)}>
| <{true}> ⇒
<{true}>
| <{false}> ⇒
<{false}>
| <{if t1 then t2 else t3}> ⇒
<{if ([x:=s] t1) then ([x:=s] t2) else ([x:=s] t3)}>
| <{(t1, t2)}> ⇒
<{( ([x:=s] t1), ([x:=s] t2) )}>
| <{t0.fst}> ⇒
<{ ([x:=s] t0).fst}>
| <{t0.snd}> ⇒
<{ ([x:=s] t0).snd}>
end
where "'[' x ':=' s ']' t" := (subst x s t) (in custom stlc).
Fixpoint subst (x : string) (s : tm) (t : tm) : tm :=
match t with
| tm_var y ⇒
if x =? y then s else t
| <{ \ y : T, t1 }> ⇒
if x =? y then t else <{ \y:T, [x:=s] t1 }>
| <{t1 t2}> ⇒
<{ ([x:=s]t1) ([x:=s]t2)}>
| <{true}> ⇒
<{true}>
| <{false}> ⇒
<{false}>
| <{if t1 then t2 else t3}> ⇒
<{if ([x:=s] t1) then ([x:=s] t2) else ([x:=s] t3)}>
| <{(t1, t2)}> ⇒
<{( ([x:=s] t1), ([x:=s] t2) )}>
| <{t0.fst}> ⇒
<{ ([x:=s] t0).fst}>
| <{t0.snd}> ⇒
<{ ([x:=s] t0).snd}>
end
where "'[' x ':=' s ']' t" := (subst x s t) (in custom stlc).
Inductive value : tm → Prop :=
| v_abs : ∀ x T2 t1,
value <{\x:T2, t1}>
| v_true :
value <{true}>
| v_false :
value <{false}>
| v_pair : ∀ v1 v2,
value v1 →
value v2 →
value <{(v1, v2)}>.
Hint Constructors value : core.
Reserved Notation "t '-->' t'" (at level 40).
Inductive step : tm → tm → Prop :=
| ST_AppAbs : ∀ x T2 t1 v2,
value v2 →
<{(\x:T2, t1) v2}> --> <{ [x:=v2]t1 }>
| ST_App1 : ∀ t1 t1' t2,
t1 --> t1' →
<{t1 t2}> --> <{t1' t2}>
| ST_App2 : ∀ v1 t2 t2',
value v1 →
t2 --> t2' →
<{v1 t2}> --> <{v1 t2'}>
| ST_IfTrue : ∀ t1 t2,
<{if true then t1 else t2}> --> t1
| ST_IfFalse : ∀ t1 t2,
<{if false then t1 else t2}> --> t2
| ST_If : ∀ t1 t1' t2 t3,
t1 --> t1' →
<{if t1 then t2 else t3}> --> <{if t1' then t2 else t3}>
| ST_Pair1 : ∀ t1 t1' t2,
t1 --> t1' →
<{ (t1,t2) }> --> <{ (t1' , t2) }>
| ST_Pair2 : ∀ v1 t2 t2',
value v1 →
t2 --> t2' →
<{ (v1, t2) }> --> <{ (v1, t2') }>
| ST_Fst1 : ∀ t0 t0',
t0 --> t0' →
<{ t0.fst }> --> <{ t0'.fst }>
| ST_FstPair : ∀ v1 v2,
value v1 →
value v2 →
<{ (v1,v2).fst }> --> v1
| ST_Snd1 : ∀ t0 t0',
t0 --> t0' →
<{ t0.snd }> --> <{ t0'.snd }>
| ST_SndPair : ∀ v1 v2,
value v1 →
value v2 →
<{ (v1,v2).snd }> --> v2
where "t '-->' t'" := (step t t').
Hint Constructors step : core.
Notation multistep := (multi step).
Notation "t1 '-->*' t2" := (multistep t1 t2) (at level 40).
Notation step_normal_form := (normal_form step).
Lemma value__normal : ∀ {t}, value t → step_normal_form t.
| v_abs : ∀ x T2 t1,
value <{\x:T2, t1}>
| v_true :
value <{true}>
| v_false :
value <{false}>
| v_pair : ∀ v1 v2,
value v1 →
value v2 →
value <{(v1, v2)}>.
Hint Constructors value : core.
Reserved Notation "t '-->' t'" (at level 40).
Inductive step : tm → tm → Prop :=
| ST_AppAbs : ∀ x T2 t1 v2,
value v2 →
<{(\x:T2, t1) v2}> --> <{ [x:=v2]t1 }>
| ST_App1 : ∀ t1 t1' t2,
t1 --> t1' →
<{t1 t2}> --> <{t1' t2}>
| ST_App2 : ∀ v1 t2 t2',
value v1 →
t2 --> t2' →
<{v1 t2}> --> <{v1 t2'}>
| ST_IfTrue : ∀ t1 t2,
<{if true then t1 else t2}> --> t1
| ST_IfFalse : ∀ t1 t2,
<{if false then t1 else t2}> --> t2
| ST_If : ∀ t1 t1' t2 t3,
t1 --> t1' →
<{if t1 then t2 else t3}> --> <{if t1' then t2 else t3}>
| ST_Pair1 : ∀ t1 t1' t2,
t1 --> t1' →
<{ (t1,t2) }> --> <{ (t1' , t2) }>
| ST_Pair2 : ∀ v1 t2 t2',
value v1 →
t2 --> t2' →
<{ (v1, t2) }> --> <{ (v1, t2') }>
| ST_Fst1 : ∀ t0 t0',
t0 --> t0' →
<{ t0.fst }> --> <{ t0'.fst }>
| ST_FstPair : ∀ v1 v2,
value v1 →
value v2 →
<{ (v1,v2).fst }> --> v1
| ST_Snd1 : ∀ t0 t0',
t0 --> t0' →
<{ t0.snd }> --> <{ t0'.snd }>
| ST_SndPair : ∀ v1 v2,
value v1 →
value v2 →
<{ (v1,v2).snd }> --> v2
where "t '-->' t'" := (step t t').
Hint Constructors step : core.
Notation multistep := (multi step).
Notation "t1 '-->*' t2" := (multistep t1 t2) (at level 40).
Notation step_normal_form := (normal_form step).
Lemma value__normal : ∀ {t}, value t → step_normal_form t.
Proof with eauto.
intros t H; induction H; intros [t' ST]; inversion ST...
Qed.
intros t H; induction H; intros [t' ST]; inversion ST...
Qed.
Aside: As a reminder, putting curly braces around one ore more
parameters in a lemma statement means that the parameters are to
be inferred from the remaining parameters. For example, in the
above lemma, Rocq can infer t from the provided value t.
This is entirely analogous to inference of type arguments in
ordinary polymorphic functions, and it can remove clutter from
explicit applications of the lemma. We use this style for most
lemma statements in the remainder of this chapter.
Definition context := partial_map ty.
Reserved Notation "Gamma '|--' t '∈' T" (at level 40,
t custom stlc, T custom stlc at level 0).
Inductive has_type : context → tm → ty → Prop :=
(* Same as before: *)
(* pure STLC *)
| T_Var : ∀ Gamma x T1,
Gamma x = Some T1 →
Gamma |-- x \in T1
| T_Abs : ∀ Gamma x T1 T2 t1,
(x ⊢> T2 ; Gamma) |-- t1 \in T1 →
Gamma |-- \x:T2, t1 \in (T2 → T1)
| T_App : ∀ T1 T2 Gamma t1 t2,
Gamma |-- t1 \in (T2 → T1) →
Gamma |-- t2 \in T2 →
Gamma |-- t1 t2 \in T1
| T_True : ∀ Gamma,
Gamma |-- true \in Bool
| T_False : ∀ Gamma,
Gamma |-- false \in Bool
| T_If : ∀ t1 t2 t3 T1 Gamma,
Gamma |-- t1 \in Bool →
Gamma |-- t2 \in T1 →
Gamma |-- t3 \in T1 →
Gamma |-- if t1 then t2 else t3 \in T1
| T_Pair : ∀ Gamma t1 t2 T1 T2,
Gamma |-- t1 \in T1 →
Gamma |-- t2 \in T2 →
Gamma |-- (t1, t2) \in (T1 × T2)
| T_Fst : ∀ Gamma t0 T1 T2,
Gamma |-- t0 \in (T1 × T2) →
Gamma |-- t0.fst \in T1
| T_Snd : ∀ Gamma t0 T1 T2,
Gamma |-- t0 \in (T1 × T2) →
Gamma |-- t0.snd \in T2
where "Gamma '|--' t '∈' T" := (has_type Gamma t T).
Hint Constructors has_type : core.
Reserved Notation "Gamma '|--' t '∈' T" (at level 40,
t custom stlc, T custom stlc at level 0).
Inductive has_type : context → tm → ty → Prop :=
(* Same as before: *)
(* pure STLC *)
| T_Var : ∀ Gamma x T1,
Gamma x = Some T1 →
Gamma |-- x \in T1
| T_Abs : ∀ Gamma x T1 T2 t1,
(x ⊢> T2 ; Gamma) |-- t1 \in T1 →
Gamma |-- \x:T2, t1 \in (T2 → T1)
| T_App : ∀ T1 T2 Gamma t1 t2,
Gamma |-- t1 \in (T2 → T1) →
Gamma |-- t2 \in T2 →
Gamma |-- t1 t2 \in T1
| T_True : ∀ Gamma,
Gamma |-- true \in Bool
| T_False : ∀ Gamma,
Gamma |-- false \in Bool
| T_If : ∀ t1 t2 t3 T1 Gamma,
Gamma |-- t1 \in Bool →
Gamma |-- t2 \in T1 →
Gamma |-- t3 \in T1 →
Gamma |-- if t1 then t2 else t3 \in T1
| T_Pair : ∀ Gamma t1 t2 T1 T2,
Gamma |-- t1 \in T1 →
Gamma |-- t2 \in T2 →
Gamma |-- (t1, t2) \in (T1 × T2)
| T_Fst : ∀ Gamma t0 T1 T2,
Gamma |-- t0 \in (T1 × T2) →
Gamma |-- t0.fst \in T1
| T_Snd : ∀ Gamma t0 T1 T2,
Gamma |-- t0 \in (T1 × T2) →
Gamma |-- t0.snd \in T2
where "Gamma '|--' t '∈' T" := (has_type Gamma t T).
Hint Constructors has_type : core.
Lemma weakening : ∀ {Gamma Gamma' t T},
includedin Gamma Gamma' →
Gamma |-- t \in T →
Gamma' |-- t \in T.
Lemma weakening_empty : ∀ {Gamma t T},
empty |-- t \in T →
Gamma |-- t \in T.
includedin Gamma Gamma' →
Gamma |-- t \in T →
Gamma' |-- t \in T.
Proof.
intros Gamma Gamma' t T H Ht.
generalize dependent Gamma'.
induction Ht; eauto using includedin_update.
Qed.
intros Gamma Gamma' t T H Ht.
generalize dependent Gamma'.
induction Ht; eauto using includedin_update.
Qed.
Lemma weakening_empty : ∀ {Gamma t T},
empty |-- t \in T →
Gamma |-- t \in T.
Lemma substitution_preserves_typing : ∀ Gamma x U t v T,
(x ⊢> U ; Gamma) |-- t \in T →
empty |-- v \in U →
Gamma |-- [x:=v]t \in T.
(x ⊢> U ; Gamma) |-- t \in T →
empty |-- v \in U →
Gamma |-- [x:=v]t \in T.
Proof with eauto.
intros Gamma x U t v T Ht Hv.
generalize dependent Gamma. generalize dependent T.
induction t; intros T Gamma H;
(* in each case, we'll want to get at the derivation of H *)
inv H; simpl; eauto.
- (* var *)
rename s into y. destruct (eqb_spec x y); subst.
+ (* x=y *)
rewrite update_eq in H2.
injection H2 as H2; subst.
apply weakening_empty. assumption.
+ (* x<>y *)
apply T_Var. rewrite update_neq in H2; auto.
- (* abs *)
rename s into y, t into S.
destruct (eqb_spec x y); subst; apply T_Abs.
+ (* x=y *)
rewrite update_shadow in H5. assumption.
+ (* x<>y *)
apply IHt.
rewrite update_permute; auto.
Qed.
intros Gamma x U t v T Ht Hv.
generalize dependent Gamma. generalize dependent T.
induction t; intros T Gamma H;
(* in each case, we'll want to get at the derivation of H *)
inv H; simpl; eauto.
- (* var *)
rename s into y. destruct (eqb_spec x y); subst.
+ (* x=y *)
rewrite update_eq in H2.
injection H2 as H2; subst.
apply weakening_empty. assumption.
+ (* x<>y *)
apply T_Var. rewrite update_neq in H2; auto.
- (* abs *)
rename s into y, t into S.
destruct (eqb_spec x y); subst; apply T_Abs.
+ (* x=y *)
rewrite update_shadow in H5. assumption.
+ (* x<>y *)
apply IHt.
rewrite update_permute; auto.
Qed.
Theorem preservation : ∀ {t t' T},
empty |-- t \in T →
t --> t' →
empty |-- t' \in T.
empty |-- t \in T →
t --> t' →
empty |-- t' \in T.
Proof with eauto.
intros t t' T HT. generalize dependent t'.
remember empty as Gamma.
induction HT;
intros t' HE; subst; inversion HE; subst...
- (* T_App *)
inversion HE; subst...
+ (* ST_AppAbs *)
apply substitution_preserves_typing with T2...
inversion HT1...
- (* T_Fst *)
inversion HT...
- (* T_Snd *)
inversion HT...
Qed.
intros t t' T HT. generalize dependent t'.
remember empty as Gamma.
induction HT;
intros t' HE; subst; inversion HE; subst...
- (* T_App *)
inversion HE; subst...
+ (* ST_AppAbs *)
apply substitution_preserves_typing with T2...
inversion HT1...
- (* T_Fst *)
inversion HT...
- (* T_Snd *)
inversion HT...
Qed.
Inductive appears_free_in : string → tm → Prop :=
| afi_var : ∀ (x : string),
appears_free_in x <{ x }>
| afi_app1 : ∀ x t1 t2,
appears_free_in x t1 → appears_free_in x <{ t1 t2 }>
| afi_app2 : ∀ x t1 t2,
appears_free_in x t2 → appears_free_in x <{ t1 t2 }>
| afi_abs : ∀ x y T11 t12,
y ≠ x →
appears_free_in x t12 →
appears_free_in x <{ \y : T11, t12 }>
(* booleans *)
| afi_if0 : ∀ x t0 t1 t2,
appears_free_in x t0 →
appears_free_in x <{ if t0 then t1 else t2 }>
| afi_if1 : ∀ x t0 t1 t2,
appears_free_in x t1 →
appears_free_in x <{ if t0 then t1 else t2 }>
| afi_if2 : ∀ x t0 t1 t2,
appears_free_in x t2 →
appears_free_in x <{ if t0 then t1 else t2 }>
(* pairs *)
| afi_pair1 : ∀ x t1 t2,
appears_free_in x t1 →
appears_free_in x <{ (t1, t2) }>
| afi_pair2 : ∀ x t1 t2,
appears_free_in x t2 →
appears_free_in x <{ (t1 , t2) }>
| afi_fst : ∀ x t,
appears_free_in x t →
appears_free_in x <{ t.fst }>
| afi_snd : ∀ x t,
appears_free_in x t →
appears_free_in x <{ t.snd }>.
Hint Constructors appears_free_in : core.
Definition closed (t:tm) :=
∀ x, ¬ appears_free_in x t.
Lemma free_in_context : ∀ x {t T Gamma},
appears_free_in x t →
Gamma |-- t \in T →
Gamma x ≠ None.
Corollary typable_empty__closed : ∀ {t T},
empty |-- t \in T →
closed t.
| afi_var : ∀ (x : string),
appears_free_in x <{ x }>
| afi_app1 : ∀ x t1 t2,
appears_free_in x t1 → appears_free_in x <{ t1 t2 }>
| afi_app2 : ∀ x t1 t2,
appears_free_in x t2 → appears_free_in x <{ t1 t2 }>
| afi_abs : ∀ x y T11 t12,
y ≠ x →
appears_free_in x t12 →
appears_free_in x <{ \y : T11, t12 }>
(* booleans *)
| afi_if0 : ∀ x t0 t1 t2,
appears_free_in x t0 →
appears_free_in x <{ if t0 then t1 else t2 }>
| afi_if1 : ∀ x t0 t1 t2,
appears_free_in x t1 →
appears_free_in x <{ if t0 then t1 else t2 }>
| afi_if2 : ∀ x t0 t1 t2,
appears_free_in x t2 →
appears_free_in x <{ if t0 then t1 else t2 }>
(* pairs *)
| afi_pair1 : ∀ x t1 t2,
appears_free_in x t1 →
appears_free_in x <{ (t1, t2) }>
| afi_pair2 : ∀ x t1 t2,
appears_free_in x t2 →
appears_free_in x <{ (t1 , t2) }>
| afi_fst : ∀ x t,
appears_free_in x t →
appears_free_in x <{ t.fst }>
| afi_snd : ∀ x t,
appears_free_in x t →
appears_free_in x <{ t.snd }>.
Hint Constructors appears_free_in : core.
Definition closed (t:tm) :=
∀ x, ¬ appears_free_in x t.
Lemma free_in_context : ∀ x {t T Gamma},
appears_free_in x t →
Gamma |-- t \in T →
Gamma x ≠ None.
Proof with eauto.
intros x t T Gamma Hafi Htyp.
induction Htyp; inv Hafi...
- (* T_Var *)
rewrite H; intro X; inv X.
- (* T_Abs *)
pose proof (IHHtyp H4). rewrite update_neq in H; auto.
Qed.
intros x t T Gamma Hafi Htyp.
induction Htyp; inv Hafi...
- (* T_Var *)
rewrite H; intro X; inv X.
- (* T_Abs *)
pose proof (IHHtyp H4). rewrite update_neq in H; auto.
Qed.
Corollary typable_empty__closed : ∀ {t T},
empty |-- t \in T →
closed t.
Determinism
Ltac solve_by_value_nf :=
match goal with | H : value ?v, H' : ?v --> ?v' ⊢ _ ⇒
exfalso; apply value__normal in H; eauto
end.
Lemma step_deterministic :
deterministic step.
match goal with | H : value ?v, H' : ?v --> ?v' ⊢ _ ⇒
exfalso; apply value__normal in H; eauto
end.
Lemma step_deterministic :
deterministic step.
Proof with eauto.
unfold deterministic.
intros t t' t'' E1 E2.
generalize dependent t''.
induction E1; intros t'' E2; inv E2;
try solve_by_invert; try f_equal; try solve_by_value_nf; eauto.
- inv E1; solve_by_value_nf.
- inv H2; solve_by_value_nf.
- inv E1; solve_by_value_nf.
- inv H2; solve_by_value_nf.
Qed.
unfold deterministic.
intros t t' t'' E1 E2.
generalize dependent t''.
induction E1; intros t'' E2; inv E2;
try solve_by_invert; try f_equal; try solve_by_value_nf; eauto.
- inv E1; solve_by_value_nf.
- inv H2; solve_by_value_nf.
- inv E1; solve_by_value_nf.
- inv H2; solve_by_value_nf.
Qed.
Normalization
☐
(The proof does not depend on the precise details of the step
relation, but in one direction you will want to use
value__normal and step_deterministic. The lemma might still
be true for nondeterministic languages, but the proof would be
harder!)
Exercise: 3 stars, standard (step_preserves_halting)
Another useful and suggestive fact: the property of halting is preserved by taking a reduction step or "undoing" a reduction step. Complete the proof of this lemma.
☐
First Proof Attempt
Theorem normalization_try1: ∀ {t T},
empty |-- t \in T →
halts t.
Proof.
intros t T HT.
(* We want to induct over the typing hypothesis. Recall that Rocq's
induction tactic forces us to generalize to an arbitrary context
Gamma first and keep track separately of the fact that Gamma
is really always empty. *)
remember empty as Gamma.
induction HT; subst Gamma; intros.
- (* Var *)
(* This case is impossible because a bare variable is not typable
in an empty enivonment. *)
rewrite apply_empty in H. inv H.
- (* Abs *)
(* This case is immediate because an abstraction is already a value *)
apply value_halts.
econstructor.
- (* App *)
unfold halts.
(* This is the hard (actually impossible) case, but let's see how
far we can get. The only way that an application can reduce to
a value is if we can somehow use the ST_AppAbs rule (otherwise
the reduction sequence will get stuck while still at a term that
is still an application, which is never a value). To make that
rule applicable, t1 must reduce to an abstraction term and
t2 must reduce to a value. The inductive hypotheses get us
almost there... *)
destruct (IHHT1 eq_refl) as [v1 [ST1 V1]].
destruct (IHHT2 eq_refl) as [v2 [ST2 V2]].
(* We still need to show that v1 is an abstraction term, which
we can do by repeated use of preservation and some reasoning
about canonical forms. *)
assert (HTV1: empty |-- v1 \in (T2 → T1)).
{ clear - HT1 ST1. induction ST1; eauto using preservation. }
assert (V1ABS: ∃ x, ∃ t, v1 = <{ \ x : T2 , t }>).
{ inv V1; inv HTV1; eauto. }
destruct V1ABS as [x [t E]]. subst v1.
(* Now we can show that reduction will indeed reach a use
of ST_AppAbs, by repeated use of ST_App1 and ST_App2. *)
assert (ST11: <{ t1 t2 }> -->* <{ (\ x : T2, t) t2 }>).
{ clear - ST1. induction ST1; eauto. (* using ST_App1 *) }
assert (ST22: <{ (\ x: T2, t) t2 }> -->* <{ (\ x : T2, t) v2 }>).
{ clear - ST2. induction ST2; eauto. (* using ST_App2 *) }
assert (ST23: <{ t1 t2 }> -->* <{ (\ x : T2, t) v2 }>).
{ eapply multi_trans; eauto. }
assert (STT: <{ t1 t2 }> -->* <{ [ x:= v2 ] t }>).
{ eapply multi_trans; eauto. (* using ST_AppAbs *) }
(* But this is as far as we can go. The induction hypotheses don't
tell us anything about <{ [x := v2] t >}, because it is not a
syntactic subterm of the original term. So we have no way to
show that it ultimately reduces to a value, and we cannot do
anything more with this case. (For what it's worth, the remaining
cases actually go through successfully.) *)
Abort.
empty |-- t \in T →
halts t.
Proof.
intros t T HT.
(* We want to induct over the typing hypothesis. Recall that Rocq's
induction tactic forces us to generalize to an arbitrary context
Gamma first and keep track separately of the fact that Gamma
is really always empty. *)
remember empty as Gamma.
induction HT; subst Gamma; intros.
- (* Var *)
(* This case is impossible because a bare variable is not typable
in an empty enivonment. *)
rewrite apply_empty in H. inv H.
- (* Abs *)
(* This case is immediate because an abstraction is already a value *)
apply value_halts.
econstructor.
- (* App *)
unfold halts.
(* This is the hard (actually impossible) case, but let's see how
far we can get. The only way that an application can reduce to
a value is if we can somehow use the ST_AppAbs rule (otherwise
the reduction sequence will get stuck while still at a term that
is still an application, which is never a value). To make that
rule applicable, t1 must reduce to an abstraction term and
t2 must reduce to a value. The inductive hypotheses get us
almost there... *)
destruct (IHHT1 eq_refl) as [v1 [ST1 V1]].
destruct (IHHT2 eq_refl) as [v2 [ST2 V2]].
(* We still need to show that v1 is an abstraction term, which
we can do by repeated use of preservation and some reasoning
about canonical forms. *)
assert (HTV1: empty |-- v1 \in (T2 → T1)).
{ clear - HT1 ST1. induction ST1; eauto using preservation. }
assert (V1ABS: ∃ x, ∃ t, v1 = <{ \ x : T2 , t }>).
{ inv V1; inv HTV1; eauto. }
destruct V1ABS as [x [t E]]. subst v1.
(* Now we can show that reduction will indeed reach a use
of ST_AppAbs, by repeated use of ST_App1 and ST_App2. *)
assert (ST11: <{ t1 t2 }> -->* <{ (\ x : T2, t) t2 }>).
{ clear - ST1. induction ST1; eauto. (* using ST_App1 *) }
assert (ST22: <{ (\ x: T2, t) t2 }> -->* <{ (\ x : T2, t) v2 }>).
{ clear - ST2. induction ST2; eauto. (* using ST_App2 *) }
assert (ST23: <{ t1 t2 }> -->* <{ (\ x : T2, t) v2 }>).
{ eapply multi_trans; eauto. }
assert (STT: <{ t1 t2 }> -->* <{ [ x:= v2 ] t }>).
{ eapply multi_trans; eauto. (* using ST_AppAbs *) }
(* But this is as far as we can go. The induction hypotheses don't
tell us anything about <{ [x := v2] t >}, because it is not a
syntactic subterm of the original term. So we have no way to
show that it ultimately reduces to a value, and we cannot do
anything more with this case. (For what it's worth, the remaining
cases actually go through successfully.) *)
Abort.
The N relation
- N bool t iff t is a closed term of type bool and t halts
in a value
- N (T1 → T2) t iff t is a closed term of type T1 → T2 and t halts in a value and, for any term s such that N T1 s, we have N T2 (t s).
Inductive N : ty → tm → Prop :=
| N_bool : ∀ b t, empty |-- t \in <{ Bool }> →
halts t →
N <{ Bool }> t
| N_arrow : ∀ T1 T2 t, empty |-- t \in <{ T1 → T2 }> →
halts t →
(∀ s, N T1 s → N T2 <{t s}>) →
N <{ T1 → T2 }> t. Unfortunately, Rocq rejects this definition because it violates the strict positivity requirement for inductive definitions, which says that the type being defined must not occur to the left of an arrow in the type of a constructor argument. Here, it is the third argument to N_arrow, namely (∀ s, N T1 s → N T2 <{t s}>), and specifically the N T1 s part, that violates this rule. (The outermost arrows separating the constructor arguments don't count when applying this rule; if they did, we could never have genuinely inductive properties at all!) The reason for the rule is that types defined with non-positive recursion can be used to build non-terminating functions, which as we know would be a disaster for Rocq's logical soundness. Even though the relation we want in this case might be perfectly innocent, Rocq still rejects it because it fails the positivity test.
Exercise: 3 stars, standard, especially useful (N_products)
Fix the product case for this definition.
Fixpoint N (T:ty) (t:tm) : Prop :=
empty |-- t \in T ∧ halts t ∧
(match T with
| <{ Bool }> ⇒ True
| <{ T1 → T2 }> ⇒ (∀ s, N T1 s → N T2 <{t s}> )
(* ... edit the next line when dealing with products *)
| <{ T1 × T2 }> ⇒ False (* FILL IN HERE *)
end).
(* Do not modify the following line: *)
Definition manual_grade_for_N_products : option (nat×string) := None.
☐
empty |-- t \in T ∧ halts t ∧
(match T with
| <{ Bool }> ⇒ True
| <{ T1 → T2 }> ⇒ (∀ s, N T1 s → N T2 <{t s}> )
(* ... edit the next line when dealing with products *)
| <{ T1 × T2 }> ⇒ False (* FILL IN HERE *)
end).
(* Do not modify the following line: *)
Definition manual_grade_for_N_products : option (nat×string) := None.
☐
Lemma N_halts : ∀ {T t}, N T t → halts t.
Lemma N_typable_empty : ∀ {T t}, N T t → empty |-- t \in T.
Lemma N_typable_empty : ∀ {T t}, N T t → empty |-- t \in T.
Membership in N_T Is Invariant Under Reduction
Exercise: 3 stars, standard (step_preserves_N)
Lemma step_preserves_N: ∀ {T t t'}, (t --> t') → N T t → N T t'.
Proof.
induction T; intros t t' E Nt; simpl in Nt ⊢ *;
destruct Nt as [typable_empty_t [halts_t NN]].
- (* Bool *)
split;[|split].
+ eapply preservation; eauto.
+ apply (step_preserves_halting E); eauto.
+ auto.
- (* Arrow *)
split;[|split].
+ eapply preservation; eauto.
+ apply (step_preserves_halting E); eauto.
+ intros.
eapply IHT2.
× apply ST_App1. apply E.
× apply NN; auto.
(* FILL IN HERE *) Admitted.
induction T; intros t t' E Nt; simpl in Nt ⊢ *;
destruct Nt as [typable_empty_t [halts_t NN]].
- (* Bool *)
split;[|split].
+ eapply preservation; eauto.
+ apply (step_preserves_halting E); eauto.
+ auto.
- (* Arrow *)
split;[|split].
+ eapply preservation; eauto.
+ apply (step_preserves_halting E); eauto.
+ intros.
eapply IHT2.
× apply ST_App1. apply E.
× apply NN; auto.
(* FILL IN HERE *) Admitted.
☐
The generalization to multiple steps is trivial:
Lemma multistep_preserves_N : ∀ {T t t'},
(t -->* t') → N T t → N T t'.
(t -->* t') → N T t → N T t'.
Proof.
intros T t t' STM; induction STM; intros.
- assumption.
- apply IHSTM. eapply step_preserves_N.
+ apply H.
+ assumption.
Qed.
intros T t t' STM; induction STM; intros.
- assumption.
- apply IHSTM. eapply step_preserves_N.
+ apply H.
+ assumption.
Qed.
In the reverse direction, we must add the fact that t has type
T before stepping as an additional hypothesis, because
subject expansion does not hold for this language (see StlcProp).
Exercise: 4 stars, standard, especially useful (step_preserves_N')
Lemma step_preserves_N' : ∀ {T t t'},
empty |-- t \in T → (t --> t') → N T t' → N T t.
empty |-- t \in T → (t --> t') → N T t' → N T t.
Proof.
(* FILL IN HERE *) Admitted.
(* FILL IN HERE *) Admitted.
☐
Lemma multistep_preserves_N' : ∀ {T t} t',
empty |-- t \in T → (t -->* t') → N T t' → N T t.
empty |-- t \in T → (t -->* t') → N T t' → N T t.
Proof.
intros T t t' HT STM.
induction STM; intros.
assumption.
eapply step_preserves_N'. assumption. apply H. apply IHSTM.
eapply preservation; eauto. auto.
Qed.
intros T t t' HT STM.
induction STM; intros.
assumption.
eapply step_preserves_N'. assumption. apply H. apply IHSTM.
eapply preservation; eauto. auto.
Qed.
Second Proof Attempt
Lemma typable_N_try1: ∀ t T,
empty |-- t \in T →
N T t.
Proof.
intros t T HT.
remember empty as Gamma. (* as before, we must do this to induct
over HT. *)
induction HT; subst Gamma; intros.
- (* Var *)
(* This case is again impossible because t is closed. *)
rewrite apply_empty in H. inv H.
- (* Abs *)
simpl; split; [| split].
+ econstructor; eauto.
+ eapply value_halts. econstructor.
+ intros s NS.
(* This is now the hard (sub)case.
Taking stock of what we know, we first observe that
s reduces to a value v *)
destruct (N_halts NS) as [v [STV V]].
(* Moreover, using the invariance of N under reduction,
we know that v is in N T2. *)
assert (NV: N T2 v) by (eapply multistep_preserves_N; eauto).
(* Also, the application in the goal reduces to a substitution. *)
assert (ST: <{ (\ x : T2, t1) s }> -->* <{ [x := v] t1 }>).
{ eapply multi_trans with <{ (\ x : T2, t1) v }>.
- clear - STV. induction STV; eauto. (* using ST_App2 *)
- eapply multi_trans.
+ eapply multi_R; eapply ST_AppAbs; auto.
+ eapply multi_refl.
}
(* And the application in the gaol is well-typed *)
assert (empty |-- (\x : T2, t1) s \in T1).
{ econstructor.
- econstructor; eauto.
- eapply N_typable_empty; eauto.
}
(* Now we can use the the invariance of N under
reverse steps to simplify the goal. *)
eapply multistep_preserves_N'; eauto.
(* Alas, we have no way to prove this goal! If we knew that
t1 was in N, the goal would be plausible: substituting
an N term into a N body "should" give a N result. And
since t1 is a subterm of the original application, we might
hope that the induction hypothesis would tell us something
useful about it. But in fact, the induction hypothesis
IHHT is completely useless, since its assumption
((x) ⊢> T2) = empty is false! Moreover, the conclusion
N T1 t1 of IHHT doesn't make sense anyway, since all
terms in N are closed but t1 may contain x free.
All this suggests that we need an even more general induction
hypothesis that talks about open terms. *)
admit. (* impossible! *)
- (* App *)
(* at least this case is now immediate, as we expected *)
eapply IHHT1; eauto.
Abort.
empty |-- t \in T →
N T t.
Proof.
intros t T HT.
remember empty as Gamma. (* as before, we must do this to induct
over HT. *)
induction HT; subst Gamma; intros.
- (* Var *)
(* This case is again impossible because t is closed. *)
rewrite apply_empty in H. inv H.
- (* Abs *)
simpl; split; [| split].
+ econstructor; eauto.
+ eapply value_halts. econstructor.
+ intros s NS.
(* This is now the hard (sub)case.
Taking stock of what we know, we first observe that
s reduces to a value v *)
destruct (N_halts NS) as [v [STV V]].
(* Moreover, using the invariance of N under reduction,
we know that v is in N T2. *)
assert (NV: N T2 v) by (eapply multistep_preserves_N; eauto).
(* Also, the application in the goal reduces to a substitution. *)
assert (ST: <{ (\ x : T2, t1) s }> -->* <{ [x := v] t1 }>).
{ eapply multi_trans with <{ (\ x : T2, t1) v }>.
- clear - STV. induction STV; eauto. (* using ST_App2 *)
- eapply multi_trans.
+ eapply multi_R; eapply ST_AppAbs; auto.
+ eapply multi_refl.
}
(* And the application in the gaol is well-typed *)
assert (empty |-- (\x : T2, t1) s \in T1).
{ econstructor.
- econstructor; eauto.
- eapply N_typable_empty; eauto.
}
(* Now we can use the the invariance of N under
reverse steps to simplify the goal. *)
eapply multistep_preserves_N'; eauto.
(* Alas, we have no way to prove this goal! If we knew that
t1 was in N, the goal would be plausible: substituting
an N term into a N body "should" give a N result. And
since t1 is a subterm of the original application, we might
hope that the induction hypothesis would tell us something
useful about it. But in fact, the induction hypothesis
IHHT is completely useless, since its assumption
((x) ⊢> T2) = empty is false! Moreover, the conclusion
N T1 t1 of IHHT doesn't make sense anyway, since all
terms in N are closed but t1 may contain x free.
All this suggests that we need an even more general induction
hypothesis that talks about open terms. *)
admit. (* impossible! *)
- (* App *)
(* at least this case is now immediate, as we expected *)
eapply IHHT1; eauto.
Abort.
Closing Multi-substitutions and Instantiations
Definition env := list (string × tm).
Fixpoint msubst (ss:env) (t:tm) : tm :=
match ss with
| nil ⇒ t
| ((x,s)::ss') ⇒ msubst ss' <{ [x:=s]t }>
end.
Fixpoint msubst (ss:env) (t:tm) : tm :=
match ss with
| nil ⇒ t
| ((x,s)::ss') ⇒ msubst ss' <{ [x:=s]t }>
end.
We need similar machinery to talk about repeated extension of a
typing context using a list of (variable, type) pairs, which we
call a type assignment. This is a more concrete representation
of typing contexts than the partial maps (developed in
Maps) that we have used up to this point. Representing
maps as functions is appealingly simple for many purposes, but
it has one major drawback: we cannot enumerate the domain of a
map or perform induction over it. We can do induction over
type assignments, and this turns out to be very useful.
Definition tass := list (string × ty).
Fixpoint mupdate (Gamma : context) (xts : tass) : context :=
match xts with
| nil ⇒ Gamma
| ((x,v)::xts') ⇒ update (mupdate Gamma xts') x v
end.
Fixpoint mupdate (Gamma : context) (xts : tass) : context :=
match xts with
| nil ⇒ Gamma
| ((x,v)::xts') ⇒ update (mupdate Gamma xts') x v
end.
A type assignment is readily converted into a typing context.
Finally, we describe the combination of a type assignment and a
value environment that have the same domain and where
corresponding type and value elements are related. We call this an
instantiation. We parameterize the definition over an arbitrary
type-indexed predicate R over closed terms, since many properties
of instantiations don't depend on the specific choice of R. (This will
allow us to reuse these definitions and properties on other logical
predicates besides N later in the chapter.)
Definition R_closed (R: ty → tm → Prop) :=
∀ T t, R T t → closed t.
Hint Unfold R_closed : core.
Inductive instantiation (R: ty → tm → Prop) (RC: R_closed R) :
tass → env → Prop :=
| V_nil :
instantiation R RC nil nil
| V_cons : ∀ x T v c e,
value v → R T v →
instantiation R RC c e →
instantiation R RC ((x,T)::c) ((x,v)::e).
Hint Constructors instantiation: core.
∀ T t, R T t → closed t.
Hint Unfold R_closed : core.
Inductive instantiation (R: ty → tm → Prop) (RC: R_closed R) :
tass → env → Prop :=
| V_nil :
instantiation R RC nil nil
| V_cons : ∀ x T v c e,
value v → R T v →
instantiation R RC c e →
instantiation R RC ((x,T)::c) ((x,v)::e).
Hint Constructors instantiation: core.
We now proceed to prove various properties of these definitions.
More Substitution Facts
Exercise: 3 stars, standard, optional (vacuous_substitution)
Lemma vacuous_substitution : ∀ {t x},
¬ appears_free_in x t →
∀ t', <{ [x:=t']t }> = t.
¬ appears_free_in x t →
∀ t', <{ [x:=t']t }> = t.
Proof with eauto.
induction t; intros; simpl...
(* FILL IN HERE *) Admitted.
induction t; intros; simpl...
(* FILL IN HERE *) Admitted.
☐
Substituting over a closed term has no effect.
Exercise: 3 stars, standard, optional (subst_not_afi)
Lemma subst_not_afi : ∀ {t x v},
closed v → ¬ appears_free_in x <{ [x:=v]t }>.
closed v → ¬ appears_free_in x <{ [x:=v]t }>.
Proof.
(* FILL IN HERE *) Admitted.
(* FILL IN HERE *) Admitted.
☐
Substituting for the same variable twice has no effect.
Exercise: 3 stars, standard (swap_subst)
Lemma swap_subst : ∀ {t x x1 v v1},
x ≠ x1 →
closed v → closed v1 →
<{ [x1:=v1]([x:=v]t) }> = <{ [x:=v]([x1:=v1]t) }>.
x ≠ x1 →
closed v → closed v1 →
<{ [x1:=v1]([x:=v]t) }> = <{ [x:=v]([x1:=v1]t) }>.
Proof with eauto.
induction t; intros; simpl.
- (* var *)
destruct (eqb_spec x s); destruct (eqb_spec x1 s).
+ subst. exfalso...
+ subst. simpl. rewrite eqb_refl. apply subst_closed...
+ subst. simpl. rewrite eqb_refl. symmetry. apply subst_closed...
+ simpl. rewrite <- eqb_neq in n; rewrite n.
rewrite <- eqb_neq in n0; rewrite n0...
(* FILL IN HERE *) Admitted.
induction t; intros; simpl.
- (* var *)
destruct (eqb_spec x s); destruct (eqb_spec x1 s).
+ subst. exfalso...
+ subst. simpl. rewrite eqb_refl. apply subst_closed...
+ subst. simpl. rewrite eqb_refl. symmetry. apply subst_closed...
+ simpl. rewrite <- eqb_neq in n; rewrite n.
rewrite <- eqb_neq in n0; rewrite n0...
(* FILL IN HERE *) Admitted.
☐
Properties of Multi-Substitutions
Fixpoint closed_env (e:env) :=
match e with
| nil ⇒ True
| (_,t)::e' ⇒ closed t ∧ closed_env e'
end.
Fixpoint remove (n:string) (e: env) : env :=
match e with
| nil ⇒ nil
| ((n',x)::nxs') ⇒
if n' =? n then remove n nxs'
else (n',x)::(remove n nxs')
end.
match e with
| nil ⇒ True
| (_,t)::e' ⇒ closed t ∧ closed_env e'
end.
Fixpoint remove (n:string) (e: env) : env :=
match e with
| nil ⇒ nil
| ((n',x)::nxs') ⇒
if n' =? n then remove n nxs'
else (n',x)::(remove n nxs')
end.
Exercise: 3 stars, standard, especially useful (msubst_subst)
Complete the following proof by induction on e. Hint: Use the lemmas about substitution proved above!
Lemma msubst_subst: ∀ {e x v t},
closed v →
closed_env e →
msubst e <{ [x:=v]t }> = <{ [x:=v] { msubst (remove x e) t } }> .
closed v →
closed_env e →
msubst e <{ [x:=v]t }> = <{ [x:=v] { msubst (remove x e) t } }> .
Proof.
(* FILL IN HERE *) Admitted.
(* FILL IN HERE *) Admitted.
☐
Multi-substituting into a closed term has no effect.
Next come a series of easy lemmas characterizing how msubst
distributes over each term form
Lemma msubst_abs: ∀ {ss x T t},
msubst ss <{ \ x : T, t }> = <{ \x : T, {msubst (remove x ss) t} }>.
msubst ss <{ \ x : T, t }> = <{ \x : T, {msubst (remove x ss) t} }>.
Proof.
induction ss; intros.
- reflexivity.
- destruct a. simpl. destruct (s =? x); simpl; auto.
Qed.
induction ss; intros.
- reflexivity.
- destruct a. simpl. destruct (s =? x); simpl; auto.
Qed.
Lemma msubst_app : ∀ {ss t1 t2},
msubst ss <{ t1 t2 }> = <{ {msubst ss t1} ({msubst ss t2}) }>.
msubst ss <{ t1 t2 }> = <{ {msubst ss t1} ({msubst ss t2}) }>.
Proof.
(* FILL IN HERE *) Admitted.
(* FILL IN HERE *) Admitted.
☐
To complete the product cases of the main lemma below, you'll want
similar results on all the other term constructors; the proofs
are extremely similar to msubst_app.
General Properties of Instantiations
Exercise: 3 stars, standard, especially useful (instantiation_msubst)
Applying the multi-substitution from an instantiation of R to a variable of type T yields a term t such that R T t.
Lemma instantiation_msubst : ∀ {R RC c e},
instantiation R RC c e →
∀ x T,
tass_context c x = Some T →
R T (msubst e x).
instantiation R RC c e →
∀ x T,
tass_context c x = Some T →
R T (msubst e x).
Proof.
intros R RC c e V.
induction V; intros x' T' G.
(* FILL IN HERE *) Admitted.
intros R RC c e V.
induction V; intros x' T' G.
(* FILL IN HERE *) Admitted.
☐
Exercise: 2 stars, standard (instantiation_env_closed)
The environment of an instantiation is always closed.
Lemma instantiation_env_closed : ∀ {R RC c e},
instantiation R RC c e →
closed_env e.
instantiation R RC c e →
closed_env e.
Proof.
(* FILL IN HERE *) Admitted.
(* FILL IN HERE *) Admitted.
☐
Properties of N Instantiations
Lemma N_instantiation_preserves_typing : ∀ {c e},
instantiation N N_closed c e →
∀ Gamma t S, (mupdate Gamma c) |-- t \in S →
Gamma |-- { (msubst e t) } \in S.
instantiation N N_closed c e →
∀ Gamma t S, (mupdate Gamma c) |-- t \in S →
Gamma |-- { (msubst e t) } \in S.
Proof.
(* FILL IN HERE *) Admitted.
(* FILL IN HERE *) Admitted.
☐
Congruence Lemmas on Multistep
Exercise: 2 stars, standard, especially useful (multistep_App2)
Lemma multistep_App2 : ∀ {v t t'},
value v → (t -->* t') → <{ v t }> -->* <{ v t' }>.
value v → (t -->* t') → <{ v t }> -->* <{ v t' }>.
Proof.
(* FILL IN HERE *) Admitted.
(* FILL IN HERE *) Admitted.
☐
To complete the conditional and product cases of the main lemma below,
you'll want similar lemmas; add them as the demand arises (the proofs
are essentially identical).
Completed Proof using N
Exercise: 5 stars, standard, especially useful (typable_N)
Lemma typable_N : ∀ c {t T},
tass_context c |-- t \in T →
∀ e,
instantiation N N_closed c e →
N T (msubst e t).
tass_context c |-- t \in T →
∀ e,
instantiation N N_closed c e →
N T (msubst e t).
Proof.
intros c t T HT.
(* We need to generalize the form of the
hypothesis a bit before invoking induction *)
remember (tass_context c) as Gamma.
generalize dependent c.
induction HT; intros c HeqGamma e V;
try rewrite HeqGamma in *; clear HeqGamma.
- (* T_Var *)
eapply instantiation_msubst; eauto.
- (* T_Abs *)
simpl.
split;[|split].
+ eapply N_instantiation_preserves_typing; eauto.
+ rewrite msubst_abs. apply value_halts. apply v_abs.
+ intros.
destruct (N_halts H) as [v [P Q]].
pose proof (multistep_preserves_N P H).
apply multistep_preserves_N' with (msubst ((x,v)::e) t1).
× eapply T_App.
-- eapply N_instantiation_preserves_typing; eauto.
-- eapply N_typable_empty; auto.
× rewrite msubst_abs.
eapply multi_trans.
-- eapply multistep_App2; eauto.
-- eapply multi_R.
simpl. rewrite msubst_subst.
++ eapply ST_AppAbs; eauto.
++ eapply typable_empty__closed.
apply (N_typable_empty H0).
++ eapply instantiation_env_closed; eauto.
× eapply (IHHT ((x,T2)::c)).
-- auto.
-- constructor; auto.
- (* T_App *)
rewrite msubst_app.
edestruct IHHT1 as [_ [_ P1]]; eauto. fold N in P1.
apply P1. eapply IHHT2; auto.
(* FILL IN HERE *) Admitted.
intros c t T HT.
(* We need to generalize the form of the
hypothesis a bit before invoking induction *)
remember (tass_context c) as Gamma.
generalize dependent c.
induction HT; intros c HeqGamma e V;
try rewrite HeqGamma in *; clear HeqGamma.
- (* T_Var *)
eapply instantiation_msubst; eauto.
- (* T_Abs *)
simpl.
split;[|split].
+ eapply N_instantiation_preserves_typing; eauto.
+ rewrite msubst_abs. apply value_halts. apply v_abs.
+ intros.
destruct (N_halts H) as [v [P Q]].
pose proof (multistep_preserves_N P H).
apply multistep_preserves_N' with (msubst ((x,v)::e) t1).
× eapply T_App.
-- eapply N_instantiation_preserves_typing; eauto.
-- eapply N_typable_empty; auto.
× rewrite msubst_abs.
eapply multi_trans.
-- eapply multistep_App2; eauto.
-- eapply multi_R.
simpl. rewrite msubst_subst.
++ eapply ST_AppAbs; eauto.
++ eapply typable_empty__closed.
apply (N_typable_empty H0).
++ eapply instantiation_env_closed; eauto.
× eapply (IHHT ((x,T2)::c)).
-- auto.
-- constructor; auto.
- (* T_App *)
rewrite msubst_app.
edestruct IHHT1 as [_ [_ P1]]; eauto. fold N in P1.
apply P1. eapply IHHT2; auto.
(* FILL IN HERE *) Admitted.
☐
And the final theorem:
Type Safety via a Logical Predicate (Optional)
First Proof Attempt
Theorem type_soundness_try1: ∀ t T, empty |-- t \in T → safe t.
Proof.
remember empty as Gamma. (* As before, we must do this to induct
over HT. *)
intros t T HT.
unfold safe.
induction HT; subst Gamma; intros t' ST.
- (* T_Var *)
(* This case is impossible because t is typable in an empty
environment. *)
inv H.
- (* T_Abs *)
(* This case is immediate because t is already a value (and
cannot step further). *)
inv ST.
+ econstructor.
+ inv H.
- (* T_App *)
intros NFt'.
(* This is the hard case. The only way t' can be a value is if
the ST sequence somehow uses the ST_AppAbs rule (otherwise it
gets stuck at some kind of application term, which is never a
value). To make that rule applicable, t1 must reduce to an
abstraction term and t2 must reduce to a value. With some effort,
we can establish these facts... *)
(* First, we can analyze ST to see that t1 must step to a
normal form somewhere along the way to t' (by zero or more
uses of ST_App1). *)
assert (N1: ∃ t1', t1 -->* t1'
∧ step_normal_form t1'
∧ <{ t1' t2 }> -->* t').
{ admit. (* this is provable by induction on ST *) }
destruct N1 as [t1' [ST1 [NF1 RST1]]].
(* The first induction hypothesis says t1' must be a value. *)
assert (V1: value t1') by (eapply IHHT1; eauto).
(* We can now use preservation to show that t1' has type Ty_Arrow. *)
assert (HT1': empty |-- t1' \in (T2 → T1)).
{ clear - HT1 ST1. induction ST1; eauto using preservation. }
(* And a value of type Ty_Arrow must be an abstraction term. *)
inversion HT1'; subst; try (inv V1; fail).
(* Now, analyzing RST1, we can see that t2 must step to a
normal form somewhere along the way to t1' (by zero or more
uses of ST_App2). *)
assert (N2: ∃ t2', t2 -->* t2'
∧ step_normal_form t2'
∧ <{ (\ x: T2, t0) t2' }> -->* t').
{ admit. (* this is provable by induction on RST1 *) }
destruct N2 as [t2' [ST2 [NF2 RST2]]].
(* And by the second induction hypothesis, t2' must be a value. *)
assert (V2: value t2') by (eapply IHHT2; eauto).
(* Now we finally have enough facts to apply the St_AppAbs
rule. *)
assert (ONE: <{ (\ x: T2, t0) t2' }> --> <{ [x := t2'] t0 }>).
{ apply ST_AppAbs; eauto. }
(* But unfortunately, we have no induction hypothesis that tells
us anything about the behavior of t0, much less [x := t2'] t0
(which is not even a syntactic subterm of our original t).
So we cannot proceed any further with this case. (The
remaining cases actually go through successfully.) *)
Abort.
Proof.
remember empty as Gamma. (* As before, we must do this to induct
over HT. *)
intros t T HT.
unfold safe.
induction HT; subst Gamma; intros t' ST.
- (* T_Var *)
(* This case is impossible because t is typable in an empty
environment. *)
inv H.
- (* T_Abs *)
(* This case is immediate because t is already a value (and
cannot step further). *)
inv ST.
+ econstructor.
+ inv H.
- (* T_App *)
intros NFt'.
(* This is the hard case. The only way t' can be a value is if
the ST sequence somehow uses the ST_AppAbs rule (otherwise it
gets stuck at some kind of application term, which is never a
value). To make that rule applicable, t1 must reduce to an
abstraction term and t2 must reduce to a value. With some effort,
we can establish these facts... *)
(* First, we can analyze ST to see that t1 must step to a
normal form somewhere along the way to t' (by zero or more
uses of ST_App1). *)
assert (N1: ∃ t1', t1 -->* t1'
∧ step_normal_form t1'
∧ <{ t1' t2 }> -->* t').
{ admit. (* this is provable by induction on ST *) }
destruct N1 as [t1' [ST1 [NF1 RST1]]].
(* The first induction hypothesis says t1' must be a value. *)
assert (V1: value t1') by (eapply IHHT1; eauto).
(* We can now use preservation to show that t1' has type Ty_Arrow. *)
assert (HT1': empty |-- t1' \in (T2 → T1)).
{ clear - HT1 ST1. induction ST1; eauto using preservation. }
(* And a value of type Ty_Arrow must be an abstraction term. *)
inversion HT1'; subst; try (inv V1; fail).
(* Now, analyzing RST1, we can see that t2 must step to a
normal form somewhere along the way to t1' (by zero or more
uses of ST_App2). *)
assert (N2: ∃ t2', t2 -->* t2'
∧ step_normal_form t2'
∧ <{ (\ x: T2, t0) t2' }> -->* t').
{ admit. (* this is provable by induction on RST1 *) }
destruct N2 as [t2' [ST2 [NF2 RST2]]].
(* And by the second induction hypothesis, t2' must be a value. *)
assert (V2: value t2') by (eapply IHHT2; eauto).
(* Now we finally have enough facts to apply the St_AppAbs
rule. *)
assert (ONE: <{ (\ x: T2, t0) t2' }> --> <{ [x := t2'] t0 }>).
{ apply ST_AppAbs; eauto. }
(* But unfortunately, we have no induction hypothesis that tells
us anything about the behavior of t0, much less [x := t2'] t0
(which is not even a syntactic subterm of our original t).
So we cannot proceed any further with this case. (The
remaining cases actually go through successfully.) *)
Abort.
St and Sv Predicates
Fixpoint St (T:ty) (t: tm) : Prop :=
∀ t', t -->* t' → step_normal_form t' → Sv T t'
with Sv (T:ty) (t:tm) {struct T} : Prop :=
closed t ∧
(match T with
| <{ Bool }> ⇒ (t = <{ true }> ∨ t = <{ false }> )
| <{ T1 → T2 }> ⇒
∃ x t2,
t = <{ \x:T1,t2 }> ∧
∀ s, Sv T1 s → St T2 <{ [x:=s] t2 }>
| <{ T1 × T2 }> ⇒ ... (* left for you to fill in *)
end).
Exercise: 3 stars, standard, especially useful (Sv_products)
Fix the product case for this definition. Note: you can skip this exercise until you are ready to start extending the later proofs.
Fixpoint Sv (T:ty) (t:tm) {struct T} : Prop :=
closed t ∧
(match T with
| <{ Bool }> ⇒ (t = <{ true }> ∨ t = <{ false }> )
| <{ T1 → T2 }> ⇒
∃ x t2, t = <{ \x:T1,t2 }> ∧
(∀ s, Sv T1 s →
(∀ t', <{ [x := s] t2 }> -->* t' →
step_normal_form t' →
Sv T2 t'))
(* ... edit the next line when dealing with products *)
| <{ T1 × T2 }> ⇒ False (* FILL IN HERE *)
end).
(* Do not modify the following line: *)
Definition manual_grade_for_Sv_products : option (nat×string) := None.
☐
closed t ∧
(match T with
| <{ Bool }> ⇒ (t = <{ true }> ∨ t = <{ false }> )
| <{ T1 → T2 }> ⇒
∃ x t2, t = <{ \x:T1,t2 }> ∧
(∀ s, Sv T1 s →
(∀ t', <{ [x := s] t2 }> -->* t' →
step_normal_form t' →
Sv T2 t'))
(* ... edit the next line when dealing with products *)
| <{ T1 × T2 }> ⇒ False (* FILL IN HERE *)
end).
(* Do not modify the following line: *)
Definition manual_grade_for_Sv_products : option (nat×string) := None.
☐
Sv T and St T are sometimes called the "value interpretation"
and "term (or expression) interpretation" of type T. They
characterize the values and terms that behave like members of
that type should.
Note that these predicates do not require (syntactic) well-typedness.
This is unusual for a logical predicates proof, but it is appropriate
here, since after all we are trying to prove type safety from new
principles. If we did require well-typedness, we could still make the
proof go through, but only with the help of the
substitution_preserves_typing lemma, which is the main result needed
to prove preservation. With the approach we take here, we don't need
either progress or preservation.
We do, however, explicitly require that Sv contain only closed
terms. (The proof works if we impose the same requirement on St, but
it brings no benefit.)
We start with a few simple consequences of these definitions:
Exercise: 2 stars, standard (Sv_val)
Once you have defined the product case for Sv, complete this proof that terms in Sv are values.
Lemma Sv_val : ∀ {T t}, Sv T t → value t.
Proof.
induction T; intros.
- inv H. destruct H1; subst; auto.
- inv H. destruct H1 as [x [t2 [E _]]]; subst; auto.
(* FILL IN HERE *) Admitted.
induction T; intros.
- inv H. destruct H1; subst; auto.
- inv H. destruct H1 as [x [t2 [E _]]]; subst; auto.
(* FILL IN HERE *) Admitted.
☐
Terms in Sv are also in St.
Lemma Sv_St : ∀ {T t}, Sv T t → St T t.
Proof.
intros.
unfold St.
intros. pose proof (Sv_val H). eapply value__normal in H2.
inv H0; auto.
exfalso; eapply H2. eexists; eauto.
Qed.
intros.
unfold St.
intros. pose proof (Sv_val H). eapply value__normal in H2.
inv H0; auto.
exfalso; eapply H2. eexists; eauto.
Qed.
We have successfully captured safety in St. (This is sometimes
called an "adequacy" theorem for St.)
As in the normalization proof, we will need to deal with open
terms by defining closing substitutions. The instantiation
machinery works for Sv just as it did for N.
Semantic Typing
Definition has_semantic_type (Gamma: context) (t:tm) (T:ty) : Prop :=
∀ (c:tass), Gamma = tass_context c →
∀ (e:env), instantiation Sv Sv_closed c e →
St T (msubst e t).
Notation "Gamma '|==' t '∈' T" := (has_semantic_type Gamma t T) (at level 40,
t custom stlc, T custom stlc at level 0).
∀ (c:tass), Gamma = tass_context c →
∀ (e:env), instantiation Sv Sv_closed c e →
St T (msubst e t).
Notation "Gamma '|==' t '∈' T" := (has_semantic_type Gamma t T) (at level 40,
t custom stlc, T custom stlc at level 0).
Semantic Typing Examples
First a handy lemma.
Lemma empty_context : ∀ {R RC c e},
instantiation R RC c e →
tass_context c = empty →
e = nil.
instantiation R RC c e →
tass_context c = empty →
e = nil.
Proof.
intros.
destruct c.
- inv H. auto.
- exfalso.
unfold tass_context in H0.
simpl in H0. destruct p.
assert (((s) ⊢> t; (mupdate empty c) s) = empty s) by (rewrite H0; auto).
rewrite update_eq in H1. rewrite apply_empty in H1. inv H1.
Qed.
intros.
destruct c.
- inv H. auto.
- exfalso.
unfold tass_context in H0.
simpl in H0. destruct p.
assert (((s) ⊢> t; (mupdate empty c) s) = empty s) by (rewrite H0; auto).
rewrite update_eq in H1. rewrite apply_empty in H1. inv H1.
Qed.
In the first example, the two arms of the conditional have
different types, but the expression reduces to a Bool value.
Remark hst_ex1 : empty |== <{ if true then false else (false,false) }> \in Ty_Bool.
Proof.
unfold has_semantic_type.
intros.
erewrite empty_context; eauto.
simpl.
unfold St.
intros.
inv H1.
+ unfold step_normal_form in H2. exfalso; apply H2; eauto.
+ inv H3.
× inv H4.
-- unfold Sv. split.
++ unfold closed. intros. intro. inv H1.
++ right; auto.
-- inv H1.
× inv H8.
Qed.
unfold has_semantic_type.
intros.
erewrite empty_context; eauto.
simpl.
unfold St.
intros.
inv H1.
+ unfold step_normal_form in H2. exfalso; apply H2; eauto.
+ inv H3.
× inv H4.
-- unfold Sv. split.
++ unfold closed. intros. intro. inv H1.
++ right; auto.
-- inv H1.
× inv H8.
Qed.
In the second example, the term doesn't reduce to a value at all
(in fact, it reduces to itself!). So not only is it
syntactically ill-typed; the normalization theorem tells us that
there is no possible choice of types on the variable bindings
that would make it syntactically well-typed. But we can give
it any semantic type we like.
Definition x : string := "x".
Hint Unfold x : core.
Remark hst_ex2: ∀ T, empty |== <{ (\ x : Bool, (x x)) (\x : Bool, (x x)) }> \in T.
End Examples.
Hint Unfold x : core.
Remark hst_ex2: ∀ T, empty |== <{ (\ x : Bool, (x x)) (\x : Bool, (x x)) }> \in T.
Proof.
unfold has_semantic_type.
intros.
erewrite empty_context; eauto.
simpl.
unfold St.
intros.
remember <{ (\ x : Bool, (x x)) (\ x : Bool, (x x)) }> as t.
induction H1.
+ subst x0. unfold step_normal_form in H2. exfalso; apply H2. eexists. eauto.
+ subst x0. inv H1.
× simpl in H3. simpl <{ [x := \ x : Bool, x x] x x }> in IHmulti.
eauto.
× inv H7.
× inv H8.
Qed.
unfold has_semantic_type.
intros.
erewrite empty_context; eauto.
simpl.
unfold St.
intros.
remember <{ (\ x : Bool, (x x)) (\ x : Bool, (x x)) }> as t.
induction H1.
+ subst x0. unfold step_normal_form in H2. exfalso; apply H2. eexists. eauto.
+ subst x0. inv H1.
× simpl in H3. simpl <{ [x := \ x : Bool, x x] x x }> in IHmulti.
eauto.
× inv H7.
× inv H8.
Qed.
End Examples.
More Properties of Substitution and Instantiation
Exercise: 4 stars, standard (instantiation_closes)
Lemma instantiation_closes: ∀ R RC c e,
instantiation R RC c e →
∀ t T, tass_context c |-- t \in T →
closed (msubst e t).
instantiation R RC c e →
∀ t T, tass_context c |-- t \in T →
closed (msubst e t).
Proof.
(* Hint: this proof is fairly straightforward once you have found
a suitable generalization of the induction hypothesis. *)
(* FILL IN HERE *) Admitted.
(* Hint: this proof is fairly straightforward once you have found
a suitable generalization of the induction hypothesis. *)
(* FILL IN HERE *) Admitted.
☐
Inversion lemmas about multistepping
Lemma value_dec : ∀ t, value t ∨ ¬ value t.
Proof.
induction t; try (right; intro X; inv X; fail); try (left; auto; fail).
destruct IHt1; destruct IHt2;
try (right; intro X; inv X; contradiction);
try (left; auto; fail).
Qed.
induction t; try (right; intro X; inv X; fail); try (left; auto; fail).
destruct IHt1; destruct IHt2;
try (right; intro X; inv X; contradiction);
try (left; auto; fail).
Qed.
Lemma nf_dec : ∀ t, step_normal_form t ∨ ∃ t', t --> t'.
Proof with eauto.
(* FILL IN HERE *) Admitted.
(* FILL IN HERE *) Admitted.
☐
Now we can proceed to the inversion lemmas themselves. All the
proofs are extremely similar.
Lemma norm_App1 : ∀ {t1 t2 t'},
<{ t1 t2 }> -->* t' → step_normal_form t' →
∃ t1', t1 -->* t1'
∧ step_normal_form t1'
∧ <{ t1' t2 }> -->* t'.
<{ t1 t2 }> -->* t' → step_normal_form t' →
∃ t1', t1 -->* t1'
∧ step_normal_form t1'
∧ <{ t1' t2 }> -->* t'.
Proof.
intros until 1.
remember <{ t1 t2 }> as t.
generalize dependent t1.
induction H; intros; subst x.
- ∃ t1.
split; [|split]; eauto.
intros [t' P]; eauto.
- destruct (nf_dec t1) as [P|[t1' P]]; eauto.
edestruct (IHmulti t1') as [t1'' [P1 [P2 P3]]]; eauto.
eapply step_deterministic; eauto.
Qed.
intros until 1.
remember <{ t1 t2 }> as t.
generalize dependent t1.
induction H; intros; subst x.
- ∃ t1.
split; [|split]; eauto.
intros [t' P]; eauto.
- destruct (nf_dec t1) as [P|[t1' P]]; eauto.
edestruct (IHmulti t1') as [t1'' [P1 [P2 P3]]]; eauto.
eapply step_deterministic; eauto.
Qed.
Lemma norm_App2 : ∀ {v1 t2 t'},
<{ v1 t2 }> -->* t' → value v1 →
step_normal_form t' →
∃ t2', t2 -->* t2'
∧ step_normal_form t2'
∧ <{ v1 t2' }> -->* t'.
<{ v1 t2 }> -->* t' → value v1 →
step_normal_form t' →
∃ t2', t2 -->* t2'
∧ step_normal_form t2'
∧ <{ v1 t2' }> -->* t'.
Proof.
(* FILL IN HERE *) Admitted.
(* FILL IN HERE *) Admitted.
☐
Add similar lemmas for other term forms as needed in the main proof below.
Syntactic Typing implies Semantic Typing
Exercise: 5 stars, standard, especially useful (syntactic_type_semantic)
Finally we reach the main lemma. Again, the conditional and product cases are left for you.
Lemma syntactic_type_semantic : ∀ {Gamma t T},
Gamma |-- t \in T →
Gamma |== t \in T.
Gamma |-- t \in T →
Gamma |== t \in T.
Proof.
unfold has_semantic_type.
intros Gamma t T HT.
induction HT; intros c E e V; try rewrite E in *; clear E.
- (* T_Var *)
eapply Sv_St.
eapply instantiation_msubst; eauto.
- (* T_Abs *)
unfold St.
rewrite msubst_abs.
intros.
inv H; [| inv H1].
unfold Sv; fold Sv; split.
+ rewrite <- msubst_abs. eapply instantiation_closes; eauto.
+ eexists. eexists. split; [eauto|].
intros s H.
pose proof (Sv_closed _ _ H).
pose proof (instantiation_env_closed V).
intros.
rewrite <- msubst_subst in H3; auto.
replace (msubst e <{ [x := s] t1 }>)
with (msubst ((x,s)::e) t1) in H3 by auto.
eapply (IHHT ((x,T2)::c)); eauto.
constructor; auto. eapply Sv_val; eauto.
- (* T_App *)
pose proof (IHHT1 _ eq_refl _ V).
pose proof (IHHT2 _ eq_refl _ V).
unfold St.
rewrite msubst_app.
intros.
destruct (norm_App1 H1 H2) as [t1' [S1 [S2 S3]]].
pose proof (H _ S1 S2).
inv H3. destruct H5 as [x [t11 [E P]]].
subst t1'.
assert (value <{ \x : T2, t11 }>) by eauto.
destruct (norm_App2 S3 H3 H2) as [t2' [Q1 [Q2 Q3]]].
pose proof (H0 _ Q1 Q2).
pose proof (P _ H5).
eapply H6; auto.
pose proof (Sv_val H5).
pose proof (ST_AppAbs x T2 t11 t2' H7).
inv Q3.
+ exfalso. eapply H2. eexists; eauto.
+ erewrite (step_deterministic _ _ _ H9 H8) in H10.
eauto.
(* FILL IN HERE *) Admitted.
unfold has_semantic_type.
intros Gamma t T HT.
induction HT; intros c E e V; try rewrite E in *; clear E.
- (* T_Var *)
eapply Sv_St.
eapply instantiation_msubst; eauto.
- (* T_Abs *)
unfold St.
rewrite msubst_abs.
intros.
inv H; [| inv H1].
unfold Sv; fold Sv; split.
+ rewrite <- msubst_abs. eapply instantiation_closes; eauto.
+ eexists. eexists. split; [eauto|].
intros s H.
pose proof (Sv_closed _ _ H).
pose proof (instantiation_env_closed V).
intros.
rewrite <- msubst_subst in H3; auto.
replace (msubst e <{ [x := s] t1 }>)
with (msubst ((x,s)::e) t1) in H3 by auto.
eapply (IHHT ((x,T2)::c)); eauto.
constructor; auto. eapply Sv_val; eauto.
- (* T_App *)
pose proof (IHHT1 _ eq_refl _ V).
pose proof (IHHT2 _ eq_refl _ V).
unfold St.
rewrite msubst_app.
intros.
destruct (norm_App1 H1 H2) as [t1' [S1 [S2 S3]]].
pose proof (H _ S1 S2).
inv H3. destruct H5 as [x [t11 [E P]]].
subst t1'.
assert (value <{ \x : T2, t11 }>) by eauto.
destruct (norm_App2 S3 H3 H2) as [t2' [Q1 [Q2 Q3]]].
pose proof (H0 _ Q1 Q2).
pose proof (P _ H5).
eapply H6; auto.
pose proof (Sv_val H5).
pose proof (ST_AppAbs x T2 t11 t2' H7).
inv Q3.
+ exfalso. eapply H2. eexists; eauto.
+ erewrite (step_deterministic _ _ _ H9 H8) in H10.
eauto.
(* FILL IN HERE *) Admitted.
☐
