[Haskell-cafe] Re: evaluation semantics of bind

ChrisK haskell at list.mightyreason.com
Thu Feb 5 14:20:39 EST 2009


Gregg Reynolds wrote:
>     getChar >>= \x -> getChar
> 
> An optimizer can see that the result of the first getChar is discarded

True, so 'x' is not used, and it can be garbage collected, and may not even be 
created.

But that data dependency is simple not the data dependency that make IO 
sequential.  Here is code from IOBase.lhs for GHC:

> newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))

The # are unboxed types and thus strict, but here we can erase them for clarity:

newtype IO a = IO (State RealWorld -> (State RealWorld, a))

getChar is of type IO Char so that is constructor IO applied to a function from 
the "State RealWorld" to a strict pair of "State RealWorld" and Char.

Since this is strict there is no laziness and the code must evaluate the input 
and output "State RealWorld" to ensure they are not bottom or error.

Here is the rest of the plumbing in GHC:

> unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
> unIO (IO a) = a
> 
> instance  Functor IO where
>    fmap f x = x >>= (return . f)
> 
> instance  Monad IO  where
>     {-# INLINE return #-}
>     {-# INLINE (>>)   #-}
>     {-# INLINE (>>=)  #-}
>     m >> k      =  m >>= \ _ -> k
>     return x    = returnIO x
> 
>     m >>= k     = bindIO m k
>     fail s      = failIO s
> 
> failIO :: String -> IO a
> failIO s = ioError (userError s)
> 
> liftIO :: IO a -> State# RealWorld -> STret RealWorld a
> liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
> 
> bindIO :: IO a -> (a -> IO b) -> IO b
> bindIO (IO m) k = IO ( \ s ->
>   case m s of 
>     (# new_s, a #) -> unIO (k a) new_s
>   )
> 
> thenIO :: IO a -> IO b -> IO b
> thenIO (IO m) k = IO ( \ s ->
>   case m s of 
>     (# new_s, _ #) -> unIO k new_s
>   )
> 
> returnIO :: a -> IO a
> returnIO x = IO (\ s -> (# s, x #))

The "bind" operation's case statement forces the unboxed "new_s :: State# 
RealWorld" to be strictly evaluated, and this depends on the input strict "s :: 
State# RealWorld".  This data dependency of new_s on s is what forces IO 
statements to evaluate sequentially.

Cheers,
    Chris



More information about the Haskell-Cafe mailing list