[GHC] #15225: `-fno-state-hack` produces incorrect results in nofib

[GHC]

#15225: `-fno-state-hack` produces incorrect results in nofib
-------------------------------------+-------------------------------------
        Reporter:  tdammers          |                Owner:  tdammers
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:  8.6.1
       Component:  Compiler          |              Version:  8.5
      Resolution:                    |             Keywords:
Operating System:  Linux             |         Architecture:  x86_64
 Type of failure:  Incorrect result  |  (amd64)
  at runtime                         |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:  #7411             |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by tdammers):

 I quickly and naively tried just using `useAsCString` instead of
 `unsafeUseAsCString`, but of course that doesn't quite work - probably
 because the code relies on actually manipulating the bytestring in place,
 whereas `useAsCString` creates a copy and manipulates that. So the output
 no longer matches that of the C implementation, but the `-fno-state-hack`
 flag no longer causes the output to differ.

 So I went a step further, and rewrote the relevant part in more idiomatic
 Haskell, using `ByteString.unfoldrN` instead of manipulating C strings in-
 place:

 {{{#!diff
 commit dc2753f4e10fec79c02ed293b72573f1aeaa2271
 Author: Tobias Dammers <tdammers at gmail.com>
 Date:   Fri Jun 15 11:27:36 2018 +0200

     Rewrite fasta in more idiomatic Haskell

 diff --git a/shootout/fasta/Main.hs b/shootout/fasta/Main.hs
 index 4bd0849..795a470 100644
 --- a/shootout/fasta/Main.hs
 +++ b/shootout/fasta/Main.hs
 @@ -11,7 +11,9 @@ import Foreign.Ptr
  import Foreign.Storable
  import System.Environment
  import qualified Data.ByteString.Char8 as B
 +import qualified Data.ByteString as BS
  import qualified Data.ByteString.Lazy.Char8 as L
 +import Data.Word (Word8)

  main = do
      n <- getArgs >>= readIO.head
 @@ -27,21 +29,30 @@ make name n0 tbl seed0 = do
    B.putStrLn name
    let modulus = 139968
        fill ((c,p):cps) j =
 -       let !k = min modulus (floor (fromIntegral modulus * (p::Float) +
 1))
 -       in B.replicate (k - j) c : fill cps k
 +        let !k = min modulus (floor (fromIntegral modulus * (p::Float) +
 1))
 +        in B.replicate (k - j) c : fill cps k
        fill _ _ = []
        lookupTable = B.concat $ fill (scanl1 (\(_,p) (c,q) -> (c,p+q))
 tbl) 0
 -      line = B.replicate 60 '\0'
 -  unsafeUseAsCString line $ \ptr -> do
 -    let make' n !i seed
 -           | n > (0::Int) = do
 -               let newseed = rem (seed * 3877 + 29573) modulus
 -               plusPtr ptr i `poke` unsafeIndex lookupTable newseed
 -               if i+1 >= 60
 -                   then puts line 60 >> make' (n-1) 0 newseed
 -                   else make' (n-1) (i+1) newseed
 -           | otherwise = when (i > 0) (puts line i) >> return seed
 -    make' n0 0 seed0
 +
 +  let next :: Int -> Maybe (Word8, Int)
 +      next seed =
 +        let newseed = rem (seed * 3877 + 29573) modulus
 +            val = unsafeIndex lookupTable newseed
 +        in Just (val, newseed)
 +
 +  let make' :: Int -> Int -> IO Int
 +      make' n seed = do
 +        if n <= (0 :: Int) then
 +          return seed
 +        else if n >= 60 then do
 +          let (line, Just newseed) = BS.unfoldrN 60 next seed
 +          puts line 60
 +          make' (n-60) newseed
 +        else do
 +          let (line, Just newseed) = BS.unfoldrN n next seed
 +          puts line n
 +          return newseed
 +  make' n0 seed0

  alu =
 "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGG\
 \TCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGG\
 }}}

 The patched version produces the correct output regardless of the state
 hack; however, I haven't done a full profiling run yet to see how it
 affects performance.

 However, considering that the unidiomatic version is essentially wrong,
 and, well, unidiomatic, I'm not so sure whether it told us anything
 meaningful in the first place.

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15225#comment:7>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler