Commit caedb995 authored by Adam Chlipala's avatar Adam Chlipala

Templatize Extensional

parent 52b5f793
...@@ -103,6 +103,7 @@ Module STLC. ...@@ -103,6 +103,7 @@ Module STLC.
Definition ExpDenote t (e : Exp t) := expDenote (e _). Definition ExpDenote t (e : Exp t) := expDenote (e _).
(* begin thide *)
Section exp_equiv. Section exp_equiv.
Variables var1 var2 : type -> Type. Variables var1 var2 : type -> Type.
...@@ -129,6 +130,7 @@ Module STLC. ...@@ -129,6 +130,7 @@ Module STLC.
Axiom Exp_equiv : forall t (E : Exp t) var1 var2, Axiom Exp_equiv : forall t (E : Exp t) var1 var2,
exp_equiv nil (E var1) (E var2). exp_equiv nil (E var1) (E var2).
(* end thide *)
End Source. End Source.
Module CPS. Module CPS.
...@@ -257,6 +259,7 @@ Module STLC. ...@@ -257,6 +259,7 @@ Module STLC.
Import Source CPS. Import Source CPS.
(* begin thide *)
Fixpoint cpsType (t : Source.type) : CPS.type := Fixpoint cpsType (t : Source.type) : CPS.type :=
match t with match t with
| Nat => Nat%cps | Nat => Nat%cps
...@@ -310,6 +313,7 @@ Module STLC. ...@@ -310,6 +313,7 @@ Module STLC.
Implicit Arguments cpsExp [var t]. Implicit Arguments cpsExp [var t].
Definition CpsExp (E : Exp Nat) : Prog := Definition CpsExp (E : Exp Nat) : Prog :=
fun var => cpsExp (E _) (PHalt (var := _)). fun var => cpsExp (E _) (PHalt (var := _)).
(* end thide *)
Eval compute in CpsExp zero. Eval compute in CpsExp zero.
Eval compute in CpsExp one. Eval compute in CpsExp one.
...@@ -323,6 +327,7 @@ Module STLC. ...@@ -323,6 +327,7 @@ Module STLC.
Eval compute in ProgDenote (CpsExp app_ident). Eval compute in ProgDenote (CpsExp app_ident).
Eval compute in ProgDenote (CpsExp app_ident'). Eval compute in ProgDenote (CpsExp app_ident').
(* begin thide *)
Fixpoint lr (t : Source.type) : Source.typeDenote t -> CPS.typeDenote (cpsType t) -> Prop := Fixpoint lr (t : Source.type) : Source.typeDenote t -> CPS.typeDenote (cpsType t) -> Prop :=
match t return (Source.typeDenote t -> CPS.typeDenote (cpsType t) -> Prop) with match t return (Source.typeDenote t -> CPS.typeDenote (cpsType t) -> Prop) with
| Nat => fun n1 n2 => n1 = n2 | Nat => fun n1 n2 => n1 = n2
...@@ -373,6 +378,7 @@ Module STLC. ...@@ -373,6 +378,7 @@ Module STLC.
generalize (cpsExp_correct (e1 := E _) (e2 := E _) generalize (cpsExp_correct (e1 := E _) (e2 := E _)
(Exp_equiv _ _ _) vars_easy (PHalt (var := _))); crush. (Exp_equiv _ _ _) vars_easy (PHalt (var := _))); crush.
Qed. Qed.
(* end thide *)
End STLC. End STLC.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment