Haskell is getting deadlocked in a situation it (in theory) shouldn't be

The following yields a deadlock error message (* Exception: thread blocked indefinitely in an MVar operation). I've thought it through step by step, and I don't see the issue.

On the main thread, a MVar is created, and given to producer, running on a new thread

producer starts, and blocks at listenOn, waiting for a connection

The main thread continues into the loop, and blocks, waiting for the MVar to receive something

Once producer gets a connection, it continues into it's loop, and after receiving something from the socket, puts it into the MVar

Meaning (as far as I understand it), it should end up with producer putting something in the MVar, and main waiting to receive something.

If it's getting stuck because listenOn doesn't connect immediately, how can I get around this? The MVar needs to be created in main, and before producer is forked so it can be passed in.

import Control.Concurrent

import Network
import Network.Socket

import System.IO

getSockInfo :: Socket -> IO String
getSockInfo s = do
        info <- getPeerName s
        return $ case info of
            (SockAddrInet port addr) -> "Addr/Port: " ++ (show addr) ++ " / " ++ (show port)
            (SockAddrInet6 port flow addr scope) ->
                "Addr/Port: " ++ (show addr) ++ " / " ++ (show port) ++ "Flow/Scope: " ++ (show flow) ++ " / " ++ (show scope)

producer :: MVar String -> IO ()
producer m = do
    s <- listenOn (PortNumber 5555)
    putStrLn "Listening..."
    info <- getSockInfo s
    putStrLn $ "Connected to " ++ info
    h <- socketToHandle s ReadMode
    loop h m
    where loop h m = do
        message <- hGetLine h
        putMVar m message
        loop h m

main :: IO ()
main = do
    withSocketsDo $ do
        m <- newEmptyMVar
        prod <- forkIO $ producer m
        loop m
        where loop m = do
            n <- takeMVar m
            print n
            loop m

---

listenOn returns immediately but doesn't give you a connected socket, so attempts to use it or read from it fail. I'm not sure why you aren't seeing an error message to indicate that, since I do when I run your code. In any case the listening thread is probably dying at that point, which leaves the main thread deadlocked as nothing can write to the MVar.

Using accept after listenOn to wait for a remote connection should fix this.

链接地址: http://www.djcxy.com/p/80648.html

上一篇: 在aws云端部署角度应用程序

下一篇: Haskell在理论上不应该这样的情况下陷入僵局