[Haskell-cafe] Battling laziness

Joel Reymont joelr1 at gmail.com
Fri Dec 16 11:00:33 EST 2005


On Dec 16, 2005, at 3:47 PM, Simon Marlow wrote:

> interesting... Word8 and Int correspond to the -hd output above,  
> but '*'
> indicates that the type of the <Script.Array.sat_s46N> is polymorphic.
> Completely polymorphic closures like this are usually (error
> "something"), which is a silly thing to fill up your heap with :-)

Hmm... I'm attaching the pickling code that I use at the end,  
together with a sample of how I use it to pickle/unpickle SrvServerInfo.

> I'm a bit mystified though, because looking at the code for
> Script.Array, all your arrays are unboxed, so I don't know where  
> all the
> Word8s and Ints are coming from.  It might be useful to do "+RTS
> -hyWord8 -hc" to see who generated the Word8s.

I will do it. Why bother with Word8, though? Shouldn't I be looking  
for the polymorphic closures instead?

>   Oh, and it looks like
> you aren't doing -auto-all, that would probably be helpful.

I compile like this:

ghc -O --make -prof -auto-all randomplay.hs -o randomplay -lssl - 
lcrypto -lz

and run like this:

./randomplay +RTS -p -hd -hclaunchScripts#8

Did I miss -auto-all somewhere?

I have Cabal 1.1.4 and I give configure the -p option which builds  
the profiled libraries for me. Do I need to separately give -auto-all  
to the compiler below

ghc-options: -fglasgow-exts -Wall -threaded -fno-warn-name-shadowing

	Thanks, Joel

----
{-# OPTIONS_GHC -fglasgow-exts -fth #-}
module Script.Pickle where

import Data.Word
import Data.Int
import Data.Bits
import Data.Char
import Data.Maybe
import Data.Array.MArray
import Script.Array
import Control.Monad

data PU a = PU
     {
      appP :: MutByteArray -> Index -> a -> IO Index,
      appU :: MutByteArray -> Index -> IO (a, Index),
      appS :: a -> IO Int
     }

pickle :: PU a -> MutByteArray -> Index -> a -> IO Index
pickle p array ix value = appP p array ix value

unpickle :: PU a -> MutByteArray -> Index -> IO (a, Index)
unpickle p array ix = appU p array ix

sizeup :: PU a -> a -> IO Int
sizeup p value = appS p value

lift :: a -> PU a
lift x = PU (\_ ix _ -> return ix) (\_ ix -> return (x, ix)) (\_ ->  
return 0)

sequ :: (b -> a) -> PU a -> (a -> PU b) -> PU b
sequ f pa k = PU
               (\array ix b ->
                    do let a = f b
                           pb = k a
                       ix1 <- appP pa array ix a
                       appP pb array ix1 b)
               (\array ix ->
                    do (a, ix1) <- appU pa array ix
                       let pb = k a
                       appU pb array ix1)
               (\b ->
                    do let a = f b
                           pb = k a
                       sz1 <- appS pa a
                       sz2 <- appS pb b
                       return $ sz1 + sz2)

pair :: PU a -> PU b -> PU (a,b)
pair pa pb = sequ fst pa (\ a -> sequ snd pb
                           (\ b -> lift (a, b)))

triple :: PU a -> PU b -> PU c -> PU (a, b, c)
triple pa pb pc = sequ (\ (x, _, _) -> x) pa
                   (\a -> sequ (\ (_, y, _) -> y) pb
                    (\b -> sequ (\ (_, _, z) -> z) pc
                     (\c -> lift (a, b, c))))

quad :: PU a -> PU b -> PU c -> PU d -> PU (a, b, c, d)
quad pa pb pc pd = sequ (\ (w, _, _, _) -> w) pa
                    (\a -> sequ (\ (_, x, _, _) -> x) pb
                     (\b -> sequ (\ (_, _, y, _) -> y) pc
                      (\c -> sequ (\ (_, _, _, z) -> z) pd
                       (\d -> lift (a, b, c, d)))))

wrap :: (a -> b, b -> a) -> PU a -> PU b
wrap (i, j) pa = sequ j pa (lift . i)

unit :: PU ()
unit = lift ()

{-# SPECIALIZE num :: PU Word8 #-}
{-# SPECIALIZE num :: PU Word16 #-}
{-# SPECIALIZE num :: PU Word32 #-}
{-# SPECIALIZE num :: PU Word64 #-}
{-# SPECIALIZE num :: PU Int16 #-}
{-# SPECIALIZE num :: PU Int32 #-}

num :: (Integral a, Bits a) => PU a
num = PU appP_num appU_num (return . byteSize)

char :: PU Char
char = wrap (fromByte, toByte) num

bool :: PU Bool
bool = wrap (toenum, fromenum) byte

enum :: (Integral a, Bits a, Enum b) => PU a -> PU b
enum pa = wrap (toenum, fromenum) pa

byte :: PU Word8
byte = num

short :: PU Word16
short = num

uint :: PU Word32
uint = num

fixlist :: PU a -> Int -> PU [a]
fixlist _ 0 = lift []
fixlist pa n = wrap (\(a, b) -> a : b,
                      \(a : b) -> (a, b))
                (pair pa (fixlist pa (n - 1)))

list :: (Integral a, Bits a) => PU a -> PU b -> PU [b]
list pa pb = sequ (fromIntegral . length) pa (\a -> fixlist pb  
(fromIntegral a))

alt :: (a -> Word8) -> [PU a] -> PU a
alt tag ps = sequ tag byte (((!!) ps) . fromIntegral)

optional :: PU a -> PU (Maybe a)
optional pa = alt tag [lift Nothing, wrap (Just, fromJust) pa]
     where tag Nothing = 0; tag (Just _) = 1

chunk :: Integral a => PU a -> PU ByteArray
chunk pa = sequ
            (fromIntegral . (+ 1) . snd . bounds)
            pa
            (\a -> bytearray $ fromIntegral a)

bytearray :: Int -> PU ByteArray
bytearray sz = PU
                (\array ix a ->
                     do let count = (snd $ bounds a) + 1
                        copyIArray array ix a 0 count
                        return $ ix + sz)
                (\array ix ->
                     do new <- emptyByteArray sz
                        copyMArray new 0 array ix sz
                        pure <- freeze new
                        return (pure, ix + sz))
                (\a -> return $ (snd $ bounds a) + 1)

--- Basic implementation

byteSize :: forall a.(Num a, Bits a) => a -> Int
byteSize a = bitSize a `div` 8

appP_num :: (Num a, Integral a, Bits a) => MutByteArray -> Index -> a  
-> IO Index
appP_num array ix a =
     do writeBits array ix a
        return $ ix + byteSize a

appU_num :: (Num a, Integral a, Bits a) => MutByteArray -> Index ->  
IO (a, Index)
appU_num array ix =
     do a <- readBits array ix
        return (a, ix + byteSize a)

--- Utility

toenum :: forall a b.(Enum a, Integral b) => b -> a
toenum = toEnum . fromIntegral

fromenum :: forall b a. (Num b, Enum a) => a -> b
fromenum = fromIntegral . fromEnum

fromByte :: Enum a => Word8 -> a
fromByte = toEnum . fromIntegral

toByte ::  Enum a => a -> Word8
toByte = fromIntegral . fromEnum

And I use it like this:

puTableInfo :: PU TableInfo
puTableInfo =
     sequ tiAvgPot endian64
          (\a -> sequ tiNumPlayers endian16
           (\b -> sequ tiWaiting endian16
            (\c -> sequ tiPlayersFlop byte
             (\d -> sequ tiTableName wstring
              (\e -> sequ tiTableID endian32
               (\f -> sequ tiGameType (enum endian16 :: PU GameType)
                (\g -> sequ tiInfoMaxPlayers endian16
                 (\h -> sequ tiIsRealMoneyTable bool
                  (\i -> sequ tiLowBet endian64
                   (\j -> sequ tiHighBet endian64
                    (\k -> sequ tiMinStartMoney endian64
                     (\l -> sequ tiMaxStartMoney endian64
                      (\m -> sequ tiGamesPerHour endian16
                       (\n -> sequ tiTourType (enum byte)
                        (\o -> sequ tiTourID endian32
                         (\p -> sequ tiBetType (enum byte)
                          (\q -> sequ tiCantReturnLess endian32
                           (\r -> sequ tiAffiliateID (list endian32  
byte)
                            (\v -> sequ tiLangID endian32
                             (\w -> lift $
                                    TableInfo a b c d e f g
                                              h i j k l m n
                                                o p q r v w
                                ))))))))))))))))))))

--
http://wagerlabs.com/







More information about the Haskell-Cafe mailing list