CS223 5/14/2010 Lecture 18 More on Haskell Classes ======================= Here is an example of something that can be done with functors in SML, but which can't be done with type classes depending only on type inference. --------------- (* astracting over an integer set type *) signature INTSET = sig type set val empty : set val insert : int * set -> set val subset : set * set -> bool end; functor F(S : INTSET) = struct (* f tests whether elements of its first * argument xs are all contained in its * second argument ys. (list subset) *) fun f (xs : int list, ys: int list) : bool = let val sx = foldl S.insert S.empty xs val sy = foldl S.insert S.empty ys in S.subset (s1, s2) end end; structure IS :> INTSET = struct type set = int list (* maintained in ascending order *) val empty = [] fun insert (x, []: int list) = [x] | insert (x, ys as (y::ys')) = (case Int.compare (x,y) of LESS => x :: ys | EQUAL => ys | GREATER => y :: insert(x, ys')) fun subset ([]:set, _) = true | subset (_, []) = false | subset (xs as (x::xs'), y::ys) = (case Int.compare(x,y) of LESS => false | EQUAL => subset(xs', ys) | GREATER => subset(xs, ys)) end structure A = F(IS); A.f([2,4,6], [1,2,3,4,5,6,7,8]); (* ==> true *) ----------------------------------------------- Attempt to emulate with type classes in Haskell ----------------------------------------------- -- :set -XFlexibleInstances class IntSet set where empty :: set insert :: Int -> set -> set subset :: set -> set -> Bool -- data IntList = Nil | Cons Int IntList instance IntSet [Int] where empty = [] insert x [] = [x] insert x (ys @ (y:ys')) = case compare x y of LT -> x : ys EQ -> ys GT -> y : insert x ys' subset [] _ = True subset _ [] = False subset (xs @ (x:xs')) (y:ys) = case compare x y of LT -> False EQ -> subset xs' ys GT -> subset xs ys f :: [Int] -> [Int] -> Bool f xs ys = let s1 = foldl (flip insert) empty xs s2 = foldl (flip insert) empty ys in subset s1 s2 ------------------------ Prelude> :l set-class.hs [1 of 1] Compiling Main ( set-class.hs, interpreted ) set-class.hs:26:31: Ambiguous type variable `a' in the constraint: `IntSet a' arising from a use of `empty' at set-class.hs:26:31-35 Probable fix: add a type signature that fixes these type variable(s) Failed, modules loaded: none. ------------------------- When we type the definition of f, we get empty.1 : S1 -- first occurrence of empty insert.1 : Int -> S2 -> S2 -- first occurrence of empty empty.2 : S3 -- first occurrence of empty insert.2 : Int -> S4 -> S4 -- first occurrence of empty because we know that empty and insert are "overloaded" variables associated only with the IntSet class, and therefore their types have to match the templates empty : set insert : Int -> set -> set for a type set to be determined (and it needs to be a type with an associated instance of IntSet). Using the polymorphic type of foldl and unifying we get S1 = S2 S3 = S4 and then using the known type scheme for subset defined in IntSet subset : set -> set -> Bool we get the equation S1 = S3 So we now know that the four occurrences are connected to the same type S1: empty.1 : S1 insert.1 : Int -> S1 -> S1 empty.2 : S1 insert.2 : Int -> S1 -> S1 subset : S1 -> S1 -> Bool But we have now run out of constraints to use to solve for S1, so it remains undetermined. But S1 is the set type that must determine the IntSet instance defining empty, insert and subset. So we cannot resolve the overloaded operators by determining their class instance, and typechecking fails. ------------------------- But if I change the definition of f as follow (adding type information in the form of an ascription on the first occurrence of empty): f :: [Int] -> [Int] -> Bool f xs ys = let s1 = foldl (flip insert) (empty::[Int]) xs s2 = foldl (flip insert) empty ys in subset s1 s2 it suddenly works. We had to add the type ascription "::[Int]" to empty to allow type inference to determine the type of empty (and hence the return type of insert) so these operators could be connected to the appropriate IntSet instance (for [Int] in this case). ====================================================================== Monads: IO and effects in Haskell [Tutorial at: http://www.haskell.org/all_about_monads/html/index.html] [RWH, Chapter 7: I/O, p. 165] In SML, we started with the canonical Hello World program: - print "Hello World\n"; In Haskell, printing "Hello World" requires advanced language features, which we will now address. Simple input model in SML ------------------------- Suppose we want to write a purely functional program in SML that does input. We'll model the input source as a list of characters, and provide a single input function that returns the next character. [In real life the input source is typically a file or the interactive terminal.] type instream = char list val inputc : instream -> char option * instream fun inputc [] = (NONE, []) | inputc (c::cs) = (SOME c, cs) Here is a program that accumulates characters up to the first blank, returning them as a string: (* scan1 : instream -> char list option * instream *) fun scan1 (str,cs) = (case (inputc str) of (NONE, str') => (NONE, str') (* end of file condition *) | (SOME c, str') => if Char.isSpace c then (SOME cs, str') else scan1 (str', c::cs)) (* scanToSpace : instream -> string option * instream *) fun scanToSpace str = case scan1(str,[]) of (NONE, str') = (NONE, str') | (SOME cs, str') => (SOME(implode(rev cs)), str) Notice how the instream argument (str) has t be "threaded" through the computation. Each step takes an instream and has to return a (possibly modified) instream. Monadic input: See the file input.sml for an implementation of scan1 and scanToSpace in a monadic style. signature INPUT = sig type instream type 'a reader = instream -> ('a * instream) option val inputc : char reader val return : 'a -> 'a reader val fail : 'a reader val perform : 'a reader -> instream -> ('a * instream) option (* i.e. perform : 'a reader -> 'a reader * it can be thought of as essentially an identity * function on readers, or as a specialized apply * function for readers *) val chain : 'a reader -> ('a -> 'b reader) -> 'b reader val choice : 'a reader * 'a reader -> 'a reader val sat : (char -> bool) -> char reader val checkChar : char -> char reader val checkChars : char list -> char list reader end Note on style: The interesting thing here is that after the first few basic functions have been defined, i.e. inputc, return, fail, chain, and choice, we rarely have to mention instreams directly when defining the other operations like sat, checkChar, checkChars, scan. We are using higher-order operators that work on readers to build more complex readers from simpler ones, and the underlying instream has been hidden both at the type level, where the types of the functions can be expressed in terms of reader without reference to instream, and in the function definitions (beyond the most basic ones), which express combinations of readers. scan1 is an exception becuase it is recursive, so it needs to be defined as an explicit function over instreams. This is not necessary in Haskell. But the definition of scan1 is in the form (fn instream => instream) where reader is a compound reader expression, so it is just an eta-expanded reader expression. Another way to allow scan1 to be recursive is to lift it by abstracting over unit, changing its type to unit -> char list reader: fun scan1 () : char list reader = choice( chain (sat (not o Char.isSpace)) (fn c => chain (scan1()) (fn cs => return(c::cs))), return []) Notice that when defining a function using return, chain, choice and similar reader constructing functions, you are building up a compound reader (i.e defining an action). But you are not actually performing the action. Performing the action is generally a final step consisting of applying the reader action that you have composed to an actual instream. ================================================================================ Where's the monad? What is a monad? ------------------------------------ The characteristic pattern involves value-yielding "actions" (or "effectful functions") entailing side effects on an associated state. Here it is embodied in the types type instream -- the state type 'a reader -- action returning an 'a value and the two basic operaions: val return : 'a -> 'a reader -- turns a value into a trivial action that returns that value without modifying the state val chain : 'a reader -> ('a -> 'b reader) -> 'b reader -- combine a real action ('a reader) with a latent action that depends on the value returned by the first action ('a -> 'b reader) into a single action that returns the value of the second action. The implicit state undergoes two successive side-effects associated with the chained actions. Here is the monad signature: signature MONAD = sig type 'a m -- monad "actions" returning 'a val return : 'a -> 'a m val bind : 'a m -> ('a -> 'b m) -> 'b m end; Monads are a kind of algebraic structure defined in category theory, so the monad operations must obey certain monad law(s) expressed as algebraic equations (like the laws for groups) (see http://www.haskell.org/haskellwiki/Monad_Laws). (1) bind (return a) f = f a -- left identity (2) bind m return = m -- right identity (3) bind (bind m f) g = bind m (\x.bind (f x) g) -- associativity "bind" is a common name for the function we called chain in our Input example. In Haskell, the bind operation is named >>= (an infix operator), and Monad is a type class: class Monad m where (>>=) :: m a -> (a -> m b) -> m b return :: a -> m a (>>) :: m a -> m b -> m b fail :: String -> m a m >> k = m >>= (\_ -> k) fail s = error s So in Haskell's notation the laws are writen (1) return a >>= f = f a -- left identity (2) m >>= return = m -- right identity (3) (m >>= f) >>= g = m >>= (\x -> f x >>= g) -- associativity Monad Examples: 1. list as a monad: structure ListMonad : MONAD = struct type 'a m = 'a list fun return v = [v] fun bind l f = concat (map f l) end 2. option as a monad: structure OptionMonad : MONAD = struct type 'a m = 'a option val return = SOME fun bind x f = case x of NONE => NONE | SOME v => f v end In these examples, of course, the interpretation of monad elements as actions on a state does not work, except perhaps in a trivail way (i.e., the "action" part is missing). 3. Input as a monad: structure InputMonad : MONAD = struct type 'a m = 'a Input.reader val return = Input.return val bind = Input.chain end Exercise: Show that all three of these example monads satisfy the monad laws (1) and (2) are satisfied. Show that the Input monad satisfies (3). 4. Another example: association lists as a monad This models a memory or store containing integers indexed by strings. type Alist = [(String, Int)] bind :: String -> Int -> Alist -> Alist bind s n a = (s,n):a lookup1 :: String -> Alist -> Int lookup1 s [] = error "unbound key" lookup1 s ((s',v):al) | s == s' = v | otherwise = lookup1 s al data AlistM a = AlistM (Alist -> (a, Alist)) assign :: String -> Int -> AlistM () assign s n = AlistM(\alist -> ((), bind s n alist)) value :: String -> AlistM Int value s = AlistM(\alist -> (lookup1 s alist, alist)) instance Monad AlistM where return a = AlistM(\alist -> (a, alist)) AlistM m >>= f = AlistM(\alist -> let (v,alist') = m alist AlistM g = f v in g alist')