noinline in where clauses again

[Duncan Coutts]

I winged before about NOINLINE pragma on things defined locally in a
where clause not doing what I expected:

http://www.mail-archive.com/glasgow-haskell-users@haskell.org/msg10338.html

Turns out that one was fixed in ghc HEAD.

I've got another similar one which is not working as I expect in 6.6 or
in head from 1st March.

This example is from an experimental re-implementation of the Put monad
in Data.Binary:

write :: Int -> (Ptr Word8 -> IO ()) -> Put ()
write !n body = Put $ \c buf@(Buffer fp o u l) ->
  if n <= l
    then write' c fp o u l
    else write' (flushOld c n fp o u) (newBuffer c n) 0 0 0

  where {-# NOINLINE write' #-}
        write' c !fp !o !u !l =
          -- warning: this is a tad hardcore
          B.inlinePerformIO
            (withForeignPtr fp
              (\p -> body $! (p `plusPtr` (o+u))))
          `seq` c () (Buffer fp o (u+n) (l-n))
{-# INLINE [1] write #-}

Then we use it with things like

word8 :: Word8 -> Put ()
word8 !w = write 1 (pokeWord8 w)

pokeWord8 :: Word8 -> Ptr Word8 -> IO ()
pokeWord8 w p = poke p w

Then there's a rule so that things like:

foo :: Word8 -> Put ()
foo !n = do
  word8 n
  word8 (n+1)
  word8 (n+17)

get turned into a single call to write.

Anyway, the point is that when we look at the stg/core we see that in
write above, the write' has been inlined at the two call sites where as
I want both branches of the if test to make calls to write'.

The code is here:
http://haskell.org/~duncan/binary/PutMonad.hs
http://haskell.org/~duncan/binary/PutTest.hs

the stg from ghc-6.6 is:
http://haskell.org/~duncan/binary/PutTest.stg

with ghc head from 1st March the result is different but still inlines
write' in both branches.

Duncan