<div dir="ltr"><br><div class="gmail_extra"><br><br><div class="gmail_quote">On Sat, Aug 2, 2014 at 12:30 AM, Bertram Felgenhauer <span dir="ltr"><<a href="mailto:bertram.felgenhauer@googlemail.com" target="_blank">bertram.felgenhauer@googlemail.com</a>></span> wrote:<br>

<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div class="">Carter Schonwald wrote:<br>
> I tried compiling your original codes with normal unsafePerformIO on ghc<br>
> 7.8.3, and I get the "B" result at -O0 and the "A" result at O1 and O2<br>
><br>
> {-# LANGUAGE BangPatterns,  UnboxedTuples,MagicHash #-}<br>
><br>
> import Data.ByteString.Internal (inlinePerformIO)<br>
> import qualified Data.Vector as V<br>
> import qualified Data.Vector.Mutable as VM<br>
><br>
> import System.IO.Unsafe<br>
><br>
> main :: IO ()<br>
> main = do<br>
>     vm <- VM.new 1<br>
>     VM.write vm 0 'A'<br>
>     !b<- return $! 'B'<br>
>     let !x = unsafePerformIO $! VM.write vm 0 b<br>
>     x `seq` (V.freeze vm >>= print)<br>
<br>
</div>Note that the compiler sees through  !b<- return $! 'B', so it does<br>
not introduce a data dependency. Looking at the core, x is getting<br>
evaluated (writing 'B' to the array) before the writeArray# call<br>
resulting from VM.write vm 0 'A'.<br>
<br>
I'm not 100% sure that the compiler is within its rights for reordering<br>
code here; after all, writeArray# has a side effect, which will not<br>
be performed in the hypothetical case that evaluation of x diverges.<br>
But at least reordering effects is far less surprising than effects<br>
disappearing completely.<br>
<br>
[Michael Snoyman:]<br>
<div class="">> > One last question on the GHC front, however. It *does* seem like there's<br>
> > still a bug in GHC here, since presumably case-ing on an unboxed tuple<br>
> > should force evaluation of both of its values.<br>
<br>
</div>No, it should not. If it did,<br>
<br>
  main = return undefined >> print "Foo"<br>
<br>
would fail.<br>
<br></blockquote></div><br></div><div class="gmail_extra">Ahh, good point, thanks.<br><br>Michael<br></div></div>