Require Import Arith List. Require Import CpdtTactics. Set Implicit Arguments. Section ilist. Variable A : Set. Inductive ilist : nat -> Set := | Nil : ilist O | Cons : forall n, A -> ilist n -> ilist (S n). Inductive fin : nat -> Set := | First : forall n, fin (S n) | Next : forall n, fin n -> fin (S n). (* Exercise, 5 minutes: Working with length-indexed lists *) (* Define a function irev that reverses an indexed list. If you run into trouble, try defining a helper function first. *) Fixpoint get n (ls : ilist n) : fin n -> A := match ls with | Nil => fun idx => match idx in fin n' return (match n' with | O => A | S _ => unit end) with | First _ => tt | Next _ _ => tt end | Cons _ x ls' => fun idx => match idx in fin n' return (fin (pred n') -> A) -> A with | First _ => fun _ => x | Next _ idx' => fun get_ls' => get_ls' idx' end (get ls') end. End ilist. Implicit Arguments Nil [A]. Implicit Arguments First [n]. Check Cons 0 (Cons 1 (Cons 2 Nil)). Eval simpl in get (Cons 0 (Cons 1 (Cons 2 Nil))) First. Eval simpl in get (Cons 0 (Cons 1 (Cons 2 Nil))) (Next First). Eval simpl in get (Cons 0 (Cons 1 (Cons 2 Nil))) (Next (Next First)). (* Example irev_test : irev (Cons 0 (Cons 1 (Cons 2 Nil))) = (Cons 2 (Cons 1 (Cons 0 Nil))). crush. Qed. *) Definition map' := map. Section ilist_map. Variables A B : Set. Variable f : A -> B. Fixpoint imap n (ls : ilist A n) : ilist B n := match ls with | Nil => Nil | Cons _ x ls' => Cons (f x) (imap ls') end. Theorem get_imap : forall n (idx : fin n) (ls : ilist A n), get (imap ls) idx = f (get ls idx). induction ls; dep_destruct idx; crush. Qed. End ilist_map. Section hlist. Variable A : Type. Variable B : A -> Type. Inductive hlist : list A -> Type := | HNil : hlist nil | HCons : forall (x : A) (ls : list A), B x -> hlist ls -> hlist (x :: ls). Variable elm : A. Inductive member : list A -> Type := | HFirst : forall ls, member (elm :: ls) | HNext : forall x ls, member ls -> member (x :: ls). Fixpoint hget ls (mls : hlist ls) : member ls -> B elm := match mls with | HNil => fun mem => match mem in member ls' return (match ls' with | nil => B elm | _ :: _ => unit end) with | HFirst _ => tt | HNext _ _ _ => tt end | HCons _ _ x mls' => fun mem => match mem in member ls' return (match ls' with | nil => Empty_set | x' :: ls'' => B x' -> (member ls'' -> B elm) -> B elm end) with | HFirst _ => fun x _ => x | HNext _ _ mem' => fun _ get_mls' => get_mls' mem' end x (hget mls') end. End hlist. Implicit Arguments HNil [A B]. Implicit Arguments HCons [A B x ls]. Implicit Arguments HFirst [A elm ls]. Implicit Arguments HNext [A elm x ls]. Definition someTypes : list Set := nat :: bool :: nil. Example someValues : hlist (fun T : Set => T) someTypes := HCons 5 (HCons true HNil). Eval simpl in hget someValues HFirst. Eval simpl in hget someValues (HNext HFirst). Example somePairs : hlist (fun T : Set => T * T)%type someTypes := HCons (1, 2) (HCons (true, false) HNil). (** ** A Lambda Calculus Interpreter *) (* Exercise, 15 minutes : add Nats and Pairs. Then, add a let expression that will evaluate the expression in its second argument in an environment extended with the value of the first argument. *) Inductive type : Set := | Unit : type | Arrow : type -> type -> type. Inductive exp : list type -> type -> Set := | Const : forall ts, exp ts Unit | Var : forall ts t, member t ts -> exp ts t | App : forall ts dom ran, exp ts (Arrow dom ran) -> exp ts dom -> exp ts ran | Abs : forall ts dom ran, exp (dom :: ts) ran -> exp ts (Arrow dom ran). Implicit Arguments Const [ts]. Fixpoint typeDenote (t : type) : Set := match t with | Unit => unit | Arrow t1 t2 => typeDenote t1 -> typeDenote t2 end. Fixpoint expDenote ts t (e : exp ts t) : hlist typeDenote ts -> typeDenote t := match e with | Const _ => fun _ => tt | Var _ _ mem => fun s => hget s mem | App _ _ _ e1 e2 => fun s => (expDenote e1 s) (expDenote e2 s) | Abs _ _ _ e' => fun s => fun x => expDenote e' (HCons x s) end. Eval simpl in expDenote Const HNil. Eval simpl in expDenote (Abs (dom := Unit) (Var HFirst)) HNil. Eval simpl in expDenote (Abs (dom := Unit) (Abs (dom := Unit) (Var (HNext HFirst)))) HNil. Eval simpl in expDenote (Abs (dom := Unit) (Abs (dom := Unit) (Var HFirst))) HNil. Eval simpl in expDenote (App (Abs (Var HFirst)) Const) HNil.