[Haskell-cafe] Battling laziness

[Joel Reymont]

Folks,

I have a huge space leak someplace and I suspect this code. The  
SrvServerInfo data structure is something like 50K compressed or  
uncompressed byte data before unpickling. My thousands of bots issue  
this request at least once and I almost run out of memory with 100  
bots on a 1Gb machine on FreeBSD. Do I need deepSeq somewhere below?

This is the read.

read :: Handle -> (SSL, BIO, BIO) -> IO Command
read h _ =
     do sa <- emptyByteArray 4
        hGetArray h sa 4
        (size', _) <- unpickle endian32 sa 0
        let size = fromIntegral $ size' - 4
        packet <- emptyByteArray size
        hGetArray h packet size
        unstuff packet 0

I suspect that I need to deepSeq cmd'' instead of return $! cmd''

unstuff :: MutByteArray -> Index -> IO Command
unstuff array ix =
     do (kind, ix1) <- unpickle puCmdType array ix
        (cmd', _) <- unpickle (puCommand kind) array ix1
        case cmd' of
          InvalidCommand -> do fail $ "unstuff: Cannot parse " ++  
show array
          SrvCompressedCommands sz bytes ->
              do bytes' <- uncompress bytes (fromIntegral sz)
                 cmd'' <- unstuff bytes' 4
                 return $! cmd''
          _ -> return cmd'

This is where the list of active tables is converted to a table id  
list of [Word32].

pickTable _ filters (Cmd cmd@(SrvServerInfo {})) =
     do let tables = filter (tableMatches filters) $ activeTables cmd
            ids = map tiTableID tables
        case tables of
          [] -> fail $ "pickTable: No tables found: " ++ show filters
          _ ->
              do pop
                 stoptimer "pickTable"
                 return $! Eat $! Just $! Custom $! Tables $! ids

This is where the table id list of [Word32] is consumed.

takeEmptySeat _ aff_id _ (Custom (Tables ids@(table:rest))) =
     do trace 85 $ "takeEmptySeat: " ++ show (length ids)
                  ++ " tables found"
        trace 100 $ "takeEmptySeat: tables: " ++ showTables ids
        trace 85 $ "takeEmptySeat: trying table# " ++ show table
        w <- get
        put_ $ w { tables_to_try = rest }
        push "goToTable" $ goToTable table aff_id
        -- kick off goToTable
        return $ Eat $ Just Go

This is the SrvServerInfo structure.

     | SrvServerInfo
       {
        activeTables :: ![TableInfo], -- Word16/
        removedTables :: ![Word32], -- Word16/
        version :: !Int32
       }

And this is the table info itself.

data TableInfo = TableInfo
     {
      tiAvgPot :: !Word64,
      tiNumPlayers :: !Word16,
      tiWaiting :: !Word16,
      tiPlayersFlop :: !Word8,
      tiTableName :: !String,
      tiTableID :: !Word32,
      tiGameType :: !GameType,
      tiInfoMaxPlayers :: !Word16,
      tiIsRealMoneyTable :: !Bool,
      tiLowBet :: !Word64,
      tiHighBet :: !Word64,
      tiMinStartMoney :: !Word64,
      tiMaxStartMoney :: !Word64,
      tiGamesPerHour :: !Word16,
      tiTourType :: !TourType,
      tiTourID :: !Word32,
      tiBetType :: !BetType,
      tiCantReturnLess :: !Word32,
      tiAffiliateID :: ![Word8],
      tiLangID :: !Word32
     }  deriving (Show, Typeable)

	Thanks, Joel

--
http://wagerlabs.com/