[Haskell-cafe] Re: A question about "monad laws"
Andrew Butterfield
Andrew.Butterfield at cs.tcd.ie
Mon Feb 11 10:59:46 EST 2008
Andrew Butterfield wrote:
> let m denote the "list monad" (hypothetically). Let's instantiate:
>
> return :: x -> [x]
> return x = [x,x]
>
> (>>=) :: [x] -> (x -> [y]) -> [y]
> xs >>= f = concat ((map f) xs)
>
> Let g n = [show n]
>
> Here (return 1 >>= g ) [1,2,3] = ["1","1","1","1","1","1"]
> but g[1,2,3] = ["1","2","3"],
> thus violating the first monad law | return
> <http://haskell.org/ghc/docs/latest/html/libraries/base/Prelude.html#v:return>
> a >>=
> <http://haskell.org/ghc/docs/latest/html/libraries/base/Prelude.html#v:>>=>
> f = f a
>
I messed this up - I was trying for the simplest example I could get !
Apologies.
Start over:
Program ----------------------------------------------------
module BadMonad where
import Monad
newtype MyList t = MyList [t]
instance Show t => Show (MyList t) where
show (MyList xs) = show xs
unmylist (MyList xs) = xs
myconcat xs = MyList (concat (map unmylist xs))
instance Monad MyList where
return x = MyList [x,x]
(MyList xs) >>= f = myconcat ((map f) xs)
i2s :: Int -> MyList Char
i2s x = MyList (show x)
m = i2s 9
Hugs transcript ----------------------------------------
BadMonad> m
"9" :: MyList Char
BadMonad> m >>= return
"99" :: MyList Char
We violate the second law (Right Identity, m = m >>= return )
--
--------------------------------------------------------------------
Andrew Butterfield Tel: +353-1-896-2517 Fax: +353-1-677-2204
Foundations and Methods Research Group Director.
Course Director, B.A. (Mod.) in CS and ICT degrees, Year 4.
Department of Computer Science, Room F.13, O'Reilly Institute,
Trinity College, University of Dublin, Ireland.
http://www.cs.tcd.ie/Andrew.Butterfield/
--------------------------------------------------------------------
More information about the Haskell-Cafe
mailing list