[GHC] #13653: Re-allocate byteArray lead internal error: evacuate: strange closure type 241

[GHC]

#13653: Re-allocate byteArray lead internal error: evacuate: strange closure type
241
-------------------------------------+-------------------------------------
        Reporter:  winter            |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  high              |            Milestone:
       Component:  Compiler          |              Version:  8.0.1
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:  x86_64
                                     |  (amd64)
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------
Description changed by winter:

@@ -15,0 +15,1 @@
+ import Data.Word
@@ -29,1 +30,1 @@
-         | otherwise = do let n' = (n + 1) `shiftL` 1
+         | otherwise = do let n' = n * 2
@@ -45,1 +46,1 @@
- main = print $ packN 64 (List.replicate 8192 128)
+ main = packN 64 (List.replicate 100000 128) `seq` return ()

New description:

 Compile and run following code lead to {{{evacuate: strange closure type
 XXX}}} on GHC 7.10.3/8.0.2/head, which is unreasonable. But running in
 GHCi is fine.

 {{{
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE UnboxedTuples #-}

 import qualified Data.List as List
 import GHC.Prim
 import Data.Primitive.ByteArray
 import GHC.Types
 import GHC.ST
 import Data.Word

 data Bytes = Bytes {-# UNPACK #-} !ByteArray -- payload
                    {-# UNPACK #-} !Int       -- s
                    {-# UNPACK #-} !Int       -- length

 packN :: Int -> [Word8] -> Bytes
 packN n0 ws0 = runST (newByteArray n0 >>= go 0 n0 ws0)
   where
     go :: Int -> Int -> [Word8] -> MutableByteArray s -> ST s Bytes
     go !i !n []     !mba = do ba <- unsafeFreezeByteArray mba
                               return (Bytes ba 0 i)
     go !i !n (w:ws) !mba
         | i <= n    = do writeByteArray mba i w
                          go (i+1) n ws mba
         | otherwise = do let n' = n * 2
                          -- mba' <- newByteArray n'  -- these dosen't work
 either
                          -- copyMutableByteArray mba' 0 mba 0 i
                          mba' <- resizeMutableByteArray mba n'
                          writeByteArray mba' i w
                          go (i+1) n' ws mba'

 resizeMutableByteArray :: MutableByteArray s -> Int -> ST s
 (MutableByteArray s)
 resizeMutableByteArray (MutableByteArray mba#) (I# i#) =
     ST (\ s# ->
             let (# s'#, mba'# #) = resizeMutableByteArray# mba# i# s#
             in (# s'#, MutableByteArray mba'# #)
        )

 main = packN 64 (List.replicate 100000 128) `seq` return ()
 }}}

--

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