tl;dr: Thanks to Felipe's comments, I think I've found the issue, which is in the primitive package, together with a possible GHC bug. Following is my blow-by-blow walk through on this issue.

OK, a little more information, and a simpler repro. This is reproducible entirely with the primitive package:

    import Control.Monad.Primitive
    import Data.Primitive.Array

    main :: IO ()
    main = do

        arr <- newArray 1 'A'
        let unit = unsafeInlineIO $ writeArray arr 0 'B'
        readArray arr 0 >>= print
        return $! unit
        readArray arr 0 >>= print

However, it's not reproducible with the underlying primops:

    {-# LANGUAGE MagicHash, UnboxedTuples #-}
    import GHC.IO (IO (..))
    import GHC.Prim

    writeB :: MutableArray# RealWorld Char -> ()
    writeB arr# =
        case writeArray# arr# 0# 'B' realWorld# of
            _ -> ()

    read0 :: MutableArray# RealWorld Char -> IO Char
    read0 arr# = IO $ \s0# -> readArray# arr# 0# s0#

    test :: IO ((), IO Char)
    test = IO $ \s0# ->
      case newArray# 1# 'A' s0# of
        (# s1#, arr# #) ->
            (# s1#, (writeB arr#, read0 arr#) #)

    main :: IO ()
    main = do

        (unit, getter) <- test
        getter >>= print
        return $! unit
        getter >>= print

This behavior only occurs with optimizations turned on (unsurprising, given Felipe's find about the simplifier pass). Now, if I define a new operation:

    unsafeWriteArray :: MutableArray RealWorld a -> Int -> a -> ()
    unsafeWriteArray (MutableArray arr#) (I# i#) x =
        case writeArray# arr# i# x realWorld# of
            _ -> ()

and then replace my unit above with:

    let unit = unsafeWriteArray arr 0 'B'

it works as expected. Similarly, the following tweak fixes the example as well:

    arr@(MutableArray arr#) <- newArray 1 'A'
    let unit =
            case writeArray# arr# 0# 'B' realWorld# of
                _ -> ()

So it appears the bug is in writeArray, or more likely in primitive_. Sure enough, setting NOINLINE on primitive_ *does* resolve the issue. And looking at the definition of primitive_:

    primitive_ f = primitive (\s# -> (# f s#, () #))

this is starting to make sense. unsafeInlineIO is completely ignoring the resulting state value, as can be seen by its implementation:

    unsafeInlineIO m = case internal m realWorld# of (# _, r #) -> r

Therefore `f s#` is never getting evaluated. However, if we force evaluation by switching to:

    primitive_ f = primitive (\s# ->
        case f s# of
            s'# -> (# s'#, () #))

seems to solve the problem. I think this is the right approach for now, and I've sent a pull request to primitive with this tweak[1].

One last question on the GHC front, however. It *does* seem like there's still a bug in GHC here, since presumably case-ing on an unboxed tuple should force evaluation of both of its values. Indeed, after going through the above debugging, I can reproduce the issue using just primops:

    {-# LANGUAGE MagicHash, UnboxedTuples #-}
    import GHC.IO (IO (..))
    import GHC.Prim

    writeB :: MutableArray# RealWorld Char -> IO ()
    writeB arr# =
        IO $ \s0# ->
            (# writeArray# arr# 0# 'B' s0#, () #)

    inlineWriteB :: MutableArray# RealWorld Char -> ()
    inlineWriteB arr# =
        case f realWorld# of
            (# _, x #) -> x
      where
        IO f = writeB arr#

    test :: IO Char
    test = IO $ \s0# ->
      case newArray# 1# 'A' s0# of
        (# s1#, arr# #) ->
          case seq# (inlineWriteB arr#) s1# of
            (# s2#, () #) ->
              readArray# arr# 0# s2#

    main :: IO ()
    main = test >>= print

I've filed this as a bug with GHC[2].

Michael

[1] https://github.com/haskell/primitive/pull/11
[2] https://ghc.haskell.org/trac/ghc/ticket/9390

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe