Question

TL; DR：我有一个haskell项目，其中所有内容都在一个线程中，没有任何并发性，但崩溃如下：

program1: thread blocked indefinitely in an MVar operation

更长的描述：

我正在尝试找到https://github.com/carldong/timeless-tutorials/blob/master/src/Tutorial1.hs上的错误，这取决于另一个库，是永恒的。您会注意到所有并发代码都已注释掉，并且对永恒仓库执行grep将显示不涉及并发代码。然后我对这次崩溃完全感到困惑，而且我不知道如何获得更详细的信息，比如堆栈跟踪。我尝试使用一些RTS参数运行：

$ stack exec -- Tutorial1 +RTS -p -M4m -xc
*** Exception (reporting due to +RTS -xc): (THUNK_STATIC), stack trace: 
  FRP.Timeless.Internal.Signal.loop.\,
  called from FRP.Timeless.Internal.Signal.loop,
  called from FRP.Timeless.state,
  called from FRP.Timeless.Internal.Signal.first.\,
  called from FRP.Timeless.Internal.Signal.first,
  called from FRP.Timeless.Internal.Signal...\,
  called from FRP.Timeless.Internal.Signal..,
  called from Tutorial1.test0,
  called from FRP.Timeless.Internal.Signal.stepSignal.step,
  called from FRP.Timeless.Internal.Signal.stepSignal,
  called from FRP.Timeless.Run.runBox,
  called from Tutorial1.main
*** Exception (reporting due to +RTS -xc): (THUNK_STATIC), stack trace: 
  FRP.Timeless.Internal.Signal.loop.\,
  called from FRP.Timeless.Internal.Signal.loop,
  called from FRP.Timeless.state,
  called from FRP.Timeless.Internal.Signal.first.\,
  called from FRP.Timeless.Internal.Signal.first,
  called from FRP.Timeless.Internal.Signal...\,
  called from FRP.Timeless.Internal.Signal..,
  called from Tutorial1.test0,
  called from FRP.Timeless.Internal.Signal.stepSignal.step,
  called from FRP.Timeless.Internal.Signal.stepSignal,
  called from FRP.Timeless.Run.runBox,
  called from Tutorial1.main
Tutorial1: thread blocked indefinitely in an MVar operation

我无法找到THUNK_STATIC的内容，因为Google上没有任何内容可以说明这一点。从recursive update a "Behaviour" in Sodium yields 'thread blocked ...'我可能会猜到这个bug可能与最初来自Netwire的神奇ArrowLoop有某种关系，但我无法理解它。

我将整个Timeless和我的测试用例分解为最小的样本，它是自包含的并包含bug。我不能再删除Signal了，因为这些最初是从Netwire分发的，而且我不完全理解ArrowLoop的内容是如何真正起作用的。

更新我让这个例子更小了。我还确认这个错误没有-threaded标志

{-# LANGUAGE Arrows #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE GADTs #-}

import Prelude hiding ((.),id)
import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.Fix
-- import Data.Monoid
import Control.Category
import Data.Maybe


---------
-- Stripped down Timeless here
---------
data Signal a b where
  SGen ::
    (Maybe a -> IO (Maybe b, Signal a b)) -> Signal a b


instance Category Signal where
    id = SGen (\ma -> return (ma, id))
    s2 . s1 = SGen $ \mx0 -> do
                (mx1, s1') <- stepSignal s1 mx0
                (mx2, s2') <- stepSignal s2 mx1
                mx2 `seq` return (mx2, s2'. s1')

instance Arrow Signal where
    arr f = SGen $ \ma -> case ma of
      Just a -> return (Just (f a), arr f)
      Nothing -> return (Nothing, arr f)

    first s' =
        SGen $ \mxy' ->
            fmap (\(mx, s) -> lstrict (liftA2 (,) mx (fmap snd mxy'), first s))
                  (stepSignal s' (fmap fst mxy'))

instance ArrowLoop Signal where
  loop s =
    SGen $ \mx ->
      fmap (fmap fst ***! loop) .
      mfix $ \ ~(mx',_) ->
        let d | Just (_,d) <- mx' = d
              | otherwise = error "Feedback broken by inhibition"
        in stepSignal s (fmap (,d) mx)

-- | Steps a signal in certain time step
stepSignal ::
              Signal a b
           -- ^ Signal to be stepped
           -> Maybe a
           -- ^ Input
           -- | Stateful output
           -> IO (Maybe b, Signal a b)
stepSignal s Nothing = return (Nothing, s)
stepSignal s (Just x) = x `seq` step s (Just x)
  where
    step (SGen f) = f

-- | Left-strict version of '&&&' for functions.
(&&&!) :: (a -> b) -> (a -> c) -> (a -> (b, c))
(&&&!) f g x' =
    let (x, y) = (f x', g x')
    in x `seq` (x, y)


-- | Left-strict version of '***' for functions.
(***!) :: (a -> c) -> (b -> d) -> ((a, b) -> (c, d))
(***!) f g (x', y') =
    let (x, y) = (f x', g y')
    in x `seq` (x, y)

-- | Left strict tuple
lstrict :: (a,b) -> (a,b)
lstrict (x,y) = x `seq` (x,y)


-- | Make a pure stateful signal from given transition function
mkPure :: (a -> (Maybe b, Signal a b)) -> Signal a b
mkPure f =
  SGen $ \mx ->
  case mx of
    Just x -> return . lstrict $ f x

-- | Make a pure stateful signal from given signal function
mkSF :: (a -> (b, Signal a b)) -> Signal a b
mkSF f = mkPure (lstrict . first Just . f)

-- | Make a pure stateless signal from given signal function
mkSF_ :: (a -> b) -> Signal a b
mkSF_ = arr

delay :: a -> Signal a a
delay x' = mkSF $ \x -> (x', delay x)

-- | Make a stateful wire from chained state transition
-- function. Notice that the output will always be the new value
mkSW_ :: b -> (b -> a -> b) -> Signal a b
mkSW_ b0 f = mkSF $ g b0
    where
      g b0 x = let b1 = f b0 x in
                   lstrict (b1, mkSW_ b1 f)

-- | This command drives a black box of signal network. The driver
-- knows nothing about the internals of the network, only stops when
-- the network is inhibited.
runBox :: Signal () () -> IO ()
runBox n = do
 (mq, n') <- stepSignal n (Just ())
 case mq of
   Just _ -> n' `seq` runBox n'
   Nothing -> return ()

-- | Holds a discrete value to be continuous. An initial value must be given
hold :: a -> Signal (Maybe a) a
hold a0 = mkSW_ a0 fromMaybe

-- | Takes a snapshot of b when an event a comes. Meanwhile, transform the
-- 'Stream' with the 'Cell' value
snapshot :: ((a,b) -> c) -> Signal (Maybe a, b) (Maybe c)
snapshot f = mkSF_ $ \(ma, b) ->
  case ma of
    Just a -> Just $ f (a,b)
    Nothing -> Nothing

state :: s -> ((a, s) -> s) -> Signal (Maybe a) s
state s0 update = loop $ proc (ma, s) -> do
  sDelay <- delay s0 -< s
  s' <- hold s0 <<< snapshot update -< (ma, sDelay)
  returnA -< (s', s')

------
-- Stripped down Timeless ends
------

-- | Problematic Arrow
test0 = proc () -> do
  s <- state 0 (\(_, coin) -> coin + 1) -< Nothing
  returnA -< ()


main :: IO ()
main = runBox test0

Haskell MVar无限期地阻塞，而没有涉及MVar

0 个答案: