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
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/