TL DR: I have a haskell project where everything is on the same thread without concurrency, but it crashes like this:
program1: thread blocked indefinitely in an MVar operation
Longer Description:
I am trying to find an error while working on https://github.com/carldong/timeless-tutorials/blob/master/src/Tutorial1.hs , which depends on another library, out of time. You would notice that all concurrency code is commented out, and running grep on an eternal repo will show that concurrency code is not involved. Then I am completely confused by this disaster, and I do not know how to get more detailed information, such as a stack trace. I tried working with some RTS parameters:
$ 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. "" ... " , ArrowLoop, Netwire, .
Timeless , . Signal, Netwire, , ArrowLoop .
. , -threaded
{-
{-
{-
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