Mercurial > cpdt > repo
changeset 174:cd39a64d41ee
Templatize Interps
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 09 Nov 2008 15:23:33 -0500 |
parents | 7fd470d8a788 |
children | 022feabdff50 |
files | src/Interps.v |
diffstat | 1 files changed, 30 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- a/src/Interps.v Sun Nov 09 15:15:41 2008 -0500 +++ b/src/Interps.v Sun Nov 09 15:23:33 2008 -0500 @@ -76,6 +76,9 @@ \f, \x, #f @ #x. Definition app_ident' : Exp Nat := fun _ => app _ @ ident _ @ zpo _. + (* EX: Define an interpreter for [Exp]s. *) + +(* begin thide *) Fixpoint typeDenote (t : type) : Set := match t with | Nat => nat @@ -94,6 +97,7 @@ end. Definition ExpDenote t (e : Exp t) := expDenote (e _). +(* end thide *) Eval compute in ExpDenote zero. Eval compute in ExpDenote one. @@ -103,6 +107,9 @@ Eval compute in ExpDenote app. Eval compute in ExpDenote app_ident'. + (* EX: Define a constant-folding function for [Exp]s. *) + +(* begin thide *) Section cfold. Variable var : type -> Type. @@ -125,7 +132,11 @@ End cfold. Definition Cfold t (E : Exp t) : Exp t := fun _ => cfold (E _). +(* end thide *) + (* EX: Prove the correctness of constant-folding. *) + +(* begin thide *) Lemma cfold_correct : forall t (e : exp _ t), expDenote (cfold e) = expDenote e. induction e; crush; try (ext_eq; crush); @@ -138,22 +149,28 @@ ExpDenote (Cfold E) = ExpDenote E. unfold ExpDenote, Cfold; intros; apply cfold_correct. Qed. +(* end thide *) End STLC. (** * Adding Products and Sums *) Module PSLC. + (* EX: Extend the development with products and sums. *) + +(* begin thide *) Inductive type : Type := | Nat : type | Arrow : type -> type -> type | Prod : type -> type -> type | Sum : type -> type -> type. +(* end thide *) Infix "-->" := Arrow (right associativity, at level 62). Infix "**" := Prod (right associativity, at level 61). Infix "++" := Sum (right associativity, at level 60). +(* begin thide *) Section vars. Variable var : type -> Type. @@ -198,6 +215,7 @@ End vars. Definition Exp t := forall var, exp var t. +(* end thide *) Implicit Arguments Var [var t]. Implicit Arguments Const [var]. @@ -233,6 +251,7 @@ Definition natOut_ns1 : Exp Nat := fun _ => natOut _ @ ns1 _. Definition natOut_ns2 : Exp Nat := fun _ => natOut _ @ ns2 _. +(* begin thide *) Fixpoint typeDenote (t : type) : Set := match t with | Nat => nat @@ -265,6 +284,7 @@ end. Definition ExpDenote t (e : Exp t) := expDenote (e _). +(* end thide *) Eval compute in ExpDenote swap. Eval compute in ExpDenote zo. @@ -276,6 +296,7 @@ Eval compute in ExpDenote natOut_ns1. Eval compute in ExpDenote natOut_ns2. +(* begin thide *) Section cfold. Variable var : type -> Type. @@ -369,12 +390,16 @@ ExpDenote (Cfold E) = ExpDenote E. unfold ExpDenote, Cfold; intros; apply cfold_correct. Qed. +(* end thide *) End PSLC. (** * Type Variables *) Module SysF. + (* EX: Follow a similar progression for System F. *) + +(* begin thide *) Section vars. Variable tvar : Type. @@ -432,6 +457,7 @@ Definition Typ := forall tvar, type tvar. Definition Exp (T : Typ) := forall tvar (var : type tvar -> Type), exp var (T _). +(* end thide *) Implicit Arguments Nat [tvar]. @@ -477,6 +503,7 @@ repeat constructor. Defined. +(* begin thide *) Fixpoint typeDenote (t : type Set) : Set := match t with | Nat => nat @@ -508,6 +535,7 @@ end. Definition ExpDenote T (E : Exp T) := expDenote (E _ _). +(* end thide *) Eval compute in ExpDenote zero. Eval compute in ExpDenote ident. @@ -515,6 +543,7 @@ Eval compute in ExpDenote ident_ident. Eval compute in ExpDenote ident5. +(* begin thide *) Section cfold. Variable tvar : Type. Variable var : type tvar -> Type. @@ -554,4 +583,5 @@ ExpDenote (Cfold E) = ExpDenote E. unfold ExpDenote, Cfold; intros; apply cfold_correct. Qed. +(* end thide *) End SysF.