[Haskell-cafe] Battling laziness

[Joel Reymont]

Looking at http://wagerlabs.com/randomplay.hd.ps I see closures  
(constructors?) in this order

<Script.Array.sat_s46N>
W8#
I#
<Script.Array.fromIntegral_s453>
<Script.Endian.sat_s1WxM>
:
<Script.Endian.sat_s1WF2>
W16#
<Script.PicklePlus.sat_s38YS>
stg_ap_2_upd_info

This tells me it's something having to do with array code. I'm  
attaching the Script.Array module at the end. This report does not  
tell me who is retaining the data, though.

Looking at http://wagerlabs.com/randomplay.hy.ps I see types ordered  
like this

*
Word8
Int
->*
[]
Char
Word16
TableInfo

What do I make of all these?

This is Script.Array:

--
module Script.Array where

import Data.Array.IO
import Data.Array.Unboxed
import Foreign hiding (newArray)
import Foreign.Ptr

type MutByteArray = IOUArray Int Word8
type ByteArray = UArray Int Word8
type Index = Int

arraySize :: HasBounds a =>  a Int e -> Int
arraySize a = (snd (bounds a)) + 1

emptyByteArray :: Int -> IO MutByteArray
emptyByteArray sz = newArray (0, sz - 1) 0

mkPureArray :: MutByteArray -> IO ByteArray
mkPureArray array = freeze array

copyMArray :: MutByteArray -> Index -> MutByteArray -> Index -> Int - 
 > IO ()
copyMArray _ _ _ _ 0 = return ()
copyMArray dest ix src src_ix n =
     do e <- readArray src src_ix
        writeArray dest ix e
        copyMArray dest (ix + 1) src (src_ix + 1) (n - 1)

copyIArray :: MutByteArray -> Index -> ByteArray -> Index -> Int ->  
IO ()
copyIArray _ _ _ _ 0 = return ()
copyIArray dest ix src src_ix n =
     do let e = src ! src_ix
        writeArray dest ix e
        copyIArray dest (ix + 1) src (src_ix + 1) (n - 1)

readBits :: forall a.(Num a, Bits a) => MutByteArray -> Index -> IO a
readBits array ix =
     readBits' array ix bitsize 0
         where bitsize = bitSize (undefined :: a)
               readBits' _ _ 0 acc = return acc
               readBits' array ix count acc =
                   do e <- readArray array ix
                      let e' = (fromIntegral e) `shiftL` (count - 8)
                      readBits' array (ix + 1) (count - 8) (acc + e')

writeBits :: (Integral a, Bits a) => MutByteArray -> Index -> a -> IO ()
writeBits array ix a =
     writeBits' array ix (bitSize a)
         where writeBits' _ _ 0 = return ()
               writeBits' array ix count =
                   do let mask = 0xff `shiftL` (count - 8)
                          a' = (a .&. mask) `shiftR` (count - 8)
                          a'' = fromIntegral a'
                      writeArray array ix a''
                      writeBits' array (ix + 1) (count - 8)

withByteArray :: ByteArray -> (Ptr Word8 -> IO a) -> IO a
withByteArray array fun =
     do let size = arraySize array
        allocaBytes size $ \ptr ->
            do copyBytes ptr array 0 size
               fun ptr
            where copyBytes _ _ _ 0 = return ()
                  copyBytes ptr arr ix sz =
                      do poke ptr (arr ! ix)
                         copyBytes (advancePtr ptr 1) arr (ix + 1)  
(sz - 1)

byteArrayFromPtr :: Ptr Word8 -> Int -> IO MutByteArray
byteArrayFromPtr ptr sz =
     do array <- emptyByteArray sz
        copyBytes array ptr 0 sz
        return array
            where copyBytes _ _ _ 0 = return ()
                  copyBytes array ptr ix n =
                      do e <- peek ptr
                         writeArray array ix e
                         copyBytes array (advancePtr ptr 1) (ix + 1)  
(n - 1)

instance Show MutByteArray where
     show a = show $ unsafePerformIO $ getElems a