diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,6 @@ +1.2.2 - 100115 +* added noise signals and the getRandom primitive (using mersenne-random) + 1.2.1 - 091204 * modified the &&@ and ||@ operators to short-circuit diff --git a/FRP/Elerea/Experimental.hs b/FRP/Elerea/Experimental.hs --- a/FRP/Elerea/Experimental.hs +++ b/FRP/Elerea/Experimental.hs @@ -53,17 +53,15 @@ infixr 2 ||@ infix 2 --> -{-| 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. -} - +-- | 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 p Bool -> SignalGen p (Signal p Bool) edge b = delay True b >>= \db -> return $ (not <$> db) &&@ b -{-| The '-->' 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. -} - +-- | The '-->' 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. (-->) :: a -- ^ Initial output -> Signal p (Maybe a) -- ^ Maybe signal to latch on -> SignalGen p (Signal p a) @@ -71,43 +69,34 @@ where store _ Nothing x = x store _ (Just x) _ = x -{-| Point-wise equality of two signals. -} - +-- | Point-wise equality of two signals. (==@) :: Eq a => Signal p a -> Signal p a -> Signal p Bool (==@) = liftA2 (==) -{-| Point-wise inequality of two signals. -} - +-- | Point-wise inequality of two signals. (/=@) :: Eq a => Signal p a -> Signal p a -> Signal p Bool (/=@) = liftA2 (/=) -{-| Point-wise comparison of two signals. -} - +-- | Point-wise comparison of two signals. (<@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool (<@) = liftA2 (<) -{-| Point-wise comparison of two signals. -} - +-- | Point-wise comparison of two signals. (<=@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool (<=@) = liftA2 (<=) -{-| Point-wise comparison of two signals. -} - +-- | Point-wise comparison of two signals. (>=@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool (>=@) = liftA2 (>=) -{-| Point-wise comparison of two signals. -} - +-- | Point-wise comparison of two signals. (>@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool (>@) = liftA2 (>) -{-| Point-wise OR of two boolean signals. -} - +-- | Point-wise OR of two boolean signals. (||@) :: Signal p Bool -> Signal p Bool -> Signal p Bool s1 ||@ s2 = s1 >>= \b -> if b then return True else s2 -{-| Point-wise AND of two boolean signals. -} - +-- | Point-wise AND of two boolean signals. (&&@) :: Signal p Bool -> Signal p Bool -> Signal p Bool s1 &&@ s2 = s1 >>= \b -> if b then s2 else return False - diff --git a/FRP/Elerea/Experimental/Delayed.hs b/FRP/Elerea/Experimental/Delayed.hs --- a/FRP/Elerea/Experimental/Delayed.hs +++ b/FRP/Elerea/Experimental/Delayed.hs @@ -36,6 +36,8 @@ , transfer , memo , generator + , noise + , getRandom , debug ) where @@ -45,27 +47,24 @@ import Data.IORef import Data.Maybe import System.Mem.Weak - -{-| 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. -} +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. -} - +-- | 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. -} - +-- | 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. -} - +-- | 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 @@ -93,13 +92,12 @@ 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. -} - +-- | 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 @@ -128,9 +126,8 @@ update ptrs [] (return ()) (return ()) return res -{-| Auxiliary function used by all the primitives that create a -mutable variable. -} - +-- | 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 @@ -141,15 +138,14 @@ 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. -} - +-- | 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) @@ -165,10 +161,9 @@ 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'. -} - +-- | 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 @@ -183,17 +178,16 @@ 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 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" @@ -203,22 +197,20 @@ 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. -} - +-- | 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) -{-| 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. -} - +-- | 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) @@ -232,16 +224,15 @@ 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. -} - +-- | 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) @@ -263,23 +254,30 @@ addSignal sample age ref pool -{-| A printing action within the 'SignalGen' monad. -} +-- | A random signal. For efficiency reasons it is not guaranteed to +-- read the same value when sampled several times in the same +-- superstep. If you need consistent noise input, you can produce it +-- through an 'external' signal from whatever source you prefer. +noise :: MTRandom a => Signal p a +noise = 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'... -} - +-- | The @Show@ instance is only defined for the sake of 'Num'... instance Show (Signal p a) where showsPrec _ _ s = "" ++ s -{-| Equality test is impossible. -} - +-- | Equality test is impossible. instance Eq (Signal p 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/Experimental/Param.hs b/FRP/Elerea/Experimental/Param.hs --- a/FRP/Elerea/Experimental/Param.hs +++ b/FRP/Elerea/Experimental/Param.hs @@ -40,6 +40,8 @@ , transfer , memo , generator + , noise + , getRandom , debug ) where @@ -49,27 +51,24 @@ import Data.IORef import Data.Maybe import System.Mem.Weak - -{-| 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. -} +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. -} - +-- | 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. -} - +-- | 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. -} - +-- | The phases every signal goes through during a superstep: before +-- or after sampling. data Phase s a = Ready s | Aged s a instance Functor (Signal p) where @@ -97,13 +96,12 @@ 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. -} - +-- | 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 @@ -132,9 +130,8 @@ update ptrs [] (return ()) (return ()) return res -{-| Auxiliary function used by all the primitives that create a -mutable variable. -} - +-- | 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 @@ -145,15 +142,14 @@ 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. -} - +-- | 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) @@ -168,10 +164,9 @@ 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'. -} - +-- | 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 @@ -185,17 +180,16 @@ 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 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 @@ -204,22 +198,20 @@ 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. -} - +-- | 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) -{-| 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. -} - +-- | 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) @@ -232,12 +224,11 @@ 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. -} - +-- | 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. 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) @@ -252,23 +243,30 @@ addSignal sample age ref pool -{-| A printing action within the 'SignalGen' monad. -} +-- | A random signal. For efficiency reasons it is not guaranteed to +-- read the same value when sampled several times in the same +-- superstep. If you need consistent noise input, you can produce it +-- through an 'external' signal from whatever source you prefer. +noise :: MTRandom a => Signal p a +noise = 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'... -} - +-- | The @Show@ instance is only defined for the sake of 'Num'... instance Show (Signal p a) where showsPrec _ _ s = "" ++ s -{-| Equality test is impossible. -} - +-- | Equality test is impossible. instance Eq (Signal p 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/Experimental/Simple.hs b/FRP/Elerea/Experimental/Simple.hs --- a/FRP/Elerea/Experimental/Simple.hs +++ b/FRP/Elerea/Experimental/Simple.hs @@ -2,10 +2,11 @@ {-| -This module provides efficient higher-order discrete signals. For a -non 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: +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 @@ -131,6 +132,8 @@ , memo , stateful , transfer + , noise + , getRandom ) where import Control.Applicative @@ -139,30 +142,27 @@ import Data.IORef import Data.Maybe import System.Mem.Weak - -{-| 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). -} +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). newtype Signal a = S (IO a) deriving (Functor, Applicative, Monad) -{-| A dynamic set of actions to update a network without breaking -consistency. -} - +-- | 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. It can -be thought of as a function of type @Nat -> a@, where the 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. -} - +-- | A signal generator is the only source of stateful signals. It +-- can be thought of as a function of type @Nat -> a@, where the +-- 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. newtype SignalGen a = SG { unSG :: IORef UpdatePool -> IO a } -{-| The phases every signal goes through during a superstep. -} - +-- | The phases every signal goes through during a superstep. data Phase a = Ready a | Updated a a instance Functor SignalGen where @@ -171,7 +171,7 @@ instance Applicative SignalGen where pure = return (<*>) = ap - + instance Monad SignalGen where return = SG . const . return SG g >>= f = SG $ \p -> g p >>= \x -> unSG (f x) p @@ -179,13 +179,12 @@ instance MonadFix SignalGen 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. -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. -} - +-- | 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. 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. start :: SignalGen (Signal a) -- ^ the generator of the top-level signal -> IO (IO a) -- ^ the computation to sample the signal start (SG gen) = do @@ -200,9 +199,8 @@ mapM_ snd acts return res -{-| Auxiliary function used by all the primitives that create a -mutable variable. -} - +-- | Auxiliary function used by all the primitives that create a +-- mutable variable. addSignal :: (a -> IO a) -- ^ sampling function -> (a -> IO ()) -- ^ aging function -> IORef (Phase a) -- ^ the mutable variable behind the signal @@ -220,26 +218,26 @@ 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' 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'): - -@ - 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 ensures that the error can -never happen. -} - +-- | 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'): +-- +-- @ +-- 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 ensures that the error can +-- never happen. delay :: a -- ^ initial output at creation time -> Signal a -- ^ the signal to delay -> SignalGen (Signal a) -- ^ the delayed signal @@ -250,27 +248,24 @@ addSignal return update ref pool -{-| 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: - -@ - 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. - --} - +-- | 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: +-- +-- @ +-- 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. generator :: Signal (SignalGen a) -- ^ the signal of generators to run -> SignalGen (Signal a) -- ^ the signal of generated structures generator (S s) = SG $ \pool -> do ref <- newIORef (Ready undefined) - + let sample = do SG g <- s x <- g pool writeIORef ref (Updated undefined x) @@ -278,10 +273,10 @@ addSignal (const sample) (const (sample >> return ())) 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. -} - +-- | 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 :: Signal a -- ^ the signal to cache -> SignalGen (Signal a) -- ^ a signal observationally equivalent to the argument memo (S s) = SG $ \pool -> do @@ -291,61 +286,65 @@ addSignal (const sample) (const (sample >> return ())) 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. -} - +-- | 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, a -> IO ()) -- ^ the signal and an IO function to feed it external x = do ref <- newIORef x return (S (readIORef ref), writeIORef ref) -{-| 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: - -@ - stateful x0 f = 'mfix' $ \sig -> 'delay' x0 (f '<$>' sig) -@ --} - +-- | 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: +-- +-- @ +-- stateful x0 f = 'mfix' $ \sig -> 'delay' x0 (f '<$>' sig) +-- @ 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 -@ --} - +-- | 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 -{-| The @Show@ instance is only defined for the sake of 'Num'... -} +-- | A random signal. For efficiency reasons it is not guaranteed to +-- read the same value when sampled several times in the same +-- superstep. If you need consistent noise input, you can produce it +-- through an 'external' signal from whatever source you prefer. +noise :: MTRandom a => Signal a +noise = S randomIO +-- | A random source within the 'SignalGen' monad. +getRandom :: MTRandom a => SignalGen a +getRandom = SG (const randomIO) + +-- 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/Graph.hs b/FRP/Elerea/Graph.hs --- a/FRP/Elerea/Graph.hs +++ b/FRP/Elerea/Graph.hs @@ -45,7 +45,7 @@ p <- getPtr r case Map.lookup p st of Just _ -> return (p,st) - Nothing -> do Ready s <- readIORef r + Nothing -> do Ready s <- readIORef r st' <- insertSignal st p s return (p,st') diff --git a/FRP/Elerea/Internal.hs b/FRP/Elerea/Internal.hs --- a/FRP/Elerea/Internal.hs +++ b/FRP/Elerea/Internal.hs @@ -374,15 +374,15 @@ 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 + SND _ s -> age s dt SNKA s l -> age s dt >> age l dt - SNF1 _ s -> age s 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 () + Aged _ _ -> return () _ -> error "Inconsistent state: signal not sampled properly!" {-| Finalising aged signals for the next round. -} @@ -398,9 +398,9 @@ 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 + SND _ s -> commit s SNKA s l -> commit s >> commit l - SNF1 _ s -> commit s + 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 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2009, Patai Gergely +Copyright (c) 2009-2010, Patai Gergely All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/elerea.cabal b/elerea.cabal --- a/elerea.cabal +++ b/elerea.cabal @@ -1,5 +1,5 @@ Name: elerea -Version: 1.2.1 +Version: 1.2.2 Cabal-Version: >= 1.2 Synopsis: A minimalistic FRP library Category: reactivity, FRP @@ -45,5 +45,5 @@ FRP.Elerea.Experimental.Param FRP.Elerea.Experimental.Delayed - Build-Depends: base >= 3 && < 5, containers + Build-Depends: base >= 3 && < 5, containers, mersenne-random ghc-options: -Wall -O2