[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
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:  x86_64         |   Type of failure:  None/Unknown
  (amd64)                            |
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 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

 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 + 1) `shiftL` 1
                          -- 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 = print $ packN 64 (List.replicate 8192 128)
 }}}

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