[Haskell-cafe] Overriding a Prelude function?

Thomas van Noort thomas at cs.ru.nl
Wed Apr 22 15:23:50 EDT 2009


You can hide (>>) from the implicit import of Prelude using:

import Prelude hiding ((>>))

Kind regards,
Thomas

michael rice wrote:
> I've been working through this example from: 
> http://en.wikibooks.org/wiki/Haskell/Understanding_monads
> 
> I understand what they're doing all the way up to the definition of 
> (>>), which duplicates Prelude function (>>). To continue following the 
> example, I need to know how to override the Prelude (>>) with the (>>) 
> definition in my file rand.hs.
> 
> Michael
> 
> ==============
> 
> [michael at localhost ~]$ cat rand.hs
> import System.Random
> 
> type Seed = Int
> 
> randomNext :: Seed -> Seed
> randomNext rand = if newRand > 0 then newRand else newRand + 2147483647
>     where newRand = 16807 * lo - 2836 * hi
>           (hi,lo) = rand `divMod` 127773
> 
> toDieRoll :: Seed -> Int
> toDieRoll seed = (seed `mod` 6) + 1
> 
> rollDie :: Seed -> (Int, Seed)
> rollDie seed = ((seed `mod` 6) + 1, randomNext seed)
> 
> sumTwoDice :: Seed -> (Int, Seed)
> sumTwoDice seed0 =
>   let (die1, seed1) = rollDie seed0
>       (die2, seed2) = rollDie seed1
>   in (die1 + die2, seed2)
> 
> (>>) m n = \seed0 ->
>   let (result1, seed1) = m seed0
>       (result2, seed2) = n seed1
>   in (result2, seed2)
> 
> [michael at localhost ~]$
> 
> 
> 
> ------------------------------------------------------------------------
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe



More information about the Haskell-Cafe mailing list