[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