diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,8 @@ +2.2.0 - 110402 +* added n-ary transfer functions +* temporarily removed transfer from the clocked variant +* revised documentation + 2.1.0 - 100805 * reimplemented the parametric variant in a way that doesn't require signals to carry the type of the parameter any more diff --git a/FRP/Elerea.hs b/FRP/Elerea.hs new file mode 100644 --- /dev/null +++ b/FRP/Elerea.hs @@ -0,0 +1,50 @@ +{-| + +Elerea (Eventless reactivity) is a tiny discrete time FRP +implementation without the notion of event-based switching and +sampling, with first-class signals (time-varying values). Reactivity +is provided through various higher-order constructs that also allow +the user to work with arbitrary time-varying structures containing +live signals. Signals have precise and simple denotational semantics. + +Stateful signals can be safely generated at any time through a monadic +interface, while stateless combinators can be used in a purely +applicative style. Elerea signals can be defined recursively, and +external input is trivial to attach. The library comes in three major +variants, one of which you need to import: + +* "FRP.Elerea.Simple": signals are plain discrete streams isomorphic +to functions over natural numbers; + +* "FRP.Elerea.Param": adds a globally accessible input signal for +convenience; + +* "FRP.Elerea.Clocked": adds the ability to freeze whole subnetworks +at will. + +Elerea is a minimal library that defines only some basic primitives, +and you are advised to install @elerea-examples@ as well to get an +idea how to build non-trivial systems with it. The examples are +separated in order to minimise the dependencies of the core library. +The @dow@ package contains a full game built on top of the simple +variant. + +The basic idea of the implementation is described in the WFLP 2010 +paper /Efficient and Compositional Higher-Order Streams/ +(). + +In short, the basic idea is to define completely dynamic data-flow +networks through a pure combinator-style monadic interface. The +network can be turned into an I/O action that samples it sequentially +by the @start@ function. Under the hood, the network is represented +by mutable variables whose interconnections are encapsulated in +closures, and consistency is ensured by a two-phase update process +(essentially double buffering). The library keeps track of the +variables through weak pointers, so all of the live variables can be +updated (this is necessary to ensure referential transparency), and +unused ones can be garbage collected. + +-} + +module FRP.Elerea where + diff --git a/FRP/Elerea/Clocked.hs b/FRP/Elerea/Clocked.hs --- a/FRP/Elerea/Clocked.hs +++ b/FRP/Elerea/Clocked.hs @@ -15,61 +15,47 @@ signals to be functions of time (natural numbers), the behaviour of delay can be described by the following function: -@ - delay x0 s (t_start,clk) t_sample - | t_start == t_sample = x0 - | t_start \< t_sample = if clk t_sample - then s (t_sample-1) - else delay x0 s (t_start (t_sample-1) - | otherwise = error \"stream doesn't exist yet\" -@ +> delay x0 s (t_start,clk) t_sample +> | t_start == t_sample = x0 +> | t_start < t_sample = if clk t_sample +> then s (t_sample-1) +> else delay x0 s t_start s_clock (t_sample-1) +> | otherwise = error "stream doesn't exist yet" A simple example to create counters operating at different rates using the same generator: -@ - divisibleBy n x = x \`mod\` n == 0 -@ - -@ - counter = stateful 0 (+1) -@ - -@ - drift = do - time \<- counter - c1 \<- withClock (divisibleBy 2 \<$\> time) counter - c2 \<- withClock (divisibleBy 3 \<$\> time) counter - return ((,) \<$\> c1 \<*\> c2) -@ +> divisibleBy n x = x `mod` n == 0 +> +> counter = stateful 0 (+1) +> +> drift = do +> time <- counter +> c1 <- withClock (divisibleBy 2 <$> time) counter +> c2 <- withClock (divisibleBy 3 <$> time) counter +> return ((,) <$> c1 <*> c2) Note that if you want to slow down the drift system defined above, the naive approach might lead to surprising results: -@ - slowDrift = do - time \<- counter - withClock (divisibleBy 2 \<$\> time) drift -@ +> slowDrift = do +> time <- counter +> withClock (divisibleBy 2 <$> time) drift The problem is that the clocks are also slowed down, and their spikes double in length. This may or may not be what you want. To overcome this problem, we can define a clock oblivious edge detector to be used within the definition of @drift@: -@ - edge = withClock (pure True) . transfer False (\\b b' -> b && not b') -@ - -@ - drift = do - time \<- counter - t2 \<- edge (divisibleBy 2 \<$\> time) - t3 \<- edge (divisibleBy 3 \<$\> time) - c1 \<- withClock t2 counter - c2 \<- withClock t3 counter - return ((,) \<$\> c1 \<*\> c2) -@ +> edge = withClock (pure True) . transfer False (\b b' -> b && not b') +> +> drift = do +> time <- counter +> t2 <- edge (divisibleBy 2 <$> time) +> t3 <- edge (divisibleBy 3 <$> time) +> c1 <- withClock t2 counter +> c2 <- withClock t3 counter +> return ((,) <$> c1 <*> c2) This works because the 'withClock' function overrides any clock imposed on the generator from outside. @@ -77,21 +63,27 @@ -} module FRP.Elerea.Clocked - ( Signal + ( + -- * The signal abstraction + Signal , SignalGen + -- * Embedding into I/O , start , external , externalMulti + , debug + -- * Basic building blocks , delay , generator , memo , until , withClock + -- * Derived combinators , stateful - , transfer + --, transfer + -- * Random sources , noise , getRandom - , debug ) where import Control.Applicative @@ -104,10 +96,24 @@ import System.Mem.Weak import System.Random.Mersenne --- | A signal can be thought of as a function of type @Nat -> a@, --- where the argument is the sampling time, and the 'Monad' instance --- agrees with the intuition (bind corresponds to extracting the --- current sample). +-- | A signal represents a value changing over time. It can be +-- thought of as a function of type @Nat -> a@, where the argument is +-- the sampling time, and the 'Monad' instance agrees with the +-- intuition (bind corresponds to extracting the current sample). +-- Signals and the values they carry are denoted the following way in +-- the documentation: +-- +-- > s = <> +-- +-- This says that @s@ is a signal that reads @s0@ during the first +-- sampling, @s1@ during the second and so on. You can also think of +-- @s@ as the following function: +-- +-- > s t_sample = [s0,s1,s2,...] !! t_sample +-- +-- Signals are constrained to be sampled sequentially, there is no +-- random access. The only way to observe their output is through +-- 'start'. newtype Signal a = S (IO a) deriving (Functor, Applicative, Monad) -- | A dynamic set of actions to update a network without breaking @@ -119,7 +125,22 @@ -- result is an arbitrary data structure that can potentially contain -- new signals, and the argument is the creation time of these new -- signals. It exposes the 'MonadFix' interface, which makes it --- possible to define signals in terms of each other. +-- possible to define signals in terms of each other. Unlike the +-- simple variant, the denotation of signal generators differs from +-- that of signals. We will use the following notation for +-- generators: +-- +-- > g = <|g0 g1 g2 ...|> +-- +-- Just like signals, generators behave as functions of time, but they +-- can also refer to the clock signal: +-- +-- > g t_start s_clock = [g0,g1,g2,...] !! t_start +-- +-- The conceptual difference between the two notions is that signals +-- are passed a sampling time, while generators expect a start time +-- that will be the creation time of all the freshly generated +-- signals in the resulting structure. newtype SignalGen a = SG { unSG :: IORef UpdatePool -> Signal Bool -> IO a } -- | The phases every signal goes through during a superstep. @@ -144,7 +165,21 @@ -- the current sample of the top-level signal is produced as a -- result. This is the only way to extract a signal generator outside -- the network, and it is equivalent to passing zero to the function --- representing the generator. +-- representing the generator. The clock associated with the +-- top-level signal ticks at every sampling point. In general: +-- +-- > replicateM n =<< start <|<> ...|> == take n [x0,x1,x2,x3,...] +-- +-- Example: +-- +-- > do +-- > smp <- start (stateful 3 (+2)) +-- > res <- replicateM 5 smp +-- > print res +-- +-- Output: +-- +-- > [3,5,7,9,11] start :: SignalGen (Signal a) -- ^ the generator of the top-level signal -> IO (IO a) -- ^ the computation to sample the signal start (SG gen) = do @@ -183,21 +218,42 @@ modifyIORef pool (updateActions:) 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. It can be thought of as the following function --- (which should also make it clear why the return value is --- 'SignalGen'): +-- | The 'delay' combinator is the elementary building block for +-- adding state to the signal network by constructing delayed versions +-- of a signal that emit a given value at creation time and the +-- previous output of the signal afterwards. -- --- @ --- delay x0 s t_start t_sample --- | t_start == t_sample = x0 --- | t_start < t_sample = s (t_sample-1) --- | otherwise = error \"Premature sample!\" --- @ +-- The clock signal associated to the generator affects 'delay' +-- elements the following way: if the clock signal is true, the delay +-- works as usual, otherwise it remembers its current output and +-- throws away its current input. If we consider signals to be +-- functions of time (natural numbers), the behaviour of delay can be +-- described by the following function: -- --- The way signal generators are extracted ensures that the error can --- never happen. +-- > delay x0 s t_start s_clock t_sample +-- > | t_start == t_sample = x0 +-- > | t_start < t_sample = if s_clock t_sample +-- > then s (t_sample-1) +-- > else delay x0 s t_start s_clock (t_sample-1) +-- > | otherwise = error "stream doesn't exist yet" +-- +-- The way signal generators are extracted by 'generator' ensures that +-- the error can never happen. +-- +-- Example (requires the @DoRec@ extension): +-- +-- > do +-- > smp <- start $ do +-- > rec let fib'' = liftA2 (+) fib' fib +-- > fib' <- delay 1 fib'' +-- > fib <- delay 1 fib' +-- > return fib +-- > res <- replicateM 7 smp +-- > print res +-- +-- Output: +-- +-- > [1,1,2,3,5,8,13] delay :: a -- ^ initial output at creation time -> Signal a -- ^ the signal to delay -> SignalGen (Signal a) -- ^ the delayed signal @@ -212,17 +268,33 @@ -- | A reactive signal that takes the value to output from a signal -- generator carried by its input with the sampling time provided as --- the time of generation. It is possible to create new signals in --- the monad. It can be thought of as the following function: +-- the start time for the generated structure. It is possible to +-- create new signals in the monad, which is the key to defining +-- dynamic data-flow networks. -- --- @ --- generator g t_start t_sample = g t_sample t_sample --- @ +-- > generator << <|x00 x01 x02 ...|> +-- > <|x10 x11 x12 ...|> +-- > <|x20 x21 x22 ...|> +-- > ... +-- > >> = <| <> +-- > <> +-- > <> +-- > ... +-- > |> -- +-- It can be thought of as the following function: +-- +-- > generator g t_start s_clock t_sample = g t_sample t_sample s_clock +-- -- It has to live in the 'SignalGen' monad, because it needs to -- maintain an internal state to be able to cache the current sample -- for efficiency reasons. However, this state is not carried between --- samples, therefore starting time doesn't matter and can be ignored. +-- samples, therefore start time doesn't matter and can be ignored. +-- Also, even though it does not make use of the clock itself, part of +-- its job is to distribute it among the newly generated signals. +-- +-- Refer to the longer example at the bottom of "FRP.Elerea.Simple" to +-- see how it can be used. generator :: Signal (SignalGen a) -- ^ the signal of generators to run -> SignalGen (Signal a) -- ^ the signal of generated structures generator (S s) = SG $ \pool clk -> do @@ -238,7 +310,13 @@ -- | Override the clock used in a generator. Note that clocks don't -- interact unless one is used in the definition of the other, i.e. it -- is possible to provide a fast clock within a generator with a slow --- associated clock. +-- associated clock. It is equivalent to the following function: +-- +-- > withClock s g t_start s_clock = g t_start s +-- +-- For instance, the following equivalence holds: +-- +-- > withClock (pure False) (stateful x f) == pure x withClock :: Signal Bool -> SignalGen a -> SignalGen a withClock clk (SG g) = SG $ \pool _ -> g pool clk @@ -246,6 +324,15 @@ -- 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. memo :: Signal a -- ^ the signal to cache -> SignalGen (Signal a) -- ^ a signal observationally equivalent to the argument memo (S s) = SG $ \pool _ -> do @@ -259,7 +346,41 @@ -- signal is true. Afterwards, it is constantly false, and it holds -- no reference to the input signal. Note that 'until' always follows -- the master clock, i.e. the fastest one, therefore it never creates --- a long spike of @True@. +-- a long spike of @True@. For instance (assuming the rest of the +-- input is constantly @False@): +-- +-- > until <> = +-- > <| <> +-- > << --- False True False False False False False False False ...>> +-- > << --- --- True False False False False False False False ...>> +-- > << --- --- --- True False False False False False False ...>> +-- > << --- --- --- --- False True False False False False ...>> +-- > << --- --- --- --- --- True False False False False ...>> +-- > << --- --- --- --- --- --- False False False False ...>> +-- > ... +-- > |> +-- +-- It is observationally equivalent to the following expression (which +-- would hold onto @s@ forever): +-- +-- > until s = withClock (pure True) $ do +-- > step <- transfer False (||) s +-- > dstep <- delay False step +-- > memo (liftA2 (/=) step dstep) +-- +-- Example: +-- +-- > do +-- > smp <- start $ do +-- > cnt <- stateful 0 (+1) +-- > tick <- until ((>=3) <$> cnt) +-- > return $ liftA2 (,) cnt tick +-- > res <- replicateM 6 smp +-- > print res +-- +-- Output: +-- +-- > [(0,False),(1,False),(2,False),(3,True),(4,False),(5,False)] until :: Signal Bool -- ^ the boolean input signal -> SignalGen (Signal Bool) -- ^ a one-shot signal true only the first time the input is true until (S s) = SG $ \pool _ -> do @@ -279,7 +400,29 @@ -- | A signal that can be directly fed through the sink function -- returned. This can be used to attach the network to the outer --- world. +-- world. The signal always yields the value last written to the +-- sink. In other words, if the sink is written less frequently than +-- the network sampled, the output remains the same during several +-- samples. If values are pushed in the sink more frequently, only +-- the last one before sampling is visible on the output. +-- +-- Example: +-- +-- > do +-- > (sig,snk) <- external 4 +-- > smp <- start (return sig) +-- > r1 <- smp +-- > r2 <- smp +-- > snk 7 +-- > r3 <- smp +-- > snk 9 +-- > snk 2 +-- > r4 <- smp +-- > print [r1,r2,r3,r4] +-- +-- Output: +-- +-- > [4,4,7,2] external :: a -- ^ initial value -> IO (Signal a, a -> IO ()) -- ^ the signal and an IO function to feed it external x = do @@ -288,12 +431,30 @@ -- | 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 +-- 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. +-- +-- Example: +-- +-- > do +-- > (gen,snk) <- externalMulti +-- > smp <- start gen +-- > r1 <- smp +-- > snk 7 +-- > r2 <- smp +-- > r3 <- smp +-- > snk 9 +-- > snk 2 +-- > r4 <- smp +-- > print [r1,r2,r3,r4] +-- +-- Output: +-- +-- > [[],[7],[],[2,9]] externalMulti :: IO (SignalGen (Signal [a]), a -> IO ()) -- ^ a generator for the event signal and the associated sink externalMulti = do var <- newMVar [] @@ -308,35 +469,50 @@ -- | A pure stateful signal. The initial state is the first output, -- and every subsequent state is derived from the preceding one by --- applying a pure transformation. It is equivalent to the following --- expression: +-- applying a pure transformation. It is affected by the associated +-- clock like 'delay': no transformation is performed in the absence +-- of a tick; see the example at the top. -- --- @ --- stateful x0 f = 'mfix' $ \sig -> 'delay' x0 (f '<$>' sig) --- @ +-- Example: +-- +-- > do +-- > smp <- start (stateful "x" ('x':)) +-- > res <- replicateM 5 smp +-- > print res +-- +-- Output: +-- +-- > ["x","xx","xxx","xxxx","xxxxx"] stateful :: a -- ^ initial state -> (a -> a) -- ^ state transformation -> SignalGen (Signal a) stateful x0 f = mfix $ \sig -> delay x0 (f <$> sig) --- | 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, and subsequent states are determined by combining the --- preceding state with the current output of the input signal using --- the function supplied. It is equivalent to the following --- expression: --- --- @ --- transfer x0 f s = 'mfix' $ \sig -> 'liftA2' f s '<$>' 'delay' x0 sig --- @ +{- + transfer :: a -- ^ initial internal state -> (t -> a -> a) -- ^ state updater function -> Signal t -- ^ input signal -> SignalGen (Signal a) -transfer x0 f s = mfix $ \sig -> liftA2 f s <$> delay x0 sig +transfer x0 f s = mfix $ \sig -> do + sig' <- delay x0 sig + -- TODO: we shouldn't apply the function when there is no tick + memo (liftA2 f s sig') +-} + -- | 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) @@ -348,15 +524,15 @@ debug :: String -> SignalGen () debug = SG . const . const . putStrLn --- The Show instance is only defined for the sake of Num... +-- | The Show instance is only defined for the sake of Num... instance Show (Signal a) where showsPrec _ _ s = "" ++ s --- Equality test is impossible. +-- | Equality test is impossible. instance Eq (Signal a) where _ == _ = False --- Error message for unimplemented instance functions. +-- | Error message for unimplemented instance functions. unimp :: String -> a unimp = error . ("Signal: "++) diff --git a/FRP/Elerea/Delayed.hs b/FRP/Elerea/Delayed.hs deleted file mode 100644 --- a/FRP/Elerea/Delayed.hs +++ /dev/null @@ -1,374 +0,0 @@ -{-| - -Note: this module is likely to be deprecated in the near future, -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 is -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.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 = "" ++ 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 diff --git a/FRP/Elerea/Legacy/Delayed.hs b/FRP/Elerea/Legacy/Delayed.hs new file mode 100644 --- /dev/null +++ b/FRP/Elerea/Legacy/Delayed.hs @@ -0,0 +1,374 @@ +{-| + +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 = "" ++ 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 diff --git a/FRP/Elerea/Param.hs b/FRP/Elerea/Param.hs --- a/FRP/Elerea/Param.hs +++ b/FRP/Elerea/Param.hs @@ -2,56 +2,41 @@ {-| -This version differs from the simple one in providing an extra -argument to the sampling action that will be globally distributed to -every node and can be used to update the state. For instance, it can -hold the time step between the two samplings, but it could also encode -all the external input to the system. - -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; - -* there is no automatic delay in order to preserve semantic soundness - (e.g. the monad laws for signals); - -* 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; - -* the input can be retrieved as an explicit signal within the - SignalGen monad, and also overridden for parts of the network. +This module provides leak-free and referentially transparent +higher-order discrete signals. Unlike in "FRP.Elerea.Simple", the +sampling action has an extra argument that will be globally +distributed to every node and can be used to update the state. For +instance, it can hold the time step between the two samplings, but it +could also encode all the external input to the system. -} module FRP.Elerea.Param - ( Signal + ( + -- * The signal abstraction + Signal , SignalGen + -- * Embedding into I/O , start , external , externalMulti + , debug + -- * Basic building blocks , delay , generator , memo , until , input , embed + -- * Derived combinators , stateful , transfer + , transfer2 + , transfer3 + , transfer4 + -- * Random sources , noise , getRandom - , debug ) where import Control.Applicative @@ -64,18 +49,52 @@ 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. +-- | A signal represents a value changing over time. It can be +-- thought of as a function of type @Nat -> a@, where the argument is +-- the sampling time, and the 'Monad' instance agrees with the +-- intuition (bind corresponds to extracting the current sample). +-- Signals and the values they carry are denoted the following way in +-- the documentation: +-- +-- > s = <> +-- +-- This says that @s@ is a signal that reads @s0@ during the first +-- sampling, @s1@ during the second and so on. You can also think of +-- @s@ as the following function: +-- +-- > s t_sample = [s0,s1,s2,...] !! t_sample +-- +-- Signals are constrained to be sampled sequentially, there is no +-- random access. The only way to observe their output is through +-- 'start'. newtype Signal a = S (IO a) deriving (Functor, Applicative, Monad) -- | A dynamic set of actions to update a network without breaking -- consistency. type UpdatePool = [Weak (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. +-- | A signal generator is the only source of stateful signals. It +-- can be thought of as a function of type @Nat -> Signal p -> a@, +-- where the result is an arbitrary data structure that can +-- potentially contain new signals, the first argument is the creation +-- time of these new signals, and the second is a globally accessible +-- input signal. It exposes the 'MonadFix' interface, which makes it +-- possible to define signals in terms of each other. Unlike the +-- simple variant, the denotation of signal generators differs from +-- that of signals. We will use the following notation for +-- generators: +-- +-- > g = <|g0 g1 g2 ...|> +-- +-- Just like signals, generators behave as functions of time, but they +-- can also refer to the input signal: +-- +-- > g t_start s_input = [g0,g1,g2,...] !! t_start +-- +-- The conceptual difference between the two notions is that signals +-- are passed a sampling time, while generators expect a start time +-- that will be the creation time of all the freshly generated +-- 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 @@ -98,10 +117,24 @@ -- | 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. +-- 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. This is the only way to +-- extract a signal generator outside the network, and it is +-- equivalent to passing zero to the function representing the +-- generator. +-- +-- Example: +-- +-- > do +-- > smp <- start (stateful 10 (+)) +-- > res <- forM [5,3,2,9,4] smp +-- > print res +-- +-- Output: +-- +-- > [10,15,18,20,29] start :: SignalGen p (Signal a) -- ^ the generator of the top-level signal -> IO (p -> IO a) -- ^ the computation to sample the signal start (SG gen) = do @@ -149,9 +182,44 @@ 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. +-- | The 'delay' combinator is the elementary building block for +-- adding state to the signal network by constructing delayed versions +-- of a signal that emit a given value at creation time and the +-- previous output of the signal afterwards (@--@ is undefined): +-- +-- > delay x0 s = <| <> +-- > <<-- x0 s1 s2 s3 ...>> +-- > <<-- -- x0 s2 s3 ...>> +-- > <<-- -- -- x0 s3 ...>> +-- > ... +-- > |> +-- +-- It can be thought of as the following function (which should also +-- make it clear why the return value is 'SignalGen'): +-- +-- > delay x0 s t_start s_input t_sample +-- > | t_start == t_sample = x0 +-- > | t_start < t_sample = s (t_sample-1) +-- > | otherwise = error \"Premature sample!\" +-- +-- The way signal generators are extracted by 'generator' ensures that +-- the error can never happen. It is also clear that the behaviour of +-- 'delay' is not affected in any way by the global input. +-- +-- Example (requires the @DoRec@ extension): +-- +-- > do +-- > smp <- start $ do +-- > rec let fib'' = liftA2 (+) fib' fib +-- > fib' <- delay 1 fib'' +-- > fib <- delay 1 fib' +-- > return fib +-- > res <- replicateM 7 (smp undefined) +-- > print res +-- +-- Output: +-- +-- > [1,1,2,3,5,8,13] delay :: a -- ^ initial output -> Signal a -- ^ the signal to delay -> SignalGen p (Signal a) @@ -167,8 +235,19 @@ 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'. +-- 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 @@ -182,9 +261,36 @@ 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. +-- | 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 +-- create new signals in the monad, which is the key to defining +-- dynamic data-flow networks. +-- +-- > generator << <|x00 x01 x02 ...|> +-- > <|x10 x11 x12 ...|> +-- > <|x20 x21 x22 ...|> +-- > ... +-- > >> = <| <> +-- > <> +-- > <> +-- > ... +-- > |> +-- +-- It can be thought of as the following function: +-- +-- > generator g t_start s_input t_sample = g t_sample t_sample s_input +-- +-- It has to live in the 'SignalGen' monad, because it needs to +-- maintain an internal state to be able to cache the current sample +-- for efficiency reasons. However, this state is not carried between +-- samples, therefore start time doesn't matter and can be ignored. +-- Also, even though it does not make use of the global input itself, +-- part of its job is to distribute it among the newly generated +-- signals. +-- +-- 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 @@ -202,7 +308,41 @@ -- | A signal that is true exactly once: the first time the input -- signal is true. Afterwards, it is constantly false, and it holds --- no reference to the input signal. +-- no reference to the input signal. For instance (assuming the rest +-- of the input is constantly @False@): +-- +-- > until <> = +-- > <| <> +-- > << --- False True False False False False False False False ...>> +-- > << --- --- True False False False False False False False ...>> +-- > << --- --- --- True False False False False False False ...>> +-- > << --- --- --- --- False True False False False False ...>> +-- > << --- --- --- --- --- True False False False False ...>> +-- > << --- --- --- --- --- --- False False False False ...>> +-- > ... +-- > |> +-- +-- It is observationally equivalent to the following expression (which +-- would hold onto @s@ forever): +-- +-- > until s = do +-- > step <- transfer False (const (||)) s +-- > dstep <- delay False step +-- > memo (liftA2 (/=) step dstep) +-- +-- Example: +-- +-- > do +-- > smp <- start $ do +-- > accum <- stateful 0 (+) +-- > tick <- until ((>=10) <$> accum) +-- > return $ liftA2 (,) accum tick +-- > res <- forM [4,1,3,5,2,8,6] smp +-- > print res +-- +-- Output: +-- +-- > [(0,False),(4,False),(5,False),(8,False),(13,True),(15,False),(23,False)] until :: Signal Bool -- ^ the boolean input signal -> SignalGen p (Signal Bool) -- ^ a one-shot signal true only the first time the input is true until (S s) = SG $ \pool _ -> do @@ -221,11 +361,45 @@ addSignal (const sample) (const (() <$ sample)) ref pool -- | The common input signal that is fed through the function returned --- by 'start', unless we are in an 'embed'ded generator. +-- by 'start', unless we are in an 'embed'ded generator. It is +-- equivalent to the following function: +-- +-- > input t_start s_input = s_input +-- +-- Example: +-- +-- > do +-- > smp <- start $ do +-- > sig <- input +-- > return (sig*2) +-- > res <- forM [4,1,3,5,2,8,6] smp +-- > print res +-- +-- Output: +-- +-- > [8,2,6,10,4,16,12] input :: SignalGen p (Signal p) input = SG $ const return --- | Embed a generator with an overridden input signal. +-- | Embed a generator with an overridden input signal. It is +-- equivalent to the following function: +-- +-- > embed s g t_start s_input = g t_start s +-- +-- Example: +-- +-- > do +-- > smp <- start $ do +-- > sig <- input +-- > embed (sig*2) $ do +-- > sig <- input +-- > return (sig+1) +-- > res <- forM [4,1,3,5,2,8,6] smp +-- > print res +-- +-- Output: +-- +-- > [9,3,7,11,5,17,13] embed :: Signal p' -> SignalGen p' a -> SignalGen p a embed s (SG g) = SG $ \pool _ -> g pool s @@ -260,14 +434,21 @@ 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 (which might have been overridden --- by 'embed'). It is equivalent to the following expression: +-- | A direct stateful transformation of the input. The initial state +-- is the first output, and every following output is calculated from +-- the previous one and the value of the global parameter (which might +-- have been overridden by 'embed'). -- --- @ --- stateful x0 f = 'mfix' $ \sig -> 'input' >>= \i -> 'delay' x0 (f '<$>' i '<*>' sig) --- @ +-- Example: +-- +-- > do +-- > smp <- start (stateful "" (:)) +-- > res <- forM "olleh~" smp +-- > print res +-- +-- Output: +-- +-- > ["","o","lo","llo","ello","hello"] stateful :: a -- ^ initial state -> (p -> a -> a) -- ^ state transformation -> SignalGen p (Signal a) @@ -281,16 +462,78 @@ -- overridden by 'embed') and the previous output. It is equivalent -- to the following expression: -- --- @ --- transfer x0 f s = 'mfix' $ \sig -> 'input' >>= \i -> 'liftA3' f i s '<$>' 'delay' x0 sig --- @ -transfer :: a -- ^ initial internal state - -> (p -> t -> a -> a) -- ^ state updater function - -> Signal t -- ^ input signal +-- Example (assuming a delta time is passed to the sampling function +-- in each step): +-- +-- > integral x0 s = transfer x0 (\dt v x -> x+dt*v) +-- +-- Example for using the above: +-- +-- > do +-- > smp <- start (integral 3 (pure 2)) +-- > res <- replicateM 7 (smp 0.1) +-- > print res +-- +-- Output: +-- +-- > [3.2,3.4,3.6,3.8,4.0,4.2,4.4] +transfer :: a -- ^ initial internal state + -> (p -> t -> a -> a) -- ^ state updater function + -> Signal t -- ^ input signal -> SignalGen p (Signal a) -transfer x0 f s = mfix $ \sig -> input >>= \i -> liftA3 f i s <$> delay x0 sig +transfer x0 f s = mfix $ \sig -> do + inp <- input + sig' <- delay x0 sig + memo (liftA3 f inp s sig') +-- | A variation of 'transfer' with two input signals. +transfer2 :: a -- ^ initial internal state + -> (p -> t1 -> t2 -> a -> a) -- ^ state updater function + -> Signal t1 -- ^ input signal 1 + -> Signal t2 -- ^ input signal 2 + -> SignalGen p (Signal a) +transfer2 x0 f s1 s2 = mfix $ \sig -> do + inp <- input + sig' <- delay x0 sig + memo (liftM4 f inp s1 s2 sig') + +-- | A variation of 'transfer' with three input signals. +transfer3 :: a -- ^ initial internal state + -> (p -> t1 -> t2 -> t3 -> a -> a) -- ^ state updater function + -> Signal t1 -- ^ input signal 1 + -> Signal t2 -- ^ input signal 2 + -> Signal t3 -- ^ input signal 3 + -> SignalGen p (Signal a) +transfer3 x0 f s1 s2 s3 = mfix $ \sig -> do + inp <- input + sig' <- delay x0 sig + memo (liftM5 f inp s1 s2 s3 sig') + +-- | A variation of 'transfer' with four input signals. +transfer4 :: a -- ^ initial internal state + -> (p -> t1 -> t2 -> t3 -> t4 -> a -> a) -- ^ state updater function + -> Signal t1 -- ^ input signal 1 + -> Signal t2 -- ^ input signal 2 + -> Signal t3 -- ^ input signal 3 + -> Signal t4 -- ^ input signal 4 + -> SignalGen p (Signal a) +transfer4 x0 f s1 s2 s3 s4 = mfix $ \sig -> do + inp <- input + sig' <- delay x0 sig + memo (liftM5 f inp s1 s2 s3 s4 `ap` sig') + -- | 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 p (Signal a) noise = memo (S randomIO) diff --git a/FRP/Elerea/Simple.hs b/FRP/Elerea/Simple.hs --- a/FRP/Elerea/Simple.hs +++ b/FRP/Elerea/Simple.hs @@ -3,140 +3,36 @@ {-| This module provides leak-free and referentially transparent -higher-order discrete signals. For a not entirely trivial example, -let's create a dynamic collection of countdown timers, where each -expired timer is removed from the collection. First of all, we'll -need a simple tester function: - -@ - sigtest gen = 'replicateM' 15 '=<<' 'start' gen -@ - -We can try it with a trivial example: - -@ - \> sigtest $ 'stateful' 2 (+3) - [2,5,8,11,14,17,20,23,26,29,32,35,38,41,44,47] -@ - -Our first definition will be a signal representing a simple named -timer: - -@ - countdown :: String -\> Int -\> SignalGen (Signal (String,Maybe Int)) - countdown name t = do - let tick prev = do { t \<- prev ; 'guard' (t \> 0) ; 'return' (t-1) } - timer \<- 'stateful' (Just t) tick - 'return' ((,) name '<$>' timer) -@ - -Let's see if it works: - -@ - \> sigtest $ countdown \"foo\" 4 - [(\"foo\",Just 4),(\"foo\",Just 3),(\"foo\",Just 2),(\"foo\",Just 1),(\"foo\",Just 0), - (\"foo\",Nothing),(\"foo\",Nothing),(\"foo\",Nothing),...] -@ - -Next, we will define a timer source that takes a list of timer names, -starting values and start times and creates a signal that delivers the -list of new timers at every point: - -@ - timerSource :: [(String, Int, Int)] -\> SignalGen (Signal [Signal (String, Maybe Int)]) - timerSource ts = do - let gen t = 'mapM' ('uncurry' countdown) newTimers - where newTimers = [(n,v) | (n,v,st) \<- ts, st == t] - cnt \<- 'stateful' 0 (+1) - 'generator' (gen '<$>' cnt) -@ - -Now we need to encapsulate the timer source signal in another signal -expression that takes care of maintaining the list of live timers. -Since working with dynamic collections is a recurring task, let's -define a generic combinator that maintains a dynamic list of signals -given a source and a test that tells from the output of each signal -whether it should be kept. We can use @mdo@ expressions (a variant of -@do@ expressions allowing forward references) as syntactic sugar for -'mfix' to make life easier: - -@ - collection :: Signal [Signal a] -\> (a -\> Bool) -\> SignalGen (Signal [a]) - collection source isAlive = mdo - sig \<- 'delay' [] ('map' 'snd' '<$>' collWithVals') - coll \<- 'memo' ('liftA2' (++) source sig) - let collWithVals = 'zip' '<$>' ('sequence' '=<<' coll) '<*>' coll - collWithVals' \<- 'memo' ('filter' (isAlive . 'fst') '<$>' collWithVals) - 'return' $ 'map' 'fst' '<$>' collWithVals' -@ - -We need recursion to define the @coll@ signal as a delayed version of -its continuation, which does not contain signals that need to be -removed in the current sample. At every point of time the running -collection is concatenated with the source. We define @collWithVals@, -which simply pairs up every signal with its current output. The -output is obtained by extracting the current value of the signal -container and sampling each element with 'sequence'. We can then -derive @collWithVals'@, which contains only the signals that must be -kept for the next round along with their output. Both @coll@ and -@collWithVals'@ have to be memoised, because they are used more than -once (the program would work without that, but it would recalculate -both signals each time they are used). By throwing out the respective -parts, we can get both the final output and the collection for the -next step (@coll'@). - -Now we can easily finish the original task: - -@ - timers :: [(String, Int, Int)] -\> SignalGen (Signal [(String, Int)]) - timers timerData = do - src \<- timerSource timerData - getOutput '<$>' collection src ('isJust' . 'snd') - where getOutput = 'fmap' ('map' (\\(name,Just val) -> (name,val))) -@ - -As a test, we can start four timers: /a/ at t=0 with value 3, /b/ and -/c/ at t=1 with values 5 and 3, and /d/ at t=3 with value 4: - -@ - \> sigtest $ timers [(\"a\",3,0),(\"b\",5,1),(\"c\",3,1),(\"d\",4,3)] - [[(\"a\",3)],[(\"b\",5),(\"c\",3),(\"a\",2)],[(\"b\",4),(\"c\",2),(\"a\",1)], - [(\"d\",4),(\"b\",3),(\"c\",1),(\"a\",0)],[(\"d\",3),(\"b\",2),(\"c\",0)], - [(\"d\",2),(\"b\",1)],[(\"d\",1),(\"b\",0)],[(\"d\",0)],[],[],[],[],[],[],[]] -@ - -If the noise of the applicative lifting operators feels annoying, she -() comes to the -save. Among other features it provides idiom brackets, which can -substitute the explicit lifting. For instance, it allows us to define -@collection@ this way: - -@ - collection :: Stream [Stream a] -> (a -> Bool) -> StreamGen (Stream [a]) - collection source isAlive = mdo - sig \<- 'delay' [] (|'map' ~'snd' collWithVals'|) - coll \<- 'memo' (|source ++ sig|) - collWithVals' \<- 'memo' (|'filter' ~(isAlive . 'fst') (|'zip' ('sequence' '=<<' coll) coll|)|) - 'return' (|'map' ~'fst' collWithVals'|) -@ +higher-order discrete signals. -} module FRP.Elerea.Simple - ( Signal + ( + -- * The signal abstraction + Signal , SignalGen + -- * Embedding into I/O , start , external , externalMulti + , debug + -- * Basic building blocks , delay , generator , memo , until + -- * Derived combinators , stateful , transfer + , transfer2 + , transfer3 + , transfer4 + -- * Random sources , noise , getRandom - , debug + -- * A longer example + -- $example ) where import Control.Applicative @@ -149,10 +45,24 @@ import System.Mem.Weak import System.Random.Mersenne --- | A signal can be thought of as a function of type @Nat -> a@, --- where the argument is the sampling time, and the 'Monad' instance --- agrees with the intuition (bind corresponds to extracting the --- current sample). +-- | A signal represents a value changing over time. It can be +-- thought of as a function of type @Nat -> a@, where the argument is +-- the sampling time, and the 'Monad' instance agrees with the +-- intuition (bind corresponds to extracting the current sample). +-- Signals and the values they carry are denoted the following way in +-- the documentation: +-- +-- > s = <> +-- +-- This says that @s@ is a signal that reads @s0@ during the first +-- sampling, @s1@ during the second and so on. You can also think of +-- @s@ as the following function: +-- +-- > s t_sample = [s0,s1,s2,...] !! t_sample +-- +-- Signals are constrained to be sampled sequentially, there is no +-- random access. The only way to observe their output is through +-- 'start'. newtype Signal a = S (IO a) deriving (Functor, Applicative, Monad) -- | A dynamic set of actions to update a network without breaking @@ -164,7 +74,21 @@ -- result is an arbitrary data structure that can potentially contain -- new signals, and the argument is the creation time of these new -- signals. It exposes the 'MonadFix' interface, which makes it --- possible to define signals in terms of each other. +-- possible to define signals in terms of each other. The denotation +-- of signal generators happens to be the same as that of signals, but +-- this partly accidental (it does not hold in the other variants), so +-- we will use a separate notation for generators: +-- +-- > g = <|g0 g1 g2 ...|> +-- +-- Just like signals, generators behave as functions of time: +-- +-- > g t_start = [g0,g1,g2,...] !! t_start +-- +-- The conceptual difference between the two notions is that signals +-- are passed a sampling time, while generators expect a start time +-- that will be the creation time of all the freshly generated +-- signals in the resulting structure. newtype SignalGen a = SG { unSG :: IORef UpdatePool -> IO a } -- | The phases every signal goes through during a superstep. @@ -189,7 +113,20 @@ -- the current sample of the top-level signal is produced as a -- result. This is the only way to extract a signal generator outside -- the network, and it is equivalent to passing zero to the function --- representing the generator. +-- representing the generator. In general: +-- +-- > replicateM n =<< start <|<> ...|> == take n [x0,x1,x2,x3,...] +-- +-- Example: +-- +-- > do +-- > smp <- start (stateful 3 (+2)) +-- > res <- replicateM 5 smp +-- > print res +-- +-- Output: +-- +-- > [3,5,7,9,11] start :: SignalGen (Signal a) -- ^ the generator of the top-level signal -> IO (IO a) -- ^ the computation to sample the signal start (SG gen) = do @@ -228,21 +165,43 @@ modifyIORef pool (updateActions:) 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. It can be thought of as the following function --- (which should also make it clear why the return value is --- 'SignalGen'): +-- | The 'delay' combinator is the elementary building block for +-- adding state to the signal network by constructing delayed versions +-- of a signal that emit a given value at creation time and the +-- previous output of the signal afterwards (@--@ is undefined): -- --- @ --- delay x0 s t_start t_sample --- | t_start == t_sample = x0 --- | t_start < t_sample = s (t_sample-1) --- | otherwise = error \"Premature sample!\" --- @ +-- > delay x0 s = <| <> +-- > <<-- x0 s1 s2 s3 ...>> +-- > <<-- -- x0 s2 s3 ...>> +-- > <<-- -- -- x0 s3 ...>> +-- > ... +-- > |> -- --- The way signal generators are extracted ensures that the error can --- never happen. +-- It can be thought of as the following function (which should also +-- make it clear why the return value is 'SignalGen'): +-- +-- > delay x0 s t_start t_sample +-- > | t_start == t_sample = x0 +-- > | t_start < t_sample = s (t_sample-1) +-- > | otherwise = error \"Premature sample!\" +-- +-- The way signal generators are extracted by 'generator' ensures that +-- the error can never happen. +-- +-- Example (requires the @DoRec@ extension): +-- +-- > do +-- > smp <- start $ do +-- > rec let fib'' = liftA2 (+) fib' fib +-- > fib' <- delay 1 fib'' +-- > fib <- delay 1 fib' +-- > return fib +-- > res <- replicateM 7 smp +-- > print res +-- +-- Output: +-- +-- > [1,1,2,3,5,8,13] delay :: a -- ^ initial output at creation time -> Signal a -- ^ the signal to delay -> SignalGen (Signal a) -- ^ the delayed signal @@ -255,17 +214,31 @@ -- | A reactive signal that takes the value to output from a signal -- generator carried by its input with the sampling time provided as --- the time of generation. It is possible to create new signals in --- the monad. It can be thought of as the following function: +-- the start time for the generated structure. It is possible to +-- create new signals in the monad, which is the key to defining +-- dynamic data-flow networks. -- --- @ --- generator g t_start t_sample = g t_sample t_sample --- @ +-- > generator << <|x00 x01 x02 ...|> +-- > <|x10 x11 x12 ...|> +-- > <|x20 x21 x22 ...|> +-- > ... +-- > >> = <| <> +-- > <> +-- > <> +-- > ... +-- > |> -- +-- It can be thought of as the following function: +-- +-- > generator g t_start t_sample = g t_sample t_sample +-- -- It has to live in the 'SignalGen' monad, because it needs to -- maintain an internal state to be able to cache the current sample -- for efficiency reasons. However, this state is not carried between --- samples, therefore starting time doesn't matter and can be ignored. +-- samples, therefore start time doesn't matter and can be ignored. +-- +-- Refer to the longer example at the bottom to see how it can be +-- used. generator :: Signal (SignalGen a) -- ^ the signal of generators to run -> SignalGen (Signal a) -- ^ the signal of generated structures generator (S s) = SG $ \pool -> do @@ -282,6 +255,15 @@ -- 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. memo :: Signal a -- ^ the signal to cache -> SignalGen (Signal a) -- ^ a signal observationally equivalent to the argument memo (S s) = SG $ \pool -> do @@ -293,15 +275,41 @@ -- | A signal that is true exactly once: the first time the input -- signal is true. Afterwards, it is constantly false, and it holds --- no reference to the input signal. It is observationally equivalent --- to the following expression (which would hold onto @s@ forever): +-- no reference to the input signal. For instance (assuming the rest +-- of the input is constantly @False@): -- --- @ --- until s = do --- step <- 'transfer' False (||) s --- dstep <- 'delay' False step --- return $ 'liftA2' (/=) step dstep --- @ +-- > until <> = +-- > <| <> +-- > << --- False True False False False False False False False ...>> +-- > << --- --- True False False False False False False False ...>> +-- > << --- --- --- True False False False False False False ...>> +-- > << --- --- --- --- False True False False False False ...>> +-- > << --- --- --- --- --- True False False False False ...>> +-- > << --- --- --- --- --- --- False False False False ...>> +-- > ... +-- > |> +-- +-- It is observationally equivalent to the following expression (which +-- would hold onto @s@ forever): +-- +-- > until s = do +-- > step <- transfer False (||) s +-- > dstep <- delay False step +-- > memo (liftA2 (/=) step dstep) +-- +-- Example: +-- +-- > do +-- > smp <- start $ do +-- > cnt <- stateful 0 (+1) +-- > tick <- until ((>=3) <$> cnt) +-- > return $ liftA2 (,) cnt tick +-- > res <- replicateM 6 smp +-- > print res +-- +-- Output: +-- +-- > [(0,False),(1,False),(2,False),(3,True),(4,False),(5,False)] until :: Signal Bool -- ^ the boolean input signal -> SignalGen (Signal Bool) -- ^ a one-shot signal true only the first time the input is true until (S s) = SG $ \pool -> do @@ -321,7 +329,29 @@ -- | A signal that can be directly fed through the sink function -- returned. This can be used to attach the network to the outer --- world. +-- world. The signal always yields the value last written to the +-- sink. In other words, if the sink is written less frequently than +-- the network sampled, the output remains the same during several +-- samples. If values are pushed in the sink more frequently, only +-- the last one before sampling is visible on the output. +-- +-- Example: +-- +-- > do +-- > (sig,snk) <- external 4 +-- > smp <- start (return sig) +-- > r1 <- smp +-- > r2 <- smp +-- > snk 7 +-- > r3 <- smp +-- > snk 9 +-- > snk 2 +-- > r4 <- smp +-- > print [r1,r2,r3,r4] +-- +-- Output: +-- +-- > [4,4,7,2] external :: a -- ^ initial value -> IO (Signal a, a -> IO ()) -- ^ the signal and an IO function to feed it external x = do @@ -330,12 +360,30 @@ -- | 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 +-- 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. +-- +-- Example: +-- +-- > do +-- > (gen,snk) <- externalMulti +-- > smp <- start gen +-- > r1 <- smp +-- > snk 7 +-- > r2 <- smp +-- > r3 <- smp +-- > snk 9 +-- > snk 2 +-- > r4 <- smp +-- > print [r1,r2,r3,r4] +-- +-- Output: +-- +-- > [[],[7],[],[2,9]] externalMulti :: IO (SignalGen (Signal [a]), a -> IO ()) -- ^ a generator for the event signal and the associated sink externalMulti = do var <- newMVar [] @@ -350,12 +398,18 @@ -- | A pure stateful signal. The initial state is the first output, -- and every subsequent state is derived from the preceding one by --- applying a pure transformation. It is equivalent to the following --- expression: +-- applying a pure transformation. -- --- @ --- stateful x0 f = 'mfix' $ \sig -> 'delay' x0 (f '<$>' sig) --- @ +-- Example: +-- +-- > do +-- > smp <- start (stateful "x" ('x':)) +-- > res <- replicateM 5 smp +-- > print res +-- +-- Output: +-- +-- > ["x","xx","xxx","xxxx","xxxxx"] stateful :: a -- ^ initial state -> (a -> a) -- ^ state transformation -> SignalGen (Signal a) @@ -366,19 +420,73 @@ -- is considered to appear before the first output, and can never be -- observed, and subsequent states are determined by combining the -- preceding state with the current output of the input signal using --- the function supplied. It is equivalent to the following --- expression: +-- the function supplied. -- --- @ --- transfer x0 f s = 'mfix' $ \sig -> 'liftA2' f s '<$>' 'delay' x0 sig --- @ +-- Example: +-- +-- > do +-- > smp <- start $ do +-- > cnt <- stateful 1 (+1) +-- > transfer 10 (+) cnt +-- > res <- replicateM 5 smp +-- > print res +-- +-- Output: +-- +-- > [11,13,16,20,25] transfer :: a -- ^ initial internal state -> (t -> a -> a) -- ^ state updater function -> Signal t -- ^ input signal -> SignalGen (Signal a) -transfer x0 f s = mfix $ \sig -> liftA2 f s <$> delay x0 sig +transfer x0 f s = mfix $ \sig -> do + sig' <- delay x0 sig + memo (liftA2 f s sig') +-- | A variation of 'transfer' with two input signals. +transfer2 :: a -- ^ initial internal state + -> (t1 -> t2 -> a -> a) -- ^ state updater function + -> Signal t1 -- ^ input signal 1 + -> Signal t2 -- ^ input signal 2 + -> SignalGen (Signal a) +transfer2 x0 f s1 s2 = mfix $ \sig -> do + sig' <- delay x0 sig + memo (liftA3 f s1 s2 sig') + +-- | A variation of 'transfer' with three input signals. +transfer3 :: a -- ^ initial internal state + -> (t1 -> t2 -> t3 -> a -> a) -- ^ state updater function + -> Signal t1 -- ^ input signal 1 + -> Signal t2 -- ^ input signal 2 + -> Signal t3 -- ^ input signal 3 + -> SignalGen (Signal a) +transfer3 x0 f s1 s2 s3 = mfix $ \sig -> do + sig' <- delay x0 sig + memo (liftM4 f s1 s2 s3 sig') + +-- | A variation of 'transfer' with four input signals. +transfer4 :: a -- ^ initial internal state + -> (t1 -> t2 -> t3 -> t4 -> a -> a) -- ^ state updater function + -> Signal t1 -- ^ input signal 1 + -> Signal t2 -- ^ input signal 2 + -> Signal t3 -- ^ input signal 3 + -> Signal t4 -- ^ input signal 4 + -> SignalGen (Signal a) +transfer4 x0 f s1 s2 s3 s4 = mfix $ \sig -> do + sig' <- delay x0 sig + memo (liftM5 f s1 s2 s3 s4 sig') + -- | 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) @@ -390,15 +498,15 @@ debug :: String -> SignalGen () debug = SG . const . putStrLn --- The Show instance is only defined for the sake of Num... +-- | The Show instance is only defined for the sake of Num... instance Show (Signal a) where showsPrec _ _ s = "" ++ s --- Equality test is impossible. +-- | Equality test is impossible. instance Eq (Signal a) where _ == _ = False --- Error message for unimplemented instance functions. +-- | Error message for unimplemented instance functions. unimp :: String -> a unimp = error . ("Signal: "++) @@ -468,3 +576,123 @@ asinh = fmap asinh atanh = fmap atanh acosh = fmap acosh + +{- $example + +For a not entirely trivial example, let's create a dynamic collection +of countdown timers, where each expired timer is removed from the +collection. First of all, we'll need a simple tester function: + +@ + sigtest gen = 'replicateM' 15 '=<<' 'start' gen +@ + +We can try it with a trivial example: + +@ + \> sigtest $ 'stateful' 2 (+3) + [2,5,8,11,14,17,20,23,26,29,32,35,38,41,44,47] +@ + +Our first definition will be a signal representing a simple named +timer: + +@ + countdown :: String -\> Int -\> SignalGen (Signal (String,Maybe Int)) + countdown name t = do + let tick prev = do { t \<- prev ; 'guard' (t \> 0) ; 'return' (t-1) } + timer \<- 'stateful' (Just t) tick + 'return' ((,) name '<$>' timer) +@ + +Let's see if it works: + +@ + \> sigtest $ countdown \"foo\" 4 + [(\"foo\",Just 4),(\"foo\",Just 3),(\"foo\",Just 2),(\"foo\",Just 1),(\"foo\",Just 0), + (\"foo\",Nothing),(\"foo\",Nothing),(\"foo\",Nothing),...] +@ + +Next, we will define a timer source that takes a list of timer names, +starting values and start times and creates a signal that delivers the +list of new timers at every point: + +@ + timerSource :: [(String, Int, Int)] -\> SignalGen (Signal [Signal (String, Maybe Int)]) + timerSource ts = do + let gen t = 'mapM' ('uncurry' countdown) newTimers + where newTimers = [(n,v) | (n,v,st) \<- ts, st == t] + cnt \<- 'stateful' 0 (+1) + 'generator' (gen '<$>' cnt) +@ + +Now we need to encapsulate the timer source signal in another signal +expression that takes care of maintaining the list of live timers. +Since working with dynamic collections is a recurring task, let's +define a generic combinator that maintains a dynamic list of signals +given a source and a test that tells from the output of each signal +whether it should be kept. We can use @mdo@ expressions (a variant of +@do@ expressions allowing forward references) as syntactic sugar for +'mfix' to make life easier: + +@ + collection :: Signal [Signal a] -\> (a -\> Bool) -\> SignalGen (Signal [a]) + collection source isAlive = mdo + sig \<- 'delay' [] ('map' 'snd' '<$>' collWithVals') + coll \<- 'memo' ('liftA2' (++) source sig) + let collWithVals = 'zip' '<$>' ('sequence' '=<<' coll) '<*>' coll + collWithVals' \<- 'memo' ('filter' (isAlive . 'fst') '<$>' collWithVals) + 'return' $ 'map' 'fst' '<$>' collWithVals' +@ + +We need recursion to define the @coll@ signal as a delayed version of +its continuation, which does not contain signals that need to be +removed in the current sample. At every point of time the running +collection is concatenated with the source. We define @collWithVals@, +which simply pairs up every signal with its current output. The +output is obtained by extracting the current value of the signal +container and sampling each element with 'sequence'. We can then +derive @collWithVals'@, which contains only the signals that must be +kept for the next round along with their output. Both @coll@ and +@collWithVals'@ have to be memoised, because they are used more than +once (the program would work without that, but it would recalculate +both signals each time they are used). By throwing out the respective +parts, we can get both the final output and the collection for the +next step (@coll'@). + +Now we can easily finish the original task: + +@ + timers :: [(String, Int, Int)] -\> SignalGen (Signal [(String, Int)]) + timers timerData = do + src \<- timerSource timerData + getOutput '<$>' collection src ('isJust' . 'snd') + where getOutput = 'fmap' ('map' (\\(name,Just val) -> (name,val))) +@ + +As a test, we can start four timers: /a/ at t=0 with value 3, /b/ and +/c/ at t=1 with values 5 and 3, and /d/ at t=3 with value 4: + +@ + \> sigtest $ timers [(\"a\",3,0),(\"b\",5,1),(\"c\",3,1),(\"d\",4,3)] + [[(\"a\",3)],[(\"b\",5),(\"c\",3),(\"a\",2)],[(\"b\",4),(\"c\",2),(\"a\",1)], + [(\"d\",4),(\"b\",3),(\"c\",1),(\"a\",0)],[(\"d\",3),(\"b\",2),(\"c\",0)], + [(\"d\",2),(\"b\",1)],[(\"d\",1),(\"b\",0)],[(\"d\",0)],[],[],[],[],[],[],[]] +@ + +If the noise of the applicative lifting operators feels annoying, she +() comes to the +save. Among other features it provides idiom brackets, which can +substitute the explicit lifting. For instance, it allows us to define +@collection@ this way: + +@ + collection :: Stream [Stream a] -> (a -> Bool) -> StreamGen (Stream [a]) + collection source isAlive = mdo + sig \<- 'delay' [] (|'map' ~'snd' collWithVals'|) + coll \<- 'memo' (|source ++ sig|) + collWithVals' \<- 'memo' (|'filter' ~(isAlive . 'fst') (|'zip' ('sequence' '=<<' coll) coll|)|) + 'return' (|'map' ~'fst' collWithVals'|) +@ + +-} diff --git a/elerea.cabal b/elerea.cabal --- a/elerea.cabal +++ b/elerea.cabal @@ -1,5 +1,5 @@ Name: elerea -Version: 2.1.0 +Version: 2.2.0 Cabal-Version: >= 1.2 Synopsis: A minimalistic FRP library Category: reactivity, FRP @@ -10,12 +10,13 @@ sampling, with first-class signals (time-varying values). Reactivity is provided through various higher-order constructs that also allow the user to work with arbitrary time-varying structures containing - live signals. + live signals. Signals have precise and simple denotational + semantics. . Stateful signals can be safely generated at any time through a - specialised monad, while stateless combinators can be used in a + monadic interface, while stateless combinators can be used in a purely applicative style. Elerea signals can be defined recursively, - and external input is trivial to attach. The library comes in four + and external input is trivial to attach. The library comes in three major variants: . * Simple: signals are plain discrete streams isomorphic to functions @@ -23,13 +24,7 @@ . * Param: adds a globally accessible input signal for convenience; . - * Clocked: adds the ability to freeze whole subnetworks at will; - . - * Delayed: attempts to resolve instantaneous dependency cycles - (i.e. cycles without a delay); this variant is likely to be - deprecated in the near future. - . - The first three variants come with precise denotational semantics. + * Clocked: adds the ability to freeze whole subnetworks at will. . This is a minimal library that defines only some basic primitives, and you are advised to install @elerea-examples@ as well to get an @@ -37,10 +32,14 @@ separated in order to minimise the dependencies of the core library. The @dow@ package contains a full game built on top of the simple variant. + . + The basic idea of the implementation is described in the WFLP 2010 + paper /Efficient and Compositional Higher-Order Streams/ + (). Author: Patai Gergely Maintainer: Patai Gergely (patai@iit.bme.hu) -Copyright: (c) 2009, Patai Gergely +Copyright: (c) 2009-2011, Patai Gergely License: BSD3 License-File: LICENSE Stability: experimental @@ -50,13 +49,14 @@ 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 - FRP.Elerea.Delayed - Build-Depends: base >= 3 && < 5, containers, mersenne-random + Build-Depends: base >= 4 && < 5, containers, mersenne-random ghc-options: -Wall -O2