TypecheckingA Typechecker for STLC
Fixpoint eqb_ty (T1 T2:ty) : bool :=
match T1,T2 with
| Bool, Bool ⇒
true
| Arrow T11 T12, Arrow T21 T22 ⇒
andb (eqb_ty T11 T21) (eqb_ty T12 T22)
| _,_ ⇒
false
end.
match T1,T2 with
| Bool, Bool ⇒
true
| Arrow T11 T12, Arrow T21 T22 ⇒
andb (eqb_ty T11 T21) (eqb_ty T12 T22)
| _,_ ⇒
false
end.
... and we need to establish the usual two-way connection between
the boolean result returned by eqb_ty and the logical
proposition that its inputs are equal.
Lemma eqb_ty_refl : ∀T1,
eqb_ty T1 T1 = true.
Lemma eqb_ty__eq : ∀T1 T2,
eqb_ty T1 T2 = true → T1 = T2.
eqb_ty T1 T1 = true.
Proof.
intros T1. induction T1; simpl.
reflexivity.
rewrite IHT1_1. rewrite IHT1_2. reflexivity. Qed.
intros T1. induction T1; simpl.
reflexivity.
rewrite IHT1_1. rewrite IHT1_2. reflexivity. Qed.
Lemma eqb_ty__eq : ∀T1 T2,
eqb_ty T1 T2 = true → T1 = T2.
Proof with auto.
intros T1. induction T1; intros T2 Hbeq; destruct T2; inversion Hbeq.
- (* T1=Bool *)
reflexivity.
- (* T1=Arrow T1_1 T1_2 *)
rewrite andb_true_iff in H0. inversion H0 as [Hbeq1 Hbeq2].
apply IHT1_1 in Hbeq1. apply IHT1_2 in Hbeq2. subst... Qed.
intros T1. induction T1; intros T2 Hbeq; destruct T2; inversion Hbeq.
- (* T1=Bool *)
reflexivity.
- (* T1=Arrow T1_1 T1_2 *)
rewrite andb_true_iff in H0. inversion H0 as [Hbeq1 Hbeq2].
apply IHT1_1 in Hbeq1. apply IHT1_2 in Hbeq2. subst... Qed.
The Typechecker
Fixpoint type_check (Gamma : context) (t : tm) : option ty :=
match t with
| var x ⇒
Gamma x
| abs x T11 t12 ⇒
match type_check (update Gamma x T11) t12 with
| Some T12 ⇒ Some (Arrow T11 T12)
| _ ⇒ None
end
| app t1 t2 ⇒
match type_check Gamma t1, type_check Gamma t2 with
| Some (Arrow T11 T12),Some T2 ⇒
if eqb_ty T11 T2 then Some T12 else None
| _,_ ⇒ None
end
| tru ⇒
Some Bool
| fls ⇒
Some Bool
| test guard t f ⇒
match type_check Gamma guard with
| Some Bool ⇒
match type_check Gamma t, type_check Gamma f with
| Some T1, Some T2 ⇒
if eqb_ty T1 T2 then Some T1 else None
| _,_ ⇒ None
end
| _ ⇒ None
end
end.
Digression: Improving the Notation
Notation " x <- e1 ;; e2" := (match e1 with
| Some x ⇒ e2
| None ⇒ None
end)
(right associativity, at level 60).
| Some x ⇒ e2
| None ⇒ None
end)
(right associativity, at level 60).
Second, we define return and fail as synonyms for Some and
None:
Notation " 'return' e "
:= (Some e) (at level 60).
Notation " 'fail' "
:= None.
:= (Some e) (at level 60).
Notation " 'fail' "
:= None.
Now we can write the same type-checking function in a more
imperative-looking style using these notations.
Fixpoint type_check (Gamma : context) (t : tm) : option ty :=
match t with
| var x ⇒
match Gamma x with
| Some T ⇒ return T
| None ⇒ fail
end
| abs x T11 t12 ⇒
T12 <- type_check (update Gamma x T11) t12 ;;
return (Arrow T11 T12)
| app t1 t2 ⇒
T1 <- type_check Gamma t1 ;;
T2 <- type_check Gamma t2 ;;
match T1 with
| Arrow T11 T12 ⇒
if eqb_ty T11 T2 then return T12 else fail
| _ ⇒ fail
end
| tru ⇒
return Bool
| fls ⇒
return Bool
| test guard t1 t2 ⇒
Tguard <- type_check Gamma guard ;;
T1 <- type_check Gamma t1 ;;
T2 <- type_check Gamma t2 ;;
match Tguard with
| Bool ⇒
if eqb_ty T1 T2 then return T1 else fail
| _ ⇒ fail
end
end.
match t with
| var x ⇒
match Gamma x with
| Some T ⇒ return T
| None ⇒ fail
end
| abs x T11 t12 ⇒
T12 <- type_check (update Gamma x T11) t12 ;;
return (Arrow T11 T12)
| app t1 t2 ⇒
T1 <- type_check Gamma t1 ;;
T2 <- type_check Gamma t2 ;;
match T1 with
| Arrow T11 T12 ⇒
if eqb_ty T11 T2 then return T12 else fail
| _ ⇒ fail
end
| tru ⇒
return Bool
| fls ⇒
return Bool
| test guard t1 t2 ⇒
Tguard <- type_check Gamma guard ;;
T1 <- type_check Gamma t1 ;;
T2 <- type_check Gamma t2 ;;
match Tguard with
| Bool ⇒
if eqb_ty T1 T2 then return T1 else fail
| _ ⇒ fail
end
end.
Properties
Theorem type_checking_sound : ∀Gamma t T,
type_check Gamma t = Some T → has_type Gamma t T.
Theorem type_checking_complete : ∀Gamma t T,
has_type Gamma t T → type_check Gamma t = Some T.
type_check Gamma t = Some T → has_type Gamma t T.
Proof with eauto.
intros Gamma t. generalize dependent Gamma.
induction t; intros Gamma T Htc; inversion Htc.
- (* var *) rename s into x. destruct (Gamma x) eqn:H.
rename t into T'. inversion H0. subst. eauto. solve_by_invert.
- (* app *)
remember (type_check Gamma t1) as TO1.
destruct TO1 as [T1|]; try solve_by_invert;
destruct T1 as [|T11 T12]; try solve_by_invert;
remember (type_check Gamma t2) as TO2;
destruct TO2 as [T2|]; try solve_by_invert.
destruct (eqb_ty T11 T2) eqn: Heqb.
apply eqb_ty__eq in Heqb.
inversion H0; subst...
inversion H0.
- (* abs *)
rename s into x. rename t into T1.
remember (update Gamma x T1) as G'.
remember (type_check G' t0) as TO2.
destruct TO2; try solve_by_invert.
inversion H0; subst...
- (* tru *) eauto.
- (* fls *) eauto.
- (* test *)
remember (type_check Gamma t1) as TOc.
remember (type_check Gamma t2) as TO1.
remember (type_check Gamma t3) as TO2.
destruct TOc as [Tc|]; try solve_by_invert.
destruct Tc; try solve_by_invert;
destruct TO1 as [T1|]; try solve_by_invert;
destruct TO2 as [T2|]; try solve_by_invert.
destruct (eqb_ty T1 T2) eqn:Heqb;
try solve_by_invert.
apply eqb_ty__eq in Heqb.
inversion H0. subst. subst...
Qed.
intros Gamma t. generalize dependent Gamma.
induction t; intros Gamma T Htc; inversion Htc.
- (* var *) rename s into x. destruct (Gamma x) eqn:H.
rename t into T'. inversion H0. subst. eauto. solve_by_invert.
- (* app *)
remember (type_check Gamma t1) as TO1.
destruct TO1 as [T1|]; try solve_by_invert;
destruct T1 as [|T11 T12]; try solve_by_invert;
remember (type_check Gamma t2) as TO2;
destruct TO2 as [T2|]; try solve_by_invert.
destruct (eqb_ty T11 T2) eqn: Heqb.
apply eqb_ty__eq in Heqb.
inversion H0; subst...
inversion H0.
- (* abs *)
rename s into x. rename t into T1.
remember (update Gamma x T1) as G'.
remember (type_check G' t0) as TO2.
destruct TO2; try solve_by_invert.
inversion H0; subst...
- (* tru *) eauto.
- (* fls *) eauto.
- (* test *)
remember (type_check Gamma t1) as TOc.
remember (type_check Gamma t2) as TO1.
remember (type_check Gamma t3) as TO2.
destruct TOc as [Tc|]; try solve_by_invert.
destruct Tc; try solve_by_invert;
destruct TO1 as [T1|]; try solve_by_invert;
destruct TO2 as [T2|]; try solve_by_invert.
destruct (eqb_ty T1 T2) eqn:Heqb;
try solve_by_invert.
apply eqb_ty__eq in Heqb.
inversion H0. subst. subst...
Qed.
Theorem type_checking_complete : ∀Gamma t T,
has_type Gamma t T → type_check Gamma t = Some T.
Proof with auto.
intros Gamma t T Hty.
induction Hty; simpl.
- (* T_Var *) destruct (Gamma x0) eqn:H0; assumption.
- (* T_Abs *) rewrite IHHty...
- (* T_App *)
rewrite IHHty1. rewrite IHHty2.
rewrite (eqb_ty_refl T11)...
- (* T_True *) eauto.
- (* T_False *) eauto.
- (* T_If *) rewrite IHHty1. rewrite IHHty2.
rewrite IHHty3. rewrite (eqb_ty_refl T)...
Qed.
intros Gamma t T Hty.
induction Hty; simpl.
- (* T_Var *) destruct (Gamma x0) eqn:H0; assumption.
- (* T_Abs *) rewrite IHHty...
- (* T_App *)
rewrite IHHty1. rewrite IHHty2.
rewrite (eqb_ty_refl T11)...
- (* T_True *) eauto.
- (* T_False *) eauto.
- (* T_If *) rewrite IHHty1. rewrite IHHty2.
rewrite IHHty3. rewrite (eqb_ty_refl T)...
Qed.