├── Generic.lagda ├── L4AlgOrn.agda ├── L4AlgOrnCrib.agda ├── L4Basics.agda ├── L4Desc.agda ├── L4DescCrib.agda ├── L4Hutton.agda ├── L4HuttonCrib.agda ├── L4Le.agda ├── L4List.agda ├── L4ListCrib.agda ├── L4Nat.agda ├── L4NatCrib.agda ├── L4Orn.agda ├── L4OrnCrib.agda ├── L4Vec.agda ├── L4VecCrib.agda ├── Lambda.lagda ├── Lec1.agda ├── Lec2.agda ├── Lec3.agda ├── Lec4.agda ├── Lec5.agda ├── Makefile ├── README.md ├── VecFin.lagda ├── View.lagda ├── dtp.bib ├── dtp.lagda ├── dtp.pdf └── index.html /Generic.lagda: -------------------------------------------------------------------------------- 1 | %if False 2 | 3 | \begin{code} 4 | 5 | module Generic where 6 | open import VecFin 7 | open import Lambda 8 | open import View 9 | 10 | \end{code} 11 | 12 | %endif 13 | 14 | \chapter{Generic Programming} 15 | 16 | A \emph{universe} is a collection of types, given as the image of a 17 | function. A simple example is the universe 18 | %format TT = "\F{TT}" 19 | %format Zero = "\D{Zero}" 20 | \begin{code} 21 | data Zero : Set where -- no constructors! 22 | 23 | TT : Two -> Set 24 | TT tt = One 25 | TT ff = Zero 26 | \end{code} 27 | 28 | |TT| gives you a universe of sets corresponding to \emph{decidable} 29 | propositions. You can use |TT| to attach decidable preconditions to 30 | functions. The standard example is this 31 | %format le = "\F{le}" 32 | %format -N = "\F{ -_{N}}" 33 | %format _-N_ = "\_\!" -N "\!\_" 34 | %format exampleSubtraction = "\F{exampleSubtraction}" 35 | %format exampleNonSubtraction = "\F{exampleNonSubtraction}" 36 | \begin{code} 37 | le : Nat -> Nat -> Two 38 | le zero n = tt 39 | le (suc m) zero = ff 40 | le (suc m) (suc n) = le m n 41 | 42 | _-N_ : (m n : Nat){p : TT (le n m)} -> Nat 43 | (m -N zero) = m 44 | (zero -N suc _) {()} 45 | (suc m -N suc n) {p} = (m -N n) {p} 46 | 47 | exampleSubtraction : Nat 48 | exampleSubtraction = 42 -N 37 49 | 50 | {-exampleNonSubtraction : Nat 51 | exampleNonSubtraction = 37 -N 42-} 52 | \end{code} 53 | 54 | 55 | \subsection{Polynomials} 56 | 57 | The basic building blocks of ordinary first-order datatypes are 58 | \emph{polynomials}, describing how structures are built over elements 59 | by choice and pairing. 60 | 61 | \begin{code} 62 | data Poly : Set where 63 | I : Poly -- the identity 64 | Zero' One' : Poly -- constants 65 | _+'_ _*'_ : (P Q : Poly) -> Poly -- choice and pairing 66 | \end{code} 67 | 68 | \begin{code} 69 | <_>P : Poly -> Set -> Set 70 | < I >P X = X 71 | < Zero' >P X = Zero 72 | < One' >P X = One 73 | < P +' Q >P X = < P >P X + < Q >P X 74 | < P *' Q >P X = < P >P X * < Q >P X 75 | \end{code} 76 | 77 | \begin{code} 78 | <_>p : (P : Poly) -> {X Y : Set} -> (X -> Y) -> < P >P X -> < P >P Y 79 | < P >p f x = ? 80 | \end{code} -------------------------------------------------------------------------------- /L4AlgOrn.agda: -------------------------------------------------------------------------------- 1 | module L4AlgOrn where 2 | 3 | open import L4OrnCrib public 4 | 5 | {- Every algebra induces an ALGEBRAIC ORNAMENT -} 6 | 7 | {- Conor, is there a picture? -} 8 | 9 | algOrn : forall {I J}(D : Desc I) -> ([ D ] J :-> J) -> Orn (Sg I J) fst D 10 | algOrn D phi = {!!} 11 | 12 | 13 | {- Conor, you had better do some examples. First check out L4Le.agda -} 14 | 15 | {- Conor, you'll need to say something about induction (L4Desc.agda) before 16 | introducing this bit. -} 17 | 18 | {- 19 | remember : forall {I J}{D : Desc I}(phi : [ D ] J :-> J) -> 20 | {i : I} -> 21 | (d : Data D i) -> -- plain data 22 | Data (ornD (algOrn D phi)) (i , fold phi d) -- becomes fancy 23 | 24 | remember {I}{J}{D} phi = 25 | induction D (\ {i} d -> Data (ornD (algOrn D phi)) (i , fold phi d)) 26 | \ d hs -> < help D phi d hs > where 27 | help : (E : Desc I)(psi : [ E ] J :-> J) 28 | {i : I} 29 | (e : [ E ] (Data D) i) -> 30 | All E (\ {i} d -> Data (ornD (algOrn D phi)) (i , fold phi d)) e -> 31 | [ ornD (algOrn E psi) ] 32 | (Data (ornD (algOrn D phi))) (i , psi (mapFold D E phi e)) 33 | help (say i) psi refl hs = refl 34 | help (sg S E) psi (s , e) hs = s , help (E s) (psi o _,_ s) e hs 35 | help (ask i * E) psi (d , e) (h , hs) = let j = fold phi d in 36 | j , h , help E (psi o _,_ j) e hs 37 | -} 38 | 39 | {- We've seen another algebra... -} 40 | 41 | {- Conor, it's time for Vec.agda. -} 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | {- 56 | 57 | 58 | AOOAThm : {I : Set}(D : Desc I){J : I -> Set}(phi : [ D ] J :-> J) -> 59 | let Dphi = algOrn D phi in 60 | {ij : Sg I J}(x : Data (ornD Dphi) ij) -> 61 | fold phi (fold (ornAlg Dphi) x) 62 | == snd ij 63 | 64 | AOOAThm {I} D {J} phi = 65 | induction oDphi 66 | (\ {ij} x -> fold phi (fold (ornAlg Dphi) x) == snd ij) 67 | (help D phi) where 68 | Dphi = algOrn D phi 69 | oDphi = ornD Dphi 70 | help : (E : Desc I)(psi : [ E ] J :-> J) 71 | {ij : Sg I J} 72 | (e : [ ornD (algOrn E psi) ] (Data oDphi) ij) -> 73 | All (ornD (algOrn E psi)) 74 | (\ {ij} x -> fold phi (fold (ornAlg Dphi) x) == snd ij) 75 | e -> psi 76 | (mapFold D E phi 77 | (ornAlgHelp (algOrn E psi) 78 | (mapFold oDphi (ornD (algOrn E psi)) 79 | (ornAlg Dphi) e))) 80 | == snd ij 81 | help (say i) psi refl hs = refl 82 | help (sg S E) psi (s , e) hs = help (E s) (psi o _,_ s) e hs 83 | help (ask i * E) psi (j , x , e) (h , hs) 84 | with fold phi (fold (ornAlg (algOrn D phi)) x) 85 | help (ask i * E) psi (j , x , e) (refl , hs) | .j = 86 | help E (psi o _,_ j) e hs 87 | 88 | -} 89 | 90 | {- Conor, it's time for the finale! Go to L4Hutton.agda -} 91 | -------------------------------------------------------------------------------- /L4AlgOrnCrib.agda: -------------------------------------------------------------------------------- 1 | module L4AlgOrnCrib where 2 | 3 | open import L4OrnCrib public 4 | 5 | {- Every algebra induces an ALGEBRAIC ORNAMENT -} 6 | 7 | {- Conor, is there a picture? -} 8 | 9 | algOrn : forall {I J}(D : Desc I) -> ([ D ] J :-> J) -> Orn (Sg I J) fst D 10 | algOrn (say i) phi = say (ok (i , phi refl)) 11 | algOrn (sg S D) phi = sg S \ s -> algOrn (D s) (phi o _,_ s) 12 | algOrn {J = J} (ask i * D) phi = 13 | insert (J i) \ j -> ask (ok (i , j)) * algOrn D (phi o _,_ j) 14 | 15 | {- Conor, you had better do some examples. First check out L4Le.agda -} 16 | 17 | {- Conor, you'll need to say something about induction (L4Desc.agda) before 18 | introducing this bit. -} 19 | 20 | remember : forall {I J}{D : Desc I}(phi : [ D ] J :-> J) -> 21 | {i : I} -> 22 | (d : Data D i) -> -- plain data 23 | Data (ornD (algOrn D phi)) (i , fold phi d) -- becomes fancy 24 | 25 | remember {I}{J}{D} phi = 26 | induction D (\ {i} d -> Data (ornD (algOrn D phi)) (i , fold phi d)) 27 | \ d hs -> < help D phi d hs > where 28 | help : (E : Desc I)(psi : [ E ] J :-> J) 29 | {i : I} 30 | (e : [ E ] (Data D) i) -> 31 | All E (\ {i} d -> Data (ornD (algOrn D phi)) (i , fold phi d)) e -> 32 | [ ornD (algOrn E psi) ] 33 | (Data (ornD (algOrn D phi))) (i , psi (mapFold D E phi e)) 34 | help (say i) psi refl hs = refl 35 | help (sg S E) psi (s , e) hs = s , help (E s) (psi o _,_ s) e hs 36 | help (ask i * E) psi (d , e) (h , hs) = let j = fold phi d in 37 | j , h , help E (psi o _,_ j) e hs 38 | 39 | 40 | {- We've seen another algebra... -} 41 | 42 | {- Conor, it's time for Vec.agda. -} 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | AOOAThm : {I : Set}(D : Desc I){J : I -> Set}(phi : [ D ] J :-> J) -> 60 | let Dphi = algOrn D phi in 61 | {ij : Sg I J}(x : Data (ornD Dphi) ij) -> 62 | fold phi (fold (ornAlg Dphi) x) 63 | == snd ij 64 | AOOAThm {I} D {J} phi = 65 | induction oDphi 66 | (\ {ij} x -> fold phi (fold (ornAlg Dphi) x) == snd ij) 67 | (help D phi) where 68 | Dphi = algOrn D phi 69 | oDphi = ornD Dphi 70 | help : (E : Desc I)(psi : [ E ] J :-> J) 71 | {ij : Sg I J} 72 | (e : [ ornD (algOrn E psi) ] (Data oDphi) ij) -> 73 | All (ornD (algOrn E psi)) 74 | (\ {ij} x -> fold phi (fold (ornAlg Dphi) x) == snd ij) 75 | e -> psi 76 | (mapFold D E phi 77 | (ornAlgHelp (algOrn E psi) 78 | (mapFold oDphi (ornD (algOrn E psi)) 79 | (ornAlg Dphi) e))) 80 | == snd ij 81 | help (say i) psi refl hs = refl 82 | help (sg S E) psi (s , e) hs = help (E s) (psi o _,_ s) e hs 83 | help (ask i * E) psi (j , x , e) (h , hs) 84 | with fold phi (fold (ornAlg (algOrn D phi)) x) 85 | help (ask i * E) psi (j , x , e) (refl , hs) | .j = 86 | help E (psi o _,_ j) e hs 87 | -------------------------------------------------------------------------------- /L4Basics.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --universe-polymorphism #-} 2 | 3 | {- Agda (from darcs only?) has an experimental implementation of 4 | universe polymorphism, allowing us to reuse equipment at all levels 5 | of the predicative hierarchy. Today, we shall be operating on 6 | structures which contain Sets. -} 7 | 8 | module L4Basics where 9 | 10 | {- This is the incantation which makes uni-poly happen. -} 11 | 12 | data Level : Set where 13 | zl : Level 14 | sl : Level -> Level 15 | 16 | {-# BUILTIN LEVEL Level #-} 17 | {-# BUILTIN LEVELZERO zl #-} 18 | {-# BUILTIN LEVELSUC sl #-} 19 | 20 | 21 | {- This is dependent composition. Look at the function before worrying 22 | about the type. The type is exactly the thing that's as dependent 23 | and polymorphic as possible. -} 24 | 25 | _o_ : ∀ {a b c} 26 | {A : Set a} {B : A → Set b} {C : {x : A} → B x → Set c} → 27 | (∀ {x} (y : B x) → C y) → (g : (x : A) → B x) → 28 | ((x : A) → C (g x)) 29 | f o g = \ x → f (g x) 30 | infixl 50 _o_ 31 | 32 | {- Identity is reassuringly normal -} 33 | 34 | id : forall {a} {A : Set a} → A → A 35 | id x = x 36 | 37 | {- The K combinator is also as standard... -} 38 | 39 | k : forall {a b} {A : Set a} {B : Set b} → A → B → A 40 | k x = \ _ → x 41 | 42 | {- ... but wait till you see S in lecture 5. -} 43 | 44 | {- A handful of elementary datatypes. -} 45 | 46 | data Zero : Set where 47 | record One : Set where 48 | constructor <> 49 | 50 | record Sg (S : Set)(T : S -> Set) : Set where 51 | constructor _,_ 52 | field 53 | fst : S 54 | snd : T fst 55 | open Sg public 56 | infixr 40 _,_ 57 | 58 | {- This is "split" or "spread". It's handy for higher 59 | order programming. If I'm asked for a function from 60 | a tuple, this lets me take it apart. -} 61 | 62 | spl : forall {a S T} -> {P : Sg S T -> Set a} -> 63 | ((s : S)(t : T s) -> P (s , t)) -> 64 | (st : Sg S T) -> P st 65 | spl p (s , t) = p s t 66 | 67 | _*_ : Set -> Set -> Set 68 | S * T = Sg S \ _ -> T 69 | 70 | {- Show a bit of splitting, eh? -} 71 | 72 | {- Homogeneous equality, in traditional form. -} 73 | 74 | data _==_ {X : Set}(x : X) : X -> Set where 75 | refl : x == x 76 | 77 | {- Conor, if you've forgotten already, the next file is L4Desc.agda -} -------------------------------------------------------------------------------- /L4Desc.agda: -------------------------------------------------------------------------------- 1 | module L4Desc where 2 | 3 | open import L4Basics public 4 | 5 | {- Descriptions of indexed datatypes. -} 6 | 7 | data Desc (I : Set) : Set1 where 8 | say : (j : I) -> Desc I 9 | sg : (S : Set)(D : S -> Desc I) -> Desc I 10 | ask_*_ : (i : I) -> (D : Desc I) -> Desc I 11 | 12 | _:->_ : {I : Set} -> (I -> Set) -> (I -> Set) -> Set 13 | X :-> Y = {i : _} -> X i -> Y i 14 | infix 40 _:->_ 15 | 16 | {- Each Desc I represents an endofunctor on I -> Set. Let's see that. -} 17 | 18 | [_] : forall {I} -> Desc I -> (I -> Set) -> (I -> Set) 19 | [_] (say j) X i = j == i 20 | [_] (sg S D) X i = Sg S \ s -> [ D s ] X i 21 | [_] (ask i * D) X i' = X i * [ D ] X i' 22 | 23 | map : forall {I X Y}(D : Desc I) -> (X :-> Y) -> [ D ] X :-> [ D ] Y 24 | map (say i) f q = q 25 | map (sg S D) f (s , xs) = s , map (D s) f xs 26 | map (ask i * D) f (x , xs) = f x , map D f xs 27 | 28 | 29 | {- Now let's tie the knot. -} 30 | 31 | data Data {I : Set}(D : Desc I)(i : I) : Set where 32 | <_> : [ D ] (Data D) i -> Data D i 33 | 34 | {- It's an inductive type (initial algebra), so we get an iterator 35 | in the classic style (?). -} 36 | 37 | {- 38 | fold : forall {I X}{D : Desc I} -> ([ D ] X :-> X) -> Data D :-> X 39 | fold {D = D} phi < ds > = phi (map D (fold phi) ds) 40 | -} 41 | 42 | {- Bugger. We can beat this into the termination checker by specializing 43 | map to map-with-fold. -} 44 | 45 | mutual 46 | fold : forall {I X}{D : Desc I} -> ([ D ] X :-> X) -> Data D :-> X 47 | fold {D = D} phi < ds > = phi (mapFold D D phi ds) 48 | 49 | mapFold : forall {I X}(D' D : Desc I) -> ([ D' ] X :-> X) -> 50 | [ D ] (Data D') :-> [ D ] X 51 | mapFold D' (say i) phi q = q 52 | mapFold D' (sg S D) phi (s , xs) = s , mapFold D' (D s) phi xs 53 | mapFold D' (ask i * D) phi (x , xs) = fold phi x , mapFold D' D phi xs 54 | 55 | 56 | {- Conor, don't do the next bit now. It's far too abstract. What you really 57 | needed five minutes ago was an example. Go to L4Nat.agda for a bit. -} 58 | 59 | {- ----------------------------------------------------------------------- -} 60 | 61 | {- Conor, you should have jumped here from L4AlgOrn.agda -} 62 | 63 | {- But we shouldn't only have an iterator. Inductive datatypes should have 64 | induction principles. Let's calculate them. -} 65 | 66 | {- Step 1. A predicate transformer. If I have a structure full of X's, 67 | how do I lift a property P of X's to the property of structures that 68 | says "P holds for all the X's in here". (Hint X is going to be Data D, 69 | and this is going to *state* the inductive hypotheses.) -} 70 | 71 | All : {I : Set}(D : Desc I){X : I -> Set}(P : {i : I} -> X i -> Set) 72 | {i : I} -> [ D ] X i -> Set 73 | All (say i) P x = One -- no x in here 74 | All (sg S D) P (s , xs) = All (D s) P xs -- s ain't no x 75 | All (ask i * D) P (x , xs) = P x * All D P xs -- business, at last! 76 | 77 | everywhere : {I : Set}(D : Desc I){X : I -> Set} 78 | (P : {i : I} -> X i -> Set) -> 79 | ({i : I}(x : X i) -> P x) -> -- if P holds for all x 80 | {i : I}(d : [ D ] X i) -> All D P d -- then P holds everywhere 81 | everywhere (say i) P p xs = _ 82 | everywhere (sg S D) P p (s , xs) = everywhere (D s) P p xs 83 | everywhere (ask i * D) P p (x , xs) = p x , everywhere D P p xs 84 | 85 | induction : {I : Set}(D : Desc I)(P : {i : I} -> Data D i -> Set) -> 86 | ({i : I} 87 | (d : [ D ] (Data D) i) -> -- a bunch of kids 88 | All D P d -> -- their inductive hypotheses 89 | P < d >) -> -- conclude P for parent 90 | {i : I}(x : Data D i) -> P x 91 | induction D P p < d > = p d (everywhere D P (induction D P p) d) 92 | 93 | 94 | {- Same problem, same fix. -} 95 | {- 96 | mutual 97 | induction : {I : Set}(D : Desc I)(P : {i : I} -> Data D i -> Set) -> 98 | ({i : I}(d : [ D ] (Data D) i) -> All D P d -> P < d >) -> 99 | {i : I}(x : Data D i) -> P x 100 | induction D P p < d > = p d (everywhereInduction D D P p d) 101 | everywhereInduction : 102 | {I : Set}(D' D : Desc I) 103 | (P : {i : I} -> Data D' i -> Set) -> 104 | ({i : I}(d : [ D' ] (Data D') i) -> All D' P d -> P < d >) -> 105 | {i : I}(d : [ D ] (Data D') i) -> All D P d 106 | everywhereInduction D' (say i) P p xs = _ 107 | everywhereInduction D' (sg S D) P p (s , xs) = 108 | everywhereInduction D' (D s) P p xs 109 | everywhereInduction D' (ask i * D) P p (x , xs) = 110 | induction D' P p x , everywhereInduction D' D P p xs 111 | -} 112 | 113 | {- Conor, now go back to L4AlgOrn.agda -} -------------------------------------------------------------------------------- /L4DescCrib.agda: -------------------------------------------------------------------------------- 1 | module L4DescCrib where 2 | 3 | open import L4Basics public 4 | 5 | data Desc (I : Set) : Set1 where 6 | say : (i : I) -> Desc I 7 | sg : (S : Set)(D : S -> Desc I) -> Desc I 8 | ask_*_ : (j : I) -> (D : Desc I) -> Desc I 9 | 10 | _:->_ : {I : Set} -> (I -> Set) -> (I -> Set) -> Set 11 | X :-> Y = {i : _} -> X i -> Y i 12 | infix 40 _:->_ 13 | 14 | [_] : forall {I} -> Desc I -> (I -> Set) -> (I -> Set) 15 | [ say i' ] X i = i' == i 16 | [ sg S D ] X i = Sg S \ s -> [ D s ] X i 17 | [ ask i' * D ] X i = X i' * [ D ] X i 18 | 19 | map : forall {I X Y}(D : Desc I) -> (X :-> Y) -> [ D ] X :-> [ D ] Y 20 | map (say i) f q = q 21 | map (sg S D) f (s , xs) = s , map (D s) f xs 22 | map (ask i * D) f (x , xs) = f x , map D f xs 23 | 24 | data Data {I : Set}(D : Desc I)(i : I) : Set where 25 | <_> : [ D ] (Data D) i -> Data D i 26 | 27 | {- 28 | fold : forall {I X}{D : Desc I} -> ([ D ] X :-> X) -> Data D :-> X 29 | fold {D = D} phi < ds > = phi (map D (fold phi) ds) 30 | -} 31 | 32 | mutual 33 | fold : forall {I X}{D : Desc I} -> ([ D ] X :-> X) -> Data D :-> X 34 | fold {D = D} phi < ds > = phi (mapFold D D phi ds) 35 | 36 | mapFold : forall {I X}(D' D : Desc I) -> ([ D' ] X :-> X) -> 37 | [ D ] (Data D') :-> [ D ] X 38 | mapFold D' (say i) phi q = q 39 | mapFold D' (sg S D) phi (s , xs) = s , mapFold D' (D s) phi xs 40 | mapFold D' (ask i * D) phi (x , xs) = fold phi x , mapFold D' D phi xs 41 | 42 | 43 | All : {I : Set}(D : Desc I){R : I -> Set}(P : {i : I} -> R i -> Set) 44 | {i : I} -> [ D ] R i -> Set 45 | All (say i) P x = One 46 | All (sg S D) P (s , d) = All (D s) P d 47 | All (ask i * D) P (x , d) = P x * All D P d 48 | 49 | {- 50 | everywhere : {I : Set}(D : Desc I){R : I -> Set} 51 | (P : {i : I} -> R i -> Set) -> 52 | ({i : I}(x : R i) -> P x) -> 53 | {i : I}(d : [ D ] R i) -> All D P d 54 | everywhere (say i) P p d = _ 55 | everywhere (sg S D) P p (s , d) = everywhere (D s) P p d 56 | everywhere (ask i * D) P p (x , d) = p x , everywhere D P p d 57 | 58 | induction : {I : Set}(D : Desc I)(P : {i : I} -> Data D i -> Set) -> 59 | ({i : I}(d : [ D ] (Data D) i) -> All D P d -> P < d >) -> 60 | {i : I}(x : Data D i) -> P x 61 | induction D P p < d > = p d (everywhere D P (induction D P p) d) 62 | -} 63 | 64 | mutual 65 | induction : {I : Set}(D : Desc I)(P : {i : I} -> Data D i -> Set) -> 66 | ({i : I}(d : [ D ] (Data D) i) -> All D P d -> P < d >) -> 67 | {i : I}(x : Data D i) -> P x 68 | induction D P p < d > = p d (everywhereInduction D D P p d) 69 | everywhereInduction : 70 | {I : Set}(D' D : Desc I) 71 | (P : {i : I} -> Data D' i -> Set) -> 72 | ({i : I}(d : [ D' ] (Data D') i) -> All D' P d -> P < d >) -> 73 | {i : I}(d : [ D ] (Data D') i) -> All D P d 74 | everywhereInduction D' (say i) P p d = _ 75 | everywhereInduction D' (sg S D) P p (s , d) = 76 | everywhereInduction D' (D s) P p d 77 | everywhereInduction D' (ask i * D) P p (x , d) = 78 | induction D' P p x , everywhereInduction D' D P p d 79 | -------------------------------------------------------------------------------- /L4Hutton.agda: -------------------------------------------------------------------------------- 1 | module L4Hutton where 2 | 3 | open import L4VecCrib 4 | open import L4AlgOrnCrib 5 | 6 | {- Here's Hutton's Razor, described. -} 7 | 8 | data HCon : Set where 9 | val : HCon 10 | add : HCon 11 | 12 | HExp : Desc One 13 | HExp = sg HCon args where 14 | args : HCon -> Desc One 15 | args val = sg Nat \ _ -> say <> 16 | args add = ask <> * ask <> * say <> 17 | 18 | {- The evaluator is a fold. -} 19 | 20 | hEval : Data HExp _ -> Nat 21 | hEval = fold evAlg where 22 | evAlg : [ HExp ] (k Nat) :-> k Nat 23 | evAlg ( val , n , refl ) = n 24 | evAlg ( add , a , b , refl ) = a + b 25 | 26 | {- Here is the Hutton stack code we had on Wednesday, described. -} 27 | 28 | data HOp : Set where 29 | PUSH : HOp 30 | SEQ : HOp 31 | ADD : HOp 32 | 33 | HCode : Desc (Nat * Nat) 34 | HCode = sg HOp args where 35 | args : HOp -> Desc (Nat * Nat) 36 | args PUSH = sg Nat \ _ -> sg Nat \ i -> say (i , su i) 37 | args SEQ = sg Nat \ k -> sg Nat \ l -> sg Nat \ m -> 38 | ask (k , l) * ask (l , m) * say (k , m) 39 | args ADD = sg Nat \ i -> say (su (su i) , su i) 40 | 41 | {- The corresponding semantic objects are functions from input 42 | stacks to output stacks. -} 43 | 44 | HSem : Nat * Nat -> Set 45 | HSem ij = Vec (fst ij) Nat -> Vec (snd ij) Nat 46 | 47 | {- Build the algebra which allows us to write the runtime as a fold. -} 48 | 49 | HAlg : [ HCode ] HSem :-> HSem 50 | HAlg codenode ns = {!!} 51 | 52 | hrun : Data HCode :-> HSem 53 | hrun = fold HAlg 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | {- Now... 78 | Invent fancy stack code, indexed by its meaning! -} 79 | 80 | HCodeSem : Desc (Sg (Nat * Nat) HSem) -- initial & final height, behaviour! 81 | HCodeSem = ornD (algOrn HCode HAlg) 82 | 83 | {- Write a compiler whose type guarantees the behaviour "push the value" -} 84 | 85 | hCompileSem : (e : Data HExp _) -> 86 | {i : Nat} -> Data HCodeSem ((i , su i) , _::_ (hEval e)) 87 | 88 | hCompileSem = induction HExp 89 | (\e -> {i : Nat} -> Data HCodeSem ((i , su i) , _::_ (hEval e))) 90 | help where 91 | help : (d : [ HExp ] (Data HExp) _) -> 92 | All HExp (\ e -> 93 | {i : Nat} -> Data HCodeSem ((i , su i) , _::_ (hEval e))) d -> 94 | {i : Nat} -> Data HCodeSem ((i , su i) , _::_ (hEval < d >)) 95 | help exp = {!!} 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | {- 114 | {- The actual compiler produces plain code by rubbing out the semantic 115 | information. -} 116 | 117 | hCompile : Data HExp _ -> {i : Nat} -> Data HCode (i , su i) 118 | hCompile e = fold (ornAlg (algOrn HCode HAlg)) (hCompileSem e) 119 | 120 | {- And it's correct for free. -} 121 | 122 | hTheorem : (e : Data HExp _){i : Nat} -> 123 | hrun (hCompile e {i}) == _::_ (hEval e) 124 | hTheorem e = AOOAThm HCode HAlg (hCompileSem e) 125 | -} -------------------------------------------------------------------------------- /L4HuttonCrib.agda: -------------------------------------------------------------------------------- 1 | module L4HuttonCrib where 2 | 3 | open import L4VecCrib 4 | open import L4AlgOrnCrib 5 | 6 | {- Here's Hutton's Razor, described. -} 7 | 8 | data HCon : Set where 9 | val : HCon 10 | add : HCon 11 | 12 | HExp : Desc One 13 | HExp = sg HCon args where 14 | args : HCon -> Desc One 15 | args val = sg Nat \ _ -> say <> 16 | args add = ask <> * ask <> * say <> 17 | 18 | {- The evaluator is a fold. -} 19 | 20 | hEval : Data HExp _ -> Nat 21 | hEval = fold evAlg where 22 | evAlg : [ HExp ] (k Nat) :-> k Nat 23 | evAlg ( val , n , refl ) = n 24 | evAlg ( add , a , b , refl ) = a + b 25 | 26 | {- Here is the Hutton stack code we had on Wednesday, described. -} 27 | 28 | data HOp : Set where 29 | PUSH : HOp 30 | SEQ : HOp 31 | ADD : HOp 32 | 33 | HCode : Desc (Nat * Nat) 34 | HCode = sg HOp args where 35 | args : HOp -> Desc (Nat * Nat) 36 | args PUSH = sg Nat \ _ -> sg Nat \ i -> say (i , su i) 37 | args SEQ = sg Nat \ k -> sg Nat \ l -> sg Nat \ m -> 38 | ask (k , l) * ask (l , m) * say (k , m) 39 | args ADD = sg Nat \ i -> say (su (su i) , su i) 40 | 41 | {- The corresponding semantic objects are functions from input 42 | stacks to output stacks. -} 43 | 44 | HSem : Nat * Nat -> Set 45 | HSem ij = Vec (fst ij) Nat -> Vec (snd ij) Nat 46 | 47 | {- Build the algebra which allows us to write the runtime as a fold. -} 48 | 49 | HAlg : [ HCode ] HSem :-> HSem 50 | HAlg (PUSH , n , i , refl) ns = n :: ns 51 | HAlg (SEQ , k , l , m , f , g , refl) ns = g (f ns) 52 | HAlg (ADD , i , refl) 53 | < step , x , .(su i) , < step , y , .i , stk , refl > , refl > 54 | = (y + x) :: stk 55 | HAlg (ADD , i , refl) < step , _ , ._ , < base , () > , refl > 56 | HAlg (ADD , i , refl) < base , () > 57 | 58 | hrun : Data HCode :-> HSem 59 | hrun = fold HAlg 60 | 61 | {- Now... 62 | Invent fancy stack code, indexed by its meaning! -} 63 | 64 | HCodeSem : Desc (Sg (Nat * Nat) HSem) -- initial & final height, behaviour! 65 | HCodeSem = ornD (algOrn HCode HAlg) 66 | 67 | {- Write a compiler whose type guarantees the behaviour "push the value" -} 68 | 69 | hCompileSem : (e : Data HExp _) -> 70 | {i : Nat} -> Data HCodeSem ((i , su i) , _::_ (hEval e)) 71 | 72 | hCompileSem = induction HExp 73 | (\e -> {i : Nat} -> Data HCodeSem ((i , su i) , _::_ (hEval e))) 74 | help where 75 | help : (d : [ HExp ] (Data HExp) _) -> 76 | All HExp (\ e -> 77 | {i : Nat} -> Data HCodeSem ((i , su i) , _::_ (hEval e))) d -> 78 | {i : Nat} -> Data HCodeSem ((i , su i) , _::_ (hEval < d >)) 79 | help ( val , n , refl ) H = < PUSH , n , _ , refl > 80 | help ( add , a , b , refl ) ( ca , cb , _ ) 81 | = < SEQ , _ , _ , _ , _ , ca , _ , 82 | < SEQ , _ , _ , _ , _ , cb , _ , 83 | < ADD , _ , refl > 84 | , refl > 85 | , refl > 86 | 87 | {- The actual compiler produces plain code by rubbing out the semantic 88 | information. -} 89 | 90 | hCompile : Data HExp _ -> {i : Nat} -> Data HCode (i , su i) 91 | hCompile e = fold (ornAlg (algOrn HCode HAlg)) (hCompileSem e) 92 | 93 | {- And it's correct for free. -} 94 | 95 | hTheorem : (e : Data HExp _){i : Nat} -> 96 | hrun (hCompile e {i}) == _::_ (hEval e) 97 | hTheorem e = AOOAThm HCode HAlg (hCompileSem e) 98 | -------------------------------------------------------------------------------- /L4Le.agda: -------------------------------------------------------------------------------- 1 | module L4Le where 2 | 3 | open import L4NatCrib 4 | open import L4AlgOrnCrib 5 | 6 | LeD : Nat -> Desc (One * Nat) 7 | LeD n = ornD (algOrn NatD (adda n)) 8 | 9 | Le : Nat -> Nat -> Set 10 | Le x y = Data (LeD x) (_ , y) 11 | 12 | leq : {y : Nat} -> Le y y 13 | leq {y} = < base , refl > 14 | 15 | les : {x y : Nat} -> Le x y -> Le x (su y) 16 | les p = < step , _ , p , refl > 17 | 18 | trans : forall {x y z} -> Le x y -> Le y z -> Le x z 19 | trans p < base , refl > = p 20 | trans p < step , _ , q , refl > = < step , _ , trans p q , refl > 21 | 22 | -------------------------------------------------------------------------------- /L4List.agda: -------------------------------------------------------------------------------- 1 | module L4List where 2 | 3 | open import L4NatCrib public 4 | open import L4OrnCrib 5 | 6 | {- Let's see how to build lists from natural numbers by 7 | inserting a label in the step case. -} 8 | 9 | ListO : Set -> Orn One _ NatD 10 | ListO X = {!!} 11 | 12 | {- Conor, before you go any further, you'll need to go 13 | back to L4Orn.agda -} 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | {- 22 | {- Get the description by interpreting the ornament. -} 23 | 24 | ListD : Set -> Desc One 25 | ListD A = ornD (ListO A) 26 | 27 | {- Define the List types. -} 28 | 29 | List : Set -> Set 30 | List X = Data (ListD X) <> 31 | 32 | {- Check that you really get the constructors. -} 33 | 34 | [l] : forall {A} -> List A 35 | [l] = {!!} 36 | _:l:_ : forall {A} -> A -> List A -> List A 37 | a :l: x = {!!} 38 | 39 | {- define append as a fold -} 40 | 41 | _+l+_ : forall {A} -> List A -> List A -> List A 42 | xs +l+ ys = fold {X = k (List _)} {!!} xs 43 | 44 | {- Conor, the last example is after a lot of space lines, because you 45 | need to go and seal the deal in L4Orn.agda -} 46 | -} 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | {- 81 | length : forall {A} -> List A -> Nat 82 | length {A} = forget (ListO A) 83 | -} 84 | 85 | {- But that's not all, folks. We're free to invent ornaments, but we can 86 | also COMPUTE them! Let's truck on over to L4AlgOrn.agda -} -------------------------------------------------------------------------------- /L4ListCrib.agda: -------------------------------------------------------------------------------- 1 | module L4ListCrib where 2 | 3 | open import L4NatCrib public 4 | open import L4OrnCrib 5 | 6 | {- Let's see how to build lists from natural numbers by 7 | inserting a label in the step case. -} 8 | 9 | ListO : Set -> Orn One _ NatD 10 | ListO X = sg Tag ( 11 | base-> say (ok <>) 12 | step-> insert X \ _ -> ask (ok <>) * say (ok <>) ) 13 | 14 | {- Conor, before you go any further, you'll need to go 15 | back to L4Orn.agda -} 16 | 17 | {- Get the description by interpreting the ornament. -} 18 | 19 | ListD : Set -> Desc One 20 | ListD A = ornD (ListO A) 21 | 22 | {- Define the List types. -} 23 | 24 | List : Set -> Set 25 | List X = Data (ListD X) _ 26 | 27 | {- Check that you really get the constructors. -} 28 | 29 | [l] : forall {A} -> List A 30 | [l] = < base , refl > 31 | _:l:_ : forall {A} -> A -> List A -> List A 32 | a :l: x = < step , a , x , refl > 33 | 34 | {- define append as a fold -} 35 | 36 | _+l+_ : forall {A} -> List A -> List A -> List A 37 | xs +l+ ys = fold {X = k (List _)} 38 | (spl (base-> (\ _ -> ys) 39 | step-> (spl \ x -> spl \ zs _ -> x :l: zs))) xs 40 | 41 | {- Conor, the last example is after a lot of space lines, because you 42 | need to go and seal the deal in L4Orn.agda -} 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | length : forall {A} -> List A -> Nat 79 | length {A} = forget (ListO A) 80 | -------------------------------------------------------------------------------- /L4Nat.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --universe-polymorphism #-} 2 | 3 | module L4Nat where 4 | 5 | open import L4DescCrib -- ok, I'm trying to keep it robust. 6 | 7 | {- I need a two element type to tag base or step cases. -} 8 | 9 | data Tag : Set where 10 | base step : Tag 11 | 12 | {- Mixfix madness! I've written a combinator for dependent 13 | case analysis on Tag, so I can write readable descriptions. -} 14 | 15 | base->_step->_ : forall {a}{P : Tag -> Set a} -> 16 | P base -> P step -> (c : Tag) -> P c 17 | base->_step->_ pb ps base = pb 18 | base->_step->_ pb ps step = ps 19 | 20 | {- Now let's describe the natural numbers. -} 21 | 22 | 23 | NatD : Desc One 24 | NatD = sg Tag (base-> say <> 25 | step-> (ask <> * say <>)) 26 | 27 | {- We've got the description, so let's get the type. -} 28 | 29 | Nat : Set 30 | Nat = Data NatD <> 31 | 32 | {- We'd better rebuild the constructors. -} 33 | 34 | ze : Nat 35 | ze = < base , refl > 36 | 37 | su : Nat -> Nat 38 | su x = < step , x , refl > 39 | 40 | {- 41 | VECD : Set -> Desc Nat 42 | VECD X = sg Tag (base-> say ze 43 | step-> sg X \ _ -> sg Nat \ n -> ask n * say (su n)) 44 | 45 | vnil : {X : Set} -> Data (VECD X) ze 46 | vnil = < base , refl > 47 | 48 | vcons : {X : Set} -> X -> 49 | {n : Nat} -> Data (VECD X) n -> Data (VECD X) (su n) 50 | vcons x xs = < step , x , _ , xs , refl > 51 | -} 52 | {- Now let's build addition as a fold. What's the algebra? -} 53 | 54 | {- 55 | adda : Nat -> [ NatD ] (k Nat) :-> k Nat 56 | adda y xnode = {!!} 57 | 58 | {- Stick it in, turn it on. -} 59 | 60 | _+_ : Nat -> Nat -> Nat 61 | x + y = fold {X = k Nat} (adda y) x 62 | -} 63 | 64 | {- Conor, in case it's slipped your mind, the next file is L4Orn.agda -} 65 | -------------------------------------------------------------------------------- /L4NatCrib.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --universe-polymorphism #-} 2 | 3 | module L4NatCrib where 4 | 5 | open import L4DescCrib -- ok, I'm trying to keep it robust. 6 | 7 | {- I need a two element type to tag base or step cases. -} 8 | 9 | data Tag : Set where 10 | base step : Tag 11 | 12 | {- Mixfix madness! I've written a combinator for dependent 13 | case analysis on Tag, so I can write readable descriptions. -} 14 | 15 | base->_step->_ : forall {a}{P : Tag -> Set a} -> 16 | P base -> P step -> (c : Tag) -> P c 17 | base->_step->_ pb ps base = pb 18 | base->_step->_ pb ps step = ps 19 | 20 | {- Now let's describe the natural numbers. -} 21 | 22 | NatD : Desc One 23 | NatD = sg Tag ( 24 | base-> say <> 25 | step-> ask <> * say <> ) 26 | 27 | {- We've got the description, so let's get the type. -} 28 | 29 | Nat : Set 30 | Nat = Data NatD <> 31 | 32 | {- We'd better rebuild the constructors. -} 33 | 34 | ze : Nat 35 | ze = < base , refl > 36 | 37 | su : Nat -> Nat 38 | su x = < step , x , refl > 39 | 40 | {- Now let's build addition as a fold. What's the algebra? -} 41 | 42 | adda : Nat -> [ NatD ] (k Nat) :-> k Nat 43 | adda y (base , refl) = y 44 | adda y (step , z , refl) = su z 45 | 46 | {- Stick it in, turn it on. -} 47 | 48 | _+_ : Nat -> Nat -> Nat 49 | x + y = fold {X = k Nat} (adda y) x 50 | -------------------------------------------------------------------------------- /L4Orn.agda: -------------------------------------------------------------------------------- 1 | module L4Orn where 2 | 3 | open import L4DescCrib public 4 | 5 | {- The inverse image construction -} 6 | 7 | data _^-1_ {I J : Set}(f : J -> I) : I -> Set where 8 | ok : (j : J) -> f ^-1 (f j) 9 | 10 | {- ok j : f ^-1 i iff f j = i -} 11 | 12 | {- The type of acetate overlays! -} 13 | 14 | {- Here, J is the type of fancy indices 15 | I is the type of plain indices 16 | f : J -> I rubs out the fancy 17 | 18 | Remember, for Nat, I is One, so f is kind of predictable. 19 | -} 20 | 21 | data Orn {I}(J : Set)(f : J -> I) : Desc I -> Set1 where 22 | -- the first three mean "keep the existing format" 23 | -- but you still have to give a fancy j , good for each plain i 24 | say : {i : I}(j : f ^-1 i) -> 25 | Orn J f (say i) 26 | sg : (S : Set){D : S -> Desc I}(O : (s : S) -> Orn J f (D s)) -> 27 | Orn J f (sg S D) 28 | ask_*_ : {i : I}(j : f ^-1 i){D : Desc I}(O : Orn J f D) -> 29 | Orn J f (ask i * D) 30 | -- the last constructor says "insert a new field here, and depend on it" 31 | insert : (S : Set){D : Desc I}(O : S -> Orn J f D) -> 32 | Orn J f D 33 | 34 | {- Conor, don't dare go any further without giving an example. Look at 35 | L4List.agda -} 36 | 37 | {- We'd better make sure that ornamenting a plain description gives us 38 | a fancy description. That amounts to obeying the "insert" instructions. -} 39 | 40 | ornD : forall {I J f}{D : Desc I} -> Orn J f D -> Desc J 41 | ornD O = {!!} 42 | 43 | {- Conor, go to L4List.agda and check that we really get lists. -} 44 | 45 | {- Read the rest of the file backwards. -} 46 | {- 47 | {- Finally, all the worker function has to do is work through the 48 | ornament, deleting all the fields which got inserted. -} 49 | 50 | ornAlgHelp : forall {I J f}{D : Desc I}{R : I -> Set} -> (O : Orn J f D) -> 51 | [ ornD O ] (R o f) :-> [ D ] R o f 52 | ornAlgHelp O rs = {!!} 53 | 54 | {- So, the forgetful map is a fold, what's it's algebra? 55 | It's called the ORNAMENTAL ALGEBRA. 56 | It builds a plain node from a fancy node, then packs it with <_>. -} 57 | 58 | ornAlg : forall {I J f}{D : Desc I}(O : Orn J f D) -> 59 | [ ornD O ] (Data D o f) :-> Data D o f 60 | ornAlg D ds = < ornAlgHelp D ds > 61 | 62 | {- We want to be sure that we can rub out the extra bits, to get plain 63 | data back from fancy data. We should be sure that f is respected. -} 64 | 65 | forget : forall {I J f}{D : Desc I}(O : Orn J f D) -> 66 | (Data (ornD O)) :-> Data D o f 67 | -- forall {j} -> Data (ornD O) j -> Data D (f j) 68 | forget O = fold (ornAlg O) 69 | -} -------------------------------------------------------------------------------- /L4OrnCrib.agda: -------------------------------------------------------------------------------- 1 | module L4OrnCrib where 2 | 3 | open import L4DescCrib public 4 | 5 | {- The inverse image construction -} 6 | 7 | data _^-1_ {I J : Set}(f : J -> I) : I -> Set where 8 | ok : (j : J) -> f ^-1 (f j) 9 | 10 | {- ok j : f ^-1 i iff f j = i -} 11 | 12 | {- The type of acetate overlays! -} 13 | 14 | {- Here, J is the type of fancy indices 15 | I is the type of plain indices 16 | f : J -> I rubs out the fancy 17 | 18 | Remember, for Nat, I is One, so f is kind of predictable. 19 | -} 20 | 21 | data Orn {I}(J : Set)(f : J -> I) : Desc I -> Set1 where 22 | -- the first three mean "keep the existing format" 23 | -- but you still have to give a fancy j , good for each plain i 24 | say : {i : I}(j : f ^-1 i) -> 25 | Orn J f (say i) 26 | sg : (S : Set){D : S -> Desc I}(O : (s : S) -> Orn J f (D s)) -> 27 | Orn J f (sg S D) 28 | ask_*_ : {i : I}(j : f ^-1 i){D : Desc I}(O : Orn J f D) -> 29 | Orn J f (ask i * D) 30 | -- the last constructor says "insert a new field here, and depend on it" 31 | insert : (S : Set){D : Desc I}(O : S -> Orn J f D) -> 32 | Orn J f D 33 | 34 | {- Conor, don't dare go any further without giving an example. Look at 35 | L4List.agda -} 36 | 37 | {- We'd better make sure that ornamenting a plain description gives us 38 | a fancy description. That amounts to obeying the "insert" instructions. -} 39 | 40 | ornD : forall {I J f}{D : Desc I} -> Orn J f D -> Desc J 41 | ornD (say (ok j)) = say j 42 | ornD (sg S O) = sg S \ s -> ornD (O s) 43 | ornD (ask (ok j) * O) = ask j * ornD O 44 | ornD (insert S O) = sg S \ s -> ornD (O s) 45 | 46 | {- Conor, go to L4List.agda and check that we really get lists. -} 47 | 48 | {- Read the rest of the file backwards. -} 49 | 50 | {- Finally, all the worker function has to do is work through the 51 | ornament, deleting all the fields which got inserted. -} 52 | 53 | ornAlgHelp : forall {I J f}{D : Desc I}{R : I -> Set} -> (O : Orn J f D) -> 54 | [ ornD O ] (R o f) :-> [ D ] R o f 55 | ornAlgHelp (say (ok j)) refl = refl 56 | ornAlgHelp (sg S O) (s , rs) = s , ornAlgHelp (O s) rs 57 | ornAlgHelp (ask (ok j) * O) (r , rs) = r , ornAlgHelp O rs 58 | ornAlgHelp (insert S O) (s , rs) = ornAlgHelp (O s) rs 59 | 60 | {- So, the forgetful map is a fold, what's it's algebra? 61 | It's called the ORNAMENTAL ALGEBRA. 62 | It builds a plain node from a fancy node, then packs it with <_>. -} 63 | 64 | ornAlg : forall {I J f}{D : Desc I}(O : Orn J f D) -> 65 | [ ornD O ] (Data D o f) :-> Data D o f 66 | ornAlg D ds = < ornAlgHelp D ds > 67 | 68 | {- We want to be sure that we can rub out the extra bits, to get plain 69 | data back from fancy data. We should be sure that f is respected. -} 70 | 71 | forget : forall {I J f}{D : Desc I}(O : Orn J f D) -> 72 | (Data (ornD O)) :-> Data D o f 73 | -- forall {j} -> Data (ornD O) j -> Data D (f j) 74 | forget O = fold (ornAlg O) 75 | -------------------------------------------------------------------------------- /L4Vec.agda: -------------------------------------------------------------------------------- 1 | module L4Vec where 2 | 3 | open import L4ListCrib public 4 | open import L4AlgOrnCrib 5 | 6 | VecO : (X : Set) -> Orn (One * Nat) fst (ListD X) 7 | VecO X = algOrn (ListD X) (ornAlg (ListO X)) 8 | 9 | VecD : (X : Set) -> Desc (One * Nat) 10 | VecD X = ornD (VecO X) 11 | 12 | Vec : Nat -> Set -> Set 13 | Vec n X = Data (VecD X) (<> , n) 14 | 15 | [] : forall {X} -> Vec ze X 16 | [] = {!!} 17 | _::_ : forall {X n} -> X -> Vec n X -> Vec (su n) X 18 | x :: xs = {!!} 19 | 20 | vecToList : forall {X n} -> Vec n X -> List X 21 | vecToList {X} = forget (VecO X) 22 | 23 | listToVec : forall {X}(xs : List X) -> Vec (length xs) X 24 | listToVec {X} = remember (ornAlg (ListO X)) 25 | 26 | {- Conor, go back to L4AlgOrn.agda and do the big shocking theorem! -} 27 | -------------------------------------------------------------------------------- /L4VecCrib.agda: -------------------------------------------------------------------------------- 1 | module L4VecCrib where 2 | 3 | open import L4ListCrib public 4 | open import L4AlgOrnCrib 5 | 6 | VecO : (X : Set) -> Orn (One * Nat) fst (ListD X) 7 | VecO X = algOrn (ListD X) (ornAlg (ListO X)) 8 | 9 | VecD : (X : Set) -> Desc (One * Nat) 10 | VecD X = ornD (VecO X) 11 | 12 | Vec : Nat -> Set -> Set 13 | Vec n X = Data (VecD X) (<> , n) 14 | 15 | [] : forall {X} -> Vec ze X 16 | [] = < base , refl > 17 | _::_ : forall {X n} -> X -> Vec n X -> Vec (su n) X 18 | x :: xs = < step , x , _ , xs , refl > 19 | 20 | vecToList : forall {X n} -> Vec n X -> List X 21 | vecToList {X} = forget (VecO X) 22 | 23 | listToVec : forall {X}(xs : List X) -> Vec (length xs) X 24 | listToVec {X} = remember (ornAlg (ListO X)) 25 | -------------------------------------------------------------------------------- /Lambda.lagda: -------------------------------------------------------------------------------- 1 | %if False 2 | 3 | \begin{code} 4 | 5 | module Lambda where 6 | open import VecFin 7 | 8 | \end{code} 9 | 10 | %endif 11 | 12 | \chapter{Lambda Calculus\\ with de Bruijn Indices} 13 | 14 | I'm revisiting chapter 7 of my thesis here. 15 | 16 | %format forall = "\D{\forall}" 17 | %format Tm = "\D{Tm}" 18 | %format var = "\C{var}" 19 | %format $ = "\C{\$}" 20 | %format _$_ = "\_\!" $ "\!\_" 21 | %format lam = "\C{lam}" 22 | 23 | 24 | Here are the $\lambda$-terms with |n| available de Bruijn indices~\citep{deBruijn:dummies}. 25 | 26 | \begin{code} 27 | data Tm (n : Nat) : Set where 28 | var : Fin n -> Tm n 29 | _$_ : Tm n -> Tm n -> Tm n 30 | lam : Tm (suc n) -> Tm n 31 | 32 | infixl 6 _$_ 33 | \end{code} 34 | 35 | Which operations work? 36 | 37 | Substitute for |zero|?\nudge{How many different kinds of trouble 38 | are we in?} 39 | %format sub0 = "\F{sub0}" 40 | %format yuk = "?" 41 | \begin{spec} 42 | sub0 : {n : Nat} -> Tm n -> Tm (suc n) -> Tm n 43 | sub0 s (var zero) = s 44 | sub0 s (var (suc i)) = var i 45 | sub0 s (f $ a) = sub0 s f $ sub0 s a 46 | sub0 s (lam b) = lam (sub0 yuk b) 47 | \end{spec} 48 | 49 | Simultaneous substitution? \nudge{Notoriously not structurally recursive.} 50 | %format ssub = "\F{ssub}" 51 | %format sig = "\V{\sigma}" 52 | %format sig' = "\V{\sigma'}" 53 | \begin{spec} 54 | ssub : {m n : Nat} -> (Fin m -> Tm n) -> Tm m -> Tm n 55 | ssub sig (var i) = sig i 56 | ssub sig (f $ a) = ssub sig f $ ssub sig a 57 | ssub {m}{n} sig (lam b) = lam (ssub sig' b) where 58 | sig' : Fin (suc m) -> Tm (suc n) 59 | sig' zero = var zero 60 | sig' (suc i) = ssub (\ i -> var (suc i)) (sig i) 61 | \end{spec} 62 | 63 | At this point, Thorsten Altenkirch and Bernhard Reus~\citep{DBLP:conf/csl/AltenkirchR99} 64 | reached for the hammer of wellordering, but there's a cheaper way to 65 | get out of the jam. 66 | 67 | 68 | \section{Simultaneous Renaming and Substitution} 69 | 70 | You can define simultaneous renaming really easily. 71 | 72 | %format wkr = "\F{wkr}" 73 | %format ren = "\F{ren}" 74 | %format rho = "\V{\rho}" 75 | \begin{code} 76 | wkr : {m n : Nat} -> (Fin m -> Fin n) -> Fin (suc m) -> Fin (suc n) 77 | wkr rho zero = zero 78 | wkr rho (suc i) = suc (rho i) 79 | 80 | ren : {m n : Nat} -> (Fin m -> Fin n) -> Tm m -> Tm n 81 | ren rho (var i) = var (rho i) 82 | ren rho (f $ a) = ren rho f $ ren rho a 83 | ren rho (lam b) = lam (ren (wkr rho) b) 84 | \end{code} 85 | 86 | And you can define substitution, given renaming. 87 | %format wks = "\F{wks}" 88 | %format sub = "\F{sub}" 89 | \begin{code} 90 | wks : {m n : Nat} -> (Fin m -> Tm n) -> Fin (suc m) -> Tm (suc n) 91 | wks sig zero = var zero 92 | wks sig (suc i) = ren suc (sig i) 93 | 94 | sub : {m n : Nat} -> (Fin m -> Tm n) -> Tm m -> Tm n 95 | sub sig (var i) = sig i 96 | sub sig (f $ a) = sub sig f $ sub sig a 97 | sub sig (lam b) = lam (sub (wks sig) b) 98 | \end{code} 99 | 100 | How repetitive! Let's abstract out the pattern. 101 | 102 | %format Kit = "\D{Kit}" 103 | %format mkKit = "\C{mkKit}" 104 | %format mkv = "\F{mkv}" 105 | %format mkt = "\F{mkt}" 106 | %format wki = "\F{wki}" 107 | \begin{code} 108 | record Kit (I : Nat -> Set) : Set where 109 | constructor mkKit 110 | field 111 | mkv : {n : Nat} -> Fin n -> I n 112 | mkt : {n : Nat} -> I n -> Tm n 113 | wki : {n : Nat} -> I n -> I (suc n) 114 | open Kit public 115 | \end{code} 116 | 117 | %format tau = "\V{\tau}" 118 | %format wk = "\F{wk}" 119 | %format act = "\F{act}" 120 | \begin{code} 121 | wk : {I : Nat -> Set} -> Kit I -> {m n : Nat} -> 122 | (Fin m -> I n) -> Fin (suc m) -> I (suc n) 123 | wk k tau zero = mkv k zero 124 | wk k tau (suc i) = wki k (tau i) 125 | 126 | act : {I : Nat -> Set} -> Kit I -> {m n : Nat} -> 127 | (Fin m -> I n) -> Tm m -> Tm n 128 | act k tau (var i) = mkt k (tau i) 129 | act k tau (f $ a) = act k tau f $ act k tau a 130 | act k tau (lam b) = lam (act k (wk k tau) b) 131 | \end{code} 132 | 133 | 134 | \subsection{Exercises} 135 | 136 | \begin{exe}[Renaming Kit] 137 | Define the renamimg kit. 138 | %format renk = "\F{renk}" 139 | \begin{spec} 140 | renk : Kit Fin 141 | \end{spec} 142 | \end{exe} 143 | 144 | \begin{exe}[Substitution Kit] 145 | Define the substitution kit. 146 | %format subk = "\F{subk}" 147 | \begin{spec} 148 | subk : Kit Tm 149 | \end{spec} 150 | \end{exe} 151 | 152 | \begin{exe}[Substitute |zero|] 153 | \begin{spec} 154 | sub0 : {n : Nat} -> Tm n -> Tm (suc n) -> Tm n 155 | \end{spec} 156 | \end{exe} 157 | 158 | \begin{exe}[Reduce One] 159 | Define a function to contract the leftmost redex in a $\lambda$-term, if there is one. 160 | %format leftRed = "\F{leftRed}" 161 | \begin{spec} 162 | leftRed : {n : Nat} -> Tm n -> Maybe (Tm n) 163 | \end{spec} 164 | \end{exe} 165 | 166 | \begin{exe}[Complete Development] 167 | Show how to compute the complete development of a $\lambda$-term, contracting all its 168 | visible redexes in parallel (but not the redexes which thus arise). 169 | %format develop = "\F{develop}" 170 | \begin{spec} 171 | develop : {n : Nat} -> Tm n -> Tm n 172 | \end{spec} 173 | \end{exe} 174 | 175 | \begin{exe}[Gasoline Alley] 176 | Write an iterator, computing the |n|-fold self-composition of an endofunction, effectively 177 | interpreting each |Nat| as its corresponding Church numeral. 178 | %format iterate = "\F{iterate}" 179 | \begin{spec} 180 | iterate : Nat -> {X : Set} -> (X -> X) -> X -> X 181 | \end{spec} 182 | You can use |iterate| and |develop| to run $\lambda$-terms for as many steps as you like, 183 | as long as you are modest in your likes. 184 | \end{exe} 185 | 186 | \begin{exe}[Another Substitution Recipe] 187 | It occurred to me at time of writing that one might cook substitution differently. 188 | Using abacus-style addition 189 | %format +a = "\mathbin{\F{+_a}}" 190 | %format _+a_ = "\_\!" +a "\!\_" 191 | \begin{code} 192 | _+a_ : Nat -> Nat -> Nat 193 | zero +a n = n 194 | suc m +a n = m +a suc n 195 | \end{code} 196 | let 197 | %format Sub = "\F{Sub}" 198 | \begin{code} 199 | Sub : Nat -> Nat -> Set 200 | Sub m n = (w : Nat) -> Fin (w +a m) -> Tm (w +a n) 201 | \end{code} 202 | be the type of substitions which can be weakened. 203 | Define 204 | %format subw = "\F{subw}" 205 | \begin{spec} 206 | subw : {m n : Nat} -> Sub m n -> Tm m -> Tm n 207 | \end{spec} 208 | Now show how to turn a renaming into a |Sub|. 209 | %format renSub = "\F{renSub}" 210 | \begin{spec} 211 | renSub : {m n : Nat} -> (Fin m -> Fin n) -> Sub m n 212 | \end{spec} 213 | Finally, show how to turn a simultaneous substitution into a |Sub|. 214 | %format subSub = "\F{subSub}" 215 | \begin{spec} 216 | subSub : {m n : Nat} -> (Fin m -> Tm n) -> Sub m n 217 | \end{spec} 218 | \end{exe} 219 | 220 | 221 | %if False 222 | What to prove? 223 | 224 | \begin{spec} 225 | record GoodKit {I : Nat -> Set}(k : Kit I) : Set where 226 | constructor mkGoodKit 227 | field 228 | acti : {m n : Nat} -> (Fin m -> I n) -> I m -> I n 229 | activ : {m n : Nat}(f : Fin m -> I n) -> (i : Fin m) -> acti f (mkv k i) == f i 230 | actit : {m n : Nat}(f : Fin m -> I n) -> (i : I m) -> act k f (mkt k i) == mkt k (acti f i) 231 | actiw : {m n : Nat}(f : Fin m -> I n) -> (t : I m) -> acti (wk k f) (wki k t) == wki k (acti f t) 232 | mktmkv : {n : Nat}(i : Fin n) -> mkt k (mkv k i) == var i 233 | wkisuc : {n : Nat}(i : Fin n) -> wki k (mkv k i) == mkv k (suc i) 234 | open GoodKit public 235 | \end{spec} 236 | 237 | \begin{spec} 238 | wkId : {I : Nat -> Set}{k : Kit I}(gk : GoodKit k) 239 | {n : Nat}(i : Fin (suc n)) -> wk k (mkv k) i == mkv k i 240 | wkId gk zero = <> 241 | wkId gk (suc i) = wkisuc gk i 242 | 243 | wkComp : {I : Nat -> Set}(k : Kit I)(gk : GoodKit k) -> 244 | {l m n : Nat}(f : Fin m -> I n)(g : Fin l -> I m) 245 | (i : Fin (suc l)) -> acti gk (wk k f) (wk k g i) == wk k (\ j -> acti gk f (g j)) i 246 | wkComp k gk f g zero = activ gk (wk k f) zero 247 | wkComp k gk f g (suc i) = actiw gk f (g i) 248 | 249 | actId : {I : Nat -> Set}(k : Kit I)(gk : GoodKit k) -> 250 | {n : Nat}(t : Tm n) -> act k (mkv k) t == t 251 | actId k gk (var i) = mktmkv gk i 252 | actId k gk (f $ a) rewrite actId k gk f | actId k gk a = <> 253 | actId k gk (lam b) = yuk 254 | \end{spec} 255 | 256 | \begin{spec} 257 | _^=_ : {S T : Set} -> (S -> T) -> (S -> T) -> Set 258 | f ^= g = (s : _) -> f s == g s 259 | 260 | wkExt : {I : Nat -> Set}(k : Kit I) 261 | {m n : Nat}(f g : Fin m -> I n)(q : f ^= g) 262 | (i : Fin (suc m)) -> wk k f i == wk k g i 263 | wkExt k f g q zero = <> 264 | wkExt k f g q (suc i) rewrite q i = <> 265 | 266 | wkId : {I : Nat -> Set}{k : Kit I}(gk : GoodKit k) 267 | {n : Nat}(i : Fin (suc n)) -> wk k (mkv k) i == mkv k i 268 | wkId gk zero = <> 269 | wkId gk (suc i) = wkisuc gk i 270 | 271 | wkComp : {I : Nat -> Set}{k : Kit I}(gk : GoodKit k) -> 272 | {l m n : Nat}(f : Fin m -> I n)(g : Fin l -> I m) 273 | (i : Fin (suc l)) -> acti gk (wk k f) (wk k g i) == wk k (\ i -> acti gk f (g i)) i 274 | wkComp {I}{k} gk f g zero = activ gk (wk k f) zero 275 | wkComp gk f g (suc i) = actiw gk f (g i) 276 | 277 | actExt : {I : Nat -> Set}(k : Kit I) 278 | {m n : Nat}(f g : Fin m -> I n)(q : f ^= g) 279 | (t : Tm m) -> act k f t == act k g t 280 | actExt k f g q (var i) rewrite q i = <> 281 | actExt k f g q (h $ a) rewrite actExt k f g q h | actExt k f g q a = <> 282 | actExt k f g q (lam b) rewrite actExt k (wk k f) (wk k g) (wkExt k f g q) b = <> 283 | 284 | actId : {I : Nat -> Set}{k : Kit I}(gk : GoodKit k) -> 285 | {n : Nat} 286 | (t : Tm n) -> act k (mkv k) t == t 287 | actId gk (var i) = mktmkv gk i 288 | actId gk (f $ a) rewrite actId gk f | actId gk a = <> 289 | actId {I}{k} gk (lam b) rewrite actExt k (wk k (mkv k)) (mkv k) (wkId gk) b 290 | | actId gk b = <> 291 | 292 | actComp : {I : Nat -> Set}{k : Kit I}(gk : GoodKit k) -> 293 | {l m n : Nat}(f : Fin m -> I n)(g : Fin l -> I m) 294 | (t : Tm l) -> act k f (act k g t) == act k (\ i -> acti gk f (g i)) t 295 | actComp gk f g (var i) = actit gk f (g i) 296 | actComp gk f g (h $ a) rewrite actComp gk f g h | actComp gk f g a = <> 297 | actComp {I}{k} gk f g (lam b) 298 | rewrite actComp gk (wk k f) (wk k g) b 299 | | actExt k (\ i -> acti gk (wk k f) (wk k g i)) 300 | (wk k (\ i -> acti gk f (g i))) (wkComp gk f g) b 301 | = <> 302 | 303 | \end{spec} 304 | 305 | \begin{spec} 306 | renK : Kit Fin 307 | renK = mkKit ic var suc 308 | 309 | renk : {m n : Nat} -> 310 | (Fin m -> Fin n) -> Tm m -> Tm n 311 | renk = act renK 312 | 313 | renGK : GoodKit renK 314 | renGK = record 315 | { acti = ic 316 | ; activ = \ f i -> <> 317 | ; actit = \ f i -> <> 318 | ; actiw = \ f t -> <> 319 | ; mktmkv = \ i -> <> 320 | ; wkisuc = \ i -> <> 321 | } 322 | 323 | subK : Kit Tm 324 | subK = mkKit var ic (renk suc) 325 | 326 | subk : {m n : Nat} -> 327 | (Fin m -> Tm n) -> Tm m -> Tm n 328 | subk = act subK 329 | 330 | subGK : GoodKit subK 331 | subGK = record 332 | { acti = subk 333 | ; activ = \ f i -> <> 334 | ; actit = \ f i -> <> 335 | ; actiw = XX 336 | ; mktmkv = \ i -> <> 337 | ; wkisuc = \ i -> <> 338 | } 339 | 340 | 341 | \end{spec} 342 | %endif 343 | 344 | 345 | \subsection{How to Hide de Bruijn Indices} 346 | 347 | %format embed = "\F{embed}" 348 | 349 | \begin{code} 350 | 351 | max : {n : Nat} -> Fin (suc n) 352 | max {zero} = zero 353 | max {suc n} = suc (max {n}) 354 | 355 | embed : {n : Nat} -> Fin n -> Fin (suc n) 356 | embed zero = zero 357 | embed (suc n) = suc (embed n) 358 | 359 | \end{code} 360 | 361 | %format shifty = "\F{shifty}" 362 | %format lambda = "\F{lambda}" 363 | %format myTest = "\F{myTest}" 364 | 365 | \begin{code} 366 | 367 | shifty : (m : Nat){n : Nat} -> Fin (suc (m +N n)) 368 | shifty zero = max 369 | shifty (suc m) = embed (shifty m) 370 | 371 | lambda : {m : Nat} -> 372 | (({n : Nat} -> Tm (suc (m +N n))) -> Tm (suc m)) -> 373 | Tm m 374 | lambda {m} f = lam (f \{n} -> var (shifty m {n})) 375 | 376 | myTest : Tm zero 377 | myTest = lambda \ f -> lambda \ x -> f $ (f $ x) 378 | 379 | \end{code} 380 | 381 | 382 | \subsection{Simply Typed Lambda Calculus} 383 | 384 | Altenkirch and Reus carry on to develop simultaneous type-preserving 385 | substitution for the \emph{simply-typed} \(\lambda\)-calculus. Let's see how. 386 | 387 | %format Ty = "\D{Ty}" 388 | %format iota = "\C{\upiota}" 389 | %format >> = "\C{\vartriangleright}" 390 | %format _>>_ = "\_\!" >> "\!\_" 391 | %format Context = "\D{Context}" 392 | %format !- = "\D{\vdash}" 393 | %format _!-_ = "\_\!" !- "\!\_" 394 | %format -! = "\D{\dashv}" 395 | %format _-!_ = "\_\!" -! "\!\_" 396 | \begin{code} 397 | infixr 4 _>>_ 398 | infixr 3 _!-_ 399 | infixr 3 _-!_ 400 | \end{code} 401 | 402 | \begin{code} 403 | data Ty : Set where 404 | iota : Ty 405 | _>>_ : (S T : Ty) -> Ty 406 | \end{code} 407 | 408 | I'll have a bunch of variations, so it will help if I make context 409 | a general type of snoc-list. 410 | 411 | \begin{code} 412 | data Context (X : Set) : Set where 413 | <> : Context X 414 | _,_ : (G : Context X)(S : X) -> Context X 415 | \end{code} 416 | 417 | Variables become typed references into the context. 418 | 419 | \begin{code} 420 | data _-!_ {X : Set} : Context X -> X -> Set where 421 | zero : forall {G T} -> G , T -! T 422 | suc : forall {G S T} (x : G -! T) -> G , S -! T 423 | \end{code} 424 | 425 | Types reflect the typing rules (which are syntax-directed). 426 | I exploit comment syntax to write a suggestive line of dashes 427 | in the relevant places. I have not managed to persuade 428 | \texttt{lhs2TeX} to achieve that. 429 | 430 | \begin{code} 431 | data _!-_ : Context Ty -> Ty -> Set where 432 | 433 | var : forall {G T} (x : G -! T) 434 | -> ---------------- 435 | G !- T 436 | 437 | -- $\lambda$-abstraction extends the context 438 | 439 | lam : forall {G S T} (b : G , S !- T) 440 | -> -------------------- 441 | G !- S >> T 442 | 443 | -- application demands a type coincidence 444 | 445 | _$_ : forall {G S T} (f : G !- S >> T) (s : G !- S) 446 | -> ------------------------------------ 447 | G !- T 448 | \end{code} 449 | 450 | %format < = "\F{\llbracket}" 451 | %format >T = "\F{\rrbracket_T}" 452 | %format <_>T = < "\_" >T 453 | %format >C = "\F{\rrbracket_C}" 454 | %format <_>C = < "\_" >C 455 | %format >v = "\F{\rrbracket_v}" 456 | %format <_>v = < "\_" >v 457 | %format >t = "\F{\rrbracket_t}" 458 | %format <_>t = < "\_" >t 459 | %format eval = "\F{eval}" 460 | %format example = "\F{example}" 461 | %format Gam = "\V{\Gamma}" 462 | %format Del = "\V{\Delta}" 463 | 464 | Implementing an evaluator is an exercise in denotational semantics. 465 | First, explain what types mean: functions are\ldots functions! 466 | 467 | \begin{code} 468 | <_>T : Ty -> Set 469 | < iota >T = Nat 470 | < S >> T >T = < S >T -> < T >T 471 | \end{code} 472 | 473 | Interpret contexts as types of environments. 474 | 475 | \begin{code} 476 | <_>C : Context Ty -> Set 477 | < <> >C = One 478 | < Gam , S >C = < Gam >C * < S >T 479 | \end{code} 480 | 481 | Interpret variables as projections from environments. 482 | 483 | \begin{code} 484 | <_>v : forall {Gam T} -> Gam -! T -> < Gam >C -> < T >T 485 | < zero >v (_ , t) = t 486 | < suc i >v (g , _) = < i >v g 487 | \end{code} 488 | 489 | Interpret terms, plumbing the environment. 490 | 491 | \begin{code} 492 | <_>t : forall {Gam T} -> Gam !- T -> < Gam >C -> < T >T 493 | < var x >t = < x >v 494 | < lam b >t = \ g s -> < b >t (g , s) 495 | < f $ s >t = \ g -> < f >t g (< s >t g) 496 | 497 | eval : forall {T} -> <> !- T -> < T >T 498 | eval t = < t >t <> 499 | \end{code} 500 | 501 | Here's an example term. You may notice that Agda cannot fully infer 502 | its type, but it is still willing to run it. 503 | 504 | \begin{spec} 505 | example : <> !- _ 506 | example = (lam (var zero)) $ lam (var zero) 507 | \end{spec} 508 | 509 | \subsection{An Exercise} 510 | 511 | \begin{exe}[Simultaneous Substitution] 512 | Using a technique of your choice and implementing auxiliary functions 513 | as needed, show how to adapt our implementation of scope-safe substitution 514 | to type-safe substitution. Define 515 | 516 | %format tsub = "\F{tsub}" 517 | 518 | \begin{spec} 519 | tsub : forall {Gam Del} -> (forall {T} -> Gam -! T -> Del !- T) 520 | -> (forall {T} -> Gam !- T -> Del !- T) 521 | \end{spec} 522 | \end{exe} 523 | 524 | \subsection{Robbing Peter to Pay Paul} 525 | 526 | Based on Paul Blain Levy's \emph{call-by-push-value} calculus, here's 527 | a variation on the simply typed $\lambda$-calculus for you to play with 528 | and extend. 529 | 530 | %format VTy = "\D{VTy}" 531 | %format CTy = "\D{CTy}" 532 | %format UNK = "\C{UNK}" 533 | %format ONE = "\C{ONE}" 534 | %format TWO = "\C{TWO}" 535 | %format EFF = "\C{EFF}" 536 | %format = "\C{\rfloor}" 538 | %format = 539 | %format Two = "\D{2\!\!2}" 540 | %format tt = "\C{tt}" 541 | %format ff = "\C{ff}" 542 | 543 | Types are separated into \emph{value} types for `being' and \emph{computation} 544 | types for `doing'. I've supplied some primitive value types. 545 | \begin{code} 546 | mutual 547 | data VTy : Set where -- value types for ways of being 548 | UNK : CTy -> VTy -- a suspended computation is a value 549 | ONE TWO : VTy -- primitive value types 550 | data CTy : Set where -- computation types for ways of doing 551 | EFF : VTy -> CTy -- making a value by doing effects 552 | _>>_ : VTy -> CTy -> CTy -- abstract a computation 553 | 554 | data Two : Set where tt ff : Two 555 | \end{code} 556 | You may wish to add more value types. 557 | 558 | %format Eff = "\D{Eff}" 559 | %format ret = "\C{ret}" 560 | %format >>= = "\mathbin{\F{>\!\!>\!\!=}}" 561 | %format _>>=_ = "\_\!" >>= "\!\_" 562 | %format toss = "\C{toss}" 563 | 564 | To give semantics to these types, we'll need a type of 565 | command-response trees. They make a monad. Here I've added a 566 | command |toss|, whose `ML type' would be |One -> Two|, but it's 567 | really tossing a coin. 568 | \begin{code} 569 | data Eff (X : Set) : Set where 570 | ret : X -> Eff X 571 | toss : One -> (Two -> Eff X) -> Eff X 572 | \end{code} 573 | 574 | The |ret| constructor puts values at the leaves of the tree. 575 | Meanwhile, the `bind', |>>=| acts like tree-grafting, pasting 576 | new command-response strategies onto the leaves of old. 577 | 578 | \begin{exe}[Bind for |toss|ing Trees] 579 | Define |>>=| to graft strategy trees together. 580 | \begin{spec} 581 | _>>=_ : forall {S T} -> Eff S -> (S -> Eff T) -> Eff T 582 | \end{spec} 583 | \end{exe} 584 | 585 | You may wish to modify the signature of operations available, 586 | but the general structure of |Eff X| trees will remain the same, 587 | with nodes carry commands and edges branching over possible responses. 588 | 589 | %format >VT = "\F{\rrbracket_{VT}}" 590 | %format <_>VT = < "\_" >VT 591 | %format >CT = "\F{\rrbracket_{CT}}" 592 | %format <_>CT = < "\_" >CT 593 | %format Args = "\F{Args}" 594 | %format Return = "\F{Return}" 595 | To give you a better clue of what's going on, let me define the 596 | semantics of these types. Values are, er, values in the given type. 597 | By contrast, computations are Kleisli arrows---operations which produce 598 | |Eff|-strategies to compute a |Return| value, given a tuple of |Args|. 599 | \begin{code} 600 | mutual 601 | <_>VT : VTy -> Set 602 | < UNK C >VT = < C >CT 603 | < ONE >VT = One 604 | < TWO >VT = Two 605 | 606 | <_>CT : CTy -> Set 607 | < C >CT = Args C -> Eff (Return C) 608 | 609 | Args : CTy -> Set 610 | Args (EFF V) = One 611 | Args (V >> C) = < V >VT * Args C 612 | 613 | Return : CTy -> Set 614 | Return (EFF V) = < V >VT 615 | Return (V >> C) = Return C 616 | \end{code} 617 | We have separated being and doing. There are two categories at work 618 | \begin{itemize} 619 | \item |<_>CT| gives the subcategory of |Set| containing just those named by 620 | elements of |CTy|, with morphisms given by 621 | %format ->C = "\mathbin{\F{\rightarrow_{C}}}" 622 | %format _->C_ = "\_\!" ->C "\!\_" 623 | %format ->V = "\mathbin{\F{\rightarrow_{V}}}" 624 | %format _->V_ = "\_\!" ->V "\!\_" 625 | \begin{code} 626 | _->C_ : CTy -> CTy -> Set 627 | C ->C C' = < C >CT -> < C' >CT 628 | \end{code} 629 | and the usual functional identity and composition; 630 | \item we have 631 | the subcategory of |Eff|'s Kleisli category induced by |<_>VT|, with objects 632 | named by elements of |VTy| and morphisms being 633 | \begin{code} 634 | _->V_ : VTy -> VTy -> Set 635 | V ->V V' = < V >VT -> Eff < V' >VT 636 | \end{code} 637 | with |ret| as the identity and |>>=| inducing a composition 638 | %format oV = "\mathbin{\F{\circ_{V}}}" 639 | %format _oV_ = "\_\!" oV "\!\_" 640 | \begin{spec} 641 | _oV_ : {R S T : Set} -> (S -> Eff T) -> (R -> Eff S) -> R -> Eff T 642 | f oV g = \ r -> g r >>= f 643 | \end{spec} 644 | You may wish to check that this composition is associative and absorbs 645 | identity on either side. 646 | \end{itemize} 647 | 648 | \begin{exe}[Functorial |EFF| and |UNK|] 649 | Show that the |EFF| and |UNK| constructors, which turn value 650 | types into computation types and vice versa, extend to functors. 651 | 652 | %format EFF$ = "\F{EFF}^{\T{\$}}" 653 | %format UNK$ = "\F{UNK}^{\T{\$}}" 654 | \begin{spec} 655 | EFF$ : {V V' : VTy} -> (V ->V V') -> (EFF V ->C EFF V') 656 | 657 | UNK$ : {C C' : CTy} -> (C ->C C') -> (UNK C ->V UNK C') 658 | \end{spec} 659 | Feel free to prove that identity and composition are suitably respected. 660 | \end{exe} 661 | 662 | \begin{exe}[Up the Adjunction] 663 | Now show 664 | \[ 665 | |C ->C EFF V| \quad\cong\quad |UNK C ->V V| 666 | \] 667 | %format c2v = "\F{c2v}" 668 | %format v2c = "\F{v2c}" 669 | \begin{spec} 670 | c2v : forall {C V} -> (C ->C EFF V) -> (UNK C ->V V) 671 | 672 | v2c : forall {C V} -> (UNK C ->V V) -> (C ->C EFF V) 673 | \end{spec} 674 | in such a way that the two are mutually inverse. 675 | \end{exe} 676 | We've split our monad into an adjunction, connecting distinct notions of 677 | value and computation. 678 | 679 | Now, let's have some language. 680 | 681 | %format Value = "\D{Value}" 682 | %format Compt = "\D{Compt}" 683 | %format if = "\C{if}" 684 | %format bind = "\C{bind}" 685 | \begin{code} 686 | mutual 687 | data Value (Gam : Context VTy) : VTy -> Set where 688 | var : forall {V} -> Gam -! V -> Value Gam V 689 | <> : Value Gam ONE 690 | tt ff : Value Gam TWO 691 | : forall {C} -> Compt Gam C -> Value Gam (UNK C) 692 | data Compt (Gam : Context VTy) : CTy -> Set where 693 | toss : Compt Gam (EFF TWO) 694 | lam : forall {V C} -> Compt (Gam , V) C -> Compt Gam (V >> C) 695 | _$_ : forall {V C} -> Compt Gam (V >> C) -> Value Gam V -> Compt Gam C 696 | ret : forall {V} -> Value Gam V -> Compt Gam (EFF V) 697 | bind : forall {V C} -> Compt Gam (EFF V) -> Compt (Gam , V) C -> 698 | Compt Gam C 699 | if : forall {C} -> Value Gam TWO -> Compt Gam C -> Compt Gam C -> 700 | Compt Gam C 701 | \end{code} 702 | 703 | Here are contexts, interpreted as environment types, with variables 704 | represented as value projections. 705 | %format >CV = "\F{\rrbracket_{CV}}" 706 | %format <_>CV = < "\_" >CV 707 | %format >vv = "\F{\rrbracket_{vv}}" 708 | %format <_>vv = < "\_" >vv 709 | \begin{code} 710 | <_>CV : Context VTy -> Set 711 | < <> >CV = One 712 | < Gam , V >CV = < Gam >CV * < V >VT 713 | 714 | <_>vv : forall {Gam V} -> Gam -! V -> < Gam >CV -> < V >VT 715 | < zero >vv (_ , t) = t 716 | < suc i >vv (g , _) = < i >vv g 717 | \end{code} 718 | 719 | Now your turn. 720 | %format >vt = "\F{\rrbracket_{vt}}" 721 | %format <_>vt = < "\_" >vt 722 | %format >ct = "\F{\rrbracket_{ct}}" 723 | %format <_>ct = < "\_" >ct 724 | \begin{exe}[Interpreter] 725 | Define mutually recursive interpreters for values and computations. 726 | You should interpret |toss| via the |toss| constructor of |Eff|. 727 | \begin{spec} 728 | mutual 729 | <_>vt : forall {Gam V} -> Value Gam V -> < Gam >CV -> < V >VT 730 | <_>ct : forall {Gam C} -> Compt Gam C -> < Gam >CV -> < C >CT 731 | \end{spec} 732 | \end{exe} 733 | 734 | \begin{exe}[Natural Numbers] 735 | Extend the language with a |VTy| of natural numbers, adding |zero| and |suc| 736 | constructors to |Value| and an effectful primitive recursor to |Compt|. 737 | \end{exe} 738 | 739 | %format get = "\C{get}" 740 | %format put = "\C{put}" 741 | \begin{exe}[Input/Output] 742 | Extend |Eff|, and your extended language with |get| and |put| operators, 743 | respectively reading and writing natural numbers. 744 | \end{exe} 745 | 746 | \begin{exe}[State] Implement an interpreter for |Eff| strategies, 747 | treating the |get| and |put| operations as reading and writing a 748 | |Nat|-valued state. Feel free to make |toss| work any way you like. 749 | \end{exe} 750 | 751 | Next, an exercise received with gratitude from Peter Hancock. 752 | 753 | \begin{exe}[Interlopers] Implement an operator which combines two 754 | communicating processes |alice : Eff One| and |bob : Eff X| to make a 755 | single demand-driven |Eff X| process. Here's the plan: |bob|'s 756 | activities should be prioritised; his |put|s should be |put| to the 757 | world, but his |get|s should come from |alice|'s |put|s; |alice| 758 | should run only when |bob| needs input, and should |get| from the 759 | world; if |alice| terminates before |bob| |ret|urns an |X|, |bob| 760 | should |get| the rest of his inputs directly from the world. 761 | 762 | Implement a similar but supply-driven combinator, connecting |bob : 763 | Eff X| and |charlie : Eff One|, where |charlie| |get|s in the way of 764 | |bob|'s |put|s. 765 | \end{exe} 766 | 767 | 768 | \subsection{Compare and Swap} 769 | 770 | Here's a little recursor for pairs of numbers, generalizing a 771 | pattern I learned from James McKinna. 772 | %format commRec = "\F{commRec}" 773 | \begin{code} 774 | commRec : {X : Set} -> (Nat -> X) -> (X -> X) -> Nat -> Nat -> X 775 | commRec z s zero n = z n 776 | commRec z s m zero = z m 777 | commRec z s (suc m) (suc n) = s (commRec z s m n) 778 | \end{code} 779 | 780 | \begin{exe}[Commutativity] Show that |commRec z s| is commutative. 781 | %format commRecComm = "\F{commRecComm}" 782 | \begin{spec} 783 | commRecComm : {X : Set}(z : Nat -> X)(s : X -> X)(m n : Nat) -> 784 | commRec z s m n == commRec z s n m 785 | \end{spec} 786 | \end{exe} 787 | 788 | \begin{exe}[Arithmetic Operations] Implement addition and 789 | multiplication by suitably instantiating |commRec|. Multiplication 790 | is a bit tricky: you may find that you need to compute an extra quantity, 791 | alongside the product, in order to make the recursion go through. 792 | \end{exe} 793 | 794 | \begin{exe}[Comparison Operations] Implement maximum and 795 | minimum by suitably instantiating |commRec|. Implement the equality test. 796 | \end{exe} 797 | 798 | %format un = "\T{$\mathrm{V}$}" 799 | I finally gave in and defined the following operation to help with the 800 | next exercise. It's the `uncurry' operation, but with a dependent type 801 | which effectively makes it the \emph{dependent case analysis} 802 | principle for |Sg A B|: not only do you split a pair |ab| into pieces 803 | |a| and |b|, you also learn that |ab| is |a , b|. I write it as |un| 804 | as it depicts the splitting of one into two. 805 | 806 | \begin{code} 807 | un : {A : Set}{B : A -> Set}{C : Sg A B -> Set} -> 808 | ((a : A)(b : B a) -> C (a , b)) -> -- two on top 809 | (ab : Sg A B) -> C ab -- one below 810 | un f ab = f (fst ab) (snd ab) 811 | \end{code} 812 | 813 | %format cas = "\F{cas}" 814 | \begin{exe}[Compare-and-swap] 815 | Use |commRec| to implement |cas|, the operation which sorts a pair of numbers 816 | into increasing order. 817 | \begin{spec} 818 | cas : Nat * Nat -> Nat * Nat 819 | \end{spec} 820 | \end{exe} 821 | 822 | But where is the $\lambda$-calculus? It's on its way. Here are today's 823 | \emph{linear} types. 824 | %format LTy = "\D{LTy}" 825 | %format -o = "\C{\multimap}" 826 | %format _-o_ = "\_\!" -o "\!\_" 827 | %format = "\C{\otimes}" 828 | %format __ = "\_\!" "\!\_" 829 | %format & = "\C{\&}" 830 | %format _&_ = "\_\!" & "\!\_" 831 | %format KEY = "\C{KEY}" 832 | %format LIST = "\C{LIST}" 833 | %format TREE = "\C{TREE}" 834 | \begin{code} 835 | data LTy : Set where 836 | ONE TWO KEY : LTy 837 | LIST TREE : LTy -> LTy 838 | _-o_ __ _&_ : LTy -> LTy -> LTy 839 | \end{code} 840 | 841 | Let's consider a \emph{linear} context to be a list of |Maybe|-types 842 | which indicate availability. 843 | 844 | %format LCx = "\F{LCx}" 845 | \begin{code} 846 | LCx : Set 847 | LCx = Context (Maybe LTy) 848 | \end{code} 849 | 850 | We can make a variable reference record the usage by indexing by 851 | contexts, before and after. 852 | %format LTm = "\D{LTm}" 853 | %format Gam0 = "\V{\Gamma_0}" 854 | %format Gam1 = "\V{\Gamma_1}" 855 | %format Gam2 = "\V{\Gamma_2}" 856 | %format Gam3 = "\V{\Gamma_3}" 857 | %format Gam4 = "\V{\Gamma_4}" 858 | %format Gam5 = "\V{\Gamma_5}" 859 | %format LV = "\D{LV}" 860 | \begin{code} 861 | data LV : LCx -> LTy -> LCx -> Set where 862 | zero : forall {Gam T} -> LV (Gam , yes T) T (Gam , no) 863 | suc : forall {Gam0 Gam1 T S} -> LV Gam0 T Gam1 -> LV (Gam0 , S) T (Gam1 , S) 864 | \end{code} 865 | 866 | \begin{code} 867 | data LTm : LCx -> LTy -> LCx -> Set where 868 | var : forall {Gam0 Gam1 T} -> LV Gam0 T Gam1 -> LTm Gam0 T Gam1 869 | lam : forall {Gam0 Gam1 S T} -> LTm (Gam0 , yes S) T (Gam1 , no) -> LTm Gam0 (S -o T) Gam1 870 | _$_ : forall {Gam0 Gam1 Gam2 S T} -> LTm Gam0 (S -o T) Gam1 -> LTm Gam1 S Gam2 -> LTm Gam0 T Gam2 871 | \end{code} 872 | 873 | Sorry folks, I've got to stop preparing this exercise and prepare the 874 | lectures instead. I'll finish it later, but let me tell you where it's 875 | going. The plan is to deliver a domain-specific language for 876 | transforming containers which neither copy nor delete elements, so 877 | that a function of type |LIST KEY -o LIST KEY| must deliver as output a 878 | permutation of its input. Equipped with compare-and-swap for |KEY|, one 879 | should be able to implement sorting functions, guaranteeing the permutation 880 | property by construction. 881 | -------------------------------------------------------------------------------- /Lec1.agda: -------------------------------------------------------------------------------- 1 | module Lec1 where 2 | 3 | 4 | data List (X : Set) : Set where 5 | <> : List X 6 | _,_ : X -> List X -> List X 7 | 8 | infixr 4 _,_ 9 | 10 | {- 11 | zap : {S T : Set} -> List (S -> T) -> List S -> List T 12 | zap <> <> = <> 13 | zap <> (y , y') = {!!} 14 | zap (f , fs) <> = {!!} 15 | zap (f , fs) (s , ss) = f s , zap fs ss 16 | -} 17 | 18 | data Nat : Set where 19 | zero : Nat 20 | suc : (n : Nat) -> Nat 21 | 22 | length : {X : Set} -> List X -> Nat 23 | length <> = zero 24 | length (x , xs) = suc (length xs) 25 | 26 | 27 | data Vec (X : Set) : Nat -> Set where 28 | <> : Vec X zero 29 | _,_ : {n : Nat} -> X -> Vec X n -> Vec X (suc n) 30 | 31 | nid : Nat -> Nat 32 | nid zero = zero 33 | nid (suc n) = suc (nid n) 34 | 35 | vap : forall {n S T} -> Vec (S -> T) n -> Vec S n -> Vec T n 36 | vap <> <> = <> 37 | vap (f , fs) (s , ss) = f s , vap fs ss 38 | 39 | vec : forall {n X} -> X -> Vec X n 40 | vec {zero} x = <> 41 | vec {suc n} x = x , vec x 42 | 43 | _+N_ : Nat -> Nat -> Nat 44 | zero +N y = y 45 | suc x +N y = suc (x +N y) 46 | 47 | dbl : Nat -> Nat 48 | dbl zero = zero 49 | dbl (suc n) = suc (suc (dbl n)) 50 | 51 | swap : forall {n X} -> Vec X (dbl n) -> Vec X (dbl n) 52 | swap {zero} <> = <> 53 | swap {suc n}(x , (y , zs)) = y , (x , swap zs) 54 | 55 | data _==_ {X : Set}(x : X) : X -> Set where 56 | refl : x == x 57 | 58 | {-# BUILTIN EQUALITY _==_ #-} 59 | {-# BUILTIN REFL refl #-} 60 | 61 | 62 | sucLem : (x y : Nat) -> (x +N suc y) == suc (x +N y) 63 | sucLem zero y = refl {- by agsy -} 64 | sucLem (suc n) y rewrite sucLem n y = refl 65 | 66 | {- 67 | mutual 68 | swap' : forall {X}(n : Nat) -> Vec X (n +N n) -> Vec X (n +N n) 69 | swap' (zero) <> = <> 70 | swap' (suc n)(x , ys) rewrite (sucLem n n) = swap'' n x ys 71 | 72 | swap'' : forall {X}(n : Nat) -> X -> 73 | Vec X (suc (n +N n)) -> Vec X (suc (suc (n +N n))) 74 | swap'' n x (y , zs) = y , x , swap' n zs 75 | -} 76 | -------------------------------------------------------------------------------- /Lec2.agda: -------------------------------------------------------------------------------- 1 | module Lec2 where 2 | 3 | data Nat : Set where 4 | zero : Nat 5 | suc : Nat -> Nat 6 | 7 | {-# BUILTIN NATURAL Nat #-} 8 | {-# BUILTIN ZERO zero #-} 9 | {-# BUILTIN SUC suc #-} 10 | 11 | data Vec (X : Set) : Nat -> Set where 12 | <> : Vec X zero 13 | _,_ : {n : Nat} -> X -> Vec X n -> Vec X (suc n) 14 | 15 | infixr 4 _,_ 16 | 17 | data Fin : Nat -> Set where 18 | zero : {n : Nat} -> Fin (suc n) 19 | suc : {n : Nat} -> (i : Fin n) -> Fin (suc n) 20 | 21 | 22 | fog : {n : Nat} -> Fin n -> Nat 23 | fog zero = zero 24 | fog (suc i) = suc (fog i) 25 | 26 | vproj : {n : Nat}{X : Set} -> Vec X n -> Fin n -> X 27 | vproj <> () 28 | vproj (x , xs) zero = x 29 | vproj (x , xs) (suc i) = vproj xs i 30 | 31 | fin0s : Vec (Fin zero) zero 32 | fin0s = <> 33 | 34 | fin1s : Vec (Fin (suc zero)) (suc zero) 35 | fin1s = zero , <> 36 | 37 | fin2s : Vec (Fin (suc (suc zero))) (suc (suc zero)) 38 | fin2s = zero {n = suc zero} , suc {n = suc zero} (zero {n = zero}) , <> 39 | 40 | -------------------------------------------------------------------------------- /Lec3.agda: -------------------------------------------------------------------------------- 1 | module Lec3 where 2 | open import VecFin 3 | 4 | data Tm (n : Nat) : Set where 5 | var : (i : Fin n) -> Tm n 6 | _$_ : (f a : Tm n) -> Tm n 7 | lam : (b : Tm (suc n)) -> Tm n 8 | 9 | infixl 6 _$_ 10 | 11 | sren : {m n : Nat} -> (Fin m -> Fin n) -> Tm m -> Tm n 12 | sren s (var i) = var (s i) 13 | sren s (f $ a) = sren s f $ sren s a 14 | sren s (lam b) = lam (sren (weaken s) b) 15 | 16 | ssub : {m n : Nat} -> (Fin m -> Tm n) -> Tm m -> Tm n 17 | ssub s (var i) = s i 18 | ssub s (f $ a) = ssub s f $ ssub s a 19 | ssub {m}{n} s (lam b) = lam (ssub s' b) where 20 | s' : Fin (suc m) -> Tm (suc n) 21 | s' zero = var zero 22 | s' (suc i) = sren suc (s i) 23 | 24 | infixr 4 _>>_ 25 | infixr 3 _!-_ 26 | infixr 3 _-!_ 27 | 28 | data Ty : Set where 29 | iota : Ty 30 | _>>_ : (S T : Ty) -> Ty 31 | 32 | [_]T : Ty -> Set 33 | [ iota ]T = Nat 34 | [ S >> T ]T = [ S ]T -> [ T ]T 35 | 36 | data Context : Set where 37 | <> : Context 38 | _,_ : (G : Context)(S : Ty) -> Context 39 | 40 | [_]C : Context -> Set 41 | [ <> ]C = One 42 | [ G , S ]C = [ G ]C * [ S ]T 43 | 44 | data _-!_ : Context -> Ty -> Set where 45 | zero : forall {G T} -> G , T -! T 46 | suc : forall {G S T} (x : G -! T) -> G , S -! T 47 | 48 | [_]v : forall {G T} -> G -! T -> [ G ]C -> [ T ]T 49 | [_]v zero = snd 50 | [_]v (suc x) = \ gs -> [ x ]v (fst gs) 51 | 52 | data _!-_ : Context -> Ty -> Set where 53 | 54 | var : forall {G T} (x : G -! T) 55 | -> ---------------- 56 | G !- T 57 | 58 | -- $\lambda$-abstraction extends the context 59 | 60 | lam : forall {G S T} (b : G , S !- T) 61 | -> -------------------- 62 | G !- S >> T 63 | 64 | -- application demands a type coincidence 65 | 66 | _$_ : forall {G S T} (f : G !- S >> T) (s : G !- S) 67 | -> ------------------------------------ 68 | G !- T 69 | 70 | 71 | [_]t : forall {G T} -> G !- T -> [ G ]C -> [ T ]T 72 | [ var x ]t = \ g -> [ x ]v g 73 | [ lam b ]t = \ g s -> [ b ]t (g , s) 74 | [ f $ s ]t = \ g -> [ f ]t g ([ s ]t g) 75 | 76 | twice : forall {G T} -> G !- ((T >> T) >> (T >> T)) 77 | twice = lam (lam (var (suc zero) $ (var (suc zero) $ var zero))) -------------------------------------------------------------------------------- /Lec4.agda: -------------------------------------------------------------------------------- 1 | module Lec4 where 2 | open import VecFin 3 | open import Lambda 4 | 5 | data _-Bounded?_ (u : Nat) : Nat -> Set where 6 | yes : (i : Fin u) -> u -Bounded? (fog i) 7 | no : (x : Nat) -> u -Bounded? (u +N x) 8 | 9 | _-bounded?_ : (u n : Nat) -> u -Bounded? n 10 | zero -bounded? n = no _ 11 | suc u -bounded? zero = yes zero 12 | suc u -bounded? suc n with u -bounded? n 13 | suc u -bounded? suc .(fog i) | yes i = yes (suc i) 14 | suc u -bounded? suc .(u +N _) | no _ = no _ 15 | 16 | 17 | finl : (m : Nat){n : Nat} -> Fin m -> Fin (m +N n) 18 | finl zero () 19 | finl (suc m) zero = zero 20 | finl (suc m) (suc i) = suc (finl m i) 21 | 22 | finr : (m : Nat){n : Nat} -> Fin n -> Fin (m +N n) 23 | finr zero i = i 24 | finr (suc m) i = suc (finr m i) 25 | 26 | data FinSum (m n : Nat) : Fin (m +N n) -> Set where 27 | isFinl : (i : Fin m) -> FinSum m n (finl m i) 28 | isFinr : (j : Fin n) -> FinSum m n (finr m j) 29 | 30 | finSum : (m : Nat){n : Nat}(k : Fin (m +N n)) -> FinSum m n k 31 | finSum zero k = isFinr _ 32 | finSum (suc m) zero = isFinl _ 33 | finSum (suc m) (suc i) with finSum m i 34 | finSum (suc m) (suc .(finl m i)) | isFinl i = isFinl (suc i) 35 | finSum (suc m) (suc .(finr m j)) | isFinr j = isFinr j 36 | 37 | 38 | 39 | Bin = Context Two 40 | 41 | bone : Bin 42 | bone = <> 43 | 44 | bsuc : Bin -> Bin 45 | bsuc <> = <> , ff 46 | bsuc (b , ff) = b , tt 47 | bsuc (b , tt) = bsuc b , ff 48 | 49 | peanoBin : (P : Bin -> Set) -> 50 | (P bone) -> 51 | ((b : Bin) -> P b -> P (bsuc b)) -> 52 | (x : Bin) -> P x 53 | peanoBin P pone psuc <> = pone 54 | peanoBin P pone psuc (bs , tt) = 55 | peanoBin (\ bs -> P (bs , tt)) 56 | (psuc _ (psuc _ pone)) (\ b p -> psuc _ (psuc _ p)) bs 57 | peanoBin P pone psuc (bs , ff) = peanoBin (\ bs -> P (bs , ff)) 58 | (psuc _ pone) (\ b p -> psuc _ (psuc _ p)) bs 59 | 60 | data PeanoBin : Bin -> Set where 61 | pone : PeanoBin bone 62 | psuc : forall {b} -> PeanoBin b -> PeanoBin (bsuc b) 63 | 64 | pBsuc : (bs : Bin)(b : Two) -> PeanoBin bs -> PeanoBin (bs , b) 65 | pBsuc .<> tt pone = psuc (psuc pone) 66 | pBsuc .<> ff pone = psuc pone 67 | pBsuc .(bsuc bs) tt (psuc {bs} p) = psuc (psuc (pBsuc bs tt p)) 68 | pBsuc .(bsuc bs) ff (psuc {bs} p) = psuc (psuc (pBsuc bs ff p)) 69 | 70 | pBin : (b : Bin) -> PeanoBin b 71 | pBin <> = pone 72 | pBin (bs , b) = pBsuc bs b (pBin bs) -------------------------------------------------------------------------------- /Lec5.agda: -------------------------------------------------------------------------------- 1 | module Lec5 where 2 | 3 | open import VecFin 4 | open import Lambda 5 | open import View 6 | 7 | data Zero : Set where -- no constructors! 8 | 9 | data Poly : Set where 10 | I' : Poly -- the identity 11 | Zero' One' : Poly -- constants 12 | _+'_ _*'_ : (P Q : Poly) -> Poly -- choice and pairing 13 | 14 | <_>P : Poly -> Set -> Set 15 | < I' >P X = X 16 | < Zero' >P X = Zero 17 | < One' >P X = One 18 | < P +' Q >P X = < P >P X + < Q >P X 19 | < P *' Q >P X = < P >P X * < Q >P X 20 | 21 | <_>p : (P : Poly) -> {X Y : Set} -> (X -> Y) -> < P >P X -> < P >P Y 22 | <_>p I' f x = f x 23 | <_>p Zero' f x = x 24 | <_>p One' f x = x 25 | <_>p (P +' Q) f (inl p) = inl (< P >p f p) 26 | <_>p (P +' Q) f (inr q) = inr (< Q >p f q) 27 | <_>p (P *' Q) f (p , q) = < P >p f p , < Q >p f q 28 | 29 | -- exercise, functor laws 30 | 31 | -- show < P >P can always be equipped idiomatic traverse 32 | 33 | cp : Poly -> Poly -> Poly 34 | cp I' R = R 35 | cp Zero' _ = Zero' 36 | cp One' _ = One' 37 | cp (P +' Q) R = cp P R +' cp Q R 38 | cp (P *' Q) R = cp P R *' cp Q R 39 | 40 | -- ring a bell? 41 | -- what to prove? 42 | 43 | -- cp P I = P 44 | -- cp associative 45 | 46 | data _=1=_ {X : Set1}(x : X) : X -> Set1 where 47 | refl : x =1= x 48 | 49 | -- should really go back and make the original polymorphic 50 | -- will revisit soon 51 | 52 | cpRespect : (P R : Poly)(X : Set) -> < cp P R >P X =1= < P >P (< R >P X) 53 | cpRespect I' R X = refl 54 | cpRespect Zero' R X = refl 55 | cpRespect One' R X = refl 56 | cpRespect (P +' Q) R X with < cp P R >P X | cpRespect P R X | < cp Q R >P X | cpRespect Q R X 57 | cpRespect (P +' Q) R X | ._ | refl | ._ | refl = refl 58 | cpRespect (P *' Q) R X with < cp P R >P X | cpRespect P R X | < cp Q R >P X | cpRespect Q R X 59 | cpRespect (P *' Q) R X | ._ | refl | ._ | refl = refl 60 | 61 | -- what happens for the morphisms? 62 | 63 | D : Poly -> Poly 64 | D I' = One' 65 | D Zero' = Zero' 66 | D One' = Zero' 67 | D (P +' Q) = D P +' D Q 68 | D (P *' Q) = (D P *' Q) +' (P *' D Q) 69 | 70 | 71 | Div : Poly -> Poly 72 | Div P = D P *' I' 73 | 74 | _-P>_ : Poly -> Poly -> Set1 75 | P -P> Q = {X : Set} -> < P >P X -> < Q >P X 76 | 77 | up : (P : Poly) -> Div P -P> P 78 | up I' (<> , x) = x 79 | up Zero' (() , y) 80 | up One' (() , x) 81 | up (P +' Q) (inl p' , x) = inl (up P (p' , x)) 82 | up (P +' Q) (inr q' , x) = inr (up Q (q' , x)) 83 | up (P *' Q) (inl (p' , q) , x) = up P (p' , x) , q 84 | up (P *' Q) (inr (p , q') , x) = p , up Q (q' , x) 85 | 86 | down : (P : Poly) -> P -P> cp P (Div P) 87 | down I' px = {!!} 88 | down Zero' px = {!!} 89 | down One' px = {!!} 90 | down (P +' Q) px = {!!} 91 | down (P *' Q) px = {!!} 92 | 93 | discard : (P : Poly) -> Div P -P> I' 94 | discard P (_ , x) = x 95 | 96 | sideways : (P : Poly) -> Div P -P> cp (Div P) (Div P) 97 | sideways P p'x = {!!} -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | default : dtp.dvi 2 | 3 | dtp.tex : dtp.lagda VecFin.lagda Lambda.lagda View.lagda 4 | lhs2TeX --agda dtp.lagda > dtp.tex 5 | 6 | dtp.aux : dtp.tex 7 | latex dtp 8 | 9 | dtp.blg : dtp.aux dtp.bib 10 | bibtex dtp 11 | 12 | dtp.dvi : dtp.tex dtp.blg 13 | latex dtp 14 | latex dtp 15 | 16 | dtp.pdf : dtp.tex dtp.blg 17 | latex dtp 18 | pdflatex dtp 19 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | 3 | This is an archival copy of the [original page](http://homepages.inf.ed.ac.uk/s0894694/agda-course/). Please see the [lecture videos](https://www.youtube.com/view_play_list?p=44F162A8B8CB7C87). 4 | 5 | ------------------------------------------------------------------------------- 6 | 7 | 8 | _[LFCS](http://www.lfcs.inf.ed.ac.uk/), [University of Edinburgh](http://www.ed.ac.uk/) presents:_ 9 | 10 | ### Introduction to Dependently Typed Programming using Agda 11 | 12 | **[Conor McBride](http://www.cis.strath.ac.uk/cis/staff/index.php?uid=conor)** 13 | 14 | _[MSP](http://www.msp.cis.strath.ac.uk/), [University of Strathclyde](http://www.strath.ac.uk/)_ 15 | 16 | Types guarantee properties of runtime behaviour. Dependent types give stronger guarantees based on runtime values. In this course we shall introduce dependently typed programming using the Agda programming language. 17 | 18 | The course consists of five weekly afternoon sessions with lectures and hands-on laboratories. Exercises between sessions will be set. Refreshments will be provided during breaks. 19 | 20 | **Prerequisites:** This is a research level course. We assume basic familiarity with a functional programming language, such as Haskell or ML, in particular pattern matching and higher-order functions like map. 21 | 22 | This course is supported by the [Scottish Informatics and Computer Science Alliance](http://www.sicsa.ac.uk/). 23 | 24 | **Location:** 25 | - Lab sessions will be held in lab **4.12, Appleton Tower**. 26 | - Lectures will take place in rooms **G.03 or G.07A, Informatics Forum**. See below. 27 | 28 | **Dates:** Mondays, January 31, 2011 - February 28, 2011. 29 | 30 | **Registration:** Please let us know you are coming so we can prepare accordingly: 31 | Ohad Kammar <…@…> 32 | 33 | **Course Material:** All course material will be available online. Conor has set up a darcs repository that contains everything available currently. You can grab it from: 34 | 35 | darcs get http://personal.cis.strath.ac.uk/~conor/pub/dtp 36 | 37 | **Mailing List:** Course announcements, discussions and questions are welcome in the [agda-course](http://lists.inf.ed.ac.uk/mailman/listinfo/agda-course) mailing list. Non registrants are welcome as well. 38 | 39 | **Schedule:** 40 | - 13:00-14:00: Laboratory 41 | - 14:00-14:20: Coffee Break 42 | - 14:20-15:20: Lecture 43 | - 15:20-15:40: Coffee Break 44 | - 15:40-16:40: Lecture 45 | - 16:40-17:00: Coffee Break 46 | - 17:00-18:00: Laboratory 47 | - 18:00-…: Pub… 48 | 49 | **Past Lectures:** 50 | 51 | 1. 31 January, 2011: **First steps: Lists, Vectors and Peano Arithmetic** 52 | Location: **IF G.03** 53 | Exercises: **1.1-1.8.** 54 | [Video](http://www.youtube.com/view_play_list?p=44F162A8B8CB7C87) 55 | 56 | 2. 07 February, 2011: **Records, unit, sigma and finite sets.** 57 | Location: **IF G.07A** 58 | Exercises: **1.9-1.14.** 59 | 60 | **Upcoming Lectures:** 61 | - 14 February, 2011 Location: **IF G.03** 62 | - 21 February, 2011 Location: **IF G.03** 63 | - 28 February, 2011 Location: **IF G.07A** 64 | -------------------------------------------------------------------------------- /VecFin.lagda: -------------------------------------------------------------------------------- 1 | %if False 2 | 3 | \begin{code} 4 | 5 | module VecFin where 6 | 7 | \end{code} 8 | 9 | %endif 10 | 11 | \chapter{Vectors and Finite Sets} 12 | 13 | %%It is necessary to cite \citet{hancock:amen} at some point. 14 | 15 | %format Set = "\D{Set}" 16 | %format List = "\D{List}" 17 | %format <> = "\C{\langle\rangle}" 18 | %format , = "\red{,}\," 19 | %format ucu = "\_" , "\!\_" 20 | %% %format _,_ = "\_" , "\_" 21 | %format Nat = "\D{Nat}" 22 | %format zero = "\C{zero}" 23 | %format suc = "\C{suc}" 24 | 25 | \nudge{Agda has a very simple lexer and very few special characters. 26 | To a first approximation, ()\{\}; stand alone and everything else must be delimited with whitespace. } 27 | \begin{spec} 28 | 29 | data List (X : Set) : Set where 30 | <> : List X 31 | ucu : X -> List X -> List X 32 | 33 | \end{spec} 34 | 35 | %if False 36 | \begin{code} 37 | 38 | data List (X : Set) : Set where 39 | <> : List X 40 | _,_ : X -> List X -> List X 41 | 42 | infixr 4 _,_ 43 | \end{code} 44 | %endif 45 | 46 | %format zap0 = "\F{zap}" 47 | \begin{code} 48 | 49 | zap0 : {S T : Set} -> List (S -> T) -> List S -> List T 50 | zap0 <> <> = <> 51 | zap0 (f , fs) (s , ss) = f s , zap0 fs ss 52 | zap0 _ _ = <> -- a dummy value, for cases we should not reach 53 | 54 | \end{code} 55 | 56 | That's the usual `garbage in? garbage out!' deal. Logically, we might 57 | want to ensure the inverse: if we supply meaningful input, we want 58 | meaningful output. But what is meaningful input? Lists the same 59 | length! Locally, we have a \emph{relative} notion of 60 | meaningfulness. What is meaningful output? We could say that if the 61 | inputs were the same length, we expect output of that length. How 62 | shall we express this property? 63 | 64 | \nudge{The number of c's in |suc| is a long standing area of open 65 | warfare.} 66 | \nudge{Agda users tend to use lowercase-vs-uppercase to distinguish things in |Set|s from things which are or manipulate |Set|s.} 67 | \nudge{The pragmas let you use decimal numerals.} 68 | \begin{code} 69 | data Nat : Set where 70 | zero : Nat 71 | suc : Nat -> Nat 72 | 73 | {-# BUILTIN NATURAL Nat #-} 74 | {-# BUILTIN ZERO zero #-} 75 | {-# BUILTIN SUC suc #-} 76 | \end{code} 77 | 78 | %format length = "\F{length}" 79 | \begin{code} 80 | length : {X : Set} -> List X -> Nat 81 | length <> = zero 82 | length (x , xs) = suc (length xs) 83 | \end{code} 84 | 85 | Informally,\footnote{by which I mean, not to a computer} 86 | we might state and prove something like 87 | \[ 88 | \forall |fs|, |ss|.\; 89 | |length fs| = |length ss| \Rightarrow |length (zap0 fs ss) = length fs| 90 | \] 91 | by structural induction~\citep{burstall:induction} on |fs|, say. 92 | Of course, we could just as well have concluded that 93 | |length (zap0 fs ss) = length ss|, and if we carry on |zap0|ping, we 94 | shall accumulate a multitude of expressions known to denote the same 95 | number. 96 | 97 | What can we say about list concatenation? We may define addition. 98 | %format +N = "\mathbin{\F{+_N}}" 99 | %format _+N_ = "\_\!" +N "\!\_" 100 | \nudge{How many ways to define |+N|?} 101 | \begin{code} 102 | _+N_ : Nat -> Nat -> Nat 103 | zero +N y = y 104 | suc x +N y = suc (x +N y) 105 | \end{code} 106 | We may define concatenation. 107 | %format +L+ = "\mathbin{\F{+_L\!+}}" 108 | %format _+L+_ = "\_\!" +L+ "\!\_" 109 | \begin{code} 110 | _+L+_ : {X : Set} -> List X -> List X -> List X 111 | <> +L+ ys = ys 112 | (x , xs) +L+ ys = x , (xs +L+ ys) 113 | \end{code} 114 | It takes a proof by induction (and a convenient definition of |+N|) 115 | to note that 116 | \[ 117 | |length (xs +L+ ys)| = |length xs +N length ys| 118 | \] 119 | 120 | 121 | Matters get worse if we try to work with matrices as lists of lists (a 122 | matrix is a column of rows, say). How do we express rectangularity? 123 | Can we define a function to compute the dimensions of a matrix? Do we 124 | want to? What happens in degenerate cases? Given \(m\), \(n\), we 125 | might at least say that the outer list has length \(m\) and that all 126 | the inner lists have length \(n\). Talking about matrices gets easier 127 | if we imagine that the dimensions are \emph{prescribed}---to be checked, 128 | not measured. 129 | 130 | 131 | \subsection{Peano Exercises} 132 | 133 | \begin{exe}[Go Forth and Multiply!] 134 | Given addition, implement multiplication. 135 | %format *N = "\mathbin{\F{\times_N}}" 136 | %format _*N_ = "\_\!" *N "\!\_" 137 | \begin{spec} 138 | _*N_ : Nat -> Nat -> Nat 139 | \end{spec} 140 | \end{exe} 141 | 142 | \begin{exe}[Subtract with Dummy] 143 | Implement subtraction, with a nasty old dummy return when you take 144 | a big number from a small one. 145 | %format -N = "\mathbin{\F{\-_N}}" 146 | %format _-N_ = "\_\!" -N "\!\_" 147 | \begin{spec} 148 | _-N_ : Nat -> Nat -> Nat 149 | \end{spec} 150 | \end{exe} 151 | 152 | \begin{exe}[Divide with a Duplicate] 153 | Implement division. Agda won't let you do repeated subtraction 154 | directly (not structurally decreasing), but you can do something 155 | sensible (modulo the dummy) like this: 156 | %format /N = "\mathbin{\F{\div_N}}" 157 | %format _/N_ = "\_\!" /N "\!\_" 158 | %format help = "\F{help}" 159 | \begin{spec} 160 | _/N_ : Nat -> Nat -> Nat 161 | x /N d = help x d where 162 | help : Nat -> Nat -> Nat 163 | help x e = -- |{!!}| 164 | \end{spec} 165 | You can recursively peel |suc|s from |e| one at a time, with the 166 | original |d| still in scope. 167 | \end{exe} 168 | 169 | 170 | \section{Vectors} 171 | 172 | Here are lists, indexed by numbers which happen to measure their 173 | length: these are known in the trade as \emph{vectors}. 174 | 175 | \nudge{Agda allows overloading of constructors, as its approach to 176 | typechecking is of a bidirectional character} 177 | %format Vec = "\D{Vec}" 178 | \begin{code} 179 | data Vec (X : Set) : Nat -> Set where 180 | <> : Vec X zero 181 | _,_ : {n : Nat} -> X -> Vec X n -> Vec X (suc n) 182 | \end{code} 183 | 184 | %format vap = "\F{vap}" 185 | \nudge{Might want to say something about head and tail, and about how 186 | coverage checking works anyway.} 187 | \nudge{Not greatly enamoured of |S T : Set| notation, but there it is.} 188 | \begin{code} 189 | vap : {n : Nat}{S T : Set} -> Vec (S -> T) n -> Vec S n -> Vec T n 190 | vap <> <> = <> 191 | vap (f , fs) (s , ss) = f s , vap fs ss 192 | \end{code} 193 | 194 | %format vec = "\F{vec}" 195 | \nudge{|vec| is an example of a function with an indexing argument that is 196 | usually inferrable, but never irrelevant.} 197 | \begin{code} 198 | vec : {n : Nat}{X : Set} -> X -> Vec X n 199 | vec {zero} x = <> 200 | vec {suc n} x = x , vec x 201 | \end{code} 202 | 203 | %format +V+ = "\mathbin{\F{+_V\!+}}" 204 | %format _+V+_ = "\_\!" +V+ "\!\_" 205 | \nudge{By now, you may have noticed the proliferation of listy types.} 206 | \begin{code} 207 | _+V+_ : {m n : Nat}{X : Set} -> Vec X m -> Vec X n -> Vec X (m +N n) 208 | <> +V+ ys = ys 209 | (x , xs) +V+ ys = x , (xs +V+ ys) 210 | \end{code} 211 | 212 | \nudge{Here's a stinker. Of course, you can rejig |+N| to be tail 213 | recursive and make |+V+| a stinker.} 214 | %format vrevapp = "\F{vrevapp}" 215 | \begin{spec} 216 | vrevapp : {m n : Nat}{X : Set} -> Vec X m -> Vec X n -> Vec X (m +N n) 217 | vrevapp <> ys = ys 218 | vrevapp (x , xs) ys = vrevapp xs (x , ys) 219 | \end{spec} 220 | 221 | \nudge{Which other things work badly? Filter?} 222 | 223 | This is the `traverse' function from the `idiom paper'~\citep{} 224 | %format vtraverse = "\F{vtraverse}" 225 | \nudge{I wanted to make |_/_| left-associative, but no such luck.} 226 | \begin{code} 227 | vtraverse : {F : Set -> Set} -> 228 | ({X : Set} -> X -> F X) -> 229 | ({S T : Set} -> F (S -> T) -> F S -> F T) -> 230 | {n : Nat}{X Y : Set} -> 231 | (X -> F Y) -> Vec X n -> F (Vec Y n) 232 | vtraverse pure _/_ f <> = pure <> 233 | vtraverse pure _/_ f (x , xs) = (pure _,_ / f x) / vtraverse pure _/_ f xs 234 | \end{code} 235 | 236 | %format ic = "\T{I}" 237 | %format kc = "\T{K}" 238 | \nudge{When would be a good time to talk about universe polymorphism?} 239 | \begin{code} 240 | ic : {X : Set} -> X -> X 241 | ic x = x 242 | 243 | kc : {X Y : Set} -> X -> Y -> X 244 | kc x y = x 245 | \end{code} 246 | 247 | %format vsum = "\F{vsum}" 248 | \nudge{Why is |Y| undetermined?} 249 | \begin{code} 250 | vsum : {n : Nat} -> Vec Nat n -> Nat 251 | vsum = vtraverse (kc zero) _+N_ {Y = Nat} ic 252 | \end{code} 253 | 254 | 255 | \subsection{Matrix Exercises} 256 | 257 | Let us define an |m| by |n| matrix to be a vector of |m| rows, each length |n|. 258 | %format Matrix = "\F{Matrix}" 259 | \begin{code} 260 | Matrix : Nat -> Nat -> Set -> Set 261 | Matrix m n X = Vec (Vec X n) m 262 | \end{code} 263 | 264 | \begin{exe}[Matrices are Applicative] 265 | Show that |Matrix m n| can be equipped with operations analogous to 266 | |vec| and |vap|. 267 | %format vvec = "\F{vvec}" 268 | %format vvap = "\F{vvap}" 269 | \begin{spec} 270 | vvec : {m n : Nat}{X : Set} -> X -> Matrix m n X 271 | vvap : {m n : Nat}{S T : Set} -> 272 | Matrix m n (S -> T) -> Matrix m n S -> Matrix m n T 273 | \end{spec} 274 | which, respectively, copy a given element into each position, and apply functions to 275 | arguments in corresponding positions. 276 | \end{exe} 277 | 278 | \begin{exe}[Matrix Addition] 279 | Use the applicative interface for |Matrix| to define their elementwise addition. 280 | %format +M = "\mathbin{\F{+_M}}" 281 | %format _+M_ = "\_\!" +M "\!\_" 282 | \begin{spec} 283 | _+M_ : {m n : Nat} -> Matrix m n Nat -> Matrix m n Nat -> Matrix m n Nat 284 | \end{spec} 285 | \end{exe} 286 | 287 | \begin{exe}[Matrix Transposition] 288 | Use |vtraverse| to give a one-line definition of matrix transposition. 289 | %format transpose = "\F{transpose}" 290 | \begin{spec} 291 | transpose : {m n : Nat}{X : Set} -> Matrix m n X -> Matrix n m X 292 | \end{spec} 293 | \end{exe} 294 | 295 | %format idMatrix = "\F{idMatrix}" 296 | \begin{exe}[Identity Matrix] 297 | Define a function 298 | \begin{spec} 299 | idMatrix : {n : Nat} -> Matrix n n Nat 300 | \end{spec} 301 | \end{exe} 302 | 303 | \begin{exe}[Matrix Multiplication] 304 | Define matrix multiplication. There are lots of ways to do this. 305 | Some involve defining scalar product, first. 306 | %format *M = "\mathbin{\F{\times_M}}" 307 | %format _*M_ = "\_\!" *M "\!\_" 308 | \begin{spec} 309 | _*M_ : {l m n : Nat} -> Matrix l m Nat -> Matrix m n Nat -> Matrix l n Nat 310 | \end{spec} 311 | \end{exe} 312 | 313 | 314 | 315 | 316 | \subsection{Unit and Sigma types} 317 | 318 | %format One = "\D{1\!\!1}" 319 | %format Sg = "\D{\Upsigma}" 320 | %format * = "\mathbin{\F{\times}}" 321 | %format _*_ = "\_\!" * "\!\_" 322 | %format fst = "\F{fst}" 323 | %format snd = "\F{snd}" 324 | 325 | %format constructor = "\mathkw{constructor}" 326 | \nudge{Why do this with records?} 327 | \begin{code} 328 | record One : Set where 329 | constructor <> 330 | open One public 331 | \end{code} 332 | 333 | \begin{code} 334 | u0 : One 335 | u0 = <> 336 | 337 | u1 : One 338 | u1 = record { } 339 | 340 | u2 : One 341 | u2 = _ 342 | 343 | \end{code} 344 | 345 | \nudge{The |field| keyword declares fields, we can also add `manifest' fields.} 346 | \begin{code} 347 | record Sg (S : Set)(T : S -> Set) : Set where 348 | constructor _,_ 349 | field 350 | fst : S 351 | snd : T fst 352 | open Sg public 353 | 354 | _*_ : Set -> Set -> Set 355 | S * T = Sg S \ _ -> T 356 | \end{code} 357 | \subsection{Apocrypha} 358 | %format VecR = "\F{VecR}" 359 | \nudge{You would not invent dependent pattern matching if vectors were your 360 | only example.} 361 | \begin{code} 362 | VecR : Set -> Nat -> Set 363 | VecR X zero = One 364 | VecR X (suc n) = X * VecR X n 365 | \end{code} 366 | %format vconcR = "\F{vconcR}" 367 | \nudge{The definition is logically the same, why are the programs noisier?} 368 | \begin{code} 369 | vconcR : {m n : Nat}{X : Set} -> 370 | VecR X m -> VecR X n -> VecR X (m +N n) 371 | vconcR {zero} <> ys = ys 372 | vconcR {suc m} (x , xs) ys = x , vconcR {m} xs ys 373 | \end{code} 374 | 375 | %format == = "\D{=\!\!=}" 376 | %format _==_ = "\_\!" == "\!\_" 377 | 378 | \begin{code} 379 | data _==_ {X : Set}(x : X) : X -> Set where 380 | <> : x == x 381 | \end{code} 382 | 383 | %if False 384 | \begin{code} 385 | {-# BUILTIN EQUALITY _==_ #-} 386 | {-# BUILTIN REFL <> #-} 387 | \end{code} 388 | %endif 389 | 390 | %format len = "\F{len}" 391 | \begin{code} 392 | len : {X : Set} -> List X -> Nat 393 | len <> = zero 394 | len (x , xs) = suc (len xs) 395 | \end{code} 396 | 397 | %format VecP = "\F{VecP}" 398 | %format vnil = "\F{vnil}" 399 | %format vcons = "\F{vcons}" 400 | %format vapP = "\F{vapP}" 401 | \nudge{Agda's |\| scopes rightward as far as possible, reducing bracketing. Even newer 402 | fancy binding sugar might make this prettier still.} 403 | \begin{code} 404 | VecP : Set -> Nat -> Set 405 | VecP X n = Sg (List X) \ xs -> len xs == n 406 | \end{code} 407 | 408 | \begin{code} 409 | vnil : {X : Set} -> VecP X zero 410 | vnil = <> , <> 411 | \end{code} 412 | 413 | \nudge{It's already getting bad here, but we can match |p| against |<>| and complete.} 414 | \begin{spec} 415 | vcons : {X : Set}{n : Nat} -> X -> VecP X n -> VecP X (suc n) 416 | vcons x (xs , p) = (x , xs) , -- |{! !}| 417 | \end{spec} 418 | 419 | %format XX = "?" 420 | \nudge{But this really is toxic.} 421 | \begin{spec} 422 | vapP : {n : Nat}{S T : Set} -> 423 | VecP (S -> T) n -> VecP S n -> VecP T n 424 | vapP (<> , <>) (<> , <>) = <> , <> 425 | vapP ((f , fs) , <>) ((s , ss) , p) = (f s , vap (fs , XX) (ss , XX)) , XX 426 | \end{spec} 427 | 428 | 429 | 430 | 431 | 432 | \section{Finite Sets} 433 | 434 | If we know the size of a vector, can we hope to project from it safely? 435 | Here's a family of \emph{finite sets}, good to use as indices into vectors. 436 | 437 | %format Fin = "\D{Fin}" 438 | \begin{code} 439 | data Fin : Nat -> Set where 440 | zero : {n : Nat} -> Fin (suc n) 441 | suc : {n : Nat} -> (i : Fin n) -> Fin (suc n) 442 | 443 | foo : {X : Set}{n : Nat} -> Fin (zero +N zero) -> X 444 | foo () 445 | 446 | \end{code} 447 | 448 | 449 | 450 | Finite sets are sets of bounded numbers. One thing we may readily do is 451 | forget the bound.\nudge{Do you resent writing this function? You should.} 452 | %format fog = "\F{fog}" 453 | \begin{code} 454 | fog : {n : Nat} -> Fin n -> Nat 455 | fog zero = zero 456 | fog (suc i) = suc (fog i) 457 | \end{code} 458 | 459 | Now let's show how to give a total projection from a vector of known size. 460 | %format vproj = "\F{vproj}" 461 | \nudge{Here's our first Aunt Fanny. We could also swap the arguments around.} 462 | \begin{code} 463 | vproj : {n : Nat}{X : Set} -> Vec X n -> Fin n -> X 464 | vproj <> () 465 | vproj (x , xs) zero = x 466 | vproj (x , xs) (suc i) = vproj xs i 467 | \end{code} 468 | \nudge{It's always possible to give enough Aunt Fannies to satisfy the coverage 469 | checker.} 470 | 471 | Suppose we want to project at an index not known to be suitably bounded. 472 | How might we check the bound? We shall return to that thought, later. 473 | 474 | 475 | 476 | \subsection{Renamings} 477 | 478 | We'll shortly use |Fin| to type bounded sets of de Bruijn indices. 479 | Functions from one finite set to another will act as `renamings'. 480 | 481 | Extending the context with a new assumption is sometimes known as `weakening': making more 482 | assumptions weakens an argument. 483 | Suppose we have a function from |Fin m| to |Fin n|, renaming variables, as it were. 484 | How should weakening act on this function? Can we extend the function to 485 | the sets one larger, mapping the `new' source zero to the `new' target zero? 486 | This operation shows how to push a renaming under a binder. 487 | %format weaken = "\F{weaken}" 488 | \nudge{Categorists, what should we prove about |weaken|?} 489 | \begin{code} 490 | weaken : {m n : Nat} -> (Fin m -> Fin n) -> Fin (suc m) -> Fin (suc n) 491 | weaken f zero = zero 492 | weaken f (suc i) = suc (f i) 493 | \end{code} 494 | 495 | One operation we'll need corresponds to inserting a new variable somewhere in 496 | the context. This operation is known as `thinning'. Let's define the order-preserving 497 | injection from |Fin n| to |Fin (suc n)| which misses a given element 498 | %format thin = "\F{thin}" 499 | \begin{code} 500 | thin : {n : Nat} -> Fin (suc n) -> Fin n -> Fin (suc n) 501 | thin zero = suc 502 | thin {zero} (suc ()) 503 | thin {suc n} (suc i) = weaken (thin i) 504 | \end{code} 505 | 506 | 507 | 508 | 509 | \subsection{Finite Set Exercises} 510 | 511 | \begin{exe}[Tabulation] Invert |vproj|. Given a function from a |Fin| set, show 512 | how to construct the vector which tabulates it. 513 | %format vtab = "\F{vtab}" 514 | \begin{spec} 515 | vtab : {n : Nat}{X : Set} -> (Fin n -> X) -> Vec X n 516 | \end{spec} 517 | \end{exe} 518 | 519 | \begin{exe}[Plan a Vector] Show how to construct the `plan' of a 520 | vector---a vector whose elements each give their own position, counting up from 521 | |zero|. 522 | %format vplan = "\F{vplan}" 523 | \begin{spec} 524 | vplan : {n : Nat} -> Vec (Fin n) n 525 | \end{spec} 526 | \end{exe} 527 | 528 | \begin{exe}[Max a |Fin|] Every nonempty finite set has a smallest 529 | element |zero| and a largest element which has as many |suc|s as 530 | allowed. Construct the latter 531 | %format max = "\F{max}" 532 | \begin{spec} 533 | max : {n : Nat} -> Fin (suc n) 534 | \end{spec} 535 | \end{exe} 536 | 537 | \begin{exe}[Embed, Preserving |fog|] Give the embedding from one finite 538 | set to the next which preserves the numerical value given by |fog|. 539 | %format emb = "\F{emb}" 540 | \begin{spec} 541 | emb : {n : Nat} -> Fin n -> Fin (suc n) 542 | \end{spec} 543 | \end{exe} 544 | 545 | %format thick = "\F{thick}" 546 | %format Maybe = "\D{Maybe}" 547 | %format yes = "\C{yes}" 548 | %format no = "\C{no}" 549 | \begin{exe}[Thickening] Construct |thick i| the partial inverse of |thin i|. You'll 550 | need 551 | \begin{code} 552 | data Maybe (X : Set) : Set where 553 | yes : X -> Maybe X 554 | no : Maybe X 555 | \end{code} 556 | Which operations on |Maybe| will help? Discover and define them as you implement: 557 | \begin{spec} 558 | thick : {n : Nat} -> Fin (suc n) -> Fin (suc n) -> Maybe (Fin n) 559 | \end{spec} 560 | Note that |thick| acts as an inequality test. 561 | \end{exe} 562 | 563 | \begin{exe}[Order-Preserving Injections] 564 | %format OPI = "\D{OPI}" 565 | Define an inductive family \[|OPI : Nat -> Nat -> Set|\] such that |OPI m n| gives a unique 566 | first-order representation to exactly the order-preserving injections from |Fin m| to 567 | |Fin n|, and give 568 | the functional interpretation of your data. Show that |OPI| is closed under identity and 569 | composition. 570 | \end{exe} -------------------------------------------------------------------------------- /View.lagda: -------------------------------------------------------------------------------- 1 | %if False 2 | 3 | \begin{code} 4 | 5 | module View where 6 | open import VecFin 7 | open import Lambda 8 | 9 | \end{code} 10 | 11 | %endif 12 | 13 | \chapter{Views} 14 | 15 | Views~\citep{wadler:views} provide a way to give an alternative interface to an 16 | existing type. 17 | 18 | We can write a program which transforms our original data to its 19 | alternative representation, but in the dependently typed setting, we 20 | may and we should get a little more. Let's see how. 21 | 22 | Given some `upper bound', a number |u|, we may check if any other number, 23 | |n| is below it or not, for example, to check if |n| may be used to index a 24 | vector of size |u|. However, a Boolean answer alone will not help, if our 25 | indexing function |vproj| demands an element of |Fin u|. We could define a 26 | function in |Nat -> Maybe (Fin u)| to compute |n|'s representation in |Fin u| 27 | if it exists, but that simple type does not tell us what that representative 28 | has to do with |n|. Alternatively, we can express what it means for |n| to 29 | be \emph{bounds-checkable}: it must be detectably either representable in |Fin u|, 30 | or |u + x| for some `excess' value |x|. Let's code up those possibilities. 31 | 32 | %format -Bounded? = "\D{\!-Bounded?}" 33 | %format _-Bounded?_ = "\_\!" -Bounded? "\!\_" 34 | %format -bounded? = "\D{\!-bounded?}" 35 | %format _-bounded?_ = "\_\!" -bounded? "\!\_" 36 | %format yes = "\C{yes}" 37 | %format no = "\C{no}" 38 | %format . = ".\!\!" 39 | \begin{code} 40 | data _-Bounded?_ (u : Nat) : Nat -> Set where 41 | yes : (i : Fin u) -> u -Bounded? (fog i) 42 | no : (x : Nat) -> u -Bounded? (u +N x) 43 | \end{code} 44 | 45 | If we had a value in |u -Bounded? n|, inspecting it would tell us which of 46 | those two possibilities applies. Let us show that we can always construct 47 | such a value. The base cases are straight forward, but something rather 48 | unusual happens in the step. 49 | 50 | \begin{code} 51 | _-bounded?_ : (u n : Nat) -> u -Bounded? n 52 | zero -bounded? n = no n 53 | (suc u) -bounded? zero = yes zero 54 | (suc u) -bounded? (suc n) with u -bounded? n 55 | (suc u) -bounded? (suc .(fog i)) | yes i = yes (suc i) 56 | (suc u) -bounded? (suc .(u +N x)) | no x = no x 57 | \end{code} 58 | 59 | If we are to compare |suc u| with |suc n|, we surely need to know the 60 | result of comparing |u| with |n|. The |with| 61 | construct~\cite{conor.james:viewfromleft} allows us to grab the result 62 | of that comparison and add a column for it to our pattern match. You 63 | can see that the subsequent lines tabulate the possible outcomes of 64 | the match, as well as showing patterns for the original 65 | arguments. Moreover, something funny happens to those patterns: |n| 66 | becomes instantiated with the non-constructor expressions corresponding to 67 | the in- and out-of-bounds cases, marked with a dot. Operationally, there 68 | is \emph{no need to check} that |n| takes the form indicated by the dotted 69 | pattern: the operational check is a constructor case analysis on the result 70 | of the recursive call, and the consequent analysis of |n| is forced by the 71 | types of those constructors. We work hard to make values in precise types, 72 | and we get repaid with information when we inspect those values! 73 | 74 | The possibility that that inspecting one value might induce knowledge of 75 | another is a phenomenon new with dependent types, and it necessitates some 76 | thought about our programming notation, and also our selection of what programs 77 | to write. When we write functions to inspect data, we should ask what the types 78 | of those functions tell us about what the inspection will learn. 79 | 80 | 81 | \subsection{Finite Set Structure} 82 | 83 | %format finl = "\F{finl}" 84 | %format finr = "\F{finr}" 85 | 86 | The natural numbers can be thought of as names for finite types. We 87 | can equip these finite types with lots of useful structure. 88 | 89 | Let's start with the \emph{coproduct} structure, corresponding to 90 | addition. We can see |Fin (m +N n)| as the disjoint union of |Fin m| 91 | (at the left, low end of the range) and |Fin n| (at the right, high end 92 | of the range). Let us implement the injections. Firstly, |finl| embeds 93 | |Fin m|, preserving numerical value. I am careful to make the value of 94 | |m| visible, as you can't easily guess it from |m +N n|. 95 | 96 | \begin{code} 97 | finl : (m : Nat){n : Nat} -> Fin m -> Fin (m +N n) 98 | finl zero () 99 | finl (suc m) zero = zero 100 | finl (suc m) (suc i) = suc (finl m i) 101 | \end{code} 102 | 103 | Secondly, |finr| embeds |Fin n| by shifting its values up by |m|. 104 | 105 | \begin{code} 106 | finr : (m : Nat){n : Nat} -> Fin n -> Fin (m +N n) 107 | finr zero i = i 108 | finr (suc m) i = suc (finr m i) 109 | \end{code} 110 | 111 | Injections leave the job half done\nudge{Landin: if a job's worth doing, 112 | it's worth half-doing.} We need to be able to tell them apart. We can 113 | certainly split |Fin (m +N n)| as a disjoint union. 114 | %format + = "\D{+}" 115 | %format _+_ = "\_\!" + "\!\_" 116 | %format inl = "\C{inl}" 117 | %format inr = "\C{inr}" 118 | \begin{code} 119 | data _+_ (S T : Set) : Set where 120 | inl : S -> S + T 121 | inr : T -> S + T 122 | \end{code} 123 | %format finlr = "\F{finlr}" 124 | \begin{code} 125 | finlr : (m : Nat){n : Nat} -> Fin (m +N n) -> Fin m + Fin n 126 | finlr zero k = inr k 127 | finlr (suc m) zero = inl zero 128 | finlr (suc m) (suc k) with finlr m k 129 | ... | inl i = inl (suc i) 130 | ... | inr j = inr j 131 | \end{code} 132 | However, that still leaves work undone. Here's another function of 133 | the same type. 134 | %format badlr = "\F{badlr}" 135 | \begin{code} 136 | badlr : (m : Nat){n : Nat} -> Fin (m +N n) -> Fin m + Fin n 137 | badlr zero {zero} () 138 | badlr zero {suc n} _ = inr zero 139 | badlr (suc m) _ = inl zero 140 | \end{code} 141 | As you can see, it ignores its argument, except where necessary to 142 | reject the input, and it returns the answer that's as far to the 143 | left as possible under the circumstances. 144 | 145 | The type of our testing function |finlr| makes no promise as to what 146 | the test will tell us about the value being tested. We compute a value 147 | in a disjoint union, but we \emph{learn} nothing about the values we 148 | already possess. There's still time to change all that. We can show 149 | that the |finl| and |finr| injections \emph{cover} |Fin (m +N n)| by 150 | consrtucting a \emph{view}. 151 | Firstly, let us state what it means to be in the image of |finl| or 152 | |finr|. 153 | %format FinSum = "\D{FinSum}" 154 | %format finSum = "\F{finSum}" 155 | %format isFinl = "\C{isFinl}" 156 | %format isFinr = "\C{isFinr}" 157 | \begin{code} 158 | data FinSum (m n : Nat) : Fin (m +N n) -> Set where 159 | isFinl : (i : Fin m) -> FinSum m n (finl m i) 160 | isFinr : (j : Fin n) -> FinSum m n (finr m j) 161 | \end{code} 162 | 163 | Then let us show that every element is in one image or the other. 164 | \begin{code} 165 | finSum : (m : Nat){n : Nat}(k : Fin (m +N n)) -> FinSum m n k 166 | finSum zero k = isFinr k 167 | finSum (suc m) zero = isFinl zero 168 | finSum (suc m) (suc k) with finSum m k 169 | finSum (suc m) (suc .(finl m i)) | isFinl i = isFinl (suc i) 170 | finSum (suc m) (suc .(finr m j)) | isFinr j = isFinr j 171 | \end{code} 172 | Note that the case analysis on the result of |finSum m k| exposes 173 | which injection made |k|, directly in the patterns. 174 | 175 | \subsection{|Fin|ish the Job} 176 | 177 | \begin{exe}[Products] 178 | Equip |Fin| with its product structure. Implement the constructor 179 | %format fpair = "\F{fpair}" 180 | \begin{spec} 181 | fpair : (m n : Nat) -> Fin m -> Fin n -> Fin (m *N n) 182 | \end{spec} 183 | then show that it covers by constructing the appropriate view. 184 | Use your view to implement the projections. 185 | \end{exe} 186 | 187 | \begin{exe}[Exponentials] 188 | Implement the exponential function for |Nat|. 189 | %format ^N = "\F{\hat{\,}^{N}}" 190 | %format _^N_ = "\_\!" ^N "\!\_" 191 | \begin{spec} 192 | _^N_ : Nat -> Nat -> Nat 193 | \end{spec} 194 | Now implement the abstraction operator which codifies the 195 | finitely many functions between |Fin m| and |Fin n|. (You know 196 | how to tabulate a function; you know that a vector, like an 197 | exponential, is an iterated product.) 198 | %format flam = "\F{flam}" 199 | \begin{spec} 200 | flam : (m n : Nat) -> (Fin m -> Fin n) -> Fin (n ^N m) 201 | \end{spec} 202 | Show that |flam| covers, and thus implement application. You 203 | will not be able to show that every function is given by applying 204 | a code, for that is true only up to an extensional equality which 205 | is not realised in Agda. 206 | \end{exe} 207 | 208 | \begin{exe}[Masochism] Implement dependent functions and pairs! 209 | \end{exe} 210 | 211 | 212 | \subsection{One Song to the Tune of Another (with James McKinna)} 213 | 214 | Let's define positive binary numbers as snoc-lists of bits. 215 | %format Bin = "\F{Bin}" 216 | \begin{code} 217 | Bin = Context Two 218 | \end{code} 219 | 220 | We can define a `one' and a `successor' operation for these numbers. 221 | %format bone = "\F{bone}" 222 | %format bsuc = "\F{bsuc}" 223 | \begin{code} 224 | bone : Bin 225 | bone = <> 226 | 227 | bsuc : Bin -> Bin 228 | bsuc <> = <> , ff 229 | bsuc (b , ff) = b , tt 230 | bsuc (b , tt) = bsuc b , ff 231 | \end{code} 232 | 233 | It's fun to write binary arithmetic operations, but our mission just 234 | now is to establish that we can still \emph{reason} about these numbers 235 | as we did with unary numbers. To do so, we must establish Peano's 236 | induction principle for binary numbers. That is, we need to implement 237 | the following: 238 | %format peanoBin = "\F{peanoBin}" 239 | \begin{spec} 240 | peanoBin : (P : Bin -> Set) -> 241 | (P bone) -> 242 | ((b : Bin) -> P b -> P (bsuc b)) -> 243 | (b : Bin) -> P b 244 | peanoBin P pone psuc = help where 245 | help : (b : Bin) -> P b 246 | help b = XX 247 | \end{spec} 248 | 249 | This goes horribly wrong. How to fix? -------------------------------------------------------------------------------- /dtp.bib: -------------------------------------------------------------------------------- 1 | @STRING{lfcs = "{L}{F}{C}{S}, {U}niversity 2 | of {E}dinburgh" } 3 | @STRING{jfp = "{JFP}" } 4 | @STRING{dtp08 = "{DTP}'08" } 5 | @STRING{brunosmiddlenames = "" } 6 | @STRING{wgp = "{WGP}"} 7 | @STRING{subm = "Submitted"} 8 | 9 | @Article{deBruijn:dummies, 10 | author = {Nicolas G. de~Bruijn}, 11 | title = "{Lambda Calculus notation with nameless dummies: a tool for automatic formula manipulation}", 12 | journal = {Indagationes Mathematic{\ae}}, 13 | year = {1972}, 14 | OPTkey = {}, 15 | volume = {34}, 16 | OPTnumber = {}, 17 | pages = {381--392}, 18 | OPTmonth = {}, 19 | OPTnote = {}, 20 | OPTannote = {} 21 | } 22 | 23 | @Article{ burstall:induction, 24 | author = "Rod Burstall", 25 | title = "Proving Properties of Programs by Structural Induction", 26 | journal = "Computer {J}ournal", 27 | year = "1969", 28 | volume = "12", 29 | number = "1", 30 | pages = "41--48", 31 | OPTmonth = feb 32 | } 33 | 34 | @Article{ burstall:inductively, 35 | author = "Rod Burstall", 36 | title = "{I}nductively {D}efined {F}unctions in {F}unctional 37 | {P}rogramming {L}anguages", 38 | journal = "Journal of Computer and System Sciences", 39 | year = "1987", 40 | volume = "34", 41 | pages = "409--421" 42 | } 43 | @inproceedings{mcbride:free_variable, 44 | author = {McBride, Conor and Mckinna, James}, 45 | booktitle = {Haskell '04}, 46 | pages = {1--9}, 47 | publisher = {ACM}, 48 | title = {Functional pearl: i am not a number--i am a free variable}, 49 | year = {2004} 50 | } 51 | 52 | @article{conor.james:viewfromleft, 53 | journal = {Journal of Functional Programming}, 54 | number = {1}, 55 | volume = {14}, 56 | title = {The View From The Left}, 57 | year = {2004}, 58 | author = {Conor McBride and James McKinna} 59 | } 60 | 61 | @incollection{dybjer:nbe, 62 | author = {Dybjer, Peter and Filinski, Andrzej}, 63 | journal = {Applied Semantics}, 64 | pages = {75--114}, 65 | title = {Normalization and Partial Evaluation}, 66 | year = {2002} 67 | } 68 | 69 | @incollection{dybjer:dependent_types_work, 70 | author = {Bove, Ana and Dybjer, Peter}, 71 | journal = {Language Engineering and Rigorous Software Development}, 72 | pages = {57--99}, 73 | title = {Dependent Types at Work}, 74 | year = {2009} 75 | } 76 | 77 | @phdthesis{chapman:phd, 78 | author = {Chapman, James}, 79 | school = {University of Nottingham}, 80 | title = {Type checking and normalisation} 81 | } 82 | 83 | @inproceedings{chapman:ett, 84 | author = {Chapman, James and Altenkirch, Thorsten and Mcbride, Conor}, 85 | booktitle = {6th Symposium on Trends in Functional Programming}, 86 | location = {Tallinn, Estonia}, 87 | month = {September}, 88 | title = {Epigram reloaded: a standalone typechecker for ETT}, 89 | year = {2005} 90 | } 91 | 92 | @inproceedings{turner:bidirectional_tc, 93 | address = {New York, NY}, 94 | author = {Pierce, Benjamin C. and Turner, David N.}, 95 | booktitle = {POPL'98}, 96 | pages = {252--265}, 97 | title = {Local Type Inference}, 98 | year = {1998} 99 | } 100 | 101 | @TechReport{boutillier:report, 102 | author = {Boutillier, Pierre}, 103 | title = {Equality for $\lambda$-terms with list primitives}, 104 | institution = {Ecole Normale Superieure de Lyon}, 105 | year = {2009}, 106 | url = {http://perso.ens-lyon.fr/pierre.boutillier/files/Boutillier09.pdf} 107 | } 108 | 109 | @inproceedings{morris:spf, 110 | author = {Morris, Peter and Altenkirch, Thorsten and Ghani, Neil}, 111 | booktitle = {CATS '07}, 112 | pages = {111--121}, 113 | publisher = {Australian Computer Society, Inc.}, 114 | title = {Constructing strictly positive families}, 115 | year = {2007} 116 | } 117 | 118 | @unpublished{mcbride:ornaments, 119 | author = {Mcbride, Conor}, 120 | title = {Ornamental Algebras, Algebraic Ornaments} 121 | } 122 | 123 | @incollection{dybjer:ir_axiom, 124 | author = {Dybjer, Peter and Setzer, Anton}, 125 | journal = {Typed Lambda Calculi and Applications}, 126 | pages = {643}, 127 | title = {A Finite Axiomatization of Inductive-Recursive Definitions}, 128 | year = {1999} 129 | } 130 | 131 | @inproceedings{dybjer:ir_algebra, 132 | author = {Dybjer, Peter and Setzer, Anton}, 133 | booktitle = {Annals of Pure and Applied Logic}, 134 | title = {Induction-Recursion and Initial Algebras}, 135 | volume = {124}, 136 | year = {2000} 137 | } 138 | 139 | @incollection{dybjer:iir, 140 | author = {Dybjer, Peter and Setzer, Anton}, 141 | journal = {Proof Theory in Computer Science}, 142 | pages = {93--113}, 143 | title = {Indexed Induction-Recursion}, 144 | year = {2001} 145 | } 146 | 147 | @inproceedings{mcbride:motive, 148 | author = {McBride, Conor}, 149 | title = {Elimination with a Motive}, 150 | booktitle = {TYPES '00}, 151 | year = {2002}, 152 | } 153 | 154 | @unpublished{hancock:amen, 155 | author = {Hancock, Peter}, 156 | title = {AMEN: the last word in combinators} 157 | } 158 | 159 | @article{huet:zipper, 160 | author = {Huet, G\'{e}rard}, 161 | title = {The Zipper}, 162 | journal = {J. Funct. Program.}, 163 | } 164 | 165 | @incollection{mcbride:pattern_matching, 166 | author = {Goguen, Healfdene and McBride, Conor and McKinna, James}, 167 | booktitle = {Algebra, Meaning and Computation }, 168 | title = {Eliminating Dependent Pattern Matching}, 169 | year = {2006} 170 | } 171 | 172 | @inproceedings{altenkirch_mcbride_swierstra:obs_equality, 173 | author = {Altenkirch, Thorsten and McBride, Conor and Swierstra, Wouter}, 174 | title = {Observational equality, now!}, 175 | booktitle = {PLPV '07: Proceedings of the 2007 workshop on Programming languages meets program verification}, 176 | year = {2007}, 177 | pages = {57--68}, 178 | location = {Freiburg, Germany}, 179 | } 180 | 181 | @inproceedings{DBLP:conf/csl/AltenkirchR99, 182 | author = {Thorsten Altenkirch and 183 | Bernhard Reus}, 184 | title = {Monadic Presentations of Lambda Terms Using Generalized 185 | Inductive Types}, 186 | booktitle = {CSL}, 187 | year = {1999}, 188 | pages = {453-468}, 189 | ee = {http://dx.doi.org/10.1007/3-540-48168-0_32}, 190 | crossref = {DBLP:conf/csl/1999}, 191 | bibsource = {DBLP, http://dblp.uni-trier.de} 192 | } 193 | 194 | @proceedings{DBLP:conf/csl/1999, 195 | editor = {J{\"o}rg Flum and 196 | Mario Rodr\'{\i}guez-Artalejo}, 197 | title = {Computer Science Logic, 13th International Workshop, CSL 198 | '99, 8th Annual Conference of the EACSL, Madrid, Spain, 199 | September 20-25, 1999, Proceedings}, 200 | booktitle = {CSL}, 201 | publisher = {Springer}, 202 | series = {LNCS}, 203 | volume = {1683}, 204 | year = {1999}, 205 | bibsource = {DBLP, http://dblp.uni-trier.de} 206 | } 207 | 208 | @Article{conor.ross:applicative.functors, 209 | author = {Conor McBride and Ross Paterson}, 210 | title = {Applicative programming with effects}, 211 | journal = jfp, 212 | year = 2008 213 | } 214 | 215 | 216 | @InProceedings{wadler:views, 217 | author = "Philip Wadler", 218 | title = "Views: A way for pattern matching to cohabit with 219 | data abstraction", 220 | crossref = "popl87", 221 | } 222 | 223 | 224 | @Proceedings{ popl87, 225 | key = "POPL'87", 226 | title = "14th {A}nnual {S}ymposium on Principles of {P}rogramming {L}anguages 227 | (POPL) (Munich)", 228 | booktitle = "Proceedings of {POPL} '87", 229 | organization = "ACM", 230 | OPTmonth = jan, 231 | year = 1987, 232 | crossrefonly = 1 233 | } 234 | -------------------------------------------------------------------------------- /dtp.lagda: -------------------------------------------------------------------------------- 1 | \documentclass{book} 2 | \usepackage{a4} 3 | \usepackage{palatino} 4 | \usepackage{natbib} 5 | \usepackage{amsfonts} 6 | \usepackage{stmaryrd} 7 | \usepackage{upgreek} 8 | 9 | 10 | \DeclareMathAlphabet{\mathkw}{OT1}{cmss}{bx}{n} 11 | 12 | \usepackage{color} 13 | \newcommand{\redFG}[1]{\textcolor[rgb]{0.6,0,0}{#1}} 14 | \newcommand{\greenFG}[1]{\textcolor[rgb]{0,0.4,0}{#1}} 15 | \newcommand{\blueFG}[1]{\textcolor[rgb]{0,0,0.8}{#1}} 16 | \newcommand{\orangeFG}[1]{\textcolor[rgb]{0.8,0.4,0}{#1}} 17 | \newcommand{\purpleFG}[1]{\textcolor[rgb]{0.4,0,0.4}{#1}} 18 | \newcommand{\yellowFG}[1]{\textcolor{yellow}{#1}} 19 | \newcommand{\brownFG}[1]{\textcolor[rgb]{0.5,0.2,0.2}{#1}} 20 | \newcommand{\blackFG}[1]{\textcolor[rgb]{0,0,0}{#1}} 21 | \newcommand{\whiteFG}[1]{\textcolor[rgb]{1,1,1}{#1}} 22 | \newcommand{\yellowBG}[1]{\colorbox[rgb]{1,1,0.2}{#1}} 23 | \newcommand{\brownBG}[1]{\colorbox[rgb]{1.0,0.7,0.4}{#1}} 24 | 25 | \newcommand{\ColourStuff}{ 26 | \newcommand{\red}{\redFG} 27 | \newcommand{\green}{\greenFG} 28 | \newcommand{\blue}{\blueFG} 29 | \newcommand{\orange}{\orangeFG} 30 | \newcommand{\purple}{\purpleFG} 31 | \newcommand{\yellow}{\yellowFG} 32 | \newcommand{\brown}{\brownFG} 33 | \newcommand{\black}{\blackFG} 34 | \newcommand{\white}{\whiteFG} 35 | } 36 | 37 | \newcommand{\MonochromeStuff}{ 38 | \newcommand{\red}{\blackFG} 39 | \newcommand{\green}{\blackFG} 40 | \newcommand{\blue}{\blackFG} 41 | \newcommand{\orange}{\blackFG} 42 | \newcommand{\purple}{\blackFG} 43 | \newcommand{\yellow}{\blackFG} 44 | \newcommand{\brown}{\blackFG} 45 | \newcommand{\black}{\blackFG} 46 | \newcommand{\white}{\blackFG} 47 | } 48 | 49 | \ColourStuff 50 | 51 | 52 | \newcommand{\D}[1]{\blue{\mathsf{#1}}} 53 | \newcommand{\C}[1]{\red{\mathsf{#1}}} 54 | \newcommand{\F}[1]{\green{\mathsf{#1}}} 55 | \newcommand{\V}[1]{\purple{\mathit{#1}}} 56 | \newcommand{\T}[1]{\raisebox{0.02in}{\tiny\green{\textsc{#1}}}} 57 | 58 | %include lhs2TeX.fmt 59 | %include lhs2TeX.sty 60 | %include polycode.fmt 61 | 62 | %subst keyword a = "\mathkw{" a "}" 63 | %subst conid a = "\V{" a "}" 64 | %subst varid a = "\V{" a "}" 65 | 66 | %format -> = "\blue{\rightarrow}" 67 | 68 | \newcommand{\nudge}[1]{\marginpar{\footnotesize #1}} 69 | \newtheorem{exe}{Exercise}[chapter] 70 | 71 | %format rewrite = "\mathkw{rewrite}" 72 | 73 | \begin{document} 74 | 75 | \title{Dependently Typed Programming: \\ an Agda introduction} 76 | \author{Conor McBride} 77 | \maketitle 78 | 79 | %include VecFin.lagda 80 | 81 | %include Lambda.lagda 82 | 83 | %include View.lagda 84 | 85 | %include Generic.lagda 86 | 87 | \bibliographystyle{plainnat} 88 | \bibliography{dtp.bib} 89 | 90 | \end{document} -------------------------------------------------------------------------------- /dtp.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mietek/agda-intro/a45f5581173c749e0dc8ce024c5a448985aef9da/dtp.pdf -------------------------------------------------------------------------------- /index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Conor's Agda Course Materials 4 | 5 | 6 | 7 |

Conor's Agda Course Materials

8 | 9 | This is a dummy homepage, designed to stop nasty 403 errors from 10 | appearing in your browser when you surf up the course darcs repo. 11 | Your best bet is to download it, using 12 |
darcs get 13 | http://personal.cis.strath.ac.uk/~conor/pub/dtp
14 | 15 | At the moment, the interesting file is VecFin.lagda, but more and more interesting 17 | files will emerge in due course, given that a course is due. 18 | 19 | 20 | 21 | --------------------------------------------------------------------------------