Lecture 10: Simply Typed Lambda Calculus

In this lecture, we will define the syntax and semantics of the simply typed lambda calculus. We will then define the typing rules and show that well-typed programs do not get stuck.

(* Useful tactics for simplifying equalities *)
Ltac simpeq := repeat match goal with
  | _ => congruence || (progress subst)
  | H : ?x = ?x |- _ => clear H
  | H : _ = _ |- _ => progress injection H as H
  end.

Ltac inv H := inversion H; clear H; simpeq.

Syntax

Require Import String.[Loading ML file ring_plugin.cmxs (using legacy method) ... done]

Inductive expr :=
  | Var (x : string)
  | Lam (x : string) (e : expr)
  | App (e1 e2 : expr)
  | Zero : expr
  | Succ (e : expr)
  | Rec (e1 e2 e3 : expr).

Typing

Inductive ty :=
  | Nat : ty
  | Fun (t1 t2 : ty).

Definition ctx := string -> option ty.

Definition empty : ctx := fun _ => None.

Definition insert (x : string) (t : ty) (Gamma : ctx) : ctx :=
  fun x' => if string_dec x x' then Some t else Gamma x'.

Inductive typed : ctx -> expr -> ty -> Prop :=
  | Typed_Var (x : string) (t : ty) (Gamma : ctx) :
    Gamma x = Some t ->
    typed Gamma (Var x) t
  | Typed_Lam (x : string) (e : expr) (t1 t2 : ty) (Gamma : ctx) :
    typed (insert x t1 Gamma) e t2 ->
    typed Gamma (Lam x e) (Fun t1 t2)
  | Typed_App (e1 e2 : expr) (t1 t2 : ty) (Gamma : ctx) :
    typed Gamma e1 (Fun t1 t2) ->
    typed Gamma e2 t1 ->
    typed Gamma (App e1 e2) t2
  | Typed_Zero (Gamma : ctx) :
    typed Gamma Zero Nat
  | Typed_Succ (e : expr) (Gamma : ctx) :
    typed Gamma e Nat ->
    typed Gamma (Succ e) Nat
  | Typed_Rec (e1 e2 e3 : expr) (Gamma : ctx) (t : ty) :
    typed Gamma e1 Nat ->
    typed Gamma e2 t ->
    typed Gamma e3 (Fun t t) ->
    typed Gamma (Rec e1 e2 e3) t.

Semantics

Substitution

Fixpoint subst (x : string) (v : expr) (e : expr) : expr :=
  match e with
  | Var y => if string_dec x y then v else e
  | Lam y e => Lam y (if string_dec x y then e else subst x v e)
  | App e1 e2 => App (subst x v e1) (subst x v e2)
  | Zero => Zero
  | Succ e => Succ (subst x v e)
  | Rec e1 e2 e3 => Rec (subst x v e1) (subst x v e2) (subst x v e3)
  end.

Values

Inductive value : expr -> Prop :=
  | Val_Lam (x : string) (e : expr) :
    value (Lam x e)
  | Val_Zero :
    value Zero
  | Val_Succ (e : expr) :
    value e ->
    value (Succ e).

Small-step Semantics

Inductive step : expr -> expr -> Prop :=
  | Step_App1 (e1 e1' e2 : expr) :
    step e1 e1' ->
    step (App e1 e2) (App e1' e2)
  | Step_App2 (e1 e2 e2' : expr) :
    step e2 e2' ->
    step (App e1 e2) (App e1 e2')
  | Step_AppLam (x : string) (v e : expr) :
    value v ->
    step (App (Lam x e) v) (subst x v e)
  | Step_Succ1 (e e' : expr) :
    step e e' ->
    step (Succ e) (Succ e')
  | Step_Rec1 (e1 e1' e2 e3 : expr) :
    step e1 e1' ->
    step (Rec e1 e2 e3) (Rec e1' e2 e3)
  | Step_Rec2 (e1 e2 e2' e3 : expr) :
    step e2 e2' ->
    step (Rec e1 e2 e3) (Rec e1 e2' e3)
  | Step_Rec3 (e1 e2 e3 e3' : expr) :
    step e3 e3' ->
    step (Rec e1 e2 e3) (Rec e1 e2 e3')
  | Step_RecZero (e2 e3 : expr) :
    value e2 -> value e3 ->
    step (Rec Zero e2 e3) e2
  | Step_RecSucc (e1 e2 e3 : expr) :
    value e1 -> value e2 -> value e3 ->
    step (Rec (Succ e1) e2 e3) (Rec e1 (App e3 e2) e3).

Progress

Theorem progress (e : expr) (t : ty) :
  typed empty e t ->
  value e \/ exists e', step e e'.e: expr
t: ty
typed empty e t ->
value e \/ (exists e' : expr, step e e')
Proof.e: expr
t: ty
typed empty e t ->
value e \/ (exists e' : expr, step e e')
  intros Htyped.e: expr
t: ty
Htyped: typed empty e t
value e \/ (exists e' : expr, step e e')
  remember empty as Gamma.e: expr
t: ty
Gamma: ctx
HeqGamma: Gamma = empty
Htyped: typed Gamma e t
value e \/ (exists e' : expr, step e e')
  induction Htyped; subst.x: string
t: ty
H: empty x = Some t
value (Var x) \/ (exists e' : expr, step (Var x) e')
x: string
e: expr
t1, t2: ty
IHHtyped: insert x t1 empty = empty ->
value e \/ (exists e' : expr, step e e')
Htyped: typed (insert x t1 empty) e t2
value (Lam x e) \/
(exists e' : expr, step (Lam x e) e')
e1, e2: expr
t1, t2: ty
IHHtyped2: empty = empty ->
value e2 \/ (exists e' : expr, step e2 e')
IHHtyped1: empty = empty ->
value e1 \/ (exists e' : expr, step e1 e')
Htyped2: typed empty e2 t1
Htyped1: typed empty e1 (Fun t1 t2)
value (App e1 e2) \/
(exists e' : expr, step (App e1 e2) e')
value Zero \/ (exists e' : expr, step Zero e')
e: expr
IHHtyped: empty = empty ->
value e \/ (exists e' : expr, step e e')
Htyped: typed empty e Nat
value (Succ e) \/ (exists e' : expr, step (Succ e) e')
e1, e2, e3: expr
t: ty
IHHtyped3: empty = empty ->
value e3 \/ (exists e' : expr, step e3 e')
IHHtyped2: empty = empty ->
value e2 \/ (exists e' : expr, step e2 e')
IHHtyped1: empty = empty ->
value e1 \/ (exists e' : expr, step e1 e')
Htyped3: typed empty e3 (Fun t t)
Htyped2: typed empty e2 t
Htyped1: typed empty e1 Nat
value (Rec e1 e2 e3) \/
(exists e' : expr, step (Rec e1 e2 e3) e')
  -x: string
t: ty
H: empty x = Some t
value (Var x) \/ (exists e' : expr, step (Var x) e') unfold empty in H.x: string
t: ty
H: None = Some t
value (Var x) \/ (exists e' : expr, step (Var x) e') simpeq.
  -x: string
e: expr
t1, t2: ty
IHHtyped: insert x t1 empty = empty ->
value e \/ (exists e' : expr, step e e')
Htyped: typed (insert x t1 empty) e t2
value (Lam x e) \/
(exists e' : expr, step (Lam x e) e') left.x: string
e: expr
t1, t2: ty
IHHtyped: insert x t1 empty = empty ->
value e \/ (exists e' : expr, step e e')
Htyped: typed (insert x t1 empty) e t2
value (Lam x e) constructor.
  -e1, e2: expr
t1, t2: ty
IHHtyped2: empty = empty ->
value e2 \/ (exists e' : expr, step e2 e')
IHHtyped1: empty = empty ->
value e1 \/ (exists e' : expr, step e1 e')
Htyped2: typed empty e2 t1
Htyped1: typed empty e1 (Fun t1 t2)
value (App e1 e2) \/
(exists e' : expr, step (App e1 e2) e') right.e1, e2: expr
t1, t2: ty
IHHtyped2: empty = empty ->
value e2 \/ (exists e' : expr, step e2 e')
IHHtyped1: empty = empty ->
value e1 \/ (exists e' : expr, step e1 e')
Htyped2: typed empty e2 t1
Htyped1: typed empty e1 (Fun t1 t2)
exists e' : expr, step (App e1 e2) e' 
    destruct IHHtyped1 as [Hval1 | [e1' Hstep1]]; eauto.e1, e2: expr
t1, t2: ty
IHHtyped2: empty = empty ->
value e2 \/ (exists e' : expr, step e2 e')
Htyped2: typed empty e2 t1
Htyped1: typed empty e1 (Fun t1 t2)
Hval1: value e1
exists e' : expr, step (App e1 e2) e'
e1, e2: expr
t1, t2: ty
IHHtyped2: empty = empty ->
value e2 \/ (exists e' : expr, step e2 e')
Htyped2: typed empty e2 t1
Htyped1: typed empty e1 (Fun t1 t2)
e1': expr
Hstep1: step e1 e1'
exists e' : expr, step (App e1 e2) e'
    +e1, e2: expr
t1, t2: ty
IHHtyped2: empty = empty ->
value e2 \/ (exists e' : expr, step e2 e')
Htyped2: typed empty e2 t1
Htyped1: typed empty e1 (Fun t1 t2)
Hval1: value e1
exists e' : expr, step (App e1 e2) e' inv Hval1; inv Htyped1.e2: expr
t1, t2: ty
IHHtyped2: empty = empty ->
value e2 \/ (exists e' : expr, step e2 e')
Htyped2: typed empty e2 t1
x: string
e: expr
H1: typed (insert x t1 empty) e t2
exists e' : expr, step (App (Lam x e) e2) e' 
      destruct IHHtyped2 as [Hval2 | [e2' Hstep2]]; eauto using step.
    +e1, e2: expr
t1, t2: ty
IHHtyped2: empty = empty ->
value e2 \/ (exists e' : expr, step e2 e')
Htyped2: typed empty e2 t1
Htyped1: typed empty e1 (Fun t1 t2)
e1': expr
Hstep1: step e1 e1'
exists e' : expr, step (App e1 e2) e' eauto using step.
  -value Zero \/ (exists e' : expr, step Zero e') left.value Zero constructor.
  -e: expr
IHHtyped: empty = empty ->
value e \/ (exists e' : expr, step e e')
Htyped: typed empty e Nat
value (Succ e) \/ (exists e' : expr, step (Succ e) e') destruct IHHtyped as [Hval | [e' Hstep]]; eauto using step.e: expr
Htyped: typed empty e Nat
Hval: value e
value (Succ e) \/ (exists e' : expr, step (Succ e) e')
    left.e: expr
Htyped: typed empty e Nat
Hval: value e
value (Succ e) constructor.e: expr
Htyped: typed empty e Nat
Hval: value e
value e eauto.
  -e1, e2, e3: expr
t: ty
IHHtyped3: empty = empty ->
value e3 \/ (exists e' : expr, step e3 e')
IHHtyped2: empty = empty ->
value e2 \/ (exists e' : expr, step e2 e')
IHHtyped1: empty = empty ->
value e1 \/ (exists e' : expr, step e1 e')
Htyped3: typed empty e3 (Fun t t)
Htyped2: typed empty e2 t
Htyped1: typed empty e1 Nat
value (Rec e1 e2 e3) \/
(exists e' : expr, step (Rec e1 e2 e3) e') destruct IHHtyped1 as [Hval1 | [e1' Hstep1]]; eauto using step.e1, e2, e3: expr
t: ty
IHHtyped3: empty = empty ->
value e3 \/ (exists e' : expr, step e3 e')
IHHtyped2: empty = empty ->
value e2 \/ (exists e' : expr, step e2 e')
Htyped3: typed empty e3 (Fun t t)
Htyped2: typed empty e2 t
Htyped1: typed empty e1 Nat
Hval1: value e1
value (Rec e1 e2 e3) \/
(exists e' : expr, step (Rec e1 e2 e3) e')
    destruct IHHtyped2 as [Hval2 | [e2' Hstep2]]; eauto using step.e1, e2, e3: expr
t: ty
IHHtyped3: empty = empty ->
value e3 \/ (exists e' : expr, step e3 e')
Htyped3: typed empty e3 (Fun t t)
Htyped2: typed empty e2 t
Htyped1: typed empty e1 Nat
Hval1: value e1
Hval2: value e2
value (Rec e1 e2 e3) \/
(exists e' : expr, step (Rec e1 e2 e3) e')
    destruct IHHtyped3 as [Hval3 | [e3' Hstep3]]; eauto using step.e1, e2, e3: expr
t: ty
Htyped3: typed empty e3 (Fun t t)
Htyped2: typed empty e2 t
Htyped1: typed empty e1 Nat
Hval1: value e1
Hval2: value e2
Hval3: value e3
value (Rec e1 e2 e3) \/
(exists e' : expr, step (Rec e1 e2 e3) e')
    inv Hval1; inv Htyped1.e2, e3: expr
t: ty
Htyped3: typed empty e3 (Fun t t)
Htyped2: typed empty e2 t
Hval2: value e2
Hval3: value e3
value (Rec Zero e2 e3) \/
(exists e' : expr, step (Rec Zero e2 e3) e')
e2, e3: expr
t: ty
Htyped3: typed empty e3 (Fun t t)
Htyped2: typed empty e2 t
e: expr
Hval2: value e2
Hval3: value e3
H: value e
H2: typed empty e Nat
value (Rec (Succ e) e2 e3) \/
(exists e' : expr, step (Rec (Succ e) e2 e3) e')
    +e2, e3: expr
t: ty
Htyped3: typed empty e3 (Fun t t)
Htyped2: typed empty e2 t
Hval2: value e2
Hval3: value e3
value (Rec Zero e2 e3) \/
(exists e' : expr, step (Rec Zero e2 e3) e') eauto using step.
    +e2, e3: expr
t: ty
Htyped3: typed empty e3 (Fun t t)
Htyped2: typed empty e2 t
e: expr
Hval2: value e2
Hval3: value e3
H: value e
H2: typed empty e Nat
value (Rec (Succ e) e2 e3) \/
(exists e' : expr, step (Rec (Succ e) e2 e3) e') eauto using step.
Qed.

Preservation

Require Import FunctionalExtensionality.

Lemma weakening (Gamma Gamma' : ctx) (e : expr) (t : ty) :
  (forall x t, Gamma x = Some t -> Gamma' x = Some t) ->
  typed Gamma e t ->
  typed Gamma' e t.Gamma, Gamma': ctx
e: expr
t: ty
(forall (x : string) (t : ty),
 Gamma x = Some t -> Gamma' x = Some t) ->
typed Gamma e t -> typed Gamma' e t
Proof.Gamma, Gamma': ctx
e: expr
t: ty
(forall (x : string) (t : ty),
 Gamma x = Some t -> Gamma' x = Some t) ->
typed Gamma e t -> typed Gamma' e t
  intros Hw H.Gamma, Gamma': ctx
e: expr
t: ty
Hw: forall (x : string) (t : ty),
Gamma x = Some t -> Gamma' x = Some t
H: typed Gamma e t
typed Gamma' e t
  revert Gamma' Hw.Gamma: ctx
e: expr
t: ty
H: typed Gamma e t
forall Gamma' : ctx,
(forall (x : string) (t : ty),
 Gamma x = Some t -> Gamma' x = Some t) ->
typed Gamma' e t
  induction H; intros; eauto using typed.x: string
e: expr
t1, t2: ty
Gamma: ctx
H: typed (insert x t1 Gamma) e t2
IHtyped: forall Gamma' : ctx,
(forall (x0 : string) (t : ty),
 insert x t1 Gamma x0 = Some t ->
 Gamma' x0 = Some t) -> 
typed Gamma' e t2
Gamma': ctx
Hw: forall (x : string) (t : ty),
Gamma x = Some t -> Gamma' x = Some t
typed Gamma' (Lam x e) (Fun t1 t2)
  constructor.x: string
e: expr
t1, t2: ty
Gamma: ctx
H: typed (insert x t1 Gamma) e t2
IHtyped: forall Gamma' : ctx,
(forall (x0 : string) (t : ty),
 insert x t1 Gamma x0 = Some t ->
 Gamma' x0 = Some t) -> 
typed Gamma' e t2
Gamma': ctx
Hw: forall (x : string) (t : ty),
Gamma x = Some t -> Gamma' x = Some t
typed (insert x t1 Gamma') e t2 eapply IHtyped.x: string
e: expr
t1, t2: ty
Gamma: ctx
H: typed (insert x t1 Gamma) e t2
IHtyped: forall Gamma' : ctx,
(forall (x0 : string) (t : ty),
 insert x t1 Gamma x0 = Some t ->
 Gamma' x0 = Some t) -> 
typed Gamma' e t2
Gamma': ctx
Hw: forall (x : string) (t : ty),
Gamma x = Some t -> Gamma' x = Some t
forall (x0 : string) (t : ty),
insert x t1 Gamma x0 = Some t ->
insert x t1 Gamma' x0 = Some t
  unfold insert.x: string
e: expr
t1, t2: ty
Gamma: ctx
H: typed (insert x t1 Gamma) e t2
IHtyped: forall Gamma' : ctx,
(forall (x0 : string) (t : ty),
 insert x t1 Gamma x0 = Some t ->
 Gamma' x0 = Some t) -> 
typed Gamma' e t2
Gamma': ctx
Hw: forall (x : string) (t : ty),
Gamma x = Some t -> Gamma' x = Some t
forall (x0 : string) (t : ty),
(if string_dec x x0 then Some t1 else Gamma x0) =
Some t ->
(if string_dec x x0 then Some t1 else Gamma' x0) =
Some t
  intros.x: string
e: expr
t1, t2: ty
Gamma: ctx
H: typed (insert x t1 Gamma) e t2
IHtyped: forall Gamma' : ctx,
(forall (x0 : string) (t : ty),
 insert x t1 Gamma x0 = Some t ->
 Gamma' x0 = Some t) -> 
typed Gamma' e t2
Gamma': ctx
Hw: forall (x : string) (t : ty),
Gamma x = Some t -> Gamma' x = Some t
x0: string
t: ty
H0: (if string_dec x x0 then Some t1 else Gamma x0) =
Some t
(if string_dec x x0 then Some t1 else Gamma' x0) =
Some t destruct string_dec; simpeq.x: string
e: expr
t1, t2: ty
Gamma: ctx
H: typed (insert x t1 Gamma) e t2
IHtyped: forall Gamma' : ctx,
(forall (x0 : string) (t : ty),
 insert x t1 Gamma x0 = Some t ->
 Gamma' x0 = Some t) -> 
typed Gamma' e t2
Gamma': ctx
Hw: forall (x : string) (t : ty),
Gamma x = Some t -> Gamma' x = Some t
x0: string
t: ty
n: x <> x0
H0: Gamma x0 = Some t
Gamma' x0 = Some t eauto.
Qed.

Lemma subst_typed (Gamma : ctx) (x : string) (v e : expr) (t tv : ty) :
  typed empty v tv ->
  typed (insert x tv Gamma) e t ->
  typed Gamma (subst x v e) t.Gamma: ctx
x: string
v, e: expr
t, tv: ty
typed empty v tv ->
typed (insert x tv Gamma) e t ->
typed Gamma (subst x v e) t
Proof.Gamma: ctx
x: string
v, e: expr
t, tv: ty
typed empty v tv ->
typed (insert x tv Gamma) e t ->
typed Gamma (subst x v e) t
  intros Hv H.Gamma: ctx
x: string
v, e: expr
t, tv: ty
Hv: typed empty v tv
H: typed (insert x tv Gamma) e t
typed Gamma (subst x v e) t
  remember (insert x tv Gamma) as Gamma'.Gamma: ctx
x: string
v, e: expr
t, tv: ty
Hv: typed empty v tv
Gamma': ctx
HeqGamma': Gamma' = insert x tv Gamma
H: typed Gamma' e t
typed Gamma (subst x v e) t
  revert Gamma HeqGamma'.x: string
v, e: expr
t, tv: ty
Hv: typed empty v tv
Gamma': ctx
H: typed Gamma' e t
forall Gamma : ctx,
Gamma' = insert x tv Gamma ->
typed Gamma (subst x v e) t
  induction H; intros; subst; simpl; eauto using typed.x: string
v: expr
tv: ty
Hv: typed empty v tv
x0: string
t: ty
Gamma0: ctx
H: insert x tv Gamma0 x0 = Some t
typed Gamma0 (if string_dec x x0 then v else Var x0) t
x: string
v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x tv Gamma0) =
insert x tv Gamma ->
typed Gamma (subst x v e) t2
H: typed (insert x0 t1 (insert x tv Gamma0)) e t2
typed Gamma0
  (Lam x0 (if string_dec x x0 then e else subst x v e))
  (Fun t1 t2)
  -x: string
v: expr
tv: ty
Hv: typed empty v tv
x0: string
t: ty
Gamma0: ctx
H: insert x tv Gamma0 x0 = Some t
typed Gamma0 (if string_dec x x0 then v else Var x0) t unfold insert in H.x: string
v: expr
tv: ty
Hv: typed empty v tv
x0: string
t: ty
Gamma0: ctx
H: (if string_dec x x0 then Some tv else Gamma0 x0) =
Some t
typed Gamma0 (if string_dec x x0 then v else Var x0) t destruct string_dec; simpeq; eauto using typed.v: expr
t: ty
Hv: typed empty v t
x0: string
Gamma0: ctx
typed Gamma0 v t
    eapply weakening; [|eauto].v: expr
t: ty
Hv: typed empty v t
x0: string
Gamma0: ctx
forall (x : string) (t : ty),
empty x = Some t -> Gamma0 x = Some t
    intros.v: expr
t: ty
Hv: typed empty v t
x0: string
Gamma0: ctx
x: string
t0: ty
H: empty x = Some t0
Gamma0 x = Some t0 unfold empty in H.v: expr
t: ty
Hv: typed empty v t
x0: string
Gamma0: ctx
x: string
t0: ty
H: None = Some t0
Gamma0 x = Some t0 simpeq.
  -x: string
v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x tv Gamma0) =
insert x tv Gamma ->
typed Gamma (subst x v e) t2
H: typed (insert x0 t1 (insert x tv Gamma0)) e t2
typed Gamma0
  (Lam x0 (if string_dec x x0 then e else subst x v e))
  (Fun t1 t2) econstructor.x: string
v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x tv Gamma0) =
insert x tv Gamma ->
typed Gamma (subst x v e) t2
H: typed (insert x0 t1 (insert x tv Gamma0)) e t2
typed (insert x0 t1 Gamma0)
  (if string_dec x x0 then e else subst x v e) t2 destruct string_dec; simpeq.v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
H: typed (insert x0 t1 (insert x0 tv Gamma0)) e t2
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x0 tv Gamma0) =
insert x0 tv Gamma ->
typed Gamma (subst x0 v e) t2
typed (insert x0 t1 Gamma0) e t2
x: string
v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x tv Gamma0) =
insert x tv Gamma ->
typed Gamma (subst x v e) t2
H: typed (insert x0 t1 (insert x tv Gamma0)) e t2
n: x <> x0
typed (insert x0 t1 Gamma0) (subst x v e) t2
    +v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
H: typed (insert x0 t1 (insert x0 tv Gamma0)) e t2
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x0 tv Gamma0) =
insert x0 tv Gamma ->
typed Gamma (subst x0 v e) t2
typed (insert x0 t1 Gamma0) e t2 eapply weakening; [|eauto].v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
H: typed (insert x0 t1 (insert x0 tv Gamma0)) e t2
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x0 tv Gamma0) =
insert x0 tv Gamma ->
typed Gamma (subst x0 v e) t2
forall (x : string) (t : ty),
insert x0 t1 (insert x0 tv Gamma0) x = Some t ->
insert x0 t1 Gamma0 x = Some t unfold insert.v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
H: typed (insert x0 t1 (insert x0 tv Gamma0)) e t2
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x0 tv Gamma0) =
insert x0 tv Gamma ->
typed Gamma (subst x0 v e) t2
forall (x : string) (t : ty),
(if string_dec x0 x
 then Some t1
 else if string_dec x0 x then Some tv else Gamma0 x) =
Some t ->
(if string_dec x0 x then Some t1 else Gamma0 x) =
Some t
      intros.v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
H: typed (insert x0 t1 (insert x0 tv Gamma0)) e t2
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x0 tv Gamma0) =
insert x0 tv Gamma ->
typed Gamma (subst x0 v e) t2
x: string
t: ty
H0: (if string_dec x0 x
 then Some t1
 else
  if string_dec x0 x then Some tv else Gamma0 x) =
Some t
(if string_dec x0 x then Some t1 else Gamma0 x) =
Some t destruct string_dec; simpeq.
    +x: string
v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x tv Gamma0) =
insert x tv Gamma ->
typed Gamma (subst x v e) t2
H: typed (insert x0 t1 (insert x tv Gamma0)) e t2
n: x <> x0
typed (insert x0 t1 Gamma0) (subst x v e) t2 eapply IHtyped.x: string
v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x tv Gamma0) =
insert x tv Gamma ->
typed Gamma (subst x v e) t2
H: typed (insert x0 t1 (insert x tv Gamma0)) e t2
n: x <> x0
insert x0 t1 (insert x tv Gamma0) =
insert x tv (insert x0 t1 Gamma0)
      apply functional_extensionality.x: string
v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x tv Gamma0) =
insert x tv Gamma ->
typed Gamma (subst x v e) t2
H: typed (insert x0 t1 (insert x tv Gamma0)) e t2
n: x <> x0
forall x1 : string,
insert x0 t1 (insert x tv Gamma0) x1 =
insert x tv (insert x0 t1 Gamma0) x1 intros.x: string
v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x tv Gamma0) =
insert x tv Gamma ->
typed Gamma (subst x v e) t2
H: typed (insert x0 t1 (insert x tv Gamma0)) e t2
n: x <> x0
x1: string
insert x0 t1 (insert x tv Gamma0) x1 =
insert x tv (insert x0 t1 Gamma0) x1
      unfold insert.x: string
v: expr
tv: ty
Hv: typed empty v tv
x0: string
e: expr
t1, t2: ty
Gamma0: ctx
IHtyped: forall Gamma : ctx,
insert x0 t1 (insert x tv Gamma0) =
insert x tv Gamma ->
typed Gamma (subst x v e) t2
H: typed (insert x0 t1 (insert x tv Gamma0)) e t2
n: x <> x0
x1: string
(if string_dec x0 x1
 then Some t1
 else if string_dec x x1 then Some tv else Gamma0 x1) =
(if string_dec x x1
 then Some tv
 else if string_dec x0 x1 then Some t1 else Gamma0 x1) 
      destruct string_dec; simpeq.x: string
v: expr
tv: ty
Hv: typed empty v tv
e: expr
t1, t2: ty
Gamma0: ctx
x1: string
n: x <> x1
H: typed (insert x1 t1 (insert x tv Gamma0)) e t2
IHtyped: forall Gamma : ctx,
insert x1 t1 (insert x tv Gamma0) =
insert x tv Gamma ->
typed Gamma (subst x v e) t2
Some t1 =
(if string_dec x x1 then Some tv else Some t1)
      destruct string_dec; simpeq.
Qed.

Theorem preservation (e e' : expr) (t : ty) :
  typed empty e t ->
  step e e' ->
  typed empty e' t.e, e': expr
t: ty
typed empty e t -> step e e' -> typed empty e' t
Proof.e, e': expr
t: ty
typed empty e t -> step e e' -> typed empty e' t
  intros Htyped Hstep.e, e': expr
t: ty
Htyped: typed empty e t
Hstep: step e e'
typed empty e' t
  revert t Htyped.e, e': expr
Hstep: step e e'
forall t : ty, typed empty e t -> typed empty e' t
  induction Hstep; intros t Htyped; inv Htyped; eauto using typed.x: string
v, e: expr
H: value v
t, t1: ty
H3: typed empty (Lam x e) (Fun t1 t)
H5: typed empty v t1
typed empty (subst x v e) t
e1, e2, e3: expr
H: value e1
H0: value e2
H1: value e3
t: ty
H6: typed empty (Succ e1) Nat
H8: typed empty e2 t
H9: typed empty e3 (Fun t t)
typed empty (Rec e1 (App e3 e2) e3) t
  -x: string
v, e: expr
H: value v
t, t1: ty
H3: typed empty (Lam x e) (Fun t1 t)
H5: typed empty v t1
typed empty (subst x v e) t inv H3.x: string
v, e: expr
H: value v
t, t1: ty
H5: typed empty v t1
H2: typed (insert x t1 empty) e t
typed empty (subst x v e) t eauto using typed.x: string
v, e: expr
H: value v
t, t1: ty
H5: typed empty v t1
H2: typed (insert x t1 empty) e t
typed empty (subst x v e) t eapply subst_typed; eauto.
  -e1, e2, e3: expr
H: value e1
H0: value e2
H1: value e3
t: ty
H6: typed empty (Succ e1) Nat
H8: typed empty e2 t
H9: typed empty e3 (Fun t t)
typed empty (Rec e1 (App e3 e2) e3) t inv H6.e1, e2, e3: expr
H: value e1
H0: value e2
H1: value e3
t: ty
H8: typed empty e2 t
H9: typed empty e3 (Fun t t)
H4: typed empty e1 Nat
typed empty (Rec e1 (App e3 e2) e3) t econstructor; eauto.e1, e2, e3: expr
H: value e1
H0: value e2
H1: value e3
t: ty
H8: typed empty e2 t
H9: typed empty e3 (Fun t t)
H4: typed empty e1 Nat
typed empty (App e3 e2) t econstructor; eauto.  
Qed.

Type Safety

Inductive rtc {A} (R : A -> A -> Prop) : A -> A -> Prop :=
  | rtc_refl (x : A) : rtc R x x
  | rtc_trans (x y z : A) : R x y -> rtc R y z -> rtc R x z.

Definition safe (e : expr) :=
  forall e', rtc step e e' -> value e' \/ exists e'', step e' e''.

Theorem safety (e : expr) (t : ty) :
  typed empty e t -> safe e.e: expr
t: ty
typed empty e t -> safe e
Proof.e: expr
t: ty
typed empty e t -> safe e
  unfold safe.e: expr
t: ty
typed empty e t ->
forall e' : expr,
rtc step e e' ->
value e' \/ (exists e'' : expr, step e' e'') intros Htyped e' Hstep.e: expr
t: ty
Htyped: typed empty e t
e': expr
Hstep: rtc step e e'
value e' \/ (exists e'' : expr, step e' e'')
  assert (typed empty e' t).e: expr
t: ty
Htyped: typed empty e t
e': expr
Hstep: rtc step e e'
typed empty e' t
e: expr
t: ty
Htyped: typed empty e t
e': expr
Hstep: rtc step e e'
H: typed empty e' t
value e' \/ (exists e'' : expr, step e' e'')
  {e: expr
t: ty
Htyped: typed empty e t
e': expr
Hstep: rtc step e e'
typed empty e' t
    induction Hstep; eauto using preservation.
  }e: expr
t: ty
Htyped: typed empty e t
e': expr
Hstep: rtc step e e'
H: typed empty e' t
value e' \/ (exists e'' : expr, step e' e'')
  eapply progress.e: expr
t: ty
Htyped: typed empty e t
e': expr
Hstep: rtc step e e'
H: typed empty e' t
typed empty e' ?t eauto.
Qed.