I. Introduction to Haskell A. interaction (Thompson chapter 2, replaces Davie 2.1) ------------------------------------------ INTERACTING WITH THE INTERPRETER $ hugs __ __ __ __ ____ ___ || || || || || || ||__ ||___|| ||__|| ||__|| __|| ||---|| ___|| || || || || Version: November 2002 Haskell 98 mode: ... Reading file "... Prelude.hs": Hugs session for: ... Prelude.hs Type :? for help Prelude> ------------------------------------------ ------------------------------------------ MORE INTERACTION Prelude> Prelude> :type 1 1 :: Num a => a Prelude> 3 + 4 7 :: Int Prelude> (+) 3 4 7 :: Int Prelude> 216 * 34 7344 :: Int Prelude> 7344 / 34 216.0 :: Double Prelude> 7 / 3 2.33333 :: Double Prelude> div 7 3 2 :: Int Prelude> 7 `div` 3 2 :: Int Prelude> 7 `rem` 3 1 :: Int Prelude> 7 `divRem` 3 ERROR: Undefined variable "divRem" Prelude> 7 `quotRem` 3 (2,1) :: (Int,Int) Prelude> :type 7 `quotRem` 3 quotRem 7 3 :: Integral a => (a,a) ------------------------------------------ ------------------------------------------ WORKING WITH FILES Prelude> :load Fact.hs Reading file "Fact.hs": Hugs session for: ... Prelude.hs Fact.hs Fact> fact fact {dict} {dict} :: Int -> Int Fact> :type fact fact :: (Num a, Enum a) => a -> a Fact> fact 4 24 Fact> fact 100 0 Fact> :edit Fact.hs Fact> :reload Hugs session for: ... Prelude.hs Fact.hs Fact> :type fact fact :: Integer -> Integer Fact> fact 100 9332621544394415268169923885626670049... Fact> Fact> :q [Leaving Hugs] ------------------------------------------ ------------------------------------------ popeye 15% hugs Fact.hs [...] Reading file "... Prelude.hs" Reading file "Fact.hs": Hugs session for: ... Prelude.hs Fact.hs Type :? for help Fact> fact 8 40320 Fact> :q [Leaving Hugs] ------------------------------------------ ------------------------------------------ LITERATE SCRIPTS file foo.lhs: ============================== A TITLE Some text, whatever you want.. > -- part of a Haskell prog > hd (x:_) = x The blank lines surrounding the program are mandatory. This file should have a .lhs suffix, or use the +l argument to the interpreter. ============================== Prelude> :load foo.lhs Reading file "foo.lhs": Hugs session for: ... Prelude.hs foo.lhs Main> hd (3 : (4 : [])) 3 :: Int ------------------------------------------ II. Built-in types of Haskell A. Fundamental classification of objects 1. simple (atomic) types (Thompson 3.1-2, 3.5-6, Davie 2.7) ------------------------------------------ HASKELL BOOLEANS Bool Values: + abstract values: true and false + printed: True, False Operations: + constructors: True, False + functions: &&, ||, not, ==, /= + syntax: if _ then _ else _ HASKELL CHARACTERS Char Values: + abstract values: a, b, c, d, ... + printed: 'a', 'b', 'c', ... Operations: + constructors: 'a', 'b', ..., '\n', ... + functions: ord, chr, isSpace, .. ==, /=, <, <=, ... ------------------------------------------ ------------------------------------------ HASKELL INTEGERS Integer Values: + abstract values: 0, 1, -1, ... + printed: 0, 1, -1, ... Operations: + constructors: 0, 1, 2, 3, ... + functions: +, -, *, negate, abs, signum, quot, rem, div, mod, ==, /=, <, <=, ... ------------------------------------------ 2. structured types (Thompson 5, Davie 2.8, 3.11, 2.10) a. pairs, tuples, and unit (Thompson 5.2, Davie 2.10) ------------------------------------------ TUPLES IN HASKELL (a,b), (a,b,c), ..., and () Values: + abstract values: pairs of a & b, triples of a & b & c, ... an empty tuple + printed: (1,True), (3, 4, 5), () Operations: + constructor (,), (,,), ... + fst, snd EXAMPLE FUNCTIONS OVER TUPLES > fst :: (a,b) -> a > fst (a,_) = a > snd :: (a,b) -> b > snd (_,b) = b ------------------------------------------ ------------------------------------------ CONSTRUCTING TUPLES Prelude> (1,True) Prelude> (1,2,3) Prelude> (1,(2,3)) Prelude> (1,(True,2.8)) Prelude> ((1,True),2.8) Prelude> (1) Prelude> () Prelude> ("zero tuple:",()) ------------------------------------------ What is the type of each? b. functions (Thompson 10) ------------------------------------------ FUNCTIONS a -> b Values: + abstract values: partial functions from a to b Operations: + constructor: \ var -> expression + syntax: f x y = expression means roughly f = \x -> \y -> expession + functions: (.), flip, curry, uncurry Examples: id :: a -> a id = \x -> x (.) :: (b -> c) -> (a -> b) -> (a -> c) (f . g) x = f (g x) flip :: (a -> b -> c) -> b -> a -> c flip f x y = f y x ------------------------------------------ B. binding, pattern matching, simple functions ------------------------------------------ PATTERN MATCHING AND BINDING Prelude> let (x,y,z) = (1,2,3) in x Prelude> let (x,y,z) = (1,2,3) in z Prelude> let (_,y,_) = (1,2,3) in y Prelude> let (a:as) = 1:2:3:[] in a 1 Prelude> let (a:as) = [1,2,3] in as [2,3] ------------------------------------------ What's the general rule for this kind of pattern matching? ------------------------------------------ PATTERNS IN FUNCTION DEFINITION Suppose we define > yodaize (subject, verb, adjective) = > (adjective, subject, verb) Then we have Prelude> yodaize ("food", "is", "good") Prelude> yodaize ("study", "you", "will") Another example: Problem: write a function to take max of 3 arguments ------------------------------------------ ------------------------------------------ FOR YOU TO DO 1. Define functions fst3 :: (a, b, c) -> a snd3 :: (a, b, c) -> b thd3 :: (a, b, c) -> c such that for all t :: (a, b, c) t = (fst3 t, snd3 t, thd3 t) 2. Define a function average :: (Float, Float) -> Float such that, for example average (1.0, 3.0) = 2.0 average (3.0, 50.0) = 26.5 ------------------------------------------ III. lists (Thompson 4, Davie 2.8, 3.11) ------------------------------------------ LISTS IN HASKELL [a] -- homogeneous lists of a Values: + abstract values: sequences of a's + printed: [], [0], [1,2,3,...] Operations: + constructors: [], : + functions: head, tail, last, init, null, ++, length, !!, map, take, drop, reverse, all, any, ... + syntax: [1,2,3] = 1:2:3:[] [1 ..] = enumFrom 1 [1,3 ..] = enumFromThen 1 3 [1 .. 8] = enumFromTo 1 10 [1,3 ..8] = enumFromThenTo 1 3 8 [e | e <- [1 ..], even e] = do e <- [1 ..] guard (even e) return e ------------------------------------------ A. lists as a DSL B. sugars 1. dot dot (..) notation 2. for infinite lists C. list comprehensions 1. mapping 2. filtering 3. using patterns 4. nested maps D. built-in functions (standard Prelude) 1. zip and unzip 2. ++, !!, concat, length, head, last, tail, init 3. replicate, take, drop 4. splitAt, reverse, and, or, any, all, sum, product 5. foldr and foldl (Thompson 9.3) E. explicit recursions. 1. practice ------------------------------------------ FOR YOU TO DO Write a function (++) :: [a] -> [a] -> [a] so that: [1,2,3] ++ [4,5] = [1,2,3,4,5] [] ++ [7,8] = [7,8] Write a function all :: (a -> Bool) -> [a] -> Bool so that: all even [] = True all even [1,2,3] = False all even [2,4 .. 20] = True ------------------------------------------ what is the base case? take the above example for the inductive case. what do we want? what are we given? how do you get that? so what are the equations? 2. more practice 3. higher-order examples ------------------------------------------ FLAT RECURSION OVER LISTS Example: map :: (a -> b) -> [a] -> [b] such that map odd [] = [] map even [1..3] = [False, True, False] map negate [1 .. 5] = [-1,-2,-3,-4,-5] map (+ 1) [1 .. 4] = [2,3,4,5] ------------------------------------------ So what will the cases be? how do we get what False:(True:False:[]) from (True:False:[]) and 1? F. tail recursion: no pending computation on recursive calls (Davie 3.9) 1. example ------------------------------------------ FULL vs. TAIL RECURSION Fully recursive > len [] = 0 > len (x:xs) = 1 + (len xs) len [5,7,9] = 1 + (len [7,9]) = 1 + (1 + (len [9])) = 1 + (1 + (1 + (len []))) = 1 + (1 + (1 + (0))) = 1 + 1 + 1 = 1 + 2 = 3 ------------------------------------------ ------------------------------------------ TAIL RECURSIVE VERSION ------------------------------------------ 2. practice ------------------------------------------ FOR YOU TO DO Write > reverse :: [a] -> [a] > reverse [] = [] > reverse (x:xs) = (reverse xs) ++ [x] tail recursively. ------------------------------------------ so what is reverse_iter(x:xs,y)? 3. when to use tail recursion ------------------------------------------ WHEN TO USE TAIL RECURSION ------------------------------------------ IV. data-driven recursion (Thompson 14, Davie sections 3.2, 4.4) A. data declaration in Haskell B. example: the natural numbers ------------------------------------------ DATA-DRIVEN RECURSION Definition of natural numbers: > data Nat = Zero | Succ Nat deriving Eq To define a function f :: Nat -> t define recursively by: f Zero = ... -- basis f (Succ n) = ... -- inductive case Examples: toInteger :: Nat -> Integer plus :: Nat -> Nat -> Nat ------------------------------------------ How does the structure of the program resemble the data declaration? How does the data declaration resemble a grammar? ------------------------------------------ FOR YOU TO DO -- data Nat = Zero | Succ Nat deriving Eq mult :: Nat -> Nat -> Nat equal :: Nat -> Nat -> Bool ------------------------------------------ What would isZero :: Nat -> Bool be like? C. structure of data determines structure of code ------------------------------------------ GENERALIZING HOW TO WRITE RECUSIONS data NonEmptyList a = Write maxl :: (Ord a) => NonEmptyList a -> a such that Write nth :: NonEmptyList a -> Nat -> a such that ------------------------------------------ How would you define a non-empty list in English? can you write this? ------------------------------------------ RECURSION OVER GRAMMARS > data Exp = BoolLit Bool | IntLit Integer > | Sub Exp Exp > | Equal Exp Exp > | If Exp Exp Exp Write the following eval :: Exp -> Exp such that eval (Sub (IntLit 5) (IntLit 4)) = (IntLit 1) ------------------------------------------ What are the base cases? Where should there be a recursion? Examples for each recursive case? V. types in Haskell (Ch 9 in Thompson, Ch 4 in Davie) A. type operators (Davie 4.1) ------------------------------------------ TYPE NOTATION Type declarations x :: Integer f :: Integer -> Integer Type operators operator meaning ============================= _ -> _ function type (_ , _) product type [ _ ] list type Associativity b f g x means (((b f) g) x) a -> b' -> c means a -> (b' -> c) ------------------------------------------ Why do you think the associtivity is different for applications and for function types? B. polymorphic types (Thompson 9.2, Davie 4.2) ------------------------------------------ POLYMORPHIC TYPES Monomorphic examples: Integer [Bool] -> Bool [(Integer, Integer) -> Bool] Polymorphic examples: [a] [b] -> b [(c,c) -> Bool] ------------------------------------------ What are some expressions that have these types? What are some other instances of these types? C. type synonyms (Davie 4.3.1) ------------------------------------------ TYPE SYNONYMS Examples > type Nat = Int > type TextString = [(Nat, String)] > type Stack a = [a] > type Queue a = [a] > type MyQueue a = Queue a > type Predicate a = (a -> Bool) ------------------------------------------ Does this allow us to pass a (Stack Int) to a function of type [Int] -> Int? D. algebraic types (Thompson 10, Davie 4.4) ------------------------------------------ ALGEBRAIC TYPES Can simulate enumerations > data Font = Roman | Italic | Bold data Color = data Boolean = Can also be used to define recursive types, including data HaskellType = ------------------------------------------ E. abstract data types (Thompson 16, Davie 4.5, 4.9) ------------------------------------------ ABSTRACT DATA TYPES -- file Fraction.hs module Fraction (Fraction, mkFraction, num, denom, add, sub) where data Fraction = Integer :/ Integer mkFraction _ 0 = error "undefined" mkFraction n d = n :/ d num (n :/ d) = n denom (n :/ d) = d add (n1 :/ d1) (n2 :/ d2) = mkFraction (n1 * d2 + n2 * d1) (d1 * d2) sub (n1 :/ d1) (n2 :/ d2) = mkFraction (n1 * d2 - n2 * d1) (d1 * d2) ------------------------------------------ ------------------------------------------ FREE TYPES VS. TYPES MODULO LAWS def: a data type is *free* (*algebraic) if Examples: def: a data type is *not free* (abstract) if Examples: ------------------------------------------ Is it ever worthwhile to hide the representation of a free type? F. overview of type inference (Thompson 13, Davie 4.7) ------------------------------------------ OVERVIEW OF TYPE INFERENCE Type checking: you declare type, compiler infers type, compiler compares Type inference: compiler infers type In Haskell don't need to declare types (usually) Example > mymap f [] = [] > mymap f (x:xs) = (f x):(mymap f xs) ------------------------------------------ G. ad hoc polymorphism and type classes (Thompson 12, Davie 4.8) ------------------------------------------ AD HOC POLYMORPHISM parametric polymorphism: map :: (a -> b) -> [a] -> [b] ad hoc polymorphism > square :: Num a => a -> a > square x = x * x ------------------------------------------ Why not require that you actually pass the multiplication yourself? What's done in OO programming? 1. type classes (Thompson 12.4) ------------------------------------------ TYPE CLASSES IN HASKELL -- abbreviated Eq type class class Eq a where (==), (/=) :: a -> a -> Bool x /= y = not (x==y) -- abbreviated Ord type class class (Eq a) => Ord a where compare :: a -> a -> Ordering (<), (<=), (>=), (>) :: a -> a -> Bool max, min :: a -> a -> a ------------------------------------------ 2. type class instances (Thompson 12.3) ------------------------------------------ DECLARING TYPE CLASS INSTANCES > data Prod a b = a :* b > instance (Eq a, Eq b) > => Eq (Prod a b) where > (x :* y) == (x' :* y') = > (x == x' && y == y') or you can write: > data Cartesian a b = a :** b deriving Eq ------------------------------------------ 3. higher-order type classes ------------------------------------------ HIGHER-ORDER TYPE CLASSES -- from the Prelude class Functor f where fmap :: (a -> b) -> (f a -> f b) instance Functor [] where fmap f [] = [] fmap f (x:xs) = f x : fmap f xs data Maybe a = Nothing | Just a deriving (Eq, Ord, Read, Show) instance Functor Maybe where fmap f Nothing = Nothing fmap f (Just x) = Just (f x) ------------------------------------------ VI. Closures and Functions (Thompson 9 and 10, Davie 5) A. \ makes functions 1. examples: ------------------------------------------ \ MAKES FUNCTIONS (CLOSURES) Prelude> (\ x -> x) "y" Prelude> ((\ x -> head x) [1,2,3]) Prelude> ((\ (x,y) -> 0) (head [], "hmm")) Prelude> ((\ () -> 5)) Prelude> (\ () -> 5)() ------------------------------------------ 2. normal order evaluation rule ------------------------------------------ AVOIDING CAPTURE let head = [4,5] in (\ x -> (\ head -> head x)) head ------------------------------------------ --------------------------------------------------------- FREE AND BOUND OCCURRENCES OF VARIABLES > data Expression = IntLit Integer | BoolLit Bool > | Varref Var | Lambda Var Expression > | App Expression Expression > deriving (Eq, Show) > type Var = String > occursFreeIn :: Var -> Expression -> Bool > occursFreeIn x (Varref y) = x == y > occursFreeIn x (Lambda y body) = > x /= y && occursFreeIn x body > occursFreeIn x (App left right) = > (occursFreeIn x left) || (occursFreeIn x right) > occursFreeIn x _ = False > freeVariables :: Expression -> [Var] > freeVariables (Varref y) = [y] > freeVariables (Lambda y body) = > delete y (freeVariables body) > freeVariables (App left right) = > (freeVariables left) `union` (freeVariables right) > freeVariables _ = [] > occursBoundIn :: Var -> Expression -> Bool > occursBoundIn x (Varref y) = False > occursBoundIn x (Lambda y body) = > x == y && occursFreeIn x body > || occursBoundIn x body > occursBoundIn x (App left right) = > (occursBoundIn x left) || (occursBoundIn x right) > occursBoundIn x _ = False --------------------------------------------------------- --------------------------------------------------------- SUBSTITUTION WITHOUT CAPTURE > substitute :: Expression -> Var > -> Expression -> Expression > substitute new old e@(Varref y) = > if y == old then new else e > substitute new old (App left right) = > (App (substitute new old left) > (substitute new old right)) > substitute new old e@(Lambda y body) = > if y `elem` (freeVariables new) > then (substitute new old > (Lambda z (substitute (Varref z) y body))) > else (Lambda y (substitute new old body)) > where z = fresh (freeVariables new) > substitute _ _ e = e --------------------------------------------------------- ------------------------------------------ NORMAL ORDER EVALUATION ((\ x -> e1) e2) =def= [e2/x]e1 examples: ((\ z -> z * z + 1) 7) = ((\ (x,y) -> x*y + 3) (5,6)) = ------------------------------------------ 3. the point: static scoping 4. implementation, closures and thunks B. Functions first-class in Haskell 1. curried functions ------------------------------------------ CURRIED FUNCTIONS > cadd = \x -> \y -> x + y > add2 = (cadd 2) Prelude> (add2 3) Prelude> (add2 7) ------------------------------------------ 2. closures in C can you write a function in C which is a curried addition? ------------------------------------------ CURRYING IN C? #include typedef int (*func)(int); int takes_y(int y) { return(x + y); } func cadd(int x) { return(&takes_y); } int main() { printf("%i\n", (cadd(2))(3)); } ------------------------------------------ does this work? ------------------------------------------ CORRECTED C PROGRAM #include typedef int (*func)(int, int); typedef struct { int x; func f; } closure; typedef closure *closurePtr; int add(int x, int y) { return x + y; } closurePtr cadd(int x) { closurePtr c; c = (closurePtr)malloc(sizeof(closure)); c->f = &add; c->x = x; return c; } int call_closure(closurePtr c, int arg) { return (c->f)(c->x, arg); } int main() { printf("%i\n", call_closure(cadd(2), 3)); } ------------------------------------------ What in C++ is like a closure? 3. gravitational force example ------------------------------------------ PHYSICS FOR FUNCTIONAL PROGRAMMERS > grav_force_c :: Kg -> Meter -> Kg -> N > grav_force_c m1 r m2 = > if r == 0.0 > then 0.0 > else (big_G * m1 * m2) > / (square r) Type synonyms and other defs used above > type Kg = Float > type Meter = Float > type N = Float > type N_x_m2_per_kg2 = Float > big_G :: N_x_m2_per_kg2 > big_G = 6.670e-11 > square :: Float -> Float > square r = r * r ------------------------------------------ ------------------------------------------ TYPES OF CURRIED FUNCTION APPLICATIONS EXPRESSION TYPE grav_force_c :: Kg -> Meter -> Kg -> N 5.96E24 :: Kg grav_force_c 5.96E24 :: 6.0E6 :: Meter grav_force_c 5.96E24 6.0E6 :: 68.0 :: Kg grav_force_c 5.96E24 6.0E6 68.0 :: ------------------------------------------ 4. tool makers a. folding ------------------------------------------ ABSTRACTING A COMMON PATTERN > sum :: Num a => [a] -> a > sum [] = 0 > sum (x:xs) = x + sum xs > product :: Num a => [a] -> a > product [] = 1 > product (x:xs) = x * product xs ------------------------------------------ What are the parts specific to computing the sum? the product? ------------------------------------------ USES OF FOLDR concat :: [[a]] -> [a] concat = foldr (++) [] FOR YOU TO DO Using foldr, write functions and, or :: [Bool] -> Bool such that and [] = True and (b:bs) = b && and bs or [] = False or (b:bs) = b || or bs ------------------------------------------ b. abstraction on a different data type ------------------------------------------ FOR YOU TO DO > data Tree a = Lf > | Br (a, Tree a, Tree a) Generalize: > preorder :: Tree a -> [a] > preorder Lf = [] > preorder (Br(v,t1,t2)) = > [v] ++ preorder t1 ++ preorder t2 > inc :: Num a => Tree a -> Tree a > inc Lf = Lf > inc (Br(v,t1,t2)) = > Br(v + fromInteger 1, inc t1, inc t2) ------------------------------------------ c. combinators ------------------------------------------ COMBINATORS (WITH HISTORICAL NAMES) > b f g x = f(g x) > w f x = ((f x) x) > twice = (w b) > by2 x = 2 * x Prelude> ((twice by2) 7) ------------------------------------------ ------------------------------------------ ENOUGH FOR COMPUTING! (almost) > i x = x > k c x = c > s f g x = ((f x) (g x)) FOR YOU TO DO What is: k 3 5 s k k 3 ------------------------------------------ ------------------------------------------ FIXPOINT COMBINATOR > fix :: ((a -> b) -> (a -> b)) > -> (a -> b) > fix f x = f (fix f) x > fact :: (Integer -> Integer) > -> (Integer -> Integer) > fact f n = > if n == 0 then 1 else n * f(n-1) > factorial = fix fact Prelude> factorial 3 ------------------------------------------ C. functions are the ultimate 1. can be used to implement "infinite" data strucutures 2. can be used to implement arbitrary control structures. VII. quiz (just for fun, ah er -- education, not graded) A. Given the following B. Given the following. C. Given the following. VIII. Name binding and scope (omit, as this is now a homework) A. pattern matching in function defs is sugar for case (Davie pp. 29 and 190) How could one define the semantics of Haskell function defs with complex features like guards and pattern matching? ------------------------------------------ FUNCTION DEFINITION SEMANTICS The problem: function defs can be complex > fact 0 = 1 > fact n | n > 0 = n * fact(n-1) > while test f x > | b = while test f (f x) > | otherwise = x > where b = test x > quotient(i,j) = lastq > where (lasti,lastq) = > (while notdone xform (i,0)) > notdone (i,q) = (i >= j) > xform (i,q) = (i-j,q+1) what does this all mean? ------------------------------------------ What features are being used? ------------------------------------------ SYNTACTIC SUGARS AN EXPLANATORY DEVICE def: a feature of a language is a *syntactic sugar* if Example: fact 0 = 1 fact n | n > 0 = n * fact(n-1) ==> ------------------------------------------ ------------------------------------------ PATTERN GUARDS SUGAR FOR IF (D 2.7.1) Guard desugaring:

| 1 = 1 | 2 = 2 ... | n = n where { } ==> FOR YOU TO DO Desugar: while test f x | b = while test f (f x) | otherwise = x where b = test x ------------------------------------------ ------------------------------------------ SYNTACTIC SUGAR FOR IF if 1 then 2 else 3 ==> case 1 of True -> 2 False -> 3 ------------------------------------------ ------------------------------------------ MULTIPLE BINDING IS SUGAR FOR CASE Function binding form:

11 ...

1n = 1 ...

m1 ...

mn = m ==> FOR YOU TO DO desugar the following > name 0 = "zero" > name 1 = "one" > name n = "many" ------------------------------------------ ------------------------------------------ FUNCTION DEFINITION SUGAR FOR LAMBDA x1 ... xn = E ==> Example: compose (f,g) x = f (g x) ==> ------------------------------------------ ------------------------------------------ GETTING PATTERNS OUT OF LAMBDAS ucompose (f,g) x = f (g x) ==> ucompose = \ (f,g) -> \ x -> f (g x) ==> ------------------------------------------ B. simultaneous binding, lexical scope (D 2.4) ------------------------------------------ SCOPE FOR DECLARATIONS AND LET > x = u + v > y = u - v > (u,v) = (4,5) :: (Integer, Integer) let x1 = u1 + v y1 = u1 - v u1 = 4 :: Integer in [x1,y1,u1,v] ------------------------------------------ What's this like in Scheme? What will that expression's value be? ------------------------------------------ SYNTACTIC SUGAR FOR LET (dynamic behavior, not typing) let

1 = 1 ...

n = n in 0 ==> let (~

1, ..., ~

n) = (1, ..., n) in 0 let

= 1 in 0 ==> let

= fix (\ ~

-> 1) in 0 let

= 1 in 0 -- if no var in

occurs -- free in 1 ==> ------------------------------------------ C. Binding vs. assignment (skip) IX. monads (Thompson 18) A. introductory example 1. maybe --------------------------------------------------------- DEALING WITH MAYBE data Maybe a = Nothing | Just a deriving (Eq, Ord, Read, Show) Database example: doQuery :: Query -> DB -> Maybe Record To do a sequence of queries: r :: Maybe Record r = case doQuery db q1 of Nothing -> Nothing Just r1 -> case doQuery db (q2 r1) of Nothing -> Nothing Just r2 -> case doQuery db (q3 r2) of Nothing -> Nothing Just r3 -> ... --------------------------------------------------------- how can we abstract from this pattern? 2. state 3. changes to interpreters ------------------------------------------ A PROBLEM WITH FUNCTIONAL PROGRAMMING Initial interpreter: eval :: Exp -> Env Val -> Val ... let v = (eval e env) ... To add a store, change the type: eval :: Exp -> Env Val -> Store -> (Val, Store) ... let (v,s) = (eval e env store) ... ------------------------------------------ 4. summary Can we generalize this into a type class so we won't even have to change the name of the combinators? B. definition and examples ------------------------------------------ MONADS class Monad m where return :: a -> m a (>>=) :: m a -> (a -> m b) -> m b (>>) :: m a -> m b -> m b fail :: String -> m a p >> q = p >>= \_ -> q fail s = error s instance Monad Maybe where Just x >>= k = k x Nothing >>= k = Nothing return = Just fail s = Nothing --------------------------------------------------------- ------------------------------------------ LISTS AS MONADS instance Monad [ ] where [] >>= f = [] (x:xs) >>= f = f x ++ (xs >>= f) return x = [x] fail s = [] ------------------------------------------ What is [] >>= (\x -> [x+1]) ? What is return 2 >>= (\x -> [x+1]) ? What is [2,3,4] >>= (\x -> [x+1]) ? What is [3] >> [4,5] ? What is [3,9] >> [4,5]? C. specification (laws) ------------------------------------------ MONAD LAWS For a monad m, \forall x::a, k,h::(a -> m b), o::m a (return x) >>= k = k x (o >>= return) = o o >>= (\x -> (k x) >>= h) = (o >>= \x -> (k x)) >>= h ------------------------------------------ Do these work for Maybe? D. sugars ------------------------------------------ MONAD SUGARS ::= do ::= [ ] | <- | let SEMANTICS do e = e do {e; stmts} = e >> do stmts do {p <- e; stmts} = e >>= \p -> do stmts do {let decllist in stmts} = let decllist in do stmts ------------------------------------------ ------------------------------------------ EXAMPLE OF MONADIC PROGRAMMING sequence :: Monad m => [m a] -> m [a] sequence [] = return [] sequence (c:cs) = do x <- c xs <- sequence cs return (x:xs) sequence [Just 3, Just 4] = do x <- Just 3 xs <- sequence [Just 4] return (x:xs) = Just 3 >>= \x -> sequence [Just 4] >>= \xs -> return (x:xs) = ((\x -> ...) 3) = sequence [Just 4] >>= \xs -> return (3:xs)) = (do x <- Just 4 xs <- sequence [] return (x:xs)) >>= (\xs -> return (3:xs)) = (Just 4 >>= \x -> sequence [] >>= \xs -> return (x:xs)) >>= (\xs -> return (3:xs)) = (sequence [] >>= \xs -> return (4:xs)) >>= (\xs -> return (3:xs)) = (return [] >>= \xs -> return (4:xs)) >>= (\xs -> return (3:xs)) = (return (4:[])) >>= (\xs -> return (3:xs)) = return (3:4:[])) = Just [3,4] ------------------------------------------ What is sequence [Just 3, Nothing, Just 5]? E. MonadPlus ------------------------------------------ MONADPLUS, A SUBCLASS OF MONAD class Monad m => MonadPlus m where mzero :: m a mplus :: m a -> m a -> m a instance MonadPlus Maybe where mzero = Nothing Nothing `mplus` ys = ys xs `mplus` ys = xs instance MonadPlus [ ] where mzero = [] mplus = (++) ------------------------------------------ What should the specification of zero be? ------------------------------------------ EXAMPLES OF USE OF MONADPLUS > filterMP :: MonadPlus m => > (a -> Bool) -> m a -> m a > filterMP p = applyM (\x -> if p x > then return x > else mzero) > applyM :: Monad m => > (a -> m b) -> m a -> m b > applyM f x = x >>= f ------------------------------------------ 1. monadic Input/Output ------------------------------------------ MONADIC INPUT/OUTPUT data IO a -- IO actions returning an a instance Monad IO where (>>=) = primbindIO return = primretIO > putStrLn :: String -> IO () > putStrLn s = do putStr s > putChar '\n' > getLine :: IO String > getLine = > do c <- getChar > if c=='\n' then return "" > else do cs <- getLine > return (c:cs) ------------------------------------------ ------------------------------------------ HOW DOES I/O HAPPEN? Prelude> getLine >>= putStrLn abc abc :: IO () Prelude> do {s <- getLine; putStrLn s} a line of input a line of input :: IO () ------------------------------------------