diff src/Interps.v @ 204:cbf2f74a5130

Parts I want to keep compile with 8.2
author Adam Chlipala <adamc@hcoop.net>
date Fri, 06 Nov 2009 10:52:43 -0500
parents cd39a64d41ee
children 2a34c4dc6a10
line wrap: on
line diff
--- a/src/Interps.v	Sun Jan 04 08:18:59 2009 -0500
+++ b/src/Interps.v	Fri Nov 06 10:52:43 2009 -0500
@@ -10,7 +10,7 @@
 (* begin hide *)
 Require Import String List.
 
-Require Import AxiomsImpred Tactics.
+Require Import Axioms Tactics.
 
 Set Implicit Arguments.
 (* end hide *)
@@ -121,7 +121,7 @@
         | Plus e1 e2 =>
           let e1' := cfold e1 in
           let e2' := cfold e2 in
-          match e1', e2' with
+          match e1', e2' return _ with
             | Const n1, Const n2 => ^(n1 + n2)
             | _, _ => e1' +^ e2'
           end
@@ -301,7 +301,7 @@
     Variable var : type -> Type.
 
     Definition pairOutType t :=
-      match t with
+      match t return Type with
         | t1 ** t2 => option (exp var t1 * exp var t2)
         | _ => unit
       end.
@@ -326,7 +326,7 @@
         | Plus e1 e2 =>
           let e1' := cfold e1 in
           let e2' := cfold e2 in
-          match e1', e2' with
+          match e1', e2' return _ with
             | Const n1, Const n2 => ^(n1 + n2)
             | _, _ => e1' +^ e2'
           end
@@ -392,196 +392,3 @@
   Qed.
 (* end thide *)
 End PSLC.
-
-
-(** * Type Variables *)
-
-Module SysF.
-  (* EX: Follow a similar progression for System F. *)
-
-(* begin thide *)
-  Section vars.
-    Variable tvar : Type.
-
-    Inductive type : Type :=
-    | Nat : type
-    | Arrow : type -> type -> type
-    | TVar : tvar -> type
-    | All : (tvar -> type) -> type.
-
-    Notation "## v" := (TVar v) (at level 40).
-    Infix "-->" := Arrow (right associativity, at level 60).
-
-    Section Subst.
-      Variable t : type.
-
-      Inductive Subst : (tvar -> type) -> type -> Prop :=
-      | SNat : Subst (fun _ => Nat) Nat
-      | SArrow : forall dom ran dom' ran',
-        Subst dom dom'
-        -> Subst ran ran'
-        -> Subst (fun v => dom v --> ran v) (dom' --> ran')
-      | SVarEq : Subst TVar t
-      | SVarNe : forall v, Subst (fun _ => ##v) (##v)
-      | SAll : forall ran ran',
-        (forall v', Subst (fun v => ran v v') (ran' v'))
-        -> Subst (fun v => All (ran v)) (All ran').
-    End Subst.
-
-    Variable var : type -> Type.
-
-    Inductive exp : type -> Type :=
-    | Var : forall t,
-      var t
-      -> exp t
-
-    | Const : nat -> exp Nat
-    | Plus : exp Nat -> exp Nat -> exp Nat
-
-    | App : forall t1 t2,
-      exp (t1 --> t2)
-      -> exp t1
-      -> exp t2
-    | Abs : forall t1 t2,
-      (var t1 -> exp t2)
-      -> exp (t1 --> t2)
-
-    | TApp : forall tf,
-      exp (All tf)
-      -> forall t tf', Subst t tf tf'
-        -> exp tf'
-    | TAbs : forall tf,
-      (forall v, exp (tf v))
-      -> exp (All tf).
-  End vars.
-
-  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].
-
-  Notation "## v" := (TVar v) (at level 40).
-  Infix "-->" := Arrow (right associativity, at level 60).
-  Notation "\\\ x , t" := (All (fun x => t)) (at level 65).
-
-  Implicit Arguments Var [tvar var t].
-  Implicit Arguments Const [tvar var].
-  Implicit Arguments Plus [tvar var].
-  Implicit Arguments App [tvar var t1 t2].
-  Implicit Arguments Abs [tvar var t1 t2].
-
-  Implicit Arguments TAbs [tvar var tf].
-
-  Notation "# v" := (Var v) (at level 70).
-
-  Notation "^ n" := (Const n) (at level 70).
-  Infix "+^" := Plus (left associativity, at level 79).
-
-  Infix "@" := App (left associativity, at level 77).
-  Notation "\ x , e" := (Abs (fun x => e)) (at level 78).
-  Notation "\ ! , e" := (Abs (fun _ => e)) (at level 78).
-
-  Notation "e @@ t" := (TApp e (t := t) _) (left associativity, at level 77).
-  Notation "\\ x , e" := (TAbs (fun x => e)) (at level 78).
-  Notation "\\ ! , e" := (TAbs (fun _ => e)) (at level 78).
-
-  Definition zero : Exp (fun _ => Nat) := fun _ _ =>
-    ^0.
-  Definition ident : Exp (fun _ => \\\T, ##T --> ##T) := fun _ _ =>
-    \\T, \x, #x.
-  Definition ident_zero : Exp (fun _ => Nat).
-    do 2 intro; refine (ident _ @@ _ @ zero _);
-      repeat constructor.
-  Defined.
-  Definition ident_ident : Exp (fun _ => \\\T, ##T --> ##T).
-    do 2 intro; refine (ident _ @@ _ @ ident _);
-      repeat constructor.
-  Defined.
-  Definition ident5 : Exp (fun _ => \\\T, ##T --> ##T).
-    do 2 intro; refine (ident_ident _ @@ _ @ ident_ident _ @@ _ @ ident _);
-      repeat constructor.
-  Defined.
-
-(* begin thide *)
-  Fixpoint typeDenote (t : type Set) : Set :=
-    match t with
-      | Nat => nat
-      | t1 --> t2 => typeDenote t1 -> typeDenote t2
-      | ##v => v
-      | All tf => forall T, typeDenote (tf T)
-    end.
-
-  Lemma Subst_typeDenote : forall t tf tf',
-    Subst t tf tf'
-    -> typeDenote (tf (typeDenote t)) = typeDenote tf'.
-    induction 1; crush; ext_eq; crush.
-  Defined.
-
-  Fixpoint expDenote t (e : exp typeDenote t) {struct e} : typeDenote t :=
-    match e in (exp _ t) return (typeDenote t) with
-      | Var _ v => v
-        
-      | Const n => n
-      | Plus e1 e2 => expDenote e1 + expDenote e2
-        
-      | App _ _ e1 e2 => (expDenote e1) (expDenote e2)
-      | Abs _ _ e' => fun x => expDenote (e' x)
-
-      | TApp _ e' t' _ pf => match Subst_typeDenote pf in _ = T return T with
-                               | refl_equal => (expDenote e') (typeDenote t')
-                             end
-      | TAbs _ e' => fun T => expDenote (e' T)
-    end.
-
-  Definition ExpDenote T (E : Exp T) := expDenote (E _ _).
-(* end thide *)
-
-  Eval compute in ExpDenote zero.
-  Eval compute in ExpDenote ident.
-  Eval compute in ExpDenote ident_zero.
-  Eval compute in ExpDenote ident_ident.
-  Eval compute in ExpDenote ident5.
-
-(* begin thide *)
-  Section cfold.
-    Variable tvar : Type.
-    Variable var : type tvar -> Type.
-
-    Fixpoint cfold t (e : exp var t) {struct e} : exp var t :=
-      match e in exp _ t return exp _ t with
-        | Var _ v => #v
-
-        | Const n => ^n
-        | Plus e1 e2 =>
-          let e1' := cfold e1 in
-          let e2' := cfold e2 in
-          match e1', e2' with
-            | Const n1, Const n2 => ^(n1 + n2)
-            | _, _ => e1' +^ e2'
-          end
-
-        | App _ _ e1 e2 => cfold e1 @ cfold e2
-        | Abs _ _ e' => Abs (fun x => cfold (e' x))
-
-        | TApp _ e' _ _ pf => TApp (cfold e') pf
-        | TAbs _ e' => \\T, cfold (e' T)
-      end.
-  End cfold.
-
-  Definition Cfold T (E : Exp T) : Exp T := fun _ _ => cfold (E _ _).
-
-  Lemma cfold_correct : forall t (e : exp _ t),
-    expDenote (cfold e) = expDenote e.
-    induction e; crush; try (ext_eq; crush);
-      repeat (match goal with
-                | [ |- context[cfold ?E] ] => dep_destruct (cfold E)
-              end; crush).
-  Qed.
-
-  Theorem Cfold_correct : forall t (E : Exp t),
-    ExpDenote (Cfold E) = ExpDenote E.
-    unfold ExpDenote, Cfold; intros; apply cfold_correct.
-  Qed.
-(* end thide *)
-End SysF.