elerea 2.4.0 → 2.5.0

raw patch · 9 files changed

+368/−1420 lines, 9 filesdep −mersenne-randomPVP ok

version bump matches the API change (PVP)

Dependencies removed: mersenne-random

API changes (from Hackage documentation)

Files

• CHANGES +9/−0
• FRP/Elerea/Clocked.hs +114/−23
• FRP/Elerea/Legacy.hs +0/−121
• FRP/Elerea/Legacy/Delayed.hs +0/−374
• FRP/Elerea/Legacy/Graph.hs +0/−169
• FRP/Elerea/Legacy/Internal.hs +0/−546
• FRP/Elerea/Param.hs +168/−94
• FRP/Elerea/Simple.hs +75/−87
• elerea.cabal +2/−6

@@ -1,3 +1,12 @@+2.5.0 - 111122+* added SignalGen liftIO equivalent to assist library writers+* simplified the signatures of effectful* combinators+* updated Param to use the more modern codebase (like Simple and+  Clocked); this was necessary to support effectful signals+* temporarily removed the static optimisation from Param+* removed dependency on mersenne-random+* removed legacy branch+ 2.4.0 - 111111 * added effectful signals to assist library writers 

@@ -71,7 +71,6 @@     , start     , external     , externalMulti-    , debug     -- * Basic building blocks     , delay     , generator@@ -85,9 +84,14 @@     , transfer2     , transfer3     , transfer4-    -- * Random sources-    , noise-    , getRandom+    -- * Signals with side effects+    -- $effectful+    , execute+    , effectful+    , effectful1+    , effectful2+    , effectful3+    , effectful4     ) where  import Control.Applicative@@ -98,7 +102,6 @@ import Data.Maybe import Prelude hiding (until) import System.Mem.Weak-import System.Random.Mersenne  -- | A signal represents a value changing over time.  It can be -- thought of as a function of type @Nat -> a@, where the argument is@@ -160,7 +163,7 @@ data Phase a = Ready a | Updated a a  instance Functor SignalGen where-    fmap = (<*>).pure+    fmap = liftM  instance Applicative SignalGen where     pure = return@@ -171,7 +174,7 @@     SG g >>= f = SG $ \p1 p2 -> g p1 p2 >>= \x -> unSG (f x) p1 p2  instance MonadFix SignalGen where-    mfix f = SG $ \p1 p2 -> mfix (\x -> unSG (f x) p1 p2)+    mfix f = SG $ \p1 p2 -> mfix $ \x -> unSG (f x) p1 p2  getUpdate :: Update -> IO (Maybe (Update, UpdateAction)) getUpdate upd@(USig ptr) = (fmap.fmap) ((,) upd) (deRefWeak ptr)@@ -280,6 +283,10 @@      addSignal return update ref pool +-- | Auxiliary function.+memoise :: IORef (Phase a) -> a -> IO a+memoise ref x = writeIORef ref (Updated undefined x) >> return x+ -- | A reactive signal that takes the value to output from a signal -- generator carried by its input with the sampling time provided as -- the start time for the generated structure.  It is possible to@@ -314,11 +321,7 @@ generator (S s) = SG $ \gpool pool -> do     ref <- newIORef (Ready undefined) -    let sample = do-            SG g <- s-            x <- g gpool pool-            writeIORef ref (Updated undefined x)-            return x+    let sample = (s >>= \(SG g) -> g gpool pool) >>= memoise ref      addSignal (const sample) (const (() <$ sample)) ref gpool @@ -344,7 +347,7 @@ memo (S s) = SG $ \_gpool pool -> do     ref <- newIORef (Ready undefined) -    let sample = s >>= \x -> writeIORef ref (Updated undefined x) >> return x+    let sample = s >>= memoise ref      addSignal (const sample) (const (() <$ sample)) ref pool @@ -596,28 +599,116 @@     sig' <- delay x0 sig     memo (liftM5 f s1 s2 s3 s4 sig') --- | A random signal.  It is affected by the associated clock.+{- $effectful++The following combinators are primarily aimed at library implementors+who wish build abstractions to effectful libraries on top of Elerea.++-}++-- | An IO action executed in the 'SignalGen' monad. Can be used as+-- `liftIO`.+execute :: IO a -> SignalGen a+execute act = SG $ \_ _ -> act++-- | A signal that executes a given IO action once at every sampling. --+-- In essence, this combinator provides cooperative multitasking+-- capabilities, and its primary purpose is to assist library writers+-- in wrapping effectful APIs as conceptually pure signals.  If there+-- are several effectful signals in the system, their order of+-- execution is undefined and should not be relied on.+-- -- Example: -- -- > do--- >     smp <- start noise :: IO (IO Double)+-- >     smp <- start $ do+-- >         ref <- execute $ newIORef 0+-- >         effectful $ do+-- >             x <- readIORef ref+-- >             putStrLn $ "Count: " ++ show x+-- >             writeIORef ref $! x+1+-- >             return ()+-- >     replicateM_ 5 smp+--+-- Output:+--+-- > Count: 0+-- > Count: 1+-- > Count: 2+-- > Count: 3+-- > Count: 4+--+-- Another example (requires mersenne-random):+--+-- > do+-- >     smp <- start $ effectful $ return randomIO :: IO (IO Double) -- >     res <- replicateM 5 smp -- >     print res -- -- Output: -- -- > [0.12067753390401374,0.8658877349182655,0.7159264443196786,0.1756941896012891,0.9513646060896676]-noise :: MTRandom a => SignalGen (Signal a)-noise = memo (S randomIO)+effectful :: IO a                 -- ^ the action to be executed repeatedly+          -> SignalGen (Signal a)+effectful act = SG $ \_gpool pool -> do+  ref <- newIORef (Ready undefined) --- | A random source within the 'SignalGen' monad.-getRandom :: MTRandom a => SignalGen a-getRandom = SG $ \_ _ -> randomIO+  let sample = act >>= memoise ref --- | A printing action within the 'SignalGen' monad.-debug :: String -> SignalGen ()-debug s = SG $ \_ _ -> putStrLn s+  addSignal (const sample) (const (() <$ sample)) ref pool++-- | A signal that executes a parametric IO action once at every+-- sampling.  The parameter is supplied by another signal at every+-- sampling step.+effectful1 :: (t -> IO a)          -- ^ the action to be executed repeatedly+           -> Signal t             -- ^ parameter signal+           -> SignalGen (Signal a)+effectful1 act (S s) = SG $ \_gpool pool -> do+  ref <- newIORef (Ready undefined)++  let sample = s >>= act >>= memoise ref++  addSignal (const sample) (const (() <$ sample)) ref pool++-- | Like 'effectful1', but with two parameter signals.+effectful2 :: (t1 -> t2 -> IO a)   -- ^ the action to be executed repeatedly+           -> Signal t1            -- ^ parameter signal 1+           -> Signal t2            -- ^ parameter signal 2+           -> SignalGen (Signal a)+effectful2 act (S s1) (S s2) = SG $ \_gpool pool -> do+  ref <- newIORef (Ready undefined)++  let sample = join (liftM2 act s1 s2) >>= memoise ref++  addSignal (const sample) (const (() <$ sample)) ref pool++-- | Like 'effectful1', but with three parameter signals.+effectful3 :: (t1 -> t2 -> t3 -> IO a) -- ^ the action to be executed repeatedly+           -> Signal t1                -- ^ parameter signal 1+           -> Signal t2                -- ^ parameter signal 2+           -> Signal t3                -- ^ parameter signal 3+           -> SignalGen (Signal a)+effectful3 act (S s1) (S s2) (S s3) = SG $ \_gpool pool -> do+  ref <- newIORef (Ready undefined)++  let sample = join (liftM3 act s1 s2 s3) >>= memoise ref++  addSignal (const sample) (const (() <$ sample)) ref pool++-- | Like 'effectful1', but with four parameter signals.+effectful4 :: (t1 -> t2 -> t3 -> t4 -> IO a) -- ^ the action to be executed repeatedly+           -> Signal t1                      -- ^ parameter signal 1+           -> Signal t2                      -- ^ parameter signal 2+           -> Signal t3                      -- ^ parameter signal 3+           -> Signal t4                      -- ^ parameter signal 4+           -> SignalGen (Signal a)+effectful4 act (S s1) (S s2) (S s3) (S s4) = SG $ \_gpool pool -> do+  ref <- newIORef (Ready undefined)++  let sample = join (liftM4 act s1 s2 s3 s4) >>= memoise ref++  addSignal (const sample) (const (() <$ sample)) ref pool  instance Show (Signal a) where     showsPrec _ _ s = "<SIGNAL>" ++ s

@@ -1,121 +0,0 @@-{-|--Elerea (Eventless Reactivity) is a simplistic FRP implementation that-parts with the concept of events, and introduces various constructs-that can be used to define completely dynamic higher-order dataflow-networks.  The user sees the functionality through a hybrid-monadic-applicative interface, where stateful signals can only be-created through a specialised monad, while most combinators are purely-applicative.  The combinators build up a network of interconnected-mutable references in the background.  The network is executed-iteratively, where each superstep consists of three phases: sampling,-aging, and finalisation.  As an example, the following code is a-possible way to define an approximation of our beloved trig functions:--@- (sine,cosine) <- mdo-   s <- integral 0 c-   c <- integral 1 (-s)-   return (s,c)-@--Note that @integral@ is not a primitive, it can be defined by the user-as a transfer function.  A possible implementation that can be used on-any 'Fractional' signal looks like this:--@- integral x0 s = transfer x0 (\\dt x x0 -> x0+x*realToFrac dt) s-@--Head to "FRP.Elerea.Legacy.Internal" for the implementation details.-To get a general idea how to use the library, check out the sources in-the @elerea-examples@ package.--The "FRP.Elerea" branch provides a similar interface with a rather-different underlying structure, which is likely to be more efficient.---}--module FRP.Elerea.Legacy-    ( DTime, Sink, Signal, SignalMonad-    , createSignal, superstep-    , external-    , stateful, transfer, delay-    , sampler, generator-    , storeJust, toMaybe-    , edge-    , keepAlive, (.@.)-    , (==@), (/=@), (<@), (<=@), (>=@), (>@)-    , (&&@), (||@)-    , signalDebug-) where--import Control.Applicative-import FRP.Elerea.Legacy.Internal--infix  4 ==@, /=@, <@, <=@, >=@, >@-infixr 3 &&@-infixr 2 ||@--{-| A short alternative name for 'keepAlive'. -}--(.@.) :: Signal a -> Signal t -> Signal a-(.@.) = keepAlive--{-| The `edge` transfer function takes a bool signal and emits another-bool signal that turns true only at the moment when there is a rising-edge on the input. -}--edge :: Signal Bool -> SignalMonad (Signal Bool)-edge b = delay True b >>= \db -> return $ (not <$> db) &&@ b--{-| The `storeJust` transfer function behaves as a latch on a 'Maybe'-input: it keeps its state when the input is 'Nothing', and replaces it-with the input otherwise. -}--storeJust :: a                      -- ^ Initial output-          -> Signal (Maybe a)       -- ^ Maybe signal to latch on-          -> SignalMonad (Signal a)-storeJust x0 s = transfer x0 store s-    where store _ Nothing  x = x-          store _ (Just x) _ = x--{-| Point-wise equality of two signals. -}--(==@) :: Eq a => Signal a -> Signal a -> Signal Bool-(==@) = liftA2 (==)--{-| Point-wise inequality of two signals. -}--(/=@) :: Eq a => Signal a -> Signal a -> Signal Bool-(/=@) = liftA2 (/=)--{-| Point-wise comparison of two signals. -}--(<@) :: Ord a => Signal a -> Signal a -> Signal Bool-(<@) = liftA2 (<)--{-| Point-wise comparison of two signals. -}--(<=@) :: Ord a => Signal a -> Signal a -> Signal Bool-(<=@) = liftA2 (<=)--{-| Point-wise comparison of two signals. -}--(>=@) :: Ord a => Signal a -> Signal a -> Signal Bool-(>=@) = liftA2 (>=)--{-| Point-wise comparison of two signals. -}--(>@) :: Ord a => Signal a -> Signal a -> Signal Bool-(>@) = liftA2 (>)--{-| Point-wise OR of two boolean signals. -}--(||@) :: Signal Bool -> Signal Bool -> Signal Bool-(||@) = liftA2 (||)--{-| Point-wise AND of two boolean signals. -}--(&&@) :: Signal Bool -> Signal Bool -> Signal Bool-(&&@) = liftA2 (&&)

@@ -1,374 +0,0 @@-{-|--Note: this module is deprecated, because automatic delays are-ill-defined, and not very useful in practice anyway.  Experience with-the library suggests that instantaneous loops are relatively easy to-avoid.--This version differs from the parametric one in introducing automatic-delays.  In practice, if a dependency loop involves a 'transfer'-primitive, it will be resolved during runtime even if transfer-functions are not delayed by default.  Also, the until construct and-multi-signal transfer variants are missing from this module.--The interface of this module differs from the old Elerea in the-following ways:--* the delta time argument is generalised to an arbitrary type, so it-  is possible to do without 'external' altogether in case someone-  wants to do so;--* there is no 'sampler' any more, it is substituted by 'join', as-  signals are monads;--* 'generator' has been conceptually simplified, so it's a more basic-  primitive now;--* all signals are aged regardless of whether they are sampled-  (i.e. their behaviour doesn't depend on the context any more);--* the user needs to cache the results of applicative operations to be-  reused in multiple places explicitly using the 'memo' combinator.---}--module FRP.Elerea.Legacy.Delayed-    ( Signal-    , SignalGen-    , start-    , external-    , externalMulti-    , delay-    , stateful-    , transfer-    , memo-    , generator-    , noise-    , getRandom-    , debug-    ) where--import Control.Applicative-import Control.Concurrent.MVar-import Control.Monad-import Control.Monad.Fix-import Data.IORef-import Data.Maybe-import System.Mem.Weak-import System.Random.Mersenne---- | A signal can be thought of as a function of type @Nat -> a@, and--- its 'Monad' instance agrees with that intuition.  Internally, is--- represented by a sampling computation.-newtype Signal p a = S { unS :: p -> IO a }---- | A dynamic set of actions to update a network without breaking--- consistency.-type UpdatePool p = [Weak (p -> IO (), IO ())]---- | A signal generator is the only source of stateful signals.--- Internally, computes a signal structure and adds the new variables--- to an existing update pool.-newtype SignalGen p a = SG { unSG :: IORef (UpdatePool p) -> IO a }---- | The phases every signal goes through during a superstep: before--- or after sampling.-data Phase s a = Ready s | Sampling s | Aged s a--instance Functor (Signal p) where-  fmap = liftM--instance Applicative (Signal p) where-  pure = return-  (<*>) = ap--instance Monad (Signal p) where-  return = S . const . return-  S g >>= f = S $ \p -> g p >>= \x -> unS (f x) p--instance Functor (SignalGen p) where-  fmap = liftM--instance Applicative (SignalGen p) where-  pure = return-  (<*>) = ap--instance Monad (SignalGen p) where-  return = SG . const . return-  SG g >>= f = SG $ \p -> g p >>= \x -> unSG (f x) p--instance MonadFix (SignalGen p) where-  mfix f = SG $ \p -> mfix (($p).unSG.f)---- | Embedding a signal into an 'IO' environment.  Repeated calls to--- the computation returned cause the whole network to be updated, and--- the current sample of the top-level signal is produced as a result.--- The computation accepts a global parameter that will be distributed--- to all signals.  For instance, this can be the time step, if we--- want to model continuous-time signals.-start :: SignalGen p (Signal p a) -- ^ the generator of the top-level signal-      -> IO (p -> IO a)           -- ^ the computation to sample the signal-start (SG gen) = do-  pool <- newIORef []-  (S sample) <- gen pool--  ptrs0 <- readIORef pool-  writeIORef pool []-  (as0,cs0) <- unzip . map fromJust <$> mapM deRefWeak ptrs0-  let ageStatic param = mapM_ ($param) as0-      commitStatic = sequence_ cs0--  return $ \param -> do-    let update [] ptrs age commit = do-          writeIORef pool ptrs-          ageStatic param >> age-          commitStatic >> commit-        update (p:ps) ptrs age commit = do-          r <- deRefWeak p-          case r of-            Nothing -> update ps ptrs age commit-            Just (a,c) -> update ps (p:ptrs) (age >> a param) (commit >> c)--    res <- sample param-    ptrs <- readIORef pool-    update ptrs [] (return ()) (return ())-    return res---- | Auxiliary function used by all the primitives that create a--- mutable variable.-addSignal :: (p -> Phase s a -> IO a)  -- ^ sampling function-          -> (p -> Phase s a -> IO ()) -- ^ aging function-          -> IORef (Phase s a)         -- ^ the mutable variable behind the signal-          -> IORef (UpdatePool p)      -- ^ the pool of update actions-          -> IO (Signal p a)-addSignal sample age ref pool = do-  let  commit (Aged s _) = Ready s-       commit _          = error "commit error: signal not aged"--       sig = S $ \p -> readIORef ref >>= sample p--  update <- mkWeak sig (\p -> readIORef ref >>= age p, modifyIORef ref commit) Nothing-  modifyIORef pool (update:)-  return sig---- | The 'delay' transfer function emits the value of a signal from--- the previous superstep, starting with the filler value given in the--- first argument.-delay :: a                        -- ^ initial output-      -> Signal p a               -- ^ the signal to delay-      -> SignalGen p (Signal p a)-delay x0 (S s) = SG $ \pool -> do-  ref <- newIORef (Ready x0)--  let  sample _ (Ready x)  = return x-       sample _ (Aged _ x) = return x-       sample _ _          = error "sampling eror: delay"--       age p (Ready x) = s p >>= \x' -> x' `seq` writeIORef ref (Aged x' x)-       age _ _         = return ()--  addSignal sample age ref pool---- | Memoising combinator.  It can be used to cache results of--- applicative combinators in case they are used in several places.--- Other than that, it is equivalent to 'return'.-memo :: Signal p a               -- ^ signal to memoise-     -> SignalGen p (Signal p a)-memo (S s) = SG $ \pool -> do-  ref <- newIORef (Ready undefined)--  let  sample p (Ready _)  = s p >>= \x -> writeIORef ref (Aged undefined x) >> return x-       sample _ (Aged _ x) = return x-       sample _ _          = error "sampling eror: memo"--       age p (Ready _) = s p >>= \x -> writeIORef ref (Aged undefined x)-       age _ _         = return ()--  addSignal sample age ref pool---- | A reactive signal that takes the value to output from a monad--- carried by its input.  It is possible to create new signals in the--- monad.-generator :: Signal p (SignalGen p a) -- ^ a stream of generators to potentially run-          -> SignalGen p (Signal p a)-generator (S gen) = SG $ \pool -> do-  ref <- newIORef (Ready undefined)--  let  next p = ($pool).unSG =<< gen p--       sample p (Ready _)  = next p >>= \x' -> writeIORef ref (Aged x' x') >> return x'-       sample _ (Aged _ x) = return x-       sample _ _          = error "sampling eror: generator"--       age p (Ready _) = next p >>= \x' -> writeIORef ref (Aged x' x')-       age _ _         = return ()--  addSignal sample age ref pool---- | A signal that can be directly fed through the sink function--- returned.  This can be used to attach the network to the outer--- world.  Note that this is optional, as all the input of the network--- can be fed in through the global parameter, although that is not--- really convenient for many signals.-external :: a                           -- ^ initial value-         -> IO (Signal p a, a -> IO ()) -- ^ the signal and an IO function to feed it-external x = do-  ref <- newIORef x-  return (S (const (readIORef ref)), writeIORef ref)---- | An event-like signal that can be fed through the sink function--- returned.  The signal carries a list of values fed in since the--- last sampling, i.e. it is constantly [] if the sink is never--- invoked.  The order of elements is reversed, so the last value--- passed to the sink is the head of the list.  Note that unlike--- 'external' this function only returns a generator to be used within--- the expression constructing the top-level stream, and this--- generator can only be used once.-externalMulti :: IO (SignalGen p (Signal p [a]), a -> IO ()) -- ^ a generator for the event signal and the associated sink-externalMulti = do-  var <- newMVar []-  return (SG $ \pool -> do-             let sig = S $ const (readMVar var)-             update <- mkWeak sig (const (return ()),takeMVar var >> putMVar var []) Nothing-             modifyIORef pool (update:)-             return sig-         ,\val -> do  vals <- takeMVar var-                      putMVar var (val:vals)-         )---- | A pure stateful signal.  The initial state is the first output,--- and every following output is calculated from the previous one and--- the value of the global parameter.-stateful :: a -> (p -> a -> a) -> SignalGen p (Signal p a)-stateful x0 f = SG $ \pool -> do-  ref <- newIORef (Ready x0)--  let  sample _ (Ready x)  = return x-       sample _ (Aged _ x) = return x-       sample _ _          = error "sampling eror: stateful"--       age p (Ready x) = let x' = f p x in x' `seq` writeIORef ref (Aged x' x)-       age _ _         = return ()--  addSignal sample age ref pool---- | A stateful transfer function.  The current input affects the--- current output, i.e. the initial state given in the first argument--- is considered to appear before the first output, and can never be--- observed.  Every output is derived from the current value of the--- input signal, the global parameter and the previous output.  The--- only exception is when a transfer function sits in a loop without a--- delay.  In this case, a delay will be inserted at a single place--- during runtime (i.e. the previous output of the node affected will--- be reused) to resolve the circular dependency.-transfer :: a -> (p -> t -> a -> a) -> Signal p t -> SignalGen p (Signal p a)-transfer x0 f (S s) = SG $ \pool -> do-  ref <- newIORef (Ready x0)--  let  sample p (Ready x)  = do-         writeIORef ref (Sampling x)-         y <- s p-         let x' = f p y x-         x' `seq` writeIORef ref (Aged x' x')-         return x'-       sample _ (Sampling x) = return x -- Reusing previous output: automatic delay-       sample _ (Aged _ x) = return x--       age p (Ready x) = do-         y <- s p-         let x' = f p y x-         x' `seq` writeIORef ref (Aged x' x')-       age _ _         = return () -- If it is Sampling, we'll error out later--  addSignal sample age ref pool---- | A random signal.-noise :: MTRandom a => SignalGen p (Signal p a)-noise = memo (S (const randomIO))---- | A random source within the 'SignalGen' monad.-getRandom :: MTRandom a => SignalGen p a-getRandom = SG (const randomIO)---- | A printing action within the 'SignalGen' monad.-debug :: String -> SignalGen p ()-debug = SG . const . putStrLn---- | The @Show@ instance is only defined for the sake of 'Num'...-instance Show (Signal p a) where-  showsPrec _ _ s = "<SIGNAL>" ++ s---- | Equality test is impossible.-instance Eq (Signal p a) where-  _ == _ = False---- | Error message for unimplemented instance functions.-unimp :: String -> a-unimp = error . ("Signal: "++)--instance Ord t => Ord (Signal p t) where-  compare = unimp "compare"-  min = liftA2 min-  max = liftA2 max--instance Enum t => Enum (Signal p t) where-  succ = fmap succ-  pred = fmap pred-  toEnum = pure . toEnum-  fromEnum = unimp "fromEnum"-  enumFrom = unimp "enumFrom"-  enumFromThen = unimp "enumFromThen"-  enumFromTo = unimp "enumFromTo"-  enumFromThenTo = unimp "enumFromThenTo"--instance Bounded t => Bounded (Signal p t) where-  minBound = pure minBound-  maxBound = pure maxBound--instance Num t => Num (Signal p t) where-  (+) = liftA2 (+)-  (-) = liftA2 (-)-  (*) = liftA2 (*)-  signum = fmap signum-  abs = fmap abs-  negate = fmap negate-  fromInteger = pure . fromInteger--instance Real t => Real (Signal p t) where-  toRational = unimp "toRational"--instance Integral t => Integral (Signal p t) where-  quot = liftA2 quot-  rem = liftA2 rem-  div = liftA2 div-  mod = liftA2 mod-  quotRem a b = (fst <$> qrab,snd <$> qrab)-    where qrab = quotRem <$> a <*> b-  divMod a b = (fst <$> dmab,snd <$> dmab)-    where dmab = divMod <$> a <*> b-  toInteger = unimp "toInteger"--instance Fractional t => Fractional (Signal p t) where-  (/) = liftA2 (/)-  recip = fmap recip-  fromRational = pure . fromRational--instance Floating t => Floating (Signal p t) where-  pi = pure pi-  exp = fmap exp-  sqrt = fmap sqrt-  log = fmap log-  (**) = liftA2 (**)-  logBase = liftA2 logBase-  sin = fmap sin-  tan = fmap tan-  cos = fmap cos-  asin = fmap asin-  atan = fmap atan-  acos = fmap acos-  sinh = fmap sinh-  tanh = fmap tanh-  cosh = fmap cosh-  asinh = fmap asinh-  atanh = fmap atanh-  acosh = fmap acosh

@@ -1,169 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}--{-|--This module provides some means to visualise the signal structure.---}--module FRP.Elerea.Legacy.Graph (signalToDot) where--import Data.IORef-import qualified Data.Map as Map-import Foreign.Ptr-import Foreign.StablePtr-import FRP.Elerea.Legacy.Internal--type Id = Int--type SignalStore = Map.Map Id SignalInfo--data SignalInfo-    = Const-    | Stateful-    | Transfer Id-    | App Id Id-    | Sampler Id-    | Generator Id Id-    | External-    | Delay Id-    | Lift1 Id-    | Lift2 Id Id-    | Lift3 Id Id Id-    | Lift4 Id Id Id Id-    | Lift5 Id Id Id Id Id-    | None--getPtr :: a -> IO Id-getPtr x = fmap (fromIntegral . ptrToIntPtr . castStablePtrToPtr) (newStablePtr x)--buildStore :: SignalStore -> Signal a -> IO (Id,SignalStore)-buildStore st (S r) = do-  p <- getPtr r-  case Map.lookup p st of-    Just _  -> return (p,st)-    Nothing -> do Ready s <- readIORef r-                  st' <- insertSignal st p s-                  return (p,st')--insertSignal :: SignalStore -> Id -> SignalNode a -> IO SignalStore-insertSignal st p (SNK _) = return (Map.insert p Const st)-insertSignal st p (SNS _ _) = return (Map.insert p Stateful st)-insertSignal st p (SNT s _ _) = do-  (s',st') <- buildStore (Map.insert p None st) s-  return (Map.insert p (Transfer s') st')-insertSignal st p (SNA sf sx) = do-  (sf',st') <- buildStore (Map.insert p None st) sf-  (sx',st'') <- buildStore st' sx-  return (Map.insert p (App sf' sx') st'')-insertSignal st p (SNH ss _) = do-  (ss',st') <- buildStore (Map.insert p None st) ss-  return (Map.insert p (Sampler ss') st')-insertSignal st p (SNM b sm) = do-  (b',st') <- buildStore (Map.insert p None st) b-  (sm',st'') <- buildStore st' sm-  return (Map.insert p (Generator b' sm') st'')-insertSignal st p (SNE _) = return (Map.insert p External st)-insertSignal st p (SND _ s) = do-  (s',st') <- buildStore (Map.insert p None st) s-  return (Map.insert p (Delay s') st')-insertSignal st p (SNKA (S r) _) = do-  Ready s <- readIORef r-  insertSignal st p s-insertSignal st p (SNF1 _ s1) = do-  (s1',st') <- buildStore (Map.insert p None st) s1-  return (Map.insert p (Lift1 s1') st')-insertSignal st p (SNF2 _ s1 s2) = do-  (s1',st') <- buildStore (Map.insert p None st) s1-  (s2',st'') <- buildStore st' s2-  return (Map.insert p (Lift2 s1' s2') st'')-insertSignal st p (SNF3 _ s1 s2 s3) = do-  (s1',st') <- buildStore (Map.insert p None st) s1-  (s2',st'') <- buildStore st' s2-  (s3',st''') <- buildStore st'' s3-  return (Map.insert p (Lift3 s1' s2' s3') st''')-insertSignal st p (SNF4 _ s1 s2 s3 s4) = do-  (s1',st') <- buildStore (Map.insert p None st) s1-  (s2',st'') <- buildStore st' s2-  (s3',st''') <- buildStore st'' s3-  (s4',st'''') <- buildStore st''' s4-  return (Map.insert p (Lift4 s1' s2' s3' s4') st'''')-insertSignal st p (SNF5 _ s1 s2 s3 s4 s5) = do-  (s1',st') <- buildStore (Map.insert p None st) s1-  (s2',st'') <- buildStore st' s2-  (s3',st''') <- buildStore st'' s3-  (s4',st'''') <- buildStore st''' s4-  (s5',st''''') <- buildStore st'''' s5-  return (Map.insert p (Lift5 s1' s2' s3' s4' s5') st''''')--nodeLabel :: Maybe Id -> SignalInfo -> [Char]-nodeLabel id node = case node of-                      Const           -> "const"-                      Stateful        -> "stateful"-                      Transfer _      -> "transfer"-                      App _ _         -> "app"-                      Sampler _       -> "sampler"-                      Generator _ _   -> "generator"-                      External        -> "external"-                      Delay _         -> "delay"-                      Lift1 _         -> "fun1"-                      Lift2 _ _       -> "fun2"-                      Lift3 _ _ _     -> "fun3"-                      Lift4 _ _ _ _   -> "fun4"-                      Lift5 _ _ _ _ _ -> "fun5"-                      None            -> "NONE"-                    ++ (maybe "" show id)--{-|--Traversing the network starting from the given signal and converting-it into a string containing the graph in Graphviz-(<http://www.graphviz.org/>) dot format.  Stateful nodes are coloured-according to their type.--The results might differ depending on whether this function is called-before or after sampling (this also affects the actual network!), but-the networks should be still equivalent.---}--signalToDot :: Signal a -> IO String-signalToDot s = do-  (_,st) <- buildStore Map.empty s-  let rules = map mkRule (Map.assocs st)-      mkRule (id,n) = "  " ++ name ++ attrs ++ edges-          where name = nodeLabel (Just id) n-                attrs = mkLabel (nodeLabel Nothing n) ("style=filled,fillcolor=\"#" ++ nodeCol ++ "\",shape=" ++ nodeShape)-                edges = case n of-                  Transfer s           -> mkEdge s "\"\""-                  App sf sx            -> mkEdge sf "f" ++ mkEdge sx "x"-                  Sampler ss           -> mkEdge ss "\"\""-                  Generator b sm       -> mkEdge b "ctl" ++ mkEdge sm "gen"-                  Delay s              -> mkEdge s "\"\""-                  Lift1 s1             -> mkEdge s1 "x1"-                  Lift2 s1 s2          -> mkEdge s1 "x1" ++ mkEdge s2 "x2"-                  Lift3 s1 s2 s3       -> mkEdge s1 "x1" ++ mkEdge s2 "x2" ++ mkEdge s3 "x3"-                  Lift4 s1 s2 s3 s4    -> mkEdge s1 "x1" ++ mkEdge s2 "x2" ++ mkEdge s3 "x3" ++ mkEdge s4 "x4"-                  Lift5 s1 s2 s3 s4 s5 -> mkEdge s1 "x1" ++ mkEdge s2 "x2" ++ mkEdge s3 "x3" ++ mkEdge s4 "x4" ++ mkEdge s5 "x5"-                  _                    -> ""-                mkEdge endId label = "  " ++ name ++ " -> " ++-                                     nodeLabel (Just endId) (st Map.! endId) ++-                                     mkLabel label "dir=back"-                mkLabel name attrs = " [label=" ++ name ++ "," ++ attrs ++ "];\n"-                nodeCol = case n of-                  Transfer _    -> "ffcc99"-                  Sampler _     -> "99ccff"-                  Generator _ _ -> "ccffff"-                  External      -> "ccff99"-                  Stateful      -> "ffffcc"-                  Delay _       -> "ffccff"-                  _             -> "ffffff"-                nodeShape = case n of-                  Transfer _    -> "diamond"-                  Sampler _     -> "hexagon"-                  Generator _ _ -> "house"-                  External      -> "invtriangle"-                  Delay _       -> "box"-                  _             -> "ellipse"-  return $ "digraph G {\n" ++ concat rules ++ "}\n"

@@ -1,546 +0,0 @@-{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}--{-|--This is the core module of Elerea, which contains the signal-implementation and the atomic constructors.--The basic idea is to create a dataflow network whose structure closely-resembles the user's definitions by turning each combinator into a-mutable variable (an 'IORef').  In other words, each signal is-represented by a variable.  Such a variable contains information about-the operation to perform and (depending on the operation) references-to other signals.  For instance, a pointwise function application-created by the '<*>' operator contains an 'SNA' node, which holds two-references: one to the function signal and another to the argument-signal.--In order to have a pure(-looking) applicative interface for the most-part, the library relies on 'unsafePerformIO' to create the references-of stateless signals, while stateful signals have to be obtained from-a special 'SignalMonad', which is just a wrapping of 'IO' that doesn't-allow any other action to be performed.--The execution of the network is explicitly marked as an IO operation.-The core library exposes a single function to animate the network-called 'superstep', which takes a signal and a time interval, and-mutates all the variables the signal depends on.  It is supposed to be-called repeatedly in a loop that also takes care of user input.--To ensure consistency, a superstep has three phases: sampling, aging-and finalisation.  Each signal reachable from the top-level signal-passed to 'superstep' is sampled at the current point of time-('sample'), and the sample is stored along with the old signal in its-reference.  If the value of a signal is requested multiple times, the-sample is simply reused.  After successfully sampling the top-level-signal, the network is traversed again to advance by the desired time-('advance'), and when that's completed, the finalisation process-throws away the intermediate samples and marks the aged signals as the-current ones, ready to be sampled again.  If there is a dependency-loop, the system tries to use the 'sampleDelayed' function instead of-'sample' to get a useful value at the problematic spot instead of-entering an infinite loop.  Evaluation is initiated by the-'signalValue' function (which is used in both the sampling and the-aging phase to calculate samples and retrieve the cached values if-they are requested again), aging is performed by 'age', while-finalisation is done by 'commit'.  Since these functions are invoked-recursively on a data structure with existential types, their types-also need to be explicity quantified.--As a bonus, applicative nodes are automatically collapsed into lifted-functions of up to five arguments.  This optimisation significantly-reduces the number of nodes in the network.---}--module FRP.Elerea.Legacy.Internal where--import Control.Applicative-import Control.Monad-import Control.Monad.Fix-import Data.IORef-import System.IO.Unsafe---- * Implementation---- ** Some type synonyms--{-| Time is continuous.  Nothing fancy. -}--type DTime = Double--{-| Sinks are used when feeding input into peripheral-bound signals. -}--type Sink a = a -> IO ()---- ** The data structures behind signals--{-| A restricted monad to create stateful signals in. -}--newtype SignalMonad a = SM { createSignal :: IO a } deriving (Monad,Applicative,Functor,MonadFix)--{-| A printing function that can be used in the 'SignalMonad'.-Provided for debugging purposes. -}--signalDebug :: Show a => a -> SignalMonad ()-signalDebug = SM . print--{-| A signal is conceptually a time-varying value. -}--newtype Signal a = S (IORef (SignalTrans a))--{-| A node can have four states that distinguish various stages of-sampling and aging. -}--data SignalTrans a-    -- | @Ready s@ is simply the signal @s@ that was not sampled yet-    = Ready (SignalNode a)-    -- | @Sampling s@ is signal @s@ after its current value was-    -- requested, but not yet delivered-    | Sampling (SignalNode a)-    -- | @Sampled x s@ is signal @s@ paired with its current value @x@-    | Sampled a (SignalNode a)-    -- | @Aged x s@ is the aged version of signal @s@ paired with its-    -- current value @x@-    | Aged a (SignalNode a)--{-| The possible structures of a node are defined by the 'SignalNode'-type.  Note that the @SNFx@ nodes are only needed to optimise-applicatives, they can all be expressed in terms of @SNK@ and-@SNA@. -}--data SignalNode a-    -- | @SNK x@: constantly @x@-    = SNK a-    -- | @SNS x t@: stateful generator, where @x@ is current state and-    -- @t@ is the update function-    | SNS a (DTime -> a -> a)-    -- | @SNT s x t@: stateful transfer function, which also depends-    -- on an input signal @s@-    | forall t . SNT (Signal t) a (DTime -> t -> a -> a)-    -- | @SNA sf sx@: pointwise function application-    | forall t . SNA (Signal (t -> a)) (Signal t)-    -- | @SNH ss r@: the higher-order signal @ss@ collapsed into a-    -- signal cached in reference @r@; @r@ is used during the aging-    -- phase-    | SNH (Signal (Signal a)) (IORef (Signal a))-    -- | @SNM b sm@: signal generator that executes the monad carried-    -- by @sm@ whenever @b@ is true, and outputs the result (or-    -- undefined when @b@ is false)-    | SNM (Signal Bool) (Signal (SignalMonad a))-    -- | @SNE r@: opaque reference to connect peripherals-    | SNE (IORef a)-    -- | @SND s@: the @s@ signal delayed by one superstep-    | SND a (Signal a)-    -- | @SNKA s l@: equivalent to @s@ while aging signal @l@-    | forall t . SNKA (Signal a) (Signal t)-    -- | @SNF1 f@: @fmap f@-    | forall t . SNF1 (t -> a) (Signal t)-    -- | @SNF2 f@: @liftA2 f@-    | forall t1 t2 . SNF2 (t1 -> t2 -> a) (Signal t1) (Signal t2)-    -- | @SNF3 f@: @liftA3 f@-    | forall t1 t2 t3 . SNF3 (t1 -> t2 -> t3 -> a) (Signal t1) (Signal t2) (Signal t3)-    -- | @SNF4 f@: @liftA4 f@-    | forall t1 t2 t3 t4 . SNF4 (t1 -> t2 -> t3 -> t4 -> a) (Signal t1) (Signal t2) (Signal t3) (Signal t4)-    -- | @SNF5 f@: @liftA5 f@-    | forall t1 t2 t3 t4 t5 . SNF5 (t1 -> t2 -> t3 -> t4 -> t5 -> a) (Signal t1) (Signal t2) (Signal t3) (Signal t4) (Signal t5)--{-| You can uncomment the verbose version of this function to see the-applicative optimisations in action. -}--debugLog :: String -> IO a -> IO a---debugLog s io = putStrLn s >> io-debugLog _ io = io--instance Functor Signal where-    fmap = (<*>) . pure--{-| The 'Applicative' instance with run-time optimisation.  The '<*>'-operator tries to move all the pure parts to its left side in order to-flatten the structure, hence cutting down on book-keeping costs.  Since-applicatives are used with pure functions and lifted values most of-the time, one can gain a lot by merging these nodes. -}--instance Applicative Signal where-    -- | A constant signal-    pure = makeSignalUnsafe . SNK-    -- | Point-wise application of a function and a data signal (like @ZipList@)----  --mf <*> mx = sampler (fmap (\f -> sampler (fmap (pure . f) mx)) mf)---  sf <*> sx = sampler (makeSignalUnsafe (SNF1 (\f -> sampler (makeSignalUnsafe (SNF1 (pure . f) sx))) sf))--    f@(S rf) <*> x@(S rx) = unsafePerformIO $ do-      -- General fall-back case-      c <- newIORef (Ready (SNA f x))--      let opt s = writeIORef c (Ready s)--      -- Optimisations might go haywire in the presence of loops,-      -- so we need to prepare to meeting undefined references by-      -- wrapping reads into exception handlers.--      flip catch (const (debugLog "no_fun" $ return ())) $ do-        Ready nf <- readIORef rf--        merged <- flip catch (const (debugLog "no_arg" $ return False)) $ do-          -- Merging constant branches from the two sides-          Ready nx <- readIORef rx-          case (nf,nx) of-            (SNK g,SNK y)                  -> debugLog "merge_00" $ opt (SNK (g y))-            (SNK g,SNF1 h y1)              -> debugLog "merge_01" $ opt (SNF1 (g.h) y1)-            (SNK g,SNF2 h y1 y2)           -> debugLog "merge_02" $ opt (SNF2 (\y1 y2 -> g (h y1 y2)) y1 y2)-            (SNK g,SNF3 h y1 y2 y3)        -> debugLog "merge_03" $ opt (SNF3 (\y1 y2 y3 -> g (h y1 y2 y3)) y1 y2 y3)-            (SNK g,SNF4 h y1 y2 y3 y4)     -> debugLog "merge_04" $ opt (SNF4 (\y1 y2 y3 y4 -> g (h y1 y2 y3 y4)) y1 y2 y3 y4)-            (SNK g,SNF5 h y1 y2 y3 y4 y5)  -> debugLog "merge_05" $ opt (SNF5 (\y1 y2 y3 y4 y5 -> g (h y1 y2 y3 y4 y5)) y1 y2 y3 y4 y5)-            (SNK g,_)                      -> debugLog "lift_1x" $ opt (SNF1 g x)-            (SNF1 g x1,SNK y)              -> debugLog "merge_10" $ opt (SNF1 (\x1 -> g x1 y) x1)-            (SNF1 g x1,SNF1 h y1)          -> debugLog "merge_11" $ opt (SNF2 (\x1 y1 -> g x1 (h y1)) x1 y1)-            (SNF1 g x1,SNF2 h y1 y2)       -> debugLog "merge_12" $ opt (SNF3 (\x1 y1 y2 -> g x1 (h y1 y2)) x1 y1 y2)-            (SNF1 g x1,SNF3 h y1 y2 y3)    -> debugLog "merge_13" $ opt (SNF4 (\x1 y1 y2 y3 -> g x1 (h y1 y2 y3)) x1 y1 y2 y3)-            (SNF1 g x1,SNF4 h y1 y2 y3 y4) -> debugLog "merge_14" $ opt (SNF5 (\x1 y1 y2 y3 y4 -> g x1 (h y1 y2 y3 y4)) x1 y1 y2 y3 y4)-            (SNF1 g x1,_)                  -> debugLog "lift_2x" $ opt (SNF2 g x1 x)-            (SNF2 g x1 x2,SNK y)           -> debugLog "merge_20" $ opt (SNF2 (\x1 x2 -> g x1 x2 y) x1 x2)-            (SNF2 g x1 x2,SNF1 h y1)       -> debugLog "merge_21" $ opt (SNF3 (\x1 x2 y1 -> g x1 x2 (h y1)) x1 x2 y1)-            (SNF2 g x1 x2,SNF2 h y1 y2)    -> debugLog "merge_22" $ opt (SNF4 (\x1 x2 y1 y2 -> g x1 x2 (h y1 y2)) x1 x2 y1 y2)-            (SNF2 g x1 x2,SNF3 h y1 y2 y3) -> debugLog "merge_23" $ opt (SNF5 (\x1 x2 y1 y2 y3 -> g x1 x2 (h y1 y2 y3)) x1 x2 y1 y2 y3)-            (SNF2 g x1 x2,_)               -> debugLog "lift_3x" $ opt (SNF3 g x1 x2 x)-            (SNF3 g x1 x2 x3,SNK y)        -> debugLog "merge_30" $ opt (SNF3 (\x1 x2 x3 -> g x1 x2 x3 y) x1 x2 x3)-            (SNF3 g x1 x2 x3,SNF1 h y1)    -> debugLog "merge_31" $ opt (SNF4 (\x1 x2 x3 y1 -> g x1 x2 x3 (h y1)) x1 x2 x3 y1)-            (SNF3 g x1 x2 x3,SNF2 h y1 y2) -> debugLog "merge_32" $ opt (SNF5 (\x1 x2 x3 y1 y2 -> g x1 x2 x3 (h y1 y2)) x1 x2 x3 y1 y2)-            (SNF3 g x1 x2 x3,_)            -> debugLog "lift_4x" $ opt (SNF4 g x1 x2 x3 x)-            (SNF4 g x1 x2 x3 x4,SNK y)     -> debugLog "merge_40" $ opt (SNF4 (\x1 x2 x3 x4 -> g x1 x2 x3 x4 y) x1 x2 x3 x4)-            (SNF4 g x1 x2 x3 x4,SNF1 h y1) -> debugLog "merge_41" $ opt (SNF5 (\x1 x2 x3 x4 y1 -> g x1 x2 x3 x4 (h y1)) x1 x2 x3 x4 y1)-            (SNF4 g x1 x2 x3 x4,_)         -> debugLog "lift_5x" $ opt (SNF5 g x1 x2 x3 x4 x)-            (SNF5 g x1 x2 x3 x4 x5,SNK y)  -> debugLog "merge_50" $ opt (SNF5 (\x1 x2 x3 x4 x5 -> g x1 x2 x3 x4 x5 y) x1 x2 x3 x4 x5)-            _                              -> return ()-          return True--        -- Lifting into higher arity not knowing the argument-        when (not merged) $ case nf of-          SNK g              -> debugLog "lift_1" $ opt (SNF1 g x)-          SNF1 g x1          -> debugLog "lift_2" $ opt (SNF2 g x1 x)-          SNF2 g x1 x2       -> debugLog "lift_3" $ opt (SNF3 g x1 x2 x)-          SNF3 g x1 x2 x3    -> debugLog "lift_4" $ opt (SNF4 g x1 x2 x3 x)-          SNF4 g x1 x2 x3 x4 -> debugLog "lift_5" $ opt (SNF5 g x1 x2 x3 x4 x)-          _                  -> return ()--      -- The final version-      return (S c)--{-| The @Show@ instance is only defined for the sake of 'Num'... -}--instance Show (Signal a) where-    showsPrec _ _ s = "<SIGNAL>" ++ s--{-| The equality test checks whether two signals are physically the same. -}--instance Eq (Signal a) where-    S s1 == S s2 = s1 == s2--{-| Error message for unimplemented instance functions. -}--unimp :: String -> a-unimp = error . ("Signal: "++)--instance Ord t => Ord (Signal t) where-    compare = unimp "compare"-    min = liftA2 min-    max = liftA2 max--instance Enum t => Enum (Signal t) where-    succ = fmap succ-    pred = fmap pred-    toEnum = pure . toEnum-    fromEnum = unimp "fromEnum"-    enumFrom = unimp "enumFrom"-    enumFromThen = unimp "enumFromThen"-    enumFromTo = unimp "enumFromTo"-    enumFromThenTo = unimp "enumFromThenTo"--instance Bounded t => Bounded (Signal t) where-    minBound = pure minBound-    maxBound = pure maxBound--instance Num t => Num (Signal t) where-    (+) = liftA2 (+)-    (-) = liftA2 (-)-    (*) = liftA2 (*)-    signum = fmap signum-    abs = fmap abs-    negate = fmap negate-    fromInteger = pure . fromInteger--instance Real t => Real (Signal t) where-    toRational = unimp "toRational"--instance Integral t => Integral (Signal t) where-    quot = liftA2 quot-    rem = liftA2 rem-    div = liftA2 div-    mod = liftA2 mod-    quotRem a b = (fst <$> qrab,snd <$> qrab)-        where qrab = quotRem <$> a <*> b-    divMod a b = (fst <$> dmab,snd <$> dmab)-        where dmab = divMod <$> a <*> b-    toInteger = unimp "toInteger"--instance Fractional t => Fractional (Signal t) where-    (/) = liftA2 (/)-    recip = fmap recip-    fromRational = pure . fromRational--instance Floating t => Floating (Signal t) where-    pi = pure pi-    exp = fmap exp-    sqrt = fmap sqrt-    log = fmap log-    (**) = liftA2 (**)-    logBase = liftA2 logBase-    sin = fmap sin-    tan = fmap tan-    cos = fmap cos-    asin = fmap asin-    atan = fmap atan-    acos = fmap acos-    sinh = fmap sinh-    tanh = fmap tanh-    cosh = fmap cosh-    asinh = fmap asinh-    atanh = fmap atanh-    acosh = fmap acosh---- ** Internal functions to run the network--{-| Creating a reference within the 'SignalMonad'.  Used for stateful-signals. -}--makeSignal :: SignalNode a -> SignalMonad (Signal a)-makeSignal node = SM $ do-  ref <- newIORef (Ready node)-  return (S ref)--{-| Creating a reference as a pure value.  Used for stateless-signals. -}--makeSignalUnsafe :: SignalNode a -> Signal a-makeSignalUnsafe = S . unsafePerformIO . newIORef . Ready--{-| Sampling the signal and all of its dependencies, at the same time.-We don't need the aged signal in the current superstep, only the-current value, so we sample before propagating the changes, which-might require the fresh sample because of recursive definitions. -}--signalValue :: forall a . Signal a -> DTime -> IO a-signalValue (S r) dt = do-  t <- readIORef r-  case t of-    Ready s     -> do writeIORef r (Sampling s)-                      -- TODO: advance can be evaluated in a separate-                      -- thread, since we don't need its result right-                      -- away, only in the next superstep.-                      v <- sample s dt-                      -- We memorise the sample to handle loops-                      -- nicely.  The undefined future signal cannot-                      -- bite us, because we don't need it during the-                      -- evaluation phase.-                      writeIORef r (Sampled v s)-                      return v-    Sampling s  -> do -- We started sampling this already, so there is-                      -- a dependency cycle we have to resolve by-                      -- adding a delay to stateful signals. Stateless-                      -- signals should not form a loop, which is-                      -- obvious...-                      v <- sampleDelayed s dt-                      writeIORef r (Sampled v s)-                      -- Since we are sampling it already, this node-                      -- will be overwritten by the case above when-                      -- the loop is closed.-                      return v-    Sampled v _ -> return v-    Aged v _    -> return v--{-| Aging the network of signals the given signal depends on. -}--age :: forall a . Signal a -> DTime -> IO ()-age (S r) dt = do-  t <- readIORef r-  case t of-    Sampled v s -> do s' <- advance s v dt-                      writeIORef r (Aged v s')-                      -- TODO: branching can be trivially parallelised-                      case s' of-                        SNT s _ _             -> age s dt-                        SNA sf sx             -> age sf dt >> age sx dt-                        SNH ss r              -> age ss dt >> readIORef r >>= \s -> age s dt-                        SNM b sm              -> age b dt >> age sm dt-                        SND _ s               -> age s dt-                        SNKA s l              -> age s dt >> age l dt-                        SNF1 _ s              -> age s dt-                        SNF2 _ s1 s2          -> age s1 dt >> age s2 dt-                        SNF3 _ s1 s2 s3       -> age s1 dt >> age s2 dt >> age s3 dt-                        SNF4 _ s1 s2 s3 s4    -> age s1 dt >> age s2 dt >> age s3 dt >> age s4 dt-                        SNF5 _ s1 s2 s3 s4 s5 -> age s1 dt >> age s2 dt >> age s3 dt >> age s4 dt >> age s5 dt-                        _                     -> return ()-    Aged _ _    -> return ()-    _           -> error "Inconsistent state: signal not sampled properly!"--{-| Finalising aged signals for the next round. -}--commit :: forall a . Signal a -> IO ()-commit (S r) = do-  t <- readIORef r-  case t of-    Aged _ s -> do writeIORef r (Ready s)-                   -- TODO: branching can be trivially parallelised-                   case s of-                     SNT s _ _             -> commit s-                     SNA sf sx             -> commit sf >> commit sx-                     SNH ss r              -> commit ss >> readIORef r >>= \s -> commit s-                     SNM b sm              -> commit b >> commit sm-                     SND _ s               -> commit s-                     SNKA s l              -> commit s >> commit l-                     SNF1 _ s              -> commit s-                     SNF2 _ s1 s2          -> commit s1 >> commit s2-                     SNF3 _ s1 s2 s3       -> commit s1 >> commit s2 >> commit s3-                     SNF4 _ s1 s2 s3 s4    -> commit s1 >> commit s2 >> commit s3 >> commit s4-                     SNF5 _ s1 s2 s3 s4 s5 -> commit s1 >> commit s2 >> commit s3 >> commit s4 >> commit s5-                     _                     -> return ()-    Ready _     -> return ()-    _           -> error "Inconsistent state: signal not aged properly!"--{-| Aging the signal.  Stateful signals have their state forced to-prevent building up big thunks.  The other nodes are structurally-static. -}--advance :: SignalNode a -> a -> DTime -> IO (SignalNode a)-advance (SNS x f)    _ dt = x `seq` return (SNS (f dt x) f)-advance (SNT s _ f)  v _  = v `seq` return (SNT s v f)-advance (SND _ s)    _ dt = do x <- signalValue s dt-                               return (SND x s)-advance s            _ _  = return s--{-| Sampling the signal at the current moment.  This is where static-nodes propagate changes to those they depend on.  Transfer functions-('SNT') work without delay, i.e. the effects of their input signals-can be observed in the same superstep. -}--sample :: SignalNode a -> DTime -> IO a-sample (SNK x)                 _  = return x-sample (SNS x _)               _  = return x-sample (SNT s x f)             dt = do t <- signalValue s dt-                                       return $! f dt t x-sample (SNA sf sx)             dt = signalValue sf dt <*> signalValue sx dt-sample (SNH ss r)              dt = do s <- signalValue ss dt-                                       writeIORef r s-                                       signalValue s dt-sample (SNM b sm)              dt = do c <- signalValue b dt-                                       SM m <- signalValue sm dt-                                       if c then m else return undefined-sample (SNE r)                 _  = readIORef r-sample (SND v _)               _  = return v-sample (SNKA s l)              dt = do _ <- signalValue l dt-                                       signalValue s dt-sample (SNF1 f s)              dt = f <$> signalValue s dt-sample (SNF2 f s1 s2)          dt = liftM2 f (signalValue s1 dt) (signalValue s2 dt)-sample (SNF3 f s1 s2 s3)       dt = liftM3 f (signalValue s1 dt) (signalValue s2 dt) (signalValue s3 dt)-sample (SNF4 f s1 s2 s3 s4)    dt = liftM4 f (signalValue s1 dt) (signalValue s2 dt) (signalValue s3 dt) (signalValue s4 dt)-sample (SNF5 f s1 s2 s3 s4 s5) dt = liftM5 f (signalValue s1 dt) (signalValue s2 dt) (signalValue s3 dt) (signalValue s4 dt) (signalValue s5 dt)--{-| Sampling the signal with some kind of delay in order to resolve-dependency loops.  Transfer functions simply return their previous-output (delays can be considered a special case, because they always-do that, so 'sampleDelayed' is never called with them), while other-types of signals are always handled by the 'sample' function, so it is-not possible to create a working stateful loop composed of solely-stateless combinators. -}--sampleDelayed :: SignalNode a -> DTime -> IO a-sampleDelayed (SNT _ x _) _  = return x-sampleDelayed sn          dt = sample sn dt---- ** Userland combinators--{-| Advancing the whole network that the given signal depends on by-the amount of time given in the second argument. -}--superstep :: Signal a -- ^ the top-level signal-          -> DTime    -- ^ the amount of time to advance-          -> IO a     -- ^ the current value of the signal-superstep world dt = do-  snapshot <- signalValue world dt-  age world dt-  commit world-  return snapshot--{-| A pure stateful signal.  The initial state is the first output. -}--stateful :: a                 -- ^ initial state-         -> (DTime -> a -> a) -- ^ state transformation-         -> SignalMonad (Signal a)-stateful x0 f = makeSignal (SNS x0 f)--{-| A stateful transfer function.  The current input affects the-current output, i.e. the initial state given in the first argument is-considered to appear before the first output, and can only be directly-observed by the `sampleDelayed` function. -}--transfer :: a                      -- ^ initial internal state-         -> (DTime -> t -> a -> a) -- ^ state updater function-         -> Signal t               -- ^ input signal-         -> SignalMonad (Signal a)-transfer x0 f s = makeSignal (SNT s x0 f)--{-| A continuous sampler that flattens a higher-order signal by-outputting its current snapshots. -}--sampler :: Signal (Signal a) -- ^ signal to flatten-        -> Signal a-sampler ss = makeSignalUnsafe (SNH ss (unsafePerformIO (newIORef undefined)))--{-| A reactive signal that takes the value to output from a monad-carried by its input when a boolean control signal is true, otherwise-it outputs 'Nothing'.  It is possible to create new signals in the-monad and also to print debug messages. -}--generator :: Signal Bool            -- ^ control (trigger) signal-          -> Signal (SignalMonad a) -- ^ a stream of monads to potentially run-          -> Signal (Maybe a)-generator b sm = toMaybe <$> b <*> makeSignalUnsafe (SNM b sm)--{-| A helper function to wrap any value in a 'Maybe' depending on a-boolean condition. -}--toMaybe :: Bool -> a -> Maybe a-toMaybe c v = if c then Just v else Nothing--{-| A signal that can be directly fed through the sink function-returned.  This can be used to attach the network to the outer-world. -}--external :: a                     -- ^ initial value-         -> IO (Signal a, Sink a) -- ^ the signal and an IO function to feed it-external x0 = do-  ref <- newIORef x0-  snr <- newIORef (Ready (SNE ref))-  return (S snr,writeIORef ref)--{-| The `delay` transfer function emits the value of a signal from the-previous superstep, starting with the filler value given in the first-argument.  It has to be a primitive, otherwise it could not be used to-prevent automatic delays. -}--delay :: a        -- ^ initial output-      -> Signal a -- ^ the signal to delay-      -> SignalMonad (Signal a)-delay x0 s = makeSignal (SND x0 s)--{-| Dependency injection to allow aging signals whose output is not-necessarily needed to produce the current sample of the first-argument.  It's equivalent to @(flip . liftA2 . flip) const@, as it-evaluates its second argument first. -}--keepAlive :: Signal a -- ^ the actual output-          -> Signal t -- ^ a signal guaranteed to age when this one is sampled-          -> Signal a-keepAlive s l = makeSignalUnsafe (SNKA s l)

@@ -20,7 +20,6 @@     , start     , external     , externalMulti-    , debug     -- * Basic building blocks     , delay     , generator@@ -34,9 +33,14 @@     , transfer2     , transfer3     , transfer4-    -- * Random sources-    , noise-    , getRandom+    -- * Signals with side effects+    -- $effectful+    , execute+    , effectful+    , effectful1+    , effectful2+    , effectful3+    , effectful4     ) where  import Control.Applicative@@ -47,7 +51,6 @@ import Data.Maybe import Prelude hiding (until) import System.Mem.Weak-import System.Random.Mersenne  -- | A signal represents a value changing over time.  It can be -- thought of as a function of type @Nat -> a@, where the argument is@@ -97,9 +100,8 @@ -- signals in the resulting structure. newtype SignalGen p a = SG { unSG :: IORef UpdatePool -> Signal p -> IO a } --- | The phases every signal goes through during a superstep: before--- or after sampling.-data Phase s a = Ready s | Aged s a+-- | The phases every signal goes through during a superstep.+data Phase a = Ready a | Updated a a  instance Functor (SignalGen p) where   fmap = liftM@@ -109,11 +111,11 @@   (<*>) = ap  instance Monad (SignalGen p) where-  return = SG . const . const . return+  return x = SG $ \_ _ -> return x   SG g >>= f = SG $ \p i -> g p i >>= \x -> unSG (f x) p i  instance MonadFix (SignalGen p) where-  mfix f = SG $ \p i -> mfix (($i).($p).unSG.f)+  mfix f = SG $ \p i -> mfix $ \x -> unSG (f x) p i  -- | Embedding a signal into an 'IO' environment.  Repeated calls to -- the computation returned cause the whole network to be updated, and@@ -141,45 +143,38 @@   pool <- newIORef []   (inp,sink) <- external undefined   S sample <- gen pool inp--  ptrs0 <- readIORef pool-  writeIORef pool []-  (as0,cs0) <- unzip . map fromJust <$> mapM deRefWeak ptrs0-  let ageStatic = sequence_ as0-      commitStatic = sequence_ cs0-   return $ \param -> do-    let update [] ptrs age commit = do-          writeIORef pool ptrs-          ageStatic >> age-          commitStatic >> commit-        update (p:ps) ptrs age commit = do-          r <- deRefWeak p-          case r of-            Nothing -> update ps ptrs age commit-            Just (a,c) -> update ps (p:ptrs) (age >> a) (commit >> c)-+    let deref ptr = (fmap.fmap) ((,) ptr) (deRefWeak ptr)     sink param     res <- sample-    ptrs <- readIORef pool-    update ptrs [] (return ()) (return ())+    (ptrs,acts) <- unzip.catMaybes <$> (mapM deref =<< readIORef pool)+    writeIORef pool ptrs+    mapM_ fst acts+    mapM_ snd acts     return res  -- | Auxiliary function used by all the primitives that create a -- mutable variable.-addSignal :: (Phase s a -> IO a)  -- ^ sampling function-          -> (Phase s a -> IO ()) -- ^ aging function-          -> IORef (Phase s a)    -- ^ the mutable variable behind the signal-          -> IORef UpdatePool     -- ^ the pool of update actions+addSignal :: (a -> IO a)      -- ^ sampling function+          -> (a -> IO ())     -- ^ aging function+          -> IORef (Phase a)  -- ^ the mutable variable behind the signal+          -> IORef UpdatePool -- ^ the pool of update actions           -> IO (Signal a)-addSignal sample age ref pool = do-  let  commit (Aged s _)  = Ready s-       commit _           = error "commit error: signal not aged"+addSignal sample update ref pool = do+  let upd = readIORef ref >>= \v -> case v of+              Ready x -> update x+              _       -> return () -       sig = S $ readIORef ref >>= sample+      fin = readIORef ref >>= \v -> case v of+              Updated x _ -> writeIORef ref $! Ready x+              _           -> error "Signal not updated!" -  update <- mkWeak sig (readIORef ref >>= age, modifyIORef ref commit) Nothing-  modifyIORef pool (update:)+      sig = S $ readIORef ref >>= \v -> case v of+              Ready x     -> sample x+              Updated _ x -> return x++  updateActions <- mkWeak sig (upd,fin) Nothing+  modifyIORef pool (updateActions:)   return sig  -- | The 'delay' combinator is the elementary building block for@@ -226,40 +221,13 @@ delay x0 (S s) = SG $ \pool _ -> do   ref <- newIORef (Ready x0) -  let  sample (Ready x)   = return x-       sample (Aged _ x)  = return x--       age (Ready x)  = s >>= \x' -> x' `seq` writeIORef ref (Aged x' x)-       age _          = return ()--  addSignal sample age ref pool---- | Memoising combinator.  It can be used to cache results of--- applicative combinators in case they are used in several places.--- It is observationally equivalent to 'return' in the 'SignalGen'--- monad.------ > memo s = <|s s s s ...|>------ For instance, if @s = f \<$\> s'@, then @f@ will be recalculated--- once for each sampling of @s@.  This can be avoided by writing @s--- \<- memo (f \<$\> s')@ instead.  However, 'memo' incurs a small--- overhead, therefore it should not be used blindly.------ All the functions defined in this module return memoised signals.--- Just like 'delay', it is independent of the global input.-memo :: Signal a               -- ^ signal to memoise-     -> SignalGen p (Signal a)-memo (S s) = SG $ \pool _ -> do-  ref <- newIORef (Ready undefined)--  let  sample (Ready _)      = s >>= \x -> writeIORef ref (Aged undefined x) >> return x-       sample (Aged _ x)     = return x+  let update x = s >>= \x' -> x' `seq` writeIORef ref (Updated x' x) -       age (Ready _)      = s >>= \x -> writeIORef ref (Aged undefined x)-       age _              = return ()+  addSignal return update ref pool -  addSignal sample age ref pool+-- | Auxiliary function.+memoise :: IORef (Phase a) -> a -> IO a+memoise ref x = writeIORef ref (Updated undefined x) >> return x  -- | A reactive signal that takes the value to output from a signal -- generator carried by its input with the sampling time provided as@@ -291,20 +259,37 @@ -- -- Refer to the longer example at the bottom of "FRP.Elerea.Simple" to -- see how it can be used.-generator :: Signal (SignalGen p a) -- ^ a stream of generators to potentially run-          -> SignalGen p (Signal a)-generator (S gen) = SG $ \pool inp -> do+generator :: Signal (SignalGen p a) -- ^ the signal of generators to run+          -> SignalGen p (Signal a) -- ^ the signal of generated structures+generator (S s) = SG $ \pool inp -> do   ref <- newIORef (Ready undefined) -  let  next = ($inp).($pool).unSG =<< gen+  let sample = (s >>= \(SG g) -> g pool inp) >>= memoise ref+  +  addSignal (const sample) (const (() <$ sample)) ref pool -       sample (Ready _)  = next >>= \x' -> writeIORef ref (Aged x' x') >> return x'-       sample (Aged _ x) = return x+-- | Memoising combinator.  It can be used to cache results of+-- applicative combinators in case they are used in several places.+-- It is observationally equivalent to 'return' in the 'SignalGen'+-- monad.+--+-- > memo s = <|s s s s ...|>+--+-- For instance, if @s = f \<$\> s'@, then @f@ will be recalculated+-- once for each sampling of @s@.  This can be avoided by writing @s+-- \<- memo (f \<$\> s')@ instead.  However, 'memo' incurs a small+-- overhead, therefore it should not be used blindly.+--+-- All the functions defined in this module return memoised signals.+-- Just like 'delay', it is independent of the global input.+memo :: Signal a               -- ^ the signal to cache+     -> SignalGen p (Signal a) -- ^ a signal observationally equivalent to the argument+memo (S s) = SG $ \pool _ -> do+  ref <- newIORef (Ready undefined) -       age (Ready _) = next >>= \x' -> writeIORef ref (Aged x' x')-       age _         = return ()+  let sample = s >>= memoise ref -  addSignal sample age ref pool+  addSignal (const sample) (const (() <$ sample)) ref pool  -- | A signal that is true exactly once: the first time the input -- signal is true.  Afterwards, it is constantly false, and it holds@@ -350,9 +335,9 @@    rsmp <- mfix $ \rs -> newIORef $ do     x <- s-    writeIORef ref (Aged undefined x)+    writeIORef ref (Updated undefined x)     when x $ writeIORef rs $ do-      writeIORef ref (Aged undefined False)+      writeIORef ref (Updated undefined False)       return False     return x @@ -430,8 +415,8 @@              update <- mkWeak sig (return (),takeMVar var >> putMVar var []) Nothing              modifyIORef pool (update:)              return sig-         ,\val -> do  vals <- takeMVar var-                      putMVar var (val:vals)+         ,\val -> do vals <- takeMVar var+                     putMVar var (val:vals)          )  -- | A direct stateful transformation of the input.  The initial state@@ -522,28 +507,117 @@     sig' <- delay x0 sig     memo (liftM5 f inp s1 s2 s3 s4 `ap` sig') --- | A random signal.+{- $effectful++The following combinators are primarily aimed at library implementors+who wish build abstractions to effectful libraries on top of Elerea.++-}++-- | An IO action executed in the 'SignalGen' monad. Can be used as+-- `liftIO`.+execute :: IO a -> SignalGen p a+execute act = SG $ \_ _ -> act++-- | A signal that executes a given IO action once at every sampling. --+-- In essence, this combinator provides cooperative multitasking+-- capabilities, and its primary purpose is to assist library writers+-- in wrapping effectful APIs as conceptually pure signals.  If there+-- are several effectful signals in the system, their order of+-- execution is undefined and should not be relied on.+-- -- Example: -- -- > do--- >     smp <- start noise :: IO (IO Double)+-- >     act <- start $ do+-- >         ref <- execute $ newIORef 0+-- >         let accum n = do+-- >                 x <- readIORef ref+-- >                 putStrLn $ "Accumulator: " ++ show x+-- >                 writeIORef ref $! x+n+-- >                 return ()+-- >         effectful1 accum =<< input+-- >     forM_ [4,9,2,1,5] act+--+-- Output:+--+-- > Accumulator: 0+-- > Accumulator: 4+-- > Accumulator: 13+-- > Accumulator: 15+-- > Accumulator: 16+--+-- Another example (requires mersenne-random):+--+-- > do+-- >     smp <- start $ effectful randomIO :: IO (IO Double) -- >     res <- replicateM 5 smp -- >     print res -- -- Output: -- -- > [0.12067753390401374,0.8658877349182655,0.7159264443196786,0.1756941896012891,0.9513646060896676]-noise :: MTRandom a => SignalGen p (Signal a)-noise = memo (S randomIO)+effectful :: IO a                 -- ^ the action to be executed repeatedly+          -> SignalGen p (Signal a)+effectful act = SG $ \pool _ -> do+  ref <- newIORef (Ready undefined) --- | A random source within the 'SignalGen' monad.-getRandom :: MTRandom a => SignalGen p a-getRandom = SG (const (const randomIO))+  let sample = act >>= memoise ref --- | A printing action within the 'SignalGen' monad.-debug :: String -> SignalGen p ()-debug = SG . const . const . putStrLn+  addSignal (const sample) (const (() <$ sample)) ref pool++-- | A signal that executes a parametric IO action once at every+-- sampling.  The parameter is supplied by another signal at every+-- sampling step.+effectful1 :: (t -> IO a)          -- ^ the action to be executed repeatedly+           -> Signal t             -- ^ parameter signal+           -> SignalGen p (Signal a)+effectful1 act (S s) = SG $ \pool _ -> do+  ref <- newIORef (Ready undefined)++  let sample = s >>= act >>= memoise ref++  addSignal (const sample) (const (() <$ sample)) ref pool++-- | Like 'effectful1', but with two parameter signals.+effectful2 :: (t1 -> t2 -> IO a)   -- ^ the action to be executed repeatedly+           -> Signal t1            -- ^ parameter signal 1+           -> Signal t2            -- ^ parameter signal 2+           -> SignalGen p (Signal a)+effectful2 act (S s1) (S s2) = SG $ \pool _ -> do+  ref <- newIORef (Ready undefined)++  let sample = join (liftM2 act s1 s2) >>= memoise ref++  addSignal (const sample) (const (() <$ sample)) ref pool++-- | Like 'effectful1', but with three parameter signals.+effectful3 :: (t1 -> t2 -> t3 -> IO a) -- ^ the action to be executed repeatedly+           -> Signal t1                -- ^ parameter signal 1+           -> Signal t2                -- ^ parameter signal 2+           -> Signal t3                -- ^ parameter signal 3+           -> SignalGen p (Signal a)+effectful3 act (S s1) (S s2) (S s3) = SG $ \pool _ -> do+  ref <- newIORef (Ready undefined)++  let sample = join (liftM3 act s1 s2 s3) >>= memoise ref++  addSignal (const sample) (const (() <$ sample)) ref pool++-- | Like 'effectful1', but with four parameter signals.+effectful4 :: (t1 -> t2 -> t3 -> t4 -> IO a) -- ^ the action to be executed repeatedly+           -> Signal t1                      -- ^ parameter signal 1+           -> Signal t2                      -- ^ parameter signal 2+           -> Signal t3                      -- ^ parameter signal 3+           -> Signal t4                      -- ^ parameter signal 4+           -> SignalGen p (Signal a)+effectful4 act (S s1) (S s2) (S s3) (S s4) = SG $ \pool _ -> do+  ref <- newIORef (Ready undefined)++  let sample = join (liftM4 act s1 s2 s3 s4) >>= memoise ref++  addSignal (const sample) (const (() <$ sample)) ref pool  -- | The @Show@ instance is only defined for the sake of 'Num'... instance Show (Signal a) where

@@ -16,7 +16,6 @@     , start     , external     , externalMulti-    , debug     -- * Basic building blocks     , delay     , generator@@ -29,14 +28,13 @@     , transfer3     , transfer4     -- * Signals with side effects+    -- $effectful+    , execute     , effectful     , effectful1     , effectful2     , effectful3     , effectful4-    -- * Random sources-    , noise-    , getRandom     -- * A longer example     -- $example     ) where@@ -49,7 +47,6 @@ import Data.Maybe import Prelude hiding (until) import System.Mem.Weak-import System.Random.Mersenne  -- | A signal represents a value changing over time.  It can be -- thought of as a function of type @Nat -> a@, where the argument is@@ -73,7 +70,7 @@  -- | A dynamic set of actions to update a network without breaking -- consistency.-type UpdatePool = [Weak (IO (),IO ())]+type UpdatePool = [Weak (IO (), IO ())]  -- | A signal generator is the only source of stateful signals.  It -- can be thought of as a function of type @Nat -> a@, where the@@ -101,18 +98,18 @@ data Phase a = Ready a | Updated a a  instance Functor SignalGen where-  fmap = (<*>).pure+  fmap = liftM  instance Applicative SignalGen where   pure = return   (<*>) = ap  instance Monad SignalGen where-  return = SG . const . return+  return x = SG $ \_ -> return x   SG g >>= f = SG $ \p -> g p >>= \x -> unSG (f x) p  instance MonadFix SignalGen where-  mfix f = SG $ \p -> mfix (($p).unSG.f)+  mfix f = SG $ \p -> mfix $ \x -> unSG (f x) p  -- | Embedding a signal into an 'IO' environment.  Repeated calls to -- the computation returned cause the whole network to be updated, and@@ -155,17 +152,17 @@           -> IORef UpdatePool -- ^ the pool of update actions           -> IO (Signal a)    -- ^ the signal created addSignal sample update ref pool = do-  let  upd = readIORef ref >>= \v -> case v of-               Ready x  -> update x-               _        -> return ()+  let upd = readIORef ref >>= \v -> case v of+              Ready x -> update x+              _       -> return () -       fin = readIORef ref >>= \v -> case v of-               Updated x _  -> writeIORef ref $! Ready x-               _            -> error "Signal not updated!"+      fin = readIORef ref >>= \v -> case v of+              Updated x _ -> writeIORef ref $! Ready x+              _           -> error "Signal not updated!" -       sig = S $ readIORef ref >>= \v -> case v of-               Ready x      -> sample x-               Updated _ x  -> return x+      sig = S $ readIORef ref >>= \v -> case v of+              Ready x     -> sample x+              Updated _ x -> return x    updateActions <- mkWeak sig (upd,fin) Nothing   modifyIORef pool (updateActions:)@@ -218,6 +215,10 @@    addSignal return update ref pool +-- | Auxiliary function.+memoise :: IORef (Phase a) -> a -> IO a+memoise ref x = writeIORef ref (Updated undefined x) >> return x+ -- | A reactive signal that takes the value to output from a signal -- generator carried by its input with the sampling time provided as -- the start time for the generated structure.  It is possible to@@ -250,17 +251,10 @@ generator (S s) = SG $ \pool -> do   ref <- newIORef (Ready undefined) -  let sample = do  SG g <- s-                   x <- g pool-                   writeIORef ref (Updated undefined x)-                   return x+  let sample = (s >>= \(SG g) -> g pool) >>= memoise ref    addSignal (const sample) (const (() <$ sample)) ref pool --- | Auxiliary function.-memoise :: IORef (Phase a) -> a -> IO a-memoise ref x = writeIORef ref (Updated undefined x) >> return x- -- | Memoising combinator.  It can be used to cache results of -- applicative combinators in case they are used in several places. -- It is observationally equivalent to 'return' in the 'SignalGen'@@ -402,8 +396,8 @@              update <- mkWeak sig (return (),takeMVar var >> putMVar var []) Nothing              modifyIORef pool (update:)              return sig-         ,\val -> do  vals <- takeMVar var-                      putMVar var (val:vals)+         ,\val -> do vals <- takeMVar var+                     putMVar var (val:vals)          )  -- | A pure stateful signal.  The initial state is the first output,@@ -485,8 +479,19 @@     sig' <- delay x0 sig     memo (liftM5 f s1 s2 s3 s4 sig') +{- $effectful++The following combinators are primarily aimed at library implementors+who wish build abstractions to effectful libraries on top of Elerea.++-}++-- | An IO action executed in the 'SignalGen' monad. Can be used as+-- `liftIO`.+execute :: IO a -> SignalGen a+execute act = SG $ \_ -> act+ -- | A signal that executes a given IO action once at every sampling.--- The IO action is constructed by an initialiser. -- -- In essence, this combinator provides cooperative multitasking -- capabilities, and its primary purpose is to assist library writers@@ -497,14 +502,14 @@ -- Example: -- -- > do--- >     act <- start $ effectful $ do--- >       ref <- newIORef 0--- >       return $ do--- >         x <- readIORef ref--- >         putStrLn $ "Count: " ++ show x--- >         writeIORef ref $! x+1--- >         return ()--- >     replicateM_ 5 act+-- >     smp <- start $ do+-- >         ref <- execute $ newIORef 0+-- >         effectful $ do+-- >             x <- readIORef ref+-- >             putStrLn $ "Count: " ++ show x+-- >             writeIORef ref $! x+1+-- >             return ()+-- >     replicateM_ 5 smp -- -- Output: --@@ -513,94 +518,77 @@ -- > Count: 2 -- > Count: 3 -- > Count: 4-effectful :: IO (IO a)             -- ^ initialiser that yields the action to be executed repeatedly+--+-- Another example (requires mersenne-random):+--+-- > do+-- >     smp <- start $ effectful randomIO :: IO (IO Double)+-- >     res <- replicateM 5 smp+-- >     print res+--+-- Output:+--+-- > [0.12067753390401374,0.8658877349182655,0.7159264443196786,0.1756941896012891,0.9513646060896676]+effectful :: IO a                 -- ^ the action to be executed repeatedly           -> SignalGen (Signal a)-effectful gen = SG $ \pool -> do+effectful act = SG $ \pool -> do   ref <- newIORef (Ready undefined)-  act <- gen    let sample = act >>= memoise ref    addSignal (const sample) (const (() <$ sample)) ref pool  -- | A signal that executes a parametric IO action once at every--- sampling.  The IO action is constructed by an initialiser, and the--- parameter is supplied by another signal at every sampling step.-effectful1 :: IO (t -> IO a)        -- ^ initialiser that yields the action to be executed repeatedly-           -> Signal t              -- ^ parameter signal+-- sampling.  The parameter is supplied by another signal at every+-- sampling step.+effectful1 :: (t -> IO a)          -- ^ the action to be executed repeatedly+           -> Signal t             -- ^ parameter signal            -> SignalGen (Signal a)-effectful1 gen (S s) = SG $ \pool -> do+effectful1 act (S s) = SG $ \pool -> do   ref <- newIORef (Ready undefined)-  act <- gen    let sample = s >>= act >>= memoise ref    addSignal (const sample) (const (() <$ sample)) ref pool  -- | Like 'effectful1', but with two parameter signals.-effectful2 :: IO (t1 -> t2 -> IO a)  -- ^ initialiser that yields the action to be executed repeatedly-           -> Signal t1              -- ^ parameter signal 1-           -> Signal t2              -- ^ parameter signal 2+effectful2 :: (t1 -> t2 -> IO a)   -- ^ the action to be executed repeatedly+           -> Signal t1            -- ^ parameter signal 1+           -> Signal t2            -- ^ parameter signal 2            -> SignalGen (Signal a)-effectful2 gen (S s1) (S s2) = SG $ \pool -> do+effectful2 act (S s1) (S s2) = SG $ \pool -> do   ref <- newIORef (Ready undefined)-  act <- gen    let sample = join (liftM2 act s1 s2) >>= memoise ref    addSignal (const sample) (const (() <$ sample)) ref pool  -- | Like 'effectful1', but with three parameter signals.-effectful3 :: IO (t1 -> t2 -> t3 -> IO a)  -- ^ initialiser that yields the action to be executed repeatedly-           -> Signal t1                    -- ^ parameter signal 1-           -> Signal t2                    -- ^ parameter signal 2-           -> Signal t3                    -- ^ parameter signal 3+effectful3 :: (t1 -> t2 -> t3 -> IO a) -- ^ the action to be executed repeatedly+           -> Signal t1                -- ^ parameter signal 1+           -> Signal t2                -- ^ parameter signal 2+           -> Signal t3                -- ^ parameter signal 3            -> SignalGen (Signal a)-effectful3 gen (S s1) (S s2) (S s3) = SG $ \pool -> do+effectful3 act (S s1) (S s2) (S s3) = SG $ \pool -> do   ref <- newIORef (Ready undefined)-  act <- gen    let sample = join (liftM3 act s1 s2 s3) >>= memoise ref    addSignal (const sample) (const (() <$ sample)) ref pool  -- | Like 'effectful1', but with four parameter signals.-effectful4 :: IO (t1 -> t2 -> t3 -> t4 -> IO a)  -- ^ initialiser that yields the action to be executed repeatedly-           -> Signal t1                          -- ^ parameter signal 1-           -> Signal t2                          -- ^ parameter signal 2-           -> Signal t3                          -- ^ parameter signal 3-           -> Signal t4                          -- ^ parameter signal 4+effectful4 :: (t1 -> t2 -> t3 -> t4 -> IO a) -- ^ the action to be executed repeatedly+           -> Signal t1                      -- ^ parameter signal 1+           -> Signal t2                      -- ^ parameter signal 2+           -> Signal t3                      -- ^ parameter signal 3+           -> Signal t4                      -- ^ parameter signal 4            -> SignalGen (Signal a)-effectful4 gen (S s1) (S s2) (S s3) (S s4) = SG $ \pool -> do+effectful4 act (S s1) (S s2) (S s3) (S s4) = SG $ \pool -> do   ref <- newIORef (Ready undefined)-  act <- gen    let sample = join (liftM4 act s1 s2 s3 s4) >>= memoise ref    addSignal (const sample) (const (() <$ sample)) ref pool---- | A random signal.------ Example:------ > do--- >     smp <- start noise :: IO (IO Double)--- >     res <- replicateM 5 smp--- >     print res------ Output:------ > [0.12067753390401374,0.8658877349182655,0.7159264443196786,0.1756941896012891,0.9513646060896676]-noise :: MTRandom a => SignalGen (Signal a)-noise = memo (S randomIO)---- | A random source within the 'SignalGen' monad.-getRandom :: MTRandom a => SignalGen a-getRandom = SG (const randomIO)---- | A printing action within the 'SignalGen' monad.-debug :: String -> SignalGen ()-debug = SG . const . putStrLn  -- | The Show instance is only defined for the sake of Num... instance Show (Signal a) where

@@ -1,5 +1,5 @@ Name:                elerea-Version:             2.4.0+Version:             2.5.0 Cabal-Version:       >= 1.2 Synopsis:            A minimalistic FRP library Category:            reactivity, FRP@@ -50,13 +50,9 @@ Library   Exposed-Modules:     FRP.Elerea-    FRP.Elerea.Legacy-    FRP.Elerea.Legacy.Graph-    FRP.Elerea.Legacy.Internal-    FRP.Elerea.Legacy.Delayed     FRP.Elerea.Simple     FRP.Elerea.Param     FRP.Elerea.Clocked -  Build-Depends:       base >= 4 && < 5, containers, mersenne-random+  Build-Depends:       base >= 4 && < 5, containers   ghc-options:         -Wall -O2