Mercurial > cpdt > repo
changeset 154:358dcb6e08f2
Progress and preservation
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 02 Nov 2008 13:14:08 -0500 |
parents | 8c19768f1a1a |
children | b31ca896f211 |
files | src/Firstorder.v |
diffstat | 1 files changed, 49 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- a/src/Firstorder.v Sun Nov 02 12:20:56 2008 -0500 +++ b/src/Firstorder.v Sun Nov 02 13:14:08 2008 -0500 @@ -296,4 +296,53 @@ Qed. End subst. + Hint Resolve subst_hasType_closed. + + Notation "[ x ~> e1 ] e2" := (subst x e1 e2) (no associativity, at level 80). + + Inductive val : exp -> Prop := + | VConst : forall b, val (Const b) + | VAbs : forall x e, val (Abs x e). + + Hint Constructors val. + + Reserved Notation "e1 ==> e2" (no associativity, at level 90). + + Inductive step : exp -> exp -> Prop := + | Beta : forall x e1 e2, + App (Abs x e1) e2 ==> [x ~> e2] e1 + | Cong1 : forall e1 e2 e1', + e1 ==> e1' + -> App e1 e2 ==> App e1' e2 + | Cong2 : forall e1 e2 e2', + val e1 + -> e2 ==> e2' + -> App e1 e2 ==> App e1 e2' + + where "e1 ==> e2" := (step e1 e2). + + Hint Constructors step. + + Theorem progress : forall G e t, G |-e e : t + -> G = nil + -> val e \/ exists e', e ==> e'. + induction 1; crush; eauto; + try match goal with + | [ H : _ |-e _ : _ --> _ |- _ ] => inversion H + end; + repeat match goal with + | [ H : _ |- _ ] => solve [ inversion H; crush; eauto ] + end. + Qed. + + Theorem preservation : forall G e t, G |-e e : t + -> G = nil + -> forall e', e ==> e' + -> G |-e e' : t. + induction 1; inversion 2; crush; eauto; + match goal with + | [ H : _ |-e Abs _ _ : _ |- _ ] => inversion H + end; eauto. + Qed. + End Concrete.