I took your code and made a few style cleanups so that hlint wouldn't complain and so that it would be easier to read. Then I read through the code and found where your code had a space leak (repeated in the client and server code). I haven't put any effort into benchmarking, profiling, etc., just cleaning it up and fixing the algorithmic issues that I noticed. Here's the current version: https://gist.github.com/etrepum/7362646 You can see the revisions here: https://gist.github.com/etrepum/7362646/revisions The space leak is a strictness issue that is common for Haskell beginners to do. Before bothering to read any more of this message, I highly recommend reading this section of Parallel and Concurrent Programming in Haskell. It has great coverage on how Haskell's evaluation works: http://chimera.labs.oreilly.com/books/1230000000929/ch02.html#sec_par-eval-w... Here's a minimal-ish example of what your code ends up doing: sum :: [Int] -> Int sum = sum' 0 sum' :: Int -> [Int] -> Int sum' acc (x:xs) = sum' (acc + x) xs sum' acc _ = acc Why does this code have a space leak? Because `acc` is never forced. When sum' recurses, the first argument is a thunk `x + acc` rather than the value of that computation. This is a space leak because the value of `x + acc` can be stored in constant space (an Int) but the nested thunks takes up linear space (a thunk that references `x` and `acc` which is a thunk itself except for the initial 0). The stack overflow happens because linear stack space and computation is required to evaluate this thunk, which your code does at the end when it prints the value. There are many ways to fix this, one way without resorting to BangPatterns would be to use `seq` to ensure that acc is evaluated before it is used. sum :: [Int] -> Int sum = sum' 0 sum' :: Int -> [Int] -> Int sum' acc _ | seq acc False = undefined sum' acc (x:xs) = sum' (acc + x) xs sum' acc _ = acc The BangPatterns method used in my cleanup is basically syntax sugar for the above, but it is not currently part of the Haskell standard so a LANGUAGE pragma is required to use it. -bob On Thu, Nov 7, 2013 at 7:40 AM, Thomas Bach wrote:

Hi list,

I had to do a little benchmarking of a network connection between two servers and I thought “Well, Haskell seemed pretty awesome, let's use it to accomplish the task.” So I spent a couple of days with the Haskell library and finally got the following (working!) code (see below). Now my questions:

1) Although being a beautiful language, my code seems to be ugly. Any hints to improve this? My problem is (I think) that I simply cannot get rid of the IO Monad and the only way I know how to deal with this is by using lots of 'do's which doesn't help at all to get rid of the monads. (Probably the imperative background problem…) :)

2) The program I wrote doesn't perform. It sended around 33 MBytes in 10 seconds over a connection where iperf (the one packaged by Ubuntu, written in C) was able send 650 MBytes. Where can I improve performance? I'm especially interested in the low hanging fruits, which are easy to understand as a Haskell novice. ;)

3) When I run this program, I get the following Error (both, on the client, as well as on the server):

$./iperf -c localhost "Running as client connecting to localhost" Stack space overflow: current size 8388608 bytes. Use `+RTS -Ksize -RTS' to increase it.

enlarging the stack space avoids it, but how can I avoid it in the code? I guess that the stack space overflow comes from the recursive call to receiveData on the server and sendIntermediateAndFinalData in the client. I thought that in the way I implemented it, these functions are tailor recursive and therefor not prone to stack overflows!?! Anyway, I didn't check that, so maybe the error is somewhere else…

Regards, Thomas Bach.

PS: This is the code pasted “As Quotation”. I couldn't find another way to get the code into Thunderbird w/o messing up line breaks and the like. I additionally added the code as an attachment. I hope this is ok – time to get a new MUA!

...

import Data.Time (DiffTime, utctDayTime, getCurrentTime) import Foreign (ForeignPtr, Int64, Ptr, mallocForeignPtr, withForeignPtr) import Foreign.Storable (sizeOf, peek, poke) import GHC.IO.Handle (Handle, BufferMode(NoBuffering), hClose, hGetBuf, hSetBuffering, hPutBuf) import Network (Socket, HostName, PortID(PortNumber), PortNumber, accept, connectTo, listenOn, withSocketsDo) import System.Console.GetOpt (ArgOrder(Permute), ArgDescr(..), OptDescr(..), getOpt, usageInfo) import System.Environment (getArgs)

data Flag = Client String | Server deriving Show

-- Command line arguments for server and client mode.

options :: [OptDescr Flag] options = [ Option ['c'] ["client"] (ReqArg Client "HOST") "Connect to host as client." , Option ['s'] ["server"] (NoArg Server) "Run as server." ]

perfOpts :: [String] -> IO [Flag] perfOpts argv = case getOpt Permute options argv of ([], [], []) -> ioError (userError ("At least one Option is needed." ++ usageInfo "" options)) (o, [], []) -> return o (_, _, errs) -> ioError (userError (concat errs ++ usageInfo "" options))

-- Some constants

port = PortNumber 8456 type Trans = Int64 numBytes = sizeOf (0 :: Trans) inital = -128 :: Trans intermediate = 0 :: Trans final = 127 :: Trans

makePtr = mallocForeignPtr :: IO (ForeignPtr Trans)

-- The client connects to the server, initializes the connection -- by sending initial, sends then for the amount of at least -- 10 secs as much intermediate (0's) as possible and finally -- sends final.

runClient :: String -> IO () runClient host = do print ("Running as client connecting to " ++ host) hdl <- initClient host port ptr <- makePtr fillInitial ptr withForeignPtr ptr (sendBuf hdl) fillIntermediate ptr curTime <- fmap utctDayTime getCurrentTime (sentBytes, time) <- sendIntermediateAndFinal ptr hdl curTime 10 0 print ("Sent " ++ show sentBytes ++ " Bytes in " ++ show time ++ " seconds.") hClose hdl

initClient :: HostName -> PortID -> IO Handle initClient host port = withSocketsDo $ do hdl <- connectTo host port hSetBuffering hdl NoBuffering return hdl

sendIntermediateAndFinal :: ForeignPtr Trans -> Handle -> DiffTime -> DiffTime -> Int -> IO (Int, DiffTime) sendIntermediateAndFinal ptr hdl start duration sent = do curTime <- fmap utctDayTime getCurrentTime if (curTime - start) > duration then do fillFinal ptr withForeignPtr ptr (sendBuf hdl) finishedTime <- fmap utctDayTime getCurrentTime return (sent + numBytes, finishedTime - start) else do withForeignPtr ptr (sendBuf hdl) sendIntermediateAndFinal ptr hdl start duration (sent + numBytes)

sendBuf :: Handle -> Ptr Trans -> IO () sendBuf hdl buf = hPutBuf hdl buf numBytes

fillPtr :: Trans -> ForeignPtr Trans -> IO () fillPtr num ptr = withForeignPtr ptr (\p -> poke p num)

fillInitial = fillPtr inital fillIntermediate = fillPtr intermediate fillFinal = fillPtr final

-- The server simply accepts connections, receives what it can get -- and adds up the received bytes and transmission time.

runServer :: IO () runServer = do print "Running as server." initServer port >>= handleConnection

initServer :: PortID -> IO Socket initServer port = withSocketsDo $ listenOn port

handleConnection :: Socket -> IO () handleConnection socket = do (hdl, host, port) <- acceptConnection socket print ("Connection from " ++ host) ptr <- makePtr (num, bytes) <- receive ptr hdl curTime <- fmap utctDayTime getCurrentTime if num == inital then do (received, time) <- receiveData ptr hdl curTime 0 print ("Received " ++ show received ++ " in " ++ show time ++ " seconds.") hClose hdl handleConnection socket else do print ("ERR: Expected " ++ show inital ++ " got " ++ show num) hClose hdl handleConnection socket

acceptConnection :: Socket -> IO (Handle, HostName, PortNumber) acceptConnection socket = do (hdl, host, port) <- accept socket hSetBuffering hdl NoBuffering return (hdl, host, port)

receiveData :: ForeignPtr Trans -> Handle -> DiffTime -> Int -> IO (Int, DiffTime) receiveData ptr hdl started received = do (num, bytes) <- receive ptr hdl if num /= final then receiveData ptr hdl started (received + bytes) else do curTime <- fmap utctDayTime getCurrentTime return (received + bytes, curTime - started)

receive :: ForeignPtr Trans -> Handle -> IO (Trans, Int) receive ptr hdl = do withForeignPtr ptr (\p -> hGetBuf hdl p numBytes) num <- withForeignPtr ptr peek return (num, numBytes)

-- The main routine decides whether to run as server or client.

main :: IO () main = do opts <- getArgs >>= perfOpts if length opts /= 1 then ioError (userError ("Too many arguments!" ++ usageInfo "" options)) else case head opts of Server -> runServer Client host -> runClient host

_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners