[grapefruit] Deadlock when sampling Continuous signals.

[Roman Cheplyaka]

* Neal Alexander <relapse.dev at gmx.com> [2009-07-13 22:09:38-0400]
> 
> 
>    (Using GHC 6.10.3 on windows7 and grapefruit-frp-0.0.0.)
> 
>    Most likely I'm doing something wrong, but its hard to find examples
>    dealing strictly with grapefruit-FRP (without grapefruit GUI).
> 
>    The intent is that the whole thing should boil down to: print (0,0)
> 
>    -----------------
> 
>    circuit (sinkR,posR) = proc () -> do
>       pos             <- playerPos posR -< ()
>       frameEvent <- framePassed sinkR -< ()
>       display        -< (frameEvent #> pos)
> 
>       returnA -< ()
> 
>    main = do
>        a <- newIORef (return ())
>        b <- newIORef (0,0)
> 
>        create (circuit (a,b)) ()
> 
>        frameEventSink <- readIORef a
> 
>        frameEVentSink () -- deadlocks here
> 
>    -------------------
> 
>    display :: Show val => forall era. Circuit era (DSignal era val) ()
>    display = consume $ consumer (print)
>    playerPos :: IORef (Int,Int) -> forall era. Circuit era () (CSignal era
>    (Int,Int))
>    playerPos r = produce $ C.producer $ readIORef r
>    framePassed ref = produce (D.producer event)
>        where
>            event :: (() -> IO ()) -> Setup
>            event f = setup $ do
>                writeIORef ref f
>                return (return ())

This code just doesn't compile. If you make it compile, it prints (0,0)
without any problem. And please, next time you send the code at least
include all necessary imports (and even better, make sure the code
compiles).

--- y.hs        2009-07-14 10:00:03.000000000 +0300
+++ x.hs        2009-07-14 09:58:10.000000000 +0300
@@ -1,3 +1,13 @@
+{-# LANGUAGE Arrows, RankNTypes #-}
+import FRP.Grapefruit.Circuit
+import FRP.Grapefruit.Signal
+import FRP.Grapefruit.Setup
+import FRP.Grapefruit.Signal.Discrete as D
+import FRP.Grapefruit.Signal.Continuous as C
+import Data.IORef
+import Control.Arrow
+circuit
+  :: (IORef (() -> IO ()), IORef (Int, Int)) -> Circuit era () ()
 circuit (sinkR,posR) = proc () -> do
    pos             <- playerPos posR -< ()
    frameEvent <- framePassed sinkR -< ()
@@ -7,7 +17,7 @@
 
 
 main = do
-    a <- newIORef (return ())
+    a <- newIORef (const $ return ())
     b <- newIORef (0,0)
 
 
@@ -16,8 +26,7 @@
 
     frameEventSink <- readIORef a
 
-    frameEVentSink () -- deadlocks here
-
+    frameEventSink () -- deadlocks here
 
 -------------------
 


-- 
Roman I. Cheplyaka :: http://ro-che.info/
"Don't let school get in the way of your education." - Mark Twain