为什么我的并发Haskell程序提前终止？

Question

我有一个UDP服务器,它反映了它收到的每个ping消息(我认为这很好用).我是客户端,我想做两件事:

1. 确保我发射了N(例如10000)消息,并且
2. 计算正确收到的回复数.

看来,无论是因为UDP的性质还是因为这forkIO件事,我的客户端代码都会过早结束/根本不进行任何计数.

另外,我很惊讶地看到函数tryOnePing返回Int 4的250倍.为什么会这样？

main = withSocketsDo $ do
        s <- socket AF_INET Datagram defaultProtocol
        hostAddr <- inet_addr host
        thread <- forkIO $ receiveMessages s
        -- is there any better way to eg to run that in parallel and make sure
        -- that sending/receiving are asynchronous? 


        -- forM_ [0 .. 10000] $ \i -> do
              -- sendTo s "ping" (SockAddrInet port hostAddr)
        -- actually this would be preferred since I can discard the Int 4 that
        -- it returns but forM or forM_ are out of scope here?

        let tryOnePing i = sendTo s "ping" (SockAddrInet port hostAddr)
        pings <- mapM tryOnePing [0 .. 1000]
        let c = length $ filter (\x -> x==4) pings

        -- killThread thread
        -- took that out to make sure the function receiveMessages does not
        -- end prematurely. still seems that it does

        sClose s
        print c
        -- return()

receiveMessages :: Socket -> IO ()
receiveMessages socket = forever $ do
        -- also tried here forM etc. instead of forever but no joy
        let recOnePing i = recv socket 1024
        msg <- mapM recOnePing [0 .. 1000]
        let r = length $ filter (\x -> x=="PING") msg
        print r
        print "END"

Answer 1

这里的主要问题是当你的主线程完成时,所有其他线程都会自动被杀死.您必须让主线程等待receiveMessages thread,否则它将在收到任何回复之前完成所有可能性.一个简单的方法是使用MVar.

An MVar是一个同步的单元格,可以为空或只保留一个值.如果当前线程尝试从空MVar或插入到完整线程,它将阻塞.在这种情况下,我们不关心价值本身,所以我们只会在其中存储一个().

我们将从MVar空洞开始.然后主线程将分叉接收器线程,发送所有数据包,并尝试从中获取值MVar.

import Control.Concurrent.MVar

main = withSocketsDo $ do
    -- prepare socket, same as before

    done <- newEmptyMVar

    -- we need to pass the MVar to the receiver thread so that
    -- it can use it to signal us when it's done
    forkIO $ receiveMessages sock done

    -- send pings, same as before

    takeMVar done    -- blocks until receiver thread is done

在接收器线程中,我们将接收所有消息,然后()在MVar信号中输入我们已接收到的消息.

receiveMessages socket done = do
    -- receive messages, same as before

    putMVar done ()  -- allows the main thread to be unblocked

这解决了主要问题,程序在我的Ubuntu笔记本电脑上正常运行,但还有一些你想要处理的事情.

• sendTo不保证将发送整个字符串.您必须检查返回值以查看已发送的内容,如果不是全部发送,则重试.即使对于短消息,例如"ping"发送缓冲区已满,也会发生这种情况.

• recv需要连接插座.你会想要使用recvFrom.(虽然它仍然可以在我的电脑上运行,原因不明).

• 打印到标准输出不同步,因此您可能希望更改此设置,以便MVar将用于传送接收到的数据包的数量,而不仅仅是().这样,您可以从主线程执行所有输出.或者,使用另一个MVar作为互斥锁来控制对标准输出的访问.

最后,我建议仔细阅读Network.Socket,Control.Concurrent和Control.Concurrent.MVar的文档.我的大部分答案都是根据那里发现的信息拼凑而成的.