diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,103 +1,109 @@ -2.8.0 - 140122 -* added MonadIO and MonadBase instances for SignalGen (Mitsutoshi Aoe) - -2.7.0.2 - 120401 -* added some inlining annotations (courtesy of Takano Akio) - -2.7.0.1 - 120131 -* made externalMulti thread-safe (courtesy of Takano Akio) - -2.7.0 - 111223 -* fixed an issue with nested signal creations not updating properly - (courtesy of Takano Akio) -* added reference implementation for the simple variant - -2.6.0 - 111211 -* added snapshot to all variants, which allows sampling signals within - signal generators - -2.5.0 - 111122 -* added SignalGen liftIO equivalent to assist library writers -* simplified the signatures of effectful* combinators -* updated Param to use the more modern codebase (like Simple and - Clocked); this was necessary to support effectful signals -* temporarily removed the static optimisation from Param -* removed dependency on mersenne-random -* removed legacy branch - -2.4.0 - 111111 -* added effectful signals to assist library writers - -2.3.0 - 110627 -* reimplemented clocked variant in a correct and more efficient way - -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 -* added the ability to extract the global input in the parametric - variant, and also to override it (input and embed, resp.) -* added until to be able to define switchers that can truly drop - references to old signals -* added debug printing capability to the simple and clocked variants -* made a note about possibly deprecating the delayed variant - -2.0.0 - 100718 -* moved experimental branch to the top (version 1 went into legacy - status) -* added the clocked variant - -1.2.3 - 100131 -* added externalMulti to handle events that can fire several times - within a superstep -* added a cache to the noise signal for safety reasons, so it lives in - SignalGen now - -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 - -1.2.0 - 091202 -* added the delayed variant to the experimental branch -* renamed storeJust to (-->) in the experimental branch - -1.1.0 - 091126 -* added experimental branch with a cleaner semantics - -1.0.0 - 090726 -* completely renewed interface by introducing the SignalMonad - -0.6.0 - 090507 -* renamed Void to StartToken -* replaced restarter with the simpler and more versatile startTokens - -0.5.0 - 090502 -* changed names of internal constructors to match primitives better -* added restarter and (==>) -* removed the unused type synonym Time - -0.4.0 - 090501 -* added keepAlive -* made delay a primitive -* completely separated sampling and aging - -0.3.0 - 090419 -* documentation bug fixed: the latcher is not delayed -* added dot (Graphviz) converter - -0.2.0 - 090412 -* removed primitives time and stateless -* removed default delay on stateful combinators and added experimental - cycle detection -* added some non-primitive combinators: delay, edge, comparisons, - logic relations -* added signal instances for various numeric classes - -0.1.0 - 090410 -* first public version +2.9.0 - 160618 +* removed clocked variant, as it proved to be impractical +* renamed external to unsafeExternal +* introduced safe (managed) external signals +* renamed until to till to avoid name clash with the prelude + +2.8.0 - 140122 +* added MonadIO and MonadBase instances for SignalGen (Mitsutoshi Aoe) + +2.7.0.2 - 120401 +* added some inlining annotations (courtesy of Takano Akio) + +2.7.0.1 - 120131 +* made externalMulti thread-safe (courtesy of Takano Akio) + +2.7.0 - 111223 +* fixed an issue with nested signal creations not updating properly + (courtesy of Takano Akio) +* added reference implementation for the simple variant + +2.6.0 - 111211 +* added snapshot to all variants, which allows sampling signals within + signal generators + +2.5.0 - 111122 +* added SignalGen liftIO equivalent to assist library writers +* simplified the signatures of effectful* combinators +* updated Param to use the more modern codebase (like Simple and + Clocked); this was necessary to support effectful signals +* temporarily removed the static optimisation from Param +* removed dependency on mersenne-random +* removed legacy branch + +2.4.0 - 111111 +* added effectful signals to assist library writers + +2.3.0 - 110627 +* reimplemented clocked variant in a correct and more efficient way + +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 +* added the ability to extract the global input in the parametric + variant, and also to override it (input and embed, resp.) +* added until to be able to define switchers that can truly drop + references to old signals +* added debug printing capability to the simple and clocked variants +* made a note about possibly deprecating the delayed variant + +2.0.0 - 100718 +* moved experimental branch to the top (version 1 went into legacy + status) +* added the clocked variant + +1.2.3 - 100131 +* added externalMulti to handle events that can fire several times + within a superstep +* added a cache to the noise signal for safety reasons, so it lives in + SignalGen now + +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 + +1.2.0 - 091202 +* added the delayed variant to the experimental branch +* renamed storeJust to (-->) in the experimental branch + +1.1.0 - 091126 +* added experimental branch with a cleaner semantics + +1.0.0 - 090726 +* completely renewed interface by introducing the SignalMonad + +0.6.0 - 090507 +* renamed Void to StartToken +* replaced restarter with the simpler and more versatile startTokens + +0.5.0 - 090502 +* changed names of internal constructors to match primitives better +* added restarter and (==>) +* removed the unused type synonym Time + +0.4.0 - 090501 +* added keepAlive +* made delay a primitive +* completely separated sampling and aging + +0.3.0 - 090419 +* documentation bug fixed: the latcher is not delayed +* added dot (Graphviz) converter + +0.2.0 - 090412 +* removed primitives time and stateless +* removed default delay on stateful combinators and added experimental + cycle detection +* added some non-primitive combinators: delay, edge, comparisons, + logic relations +* added signal instances for various numeric classes + +0.1.0 - 090410 +* first public version diff --git a/FRP/Elerea.hs b/FRP/Elerea.hs --- a/FRP/Elerea.hs +++ b/FRP/Elerea.hs @@ -1,50 +1,47 @@ -{-| - -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 - +{-| + +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 two 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; + +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 deleted file mode 100644 --- a/FRP/Elerea/Clocked.hs +++ /dev/null @@ -1,822 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -{-| - -This version differs from the simple one in adding associated freeze -control signals (\'clocks\') to stateful entities to be able to pause -entire subnetworks without having to write all the low-level logic -explicitly. The clocks are fixed to signals upon their creation, and -the 'withClock' function can be used to specify the common clock for -the signals created in a given generator. - -A clock signal 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: - -> 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) - -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 - -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) - -This works because the 'withClock' function overrides any clock -imposed on the generator from outside. - --} - -module FRP.Elerea.Clocked - ( - -- * The signal abstraction - Signal - , SignalGen - -- * Embedding into I/O - , start - , external - , externalMulti - -- * Basic building blocks - , delay - , snapshot - , generator - , memo - , until - , withClock - , global - -- * Derived combinators - , stateful - , transfer - , transfer2 - , transfer3 - , transfer4 - -- * Signals with side effects - -- $effectful - , execute - , effectful - , effectful1 - , effectful2 - , effectful3 - , effectful4 - ) where - -import Control.Applicative -import Control.Concurrent.MVar -import Control.Monad -import Control.Monad.Base -import Control.Monad.Fix -import Control.Monad.IO.Class -import Data.IORef -import Data.Maybe -import Prelude hiding (until) -import System.Mem.Weak - --- | 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 pair of actions to update a signal in two phases: internal --- update without changing the output, finalisation (throwing away --- previous state). -type UpdateAction = (IO (), IO ()) - --- | A pointer to an update pair. -data Update = USig (Weak UpdateAction) -- ^ ordinary signal - | UClk UpdateAction -- ^ clocked subnetwork superstep - --- | A dynamic set of actions to update a network without breaking --- consistency. -type UpdatePool = [Update] - --- | 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. 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 -> IORef UpdatePool -> IO a } - --- | The phases every signal goes through during a superstep. -data Phase a = Ready a | Updated a a - -instance Functor SignalGen where - fmap = liftM - -instance Applicative SignalGen where - pure = return - (<*>) = ap - -instance Monad SignalGen where - return x = SG $ \_ _ -> return x - SG g >>= f = SG $ \p1 p2 -> g p1 p2 >>= \x -> unSG (f x) p1 p2 - -instance MonadFix SignalGen where - mfix f = SG $ \p1 p2 -> mfix $ \x -> unSG (f x) p1 p2 - -instance MonadIO SignalGen where - liftIO = execute - -instance MonadBase SignalGen SignalGen where - liftBase = id - -getUpdate :: Update -> IO (Maybe (Update, UpdateAction)) -getUpdate upd@(USig ptr) = (fmap.fmap) ((,) upd) (deRefWeak ptr) -getUpdate upd@(UClk ua) = return (Just (upd,ua)) - --- | 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. 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 - pool <- newIORef [] - S sample <- gen pool pool - return $ do - res <- sample - superstep pool - return res - --- | Performing the two-phase superstep. -superstep :: IORef UpdatePool -> IO () -superstep pool = loop id [] - where - loop getPtrs final = do - (ptrs,acts) <- unzip.catMaybes <$> (mapM getUpdate =<< readIORef pool) - case acts of - [] -> do - sequence_ final - writeIORef pool (getPtrs []) - _ -> do - writeIORef pool [] - mapM_ fst acts - loop ((ptrs++) . getPtrs) (mapM_ snd acts : final) - --- | 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 - -> IORef UpdatePool -- ^ the pool of update actions - -> IO (Signal a) -- ^ the signal created -addSignal sample update ref pool = do - let upd = readIORef ref >>= \v -> case v of - Ready x -> update x - _ -> return () - - fin = readIORef ref >>= \v -> case v of - Updated x _ -> writeIORef ref $! Ready x - _ -> error "Signal not updated!" - - sig = S $ readIORef ref >>= \v -> case v of - Ready x -> sample x - Updated _ x -> return x - {-# NOINLINE sig #-} - -- NOINLINE to prevent sig from getting inlined into the - -- argument position of mkWeak. - - updateActions <- mkWeak sig (upd,fin) Nothing - modifyIORef pool (USig updateActions:) - return sig - --- | 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. --- --- 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: --- --- > 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 -delay x0 (S s) = SG $ \_gpool pool -> do - ref <- newIORef (Ready x0) - - let update x = s >>= \x' -> x' `seq` writeIORef ref (Updated x' x) - - addSignal return update ref pool - --- | A formal conversion from signals to signal generators, which --- effectively allows for retrieving the current value of a previously --- created signal within a generator. This includes both signals --- defined in an external scope as well as those created earlier in --- the same generator. It can be modelled by the following function: --- --- > snapshot s t_start s_clock = s t_start -snapshot :: Signal a -> SignalGen a -snapshot (S s) = SG $ \_ _ -> s - --- | Auxiliary function. -memoise :: IORef (Phase a) -> a -> IO a -memoise ref x = writeIORef ref (Updated undefined x) >> return x - --- | A reactive signal that takes the value to output from a signal --- generator carried by its input with the sampling time provided as --- the start time for the generated structure. It is possible to --- 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_clock t_sample = g t_sample s_clock 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 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 $ \gpool pool -> do - ref <- newIORef (Ready undefined) - - let sample = (s >>= \(SG g) -> g gpool pool) >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref gpool - --- | Memoising combinator. It can be used to cache results of --- applicative combinators in case they are used in several places. --- Unlike in the simple variant, it is not observationally equivalent --- to 'return' in the 'SignalGen' monad, because it only samples its --- input signal when the associated clock ticks. The @memo@ --- combinator can be modelled by the following function: --- --- > memo s t_start s_clock t_sample --- > | s_clock t_sample = s t_sample --- > | otherwise = memo s t_start s_clock (t_sample-1) --- --- 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 $ \_gpool pool -> do - ref <- newIORef (Ready undefined) - - let sample = s >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | A signal that is true exactly once: the first time the input --- signal is true. Afterwards, it is constantly false, and it holds --- 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@. 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 = global $ 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 $ \gpool _pool -> do - ref <- newIORef (Ready undefined) - - rsmp <- mfix $ \rs -> newIORef $ do - x <- s - writeIORef ref (Updated undefined x) - when x $ writeIORef rs $ do - writeIORef ref (Updated undefined False) - return False - return x - - let sample = join (readIORef rsmp) - - addSignal (const sample) (const (() <$ sample)) ref gpool - --- | 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. 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 (S cs) (SG g) = SG $ \gpool _pool -> do - pool' <- newIORef [] - pref <- newIORef Nothing - - let whenc act = cs >>= flip when act - - upd = readIORef pref >>= \mp -> case mp of - Nothing -> do - (ptrs,acts) <- unzip.catMaybes <$> (mapM getUpdate =<< readIORef pool') - writeIORef pool' ptrs - writeIORef pref (Just acts) - mapM_ fst acts - Just _ -> return () - - fin = readIORef pref >>= \mp -> case mp of - Nothing -> return () - Just acts -> do - writeIORef pref Nothing - mapM_ snd acts - - modifyIORef gpool (UClk (whenc upd, whenc fin):) - g gpool pool' - --- | Equivalent to @withClock (pure True)@, but more efficient. -global :: SignalGen a -> SignalGen a -global (SG g) = SG $ \gpool _ -> g gpool gpool - --- | A signal that can be directly fed through the sink function --- returned. This can be used to attach the network to the outer --- 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 - ref <- newIORef x - return (S (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 (always synchronised to the top-level samplings --- regardless of any associated clock), 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 [] - return (SG $ \gpool _pool -> do - ref <- newIORef (Ready undefined) - let sample = modifyMVar var $ \list -> memoise ref list >> return ([], list) - addSignal (const sample) (const (() <$ sample)) ref gpool - ,\val -> do - vals <- takeMVar var - putMVar var (val:vals) - ) - --- | 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 affected by the associated --- clock like 'delay': no transformation is performed in the absence --- of a tick; see the example at the top. --- --- 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 affected by the associated clock like --- 'delay': no transformation is performed in the absence of a tick; --- see the example at the top. --- --- 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 -> 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') - -{- $effectful - -The following combinators are primarily aimed at library implementors -who wish build abstractions to effectful libraries on top of Elerea. - --} - --- | An IO action executed in the 'SignalGen' monad. Can be used as --- `liftIO`. -execute :: IO a -> SignalGen a -execute act = SG $ \_ _ -> act - --- | A signal that executes a given IO action once at every sampling. --- --- In essence, this combinator provides cooperative multitasking --- capabilities, and its primary purpose is to assist library writers --- in wrapping effectful APIs as conceptually pure signals. If there --- are several effectful signals in the system, their order of --- execution is undefined and should not be relied on. --- --- Example: --- --- > do --- > smp <- start $ do --- > ref <- execute $ newIORef 0 --- > effectful $ do --- > x <- readIORef ref --- > putStrLn $ "Count: " ++ show x --- > writeIORef ref $! x+1 --- > return () --- > replicateM_ 5 smp --- --- Output: --- --- > Count: 0 --- > Count: 1 --- > Count: 2 --- > Count: 3 --- > Count: 4 --- --- Another example (requires mersenne-random): --- --- > do --- > smp <- start $ effectful $ return randomIO :: IO (IO Double) --- > res <- replicateM 5 smp --- > print res --- --- Output: --- --- > [0.12067753390401374,0.8658877349182655,0.7159264443196786,0.1756941896012891,0.9513646060896676] -effectful :: IO a -- ^ the action to be executed repeatedly - -> SignalGen (Signal a) -effectful act = SG $ \_gpool pool -> do - ref <- newIORef (Ready undefined) - - let sample = act >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | A signal that executes a parametric IO action once at every --- sampling. The parameter is supplied by another signal at every --- sampling step. -effectful1 :: (t -> IO a) -- ^ the action to be executed repeatedly - -> Signal t -- ^ parameter signal - -> SignalGen (Signal a) -effectful1 act (S s) = SG $ \_gpool pool -> do - ref <- newIORef (Ready undefined) - - let sample = s >>= act >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | Like 'effectful1', but with two parameter signals. -effectful2 :: (t1 -> t2 -> IO a) -- ^ the action to be executed repeatedly - -> Signal t1 -- ^ parameter signal 1 - -> Signal t2 -- ^ parameter signal 2 - -> SignalGen (Signal a) -effectful2 act (S s1) (S s2) = SG $ \_gpool pool -> do - ref <- newIORef (Ready undefined) - - let sample = join (liftM2 act s1 s2) >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | Like 'effectful1', but with three parameter signals. -effectful3 :: (t1 -> t2 -> t3 -> IO a) -- ^ the action to be executed repeatedly - -> Signal t1 -- ^ parameter signal 1 - -> Signal t2 -- ^ parameter signal 2 - -> Signal t3 -- ^ parameter signal 3 - -> SignalGen (Signal a) -effectful3 act (S s1) (S s2) (S s3) = SG $ \_gpool pool -> do - ref <- newIORef (Ready undefined) - - let sample = join (liftM3 act s1 s2 s3) >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | Like 'effectful1', but with four parameter signals. -effectful4 :: (t1 -> t2 -> t3 -> t4 -> IO a) -- ^ the action to be executed repeatedly - -> Signal t1 -- ^ parameter signal 1 - -> Signal t2 -- ^ parameter signal 2 - -> Signal t3 -- ^ parameter signal 3 - -> Signal t4 -- ^ parameter signal 4 - -> SignalGen (Signal a) -effectful4 act (S s1) (S s2) (S s3) (S s4) = SG $ \_gpool pool -> do - ref <- newIORef (Ready undefined) - - let sample = join (liftM4 act s1 s2 s3 s4) >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - -instance Show (Signal a) where - showsPrec _ _ s = "" ++ s - -instance Eq (Signal a) where - _ == _ = False - --- | Error message for unimplemented instance functions. -unimp :: String -> a -unimp = error . ("Signal: "++) - -instance Ord t => Ord (Signal t) where - compare = unimp "compare" - min = liftA2 min - max = liftA2 max - -instance Enum t => Enum (Signal t) where - succ = fmap succ - pred = fmap pred - toEnum = pure . toEnum - fromEnum = unimp "fromEnum" - enumFrom = unimp "enumFrom" - enumFromThen = unimp "enumFromThen" - enumFromTo = unimp "enumFromTo" - enumFromThenTo = unimp "enumFromThenTo" - -instance Bounded t => Bounded (Signal t) where - minBound = pure minBound - maxBound = pure maxBound - -instance Num t => Num (Signal t) where - (+) = liftA2 (+) - (-) = liftA2 (-) - (*) = liftA2 (*) - signum = fmap signum - abs = fmap abs - negate = fmap negate - fromInteger = pure . fromInteger - -instance Real t => Real (Signal t) where - toRational = unimp "toRational" - -instance Integral t => Integral (Signal t) where - quot = liftA2 quot - rem = liftA2 rem - div = liftA2 div - mod = liftA2 mod - quotRem a b = (fst <$> qrab,snd <$> qrab) - where qrab = quotRem <$> a <*> b - divMod a b = (fst <$> dmab,snd <$> dmab) - where dmab = divMod <$> a <*> b - toInteger = unimp "toInteger" - -instance Fractional t => Fractional (Signal t) where - (/) = liftA2 (/) - recip = fmap recip - fromRational = pure . fromRational - -instance Floating t => Floating (Signal t) where - pi = pure pi - exp = fmap exp - sqrt = fmap sqrt - log = fmap log - (**) = liftA2 (**) - logBase = liftA2 logBase - sin = fmap sin - tan = fmap tan - cos = fmap cos - asin = fmap asin - atan = fmap atan - acos = fmap acos - sinh = fmap sinh - tanh = fmap tanh - cosh = fmap cosh - asinh = fmap asinh - atanh = fmap atanh - acosh = fmap acosh diff --git a/FRP/Elerea/Param.hs b/FRP/Elerea/Param.hs --- a/FRP/Elerea/Param.hs +++ b/FRP/Elerea/Param.hs @@ -1,733 +1,752 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -{-| - -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 - ( - -- * The signal abstraction - Signal - , SignalGen - -- * Embedding into I/O - , start - , external - , externalMulti - -- * Basic building blocks - , delay - , snapshot - , generator - , memo - , until - , input - , embed - -- * Derived combinators - , stateful - , transfer - , transfer2 - , transfer3 - , transfer4 - -- * Signals with side effects - -- $effectful - , execute - , effectful - , effectful1 - , effectful2 - , effectful3 - , effectful4 - ) where - -import Control.Applicative -import Control.Concurrent.MVar -import Control.Monad -import Control.Monad.Base -import Control.Monad.Fix -import Control.Monad.IO.Class -import Data.IORef -import Data.Maybe -import Prelude hiding (until) -import System.Mem.Weak - --- | 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. 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. -data Phase a = Ready a | Updated a a - -instance Functor (SignalGen p) where - fmap = liftM - -instance Applicative (SignalGen p) where - pure = return - (<*>) = ap - -instance Monad (SignalGen p) where - return x = SG $ \_ _ -> return x - SG g >>= f = SG $ \p i -> g p i >>= \x -> unSG (f x) p i - -instance MonadFix (SignalGen p) where - mfix f = SG $ \p i -> mfix $ \x -> unSG (f x) p i - -instance MonadIO (SignalGen p) where - liftIO = execute - -instance MonadBase (SignalGen p) (SignalGen p) where - liftBase = id - --- | 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. 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 - pool <- newIORef [] - (inp,sink) <- external undefined - S sample <- gen pool inp - return $ \param -> do - sink param - res <- sample - superstep pool - return res - --- | Performing the two-phase superstep. -superstep :: IORef UpdatePool -> IO () -superstep pool = loop id [] - where - deref ptr = (fmap.fmap) ((,) ptr) (deRefWeak ptr) - loop getPtrs final = do - (ptrs,acts) <- unzip.catMaybes <$> (mapM deref =<< readIORef pool) - case acts of - [] -> do - sequence_ final - writeIORef pool (getPtrs []) - _ -> do - writeIORef pool [] - mapM_ fst acts - loop ((ptrs++) . getPtrs) (mapM_ snd acts : final) - --- | 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 - -> IORef UpdatePool -- ^ the pool of update actions - -> IO (Signal a) -addSignal sample update ref pool = do - let upd = readIORef ref >>= \v -> case v of - Ready x -> update x - _ -> return () - - fin = readIORef ref >>= \v -> case v of - Updated x _ -> writeIORef ref $! Ready x - _ -> error "Signal not updated!" - - sig = S $ readIORef ref >>= \v -> case v of - Ready x -> sample x - Updated _ x -> return x - {-# NOINLINE sig #-} - -- NOINLINE to prevent sig from getting inlined into the - -- argument position of mkWeak. - - updateActions <- mkWeak sig (upd,fin) Nothing - modifyIORef pool (updateActions:) - return sig - --- | 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) -delay x0 (S s) = SG $ \pool _ -> do - ref <- newIORef (Ready x0) - - let update x = s >>= \x' -> x' `seq` writeIORef ref (Updated x' x) - - addSignal return update ref pool - --- | A formal conversion from signals to signal generators, which --- effectively allows for retrieving the current value of a previously --- created signal within a generator. This includes both signals --- defined in an external scope as well as those created earlier in --- the same generator. It can be modelled by the following function: --- --- > snapshot s t_start s_input = s t_start -snapshot :: Signal a -> SignalGen p a -snapshot (S s) = SG $ \_ _ -> s - --- | Auxiliary function. -memoise :: IORef (Phase a) -> a -> IO a -memoise ref x = writeIORef ref (Updated undefined x) >> return x - --- | A reactive signal that takes the value to output from a signal --- generator carried by its input with the sampling time provided as --- the start time for the generated structure. It is possible to --- 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) -- ^ the signal of generators to run - -> SignalGen p (Signal a) -- ^ the signal of generated structures -generator (S s) = SG $ \pool inp -> do - ref <- newIORef (Ready undefined) - - let sample = (s >>= \(SG g) -> g pool inp) >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | Memoising combinator. It can be used to cache results of --- applicative combinators in case they are used in several places. --- It is observationally equivalent to 'return' in the 'SignalGen' --- monad. --- --- > memo s = <|s s s s ...|> --- --- For instance, if @s = f \<$\> s'@, then @f@ will be recalculated --- once for each sampling of @s@. This can be avoided by writing @s --- \<- memo (f \<$\> s')@ instead. However, 'memo' incurs a small --- overhead, therefore it should not be used blindly. --- --- All the functions defined in this module return memoised signals. --- Just like 'delay', it is independent of the global input. -memo :: Signal a -- ^ the signal to cache - -> SignalGen p (Signal a) -- ^ a signal observationally equivalent to the argument -memo (S s) = SG $ \pool _ -> do - ref <- newIORef (Ready undefined) - - let sample = s >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | A signal that is true exactly once: the first time the input --- signal is true. Afterwards, it is constantly false, and it holds --- 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 - ref <- newIORef (Ready undefined) - - rsmp <- mfix $ \rs -> newIORef $ do - x <- s - writeIORef ref (Updated undefined x) - when x $ writeIORef rs $ do - writeIORef ref (Updated undefined False) - return False - return x - - let sample = join (readIORef rsmp) - - 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. 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. 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 - --- | 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 a, a -> IO ()) -- ^ the signal and an IO function to feed it -external x = do - ref <- newIORef x - return (S (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 [a]), a -> IO ()) -- ^ a generator for the event signal and the associated sink -externalMulti = do - var <- newMVar [] - return (SG $ \pool _ -> do - ref <- newIORef (Ready undefined) - let sample = modifyMVar var $ \list -> memoise ref list >> return ([], list) - addSignal (const sample) (const (() <$ sample)) ref pool - ,\val -> do vals <- takeMVar var - putMVar var (val:vals) - ) - --- | 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'). --- --- 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) -stateful x0 f = mfix $ \sig -> input >>= \i -> delay x0 (f <$> i <*> 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. Every output is derived from the current value of the --- input signal, the global parameter (which might have been --- overridden by 'embed') and the previous output. It is equivalent --- to the following expression: --- --- 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 -> 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') - -{- $effectful - -The following combinators are primarily aimed at library implementors -who wish build abstractions to effectful libraries on top of Elerea. - --} - --- | An IO action executed in the 'SignalGen' monad. Can be used as --- `liftIO`. -execute :: IO a -> SignalGen p a -execute act = SG $ \_ _ -> act - --- | A signal that executes a given IO action once at every sampling. --- --- In essence, this combinator provides cooperative multitasking --- capabilities, and its primary purpose is to assist library writers --- in wrapping effectful APIs as conceptually pure signals. If there --- are several effectful signals in the system, their order of --- execution is undefined and should not be relied on. --- --- Example: --- --- > do --- > act <- start $ do --- > ref <- execute $ newIORef 0 --- > let accum n = do --- > x <- readIORef ref --- > putStrLn $ "Accumulator: " ++ show x --- > writeIORef ref $! x+n --- > return () --- > effectful1 accum =<< input --- > forM_ [4,9,2,1,5] act --- --- Output: --- --- > Accumulator: 0 --- > Accumulator: 4 --- > Accumulator: 13 --- > Accumulator: 15 --- > Accumulator: 16 --- --- Another example (requires mersenne-random): --- --- > do --- > smp <- start $ effectful randomIO :: IO (IO Double) --- > res <- replicateM 5 smp --- > print res --- --- Output: --- --- > [0.12067753390401374,0.8658877349182655,0.7159264443196786,0.1756941896012891,0.9513646060896676] -effectful :: IO a -- ^ the action to be executed repeatedly - -> SignalGen p (Signal a) -effectful act = SG $ \pool _ -> do - ref <- newIORef (Ready undefined) - - let sample = act >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | A signal that executes a parametric IO action once at every --- sampling. The parameter is supplied by another signal at every --- sampling step. -effectful1 :: (t -> IO a) -- ^ the action to be executed repeatedly - -> Signal t -- ^ parameter signal - -> SignalGen p (Signal a) -effectful1 act (S s) = SG $ \pool _ -> do - ref <- newIORef (Ready undefined) - - let sample = s >>= act >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | Like 'effectful1', but with two parameter signals. -effectful2 :: (t1 -> t2 -> IO a) -- ^ the action to be executed repeatedly - -> Signal t1 -- ^ parameter signal 1 - -> Signal t2 -- ^ parameter signal 2 - -> SignalGen p (Signal a) -effectful2 act (S s1) (S s2) = SG $ \pool _ -> do - ref <- newIORef (Ready undefined) - - let sample = join (liftM2 act s1 s2) >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | Like 'effectful1', but with three parameter signals. -effectful3 :: (t1 -> t2 -> t3 -> IO a) -- ^ the action to be executed repeatedly - -> Signal t1 -- ^ parameter signal 1 - -> Signal t2 -- ^ parameter signal 2 - -> Signal t3 -- ^ parameter signal 3 - -> SignalGen p (Signal a) -effectful3 act (S s1) (S s2) (S s3) = SG $ \pool _ -> do - ref <- newIORef (Ready undefined) - - let sample = join (liftM3 act s1 s2 s3) >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | Like 'effectful1', but with four parameter signals. -effectful4 :: (t1 -> t2 -> t3 -> t4 -> IO a) -- ^ the action to be executed repeatedly - -> Signal t1 -- ^ parameter signal 1 - -> Signal t2 -- ^ parameter signal 2 - -> Signal t3 -- ^ parameter signal 3 - -> Signal t4 -- ^ parameter signal 4 - -> SignalGen p (Signal a) -effectful4 act (S s1) (S s2) (S s3) (S s4) = SG $ \pool _ -> do - ref <- newIORef (Ready undefined) - - let sample = join (liftM4 act s1 s2 s3 s4) >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | The @Show@ instance is only defined for the sake of 'Num'... -instance Show (Signal a) where - showsPrec _ _ s = "" ++ s - --- | Equality test is impossible. -instance Eq (Signal a) where - _ == _ = False - --- | Error message for unimplemented instance functions. -unimp :: String -> a -unimp = error . ("Signal: "++) - -instance Ord t => Ord (Signal t) where - compare = unimp "compare" - min = liftA2 min - max = liftA2 max - -instance Enum t => Enum (Signal t) where - succ = fmap succ - pred = fmap pred - toEnum = pure . toEnum - fromEnum = unimp "fromEnum" - enumFrom = unimp "enumFrom" - enumFromThen = unimp "enumFromThen" - enumFromTo = unimp "enumFromTo" - enumFromThenTo = unimp "enumFromThenTo" - -instance Bounded t => Bounded (Signal t) where - minBound = pure minBound - maxBound = pure maxBound - -instance Num t => Num (Signal t) where - (+) = liftA2 (+) - (-) = liftA2 (-) - (*) = liftA2 (*) - signum = fmap signum - abs = fmap abs - negate = fmap negate - fromInteger = pure . fromInteger - -instance Real t => Real (Signal t) where - toRational = unimp "toRational" - -instance Integral t => Integral (Signal t) where - quot = liftA2 quot - rem = liftA2 rem - div = liftA2 div - mod = liftA2 mod - quotRem a b = (fst <$> qrab,snd <$> qrab) - where qrab = quotRem <$> a <*> b - divMod a b = (fst <$> dmab,snd <$> dmab) - where dmab = divMod <$> a <*> b - toInteger = unimp "toInteger" - -instance Fractional t => Fractional (Signal t) where - (/) = liftA2 (/) - recip = fmap recip - fromRational = pure . fromRational - -instance Floating t => Floating (Signal t) where - pi = pure pi - exp = fmap exp - sqrt = fmap sqrt - log = fmap log - (**) = liftA2 (**) - logBase = liftA2 logBase - sin = fmap sin - tan = fmap tan - cos = fmap cos - asin = fmap asin - atan = fmap atan - acos = fmap acos - sinh = fmap sinh - tanh = fmap tanh - cosh = fmap cosh - asinh = fmap asinh - atanh = fmap atanh - acosh = fmap acosh +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +{-| + +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 + ( + -- * The signal abstraction + Signal + , SignalGen + -- * Embedding into I/O + , start + , external + , externalMulti + , unsafeExternal + -- * Basic building blocks + , delay + , snapshot + , generator + , memo + , till + , input + , embed + -- * Derived combinators + , stateful + , transfer + , transfer2 + , transfer3 + , transfer4 + -- * Signals with side effects + -- $effectful + , execute + , effectful + , effectful1 + , effectful2 + , effectful3 + , effectful4 + ) where + +import Control.Applicative +import Control.Concurrent.MVar +import Control.Monad +import Control.Monad.Base +import Control.Monad.Fix +import Control.Monad.IO.Class +import Data.IORef +import Data.Maybe +import System.Mem.Weak + +-- | 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. 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. +data Phase a = Ready a | Updated a a + +instance Functor (SignalGen p) where + fmap = liftM + +instance Applicative (SignalGen p) where + pure = return + (<*>) = ap + +instance Monad (SignalGen p) where + return x = SG $ \_ _ -> return x + SG g >>= f = SG $ \p i -> g p i >>= \x -> unSG (f x) p i + +instance MonadFix (SignalGen p) where + mfix f = SG $ \p i -> mfix $ \x -> unSG (f x) p i + +instance MonadIO (SignalGen p) where + liftIO = execute + +instance MonadBase (SignalGen p) (SignalGen p) where + liftBase = id + +-- | 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. 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 + pool <- newIORef [] + (inp,sink) <- unsafeExternal undefined + S sample <- gen pool inp + return $ \param -> do + sink param + res <- sample + superstep pool + return res + +-- | Performing the two-phase superstep. +superstep :: IORef UpdatePool -> IO () +superstep pool = loop id [] + where + deref ptr = (fmap.fmap) ((,) ptr) (deRefWeak ptr) + loop getPtrs final = do + (ptrs,acts) <- unzip.catMaybes <$> (mapM deref =<< readIORef pool) + case acts of + [] -> do + sequence_ final + writeIORef pool (getPtrs []) + _ -> do + writeIORef pool [] + mapM_ fst acts + loop ((ptrs++) . getPtrs) (mapM_ snd acts : final) + +-- | 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 + -> IORef UpdatePool -- ^ the pool of update actions + -> IO (Signal a) +addSignal sample update ref pool = do + let upd = readIORef ref >>= \v -> case v of + Ready x -> update x + _ -> return () + + fin = readIORef ref >>= \v -> case v of + Updated x _ -> writeIORef ref $! Ready x + _ -> error "Signal not updated!" + + sig = S $ readIORef ref >>= \v -> case v of + Ready x -> sample x + Updated _ x -> return x + {-# NOINLINE sig #-} + -- NOINLINE to prevent sig from getting inlined into the + -- argument position of mkWeak. + + updateActions <- mkWeak sig (upd,fin) Nothing + modifyIORef pool (updateActions:) + return sig + +-- | 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) +delay x0 (S s) = SG $ \pool _ -> do + ref <- newIORef (Ready x0) + + let update x = s >>= \x' -> x' `seq` writeIORef ref (Updated x' x) + + addSignal return update ref pool + +-- | A formal conversion from signals to signal generators, which +-- effectively allows for retrieving the current value of a previously +-- created signal within a generator. This includes both signals +-- defined in an external scope as well as those created earlier in +-- the same generator. It can be modelled by the following function: +-- +-- > snapshot s t_start s_input = s t_start +snapshot :: Signal a -> SignalGen p a +snapshot (S s) = SG $ \_ _ -> s + +-- | Auxiliary function. +memoise :: IORef (Phase a) -> a -> IO a +memoise ref x = writeIORef ref (Updated undefined x) >> return x + +-- | A reactive signal that takes the value to output from a signal +-- generator carried by its input with the sampling time provided as +-- the start time for the generated structure. It is possible to +-- 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) -- ^ the signal of generators to run + -> SignalGen p (Signal a) -- ^ the signal of generated structures +generator (S s) = SG $ \pool inp -> do + ref <- newIORef (Ready undefined) + + let sample = (s >>= \(SG g) -> g pool inp) >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | Memoising combinator. It can be used to cache results of +-- applicative combinators in case they are used in several places. +-- It is observationally equivalent to 'return' in the 'SignalGen' +-- monad. +-- +-- > memo s = <|s s s s ...|> +-- +-- For instance, if @s = f \<$\> s'@, then @f@ will be recalculated +-- once for each sampling of @s@. This can be avoided by writing @s +-- \<- memo (f \<$\> s')@ instead. However, 'memo' incurs a small +-- overhead, therefore it should not be used blindly. +-- +-- All the functions defined in this module return memoised signals. +-- Just like 'delay', it is independent of the global input. +memo :: Signal a -- ^ the signal to cache + -> SignalGen p (Signal a) -- ^ a signal observationally equivalent to the argument +memo (S s) = SG $ \pool _ -> do + ref <- newIORef (Ready undefined) + + let sample = s >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | A signal that is true exactly once: the first time the input +-- signal is true. Afterwards, it is constantly false, and it holds +-- no reference to the input signal. For instance (assuming the rest +-- of the input is constantly @False@): +-- +-- > till <> = +-- > <| <> +-- > << --- 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): +-- +-- > till s = do +-- > step <- transfer False (const (||)) s +-- > dstep <- delay False step +-- > memo (liftA2 (/=) step dstep) +-- +-- Example: +-- +-- > do +-- > smp <- start $ do +-- > accum <- stateful 0 (+) +-- > tick <- till ((>=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)] +till :: Signal Bool -- ^ the boolean input signal + -> SignalGen p (Signal Bool) -- ^ a one-shot signal true only the first time the input is true +till (S s) = SG $ \pool _ -> do + ref <- newIORef (Ready undefined) + + rsmp <- mfix $ \rs -> newIORef $ do + x <- s + writeIORef ref (Updated undefined x) + when x $ writeIORef rs $ do + writeIORef ref (Updated undefined False) + return False + return x + + let sample = join (readIORef rsmp) + + 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. 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. 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 + +-- | 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. +-- +-- As for why this construct is unsafe, consult the explanation for +-- the equivalent in "FRP.Elerea.Simple". +unsafeExternal :: a -- ^ initial value + -> IO (Signal a, a -> IO ()) -- ^ the signal and an IO function to feed it +unsafeExternal x = do + ref <- newIORef x + return (S (readIORef ref), writeIORef ref) + +-- | A signal that can be directly fed through the sink function +-- returned. This can be used to attach the network to the outer +-- world. The signal always yields the value last written to the +-- sink at the start of the superstep. 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. +external :: a -- ^ initial value + -> IO (SignalGen p (Signal a), a -> IO ()) -- ^ the generator to create the signal and an IO function to feed it +external x = do + ref <- newIORef x + return (SG $ \pool _ -> do + memoRef <- newIORef (Updated undefined x) + let sample = readIORef ref >>= memoise memoRef + addSignal (const sample) (const (() <$ sample)) memoRef pool + ,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. +externalMulti :: IO (SignalGen p (Signal [a]), a -> IO ()) -- ^ a generator for the event signal and the associated sink +externalMulti = do + var <- newMVar [] + return (SG $ \pool _ -> do + ref <- newIORef (Ready undefined) + let sample = modifyMVar var $ \list -> memoise ref list >> return ([], list) + addSignal (const sample) (const (() <$ sample)) ref pool + ,\val -> do vals <- takeMVar var + putMVar var (val:vals) + ) + +-- | 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'). +-- +-- 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) +stateful x0 f = mfix $ \sig -> input >>= \i -> delay x0 (f <$> i <*> 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. Every output is derived from the current value of the +-- input signal, the global parameter (which might have been +-- overridden by 'embed') and the previous output. It is equivalent +-- to the following expression: +-- +-- 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 -> 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') + +{- $effectful + +The following combinators are primarily aimed at library implementors +who wish build abstractions to effectful libraries on top of Elerea. + +-} + +-- | An IO action executed in the 'SignalGen' monad. Can be used as +-- `liftIO`. +execute :: IO a -> SignalGen p a +execute act = SG $ \_ _ -> act + +-- | A signal that executes a given IO action once at every sampling. +-- +-- In essence, this combinator provides cooperative multitasking +-- capabilities, and its primary purpose is to assist library writers +-- in wrapping effectful APIs as conceptually pure signals. If there +-- are several effectful signals in the system, their order of +-- execution is undefined and should not be relied on. +-- +-- Example: +-- +-- > do +-- > act <- start $ do +-- > ref <- execute $ newIORef 0 +-- > let accum n = do +-- > x <- readIORef ref +-- > putStrLn $ "Accumulator: " ++ show x +-- > writeIORef ref $! x+n +-- > return () +-- > effectful1 accum =<< input +-- > forM_ [4,9,2,1,5] act +-- +-- Output: +-- +-- > Accumulator: 0 +-- > Accumulator: 4 +-- > Accumulator: 13 +-- > Accumulator: 15 +-- > Accumulator: 16 +-- +-- Another example (requires mersenne-random): +-- +-- > do +-- > smp <- start $ effectful randomIO :: IO (IO Double) +-- > res <- replicateM 5 smp +-- > print res +-- +-- Output: +-- +-- > [0.12067753390401374,0.8658877349182655,0.7159264443196786,0.1756941896012891,0.9513646060896676] +effectful :: IO a -- ^ the action to be executed repeatedly + -> SignalGen p (Signal a) +effectful act = SG $ \pool _ -> do + ref <- newIORef (Ready undefined) + + let sample = act >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | A signal that executes a parametric IO action once at every +-- sampling. The parameter is supplied by another signal at every +-- sampling step. +effectful1 :: (t -> IO a) -- ^ the action to be executed repeatedly + -> Signal t -- ^ parameter signal + -> SignalGen p (Signal a) +effectful1 act (S s) = SG $ \pool _ -> do + ref <- newIORef (Ready undefined) + + let sample = s >>= act >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | Like 'effectful1', but with two parameter signals. +effectful2 :: (t1 -> t2 -> IO a) -- ^ the action to be executed repeatedly + -> Signal t1 -- ^ parameter signal 1 + -> Signal t2 -- ^ parameter signal 2 + -> SignalGen p (Signal a) +effectful2 act (S s1) (S s2) = SG $ \pool _ -> do + ref <- newIORef (Ready undefined) + + let sample = join (liftM2 act s1 s2) >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | Like 'effectful1', but with three parameter signals. +effectful3 :: (t1 -> t2 -> t3 -> IO a) -- ^ the action to be executed repeatedly + -> Signal t1 -- ^ parameter signal 1 + -> Signal t2 -- ^ parameter signal 2 + -> Signal t3 -- ^ parameter signal 3 + -> SignalGen p (Signal a) +effectful3 act (S s1) (S s2) (S s3) = SG $ \pool _ -> do + ref <- newIORef (Ready undefined) + + let sample = join (liftM3 act s1 s2 s3) >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | Like 'effectful1', but with four parameter signals. +effectful4 :: (t1 -> t2 -> t3 -> t4 -> IO a) -- ^ the action to be executed repeatedly + -> Signal t1 -- ^ parameter signal 1 + -> Signal t2 -- ^ parameter signal 2 + -> Signal t3 -- ^ parameter signal 3 + -> Signal t4 -- ^ parameter signal 4 + -> SignalGen p (Signal a) +effectful4 act (S s1) (S s2) (S s3) (S s4) = SG $ \pool _ -> do + ref <- newIORef (Ready undefined) + + let sample = join (liftM4 act s1 s2 s3 s4) >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | The @Show@ instance is only defined for the sake of 'Num'... +instance Show (Signal a) where + showsPrec _ _ s = "" ++ s + +-- | Equality test is impossible. +instance Eq (Signal a) where + _ == _ = False + +-- | Error message for unimplemented instance functions. +unimp :: String -> a +unimp = error . ("Signal: "++) + +instance Ord t => Ord (Signal t) where + compare = unimp "compare" + min = liftA2 min + max = liftA2 max + +instance Enum t => Enum (Signal t) where + succ = fmap succ + pred = fmap pred + toEnum = pure . toEnum + fromEnum = unimp "fromEnum" + enumFrom = unimp "enumFrom" + enumFromThen = unimp "enumFromThen" + enumFromTo = unimp "enumFromTo" + enumFromThenTo = unimp "enumFromThenTo" + +instance Bounded t => Bounded (Signal t) where + minBound = pure minBound + maxBound = pure maxBound + +instance Num t => Num (Signal t) where + (+) = liftA2 (+) + (-) = liftA2 (-) + (*) = liftA2 (*) + signum = fmap signum + abs = fmap abs + negate = fmap negate + fromInteger = pure . fromInteger + +instance Real t => Real (Signal t) where + toRational = unimp "toRational" + +instance Integral t => Integral (Signal t) where + quot = liftA2 quot + rem = liftA2 rem + div = liftA2 div + mod = liftA2 mod + quotRem a b = (fst <$> qrab,snd <$> qrab) + where qrab = quotRem <$> a <*> b + divMod a b = (fst <$> dmab,snd <$> dmab) + where dmab = divMod <$> a <*> b + toInteger = unimp "toInteger" + +instance Fractional t => Fractional (Signal t) where + (/) = liftA2 (/) + recip = fmap recip + fromRational = pure . fromRational + +instance Floating t => Floating (Signal t) where + pi = pure pi + exp = fmap exp + sqrt = fmap sqrt + log = fmap log + (**) = liftA2 (**) + logBase = liftA2 logBase + sin = fmap sin + tan = fmap tan + cos = fmap cos + asin = fmap asin + atan = fmap atan + acos = fmap acos + sinh = fmap sinh + tanh = fmap tanh + cosh = fmap cosh + asinh = fmap asinh + atanh = fmap atanh + acosh = fmap acosh diff --git a/FRP/Elerea/Simple.hs b/FRP/Elerea/Simple.hs --- a/FRP/Elerea/Simple.hs +++ b/FRP/Elerea/Simple.hs @@ -1,823 +1,866 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -{-| - -This module provides leak-free and referentially transparent -higher-order discrete signals. - --} - -module FRP.Elerea.Simple - ( - -- * The signal abstraction - Signal - , SignalGen - -- * Embedding into I/O - , start - , external - , externalMulti - -- * Basic building blocks - , delay - , snapshot - , generator - , memo - , until - -- * Derived combinators - , stateful - , transfer - , transfer2 - , transfer3 - , transfer4 - -- * Signals with side effects - -- $effectful - , execute - , effectful - , effectful1 - , effectful2 - , effectful3 - , effectful4 - -- * A longer example - -- $example - ) where - -import Control.Applicative -import Control.Concurrent.MVar -import Control.Monad -import Control.Monad.Base -import Control.Monad.Fix -import Control.Monad.IO.Class -import Data.IORef -import Data.Maybe -import Prelude hiding (until) -import System.Mem.Weak - --- | 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. 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. 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. -data Phase a = Ready a | Updated a a - -instance Functor SignalGen where - fmap = liftM - -instance Applicative SignalGen where - pure = return - (<*>) = ap - -instance Monad SignalGen where - return x = SG $ \_ -> return x - SG g >>= f = SG $ \p -> g p >>= \x -> unSG (f x) p - -instance MonadFix SignalGen where - mfix f = SG $ \p -> mfix $ \x -> unSG (f x) p - -instance MonadIO SignalGen where - liftIO = execute - -instance MonadBase SignalGen SignalGen where - liftBase = id - --- | 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. 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 - pool <- newIORef [] - S sample <- gen pool - return $ do - res <- sample - superstep pool - return res - --- | Performing the two-phase superstep. -superstep :: IORef UpdatePool -> IO () -superstep pool = loop id [] - where - deref ptr = (fmap.fmap) ((,) ptr) (deRefWeak ptr) - loop getPtrs final = do - (ptrs,acts) <- unzip.catMaybes <$> (mapM deref =<< readIORef pool) - case acts of - [] -> do - sequence_ final - writeIORef pool (getPtrs []) - _ -> do - writeIORef pool [] - mapM_ fst acts - loop ((ptrs++) . getPtrs) (mapM_ snd acts : final) - --- | 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 - -> IORef UpdatePool -- ^ the pool of update actions - -> IO (Signal a) -- ^ the signal created -addSignal sample update ref pool = do - let upd = readIORef ref >>= \v -> case v of - Ready x -> update x - _ -> return () - - fin = readIORef ref >>= \v -> case v of - Updated x _ -> writeIORef ref $! Ready x - _ -> error "Signal not updated!" - - sig = S $ readIORef ref >>= \v -> case v of - Ready x -> sample x - Updated _ x -> return x - {-# NOINLINE sig #-} - -- NOINLINE to prevent sig from getting inlined into the - -- argument position of mkWeak. - - updateActions <- mkWeak sig (upd,fin) Nothing - modifyIORef pool (updateActions:) - return sig - --- | 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 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 -delay x0 (S s) = SG $ \pool -> do - ref <- newIORef (Ready x0) - - let update x = s >>= \x' -> x' `seq` writeIORef ref (Updated x' x) - - addSignal return update ref pool - --- | A formal conversion from signals to signal generators, which --- effectively allows for retrieving the current value of a previously --- created signal within a generator. This includes both signals --- defined in an external scope as well as those created earlier in --- the same generator. In the model, it corresponds to the identity --- function. -snapshot :: Signal a -> SignalGen a -snapshot (S s) = SG $ \_ -> s - --- | Auxiliary function. -memoise :: IORef (Phase a) -> a -> IO a -memoise ref x = writeIORef ref (Updated undefined x) >> return x - --- | A reactive signal that takes the value to output from a signal --- generator carried by its input with the sampling time provided as --- the start time for the generated structure. It is possible to --- 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 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 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 - ref <- newIORef (Ready undefined) - - let sample = (s >>= \(SG g) -> g pool) >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | Memoising combinator. It can be used to cache results of --- applicative combinators in case they are used in several places. --- It is observationally equivalent to 'return' in the 'SignalGen' --- monad. --- --- > memo s = <|s s s s ...|> --- --- For instance, if @s = f \<$\> s'@, then @f@ will be recalculated --- once for each sampling of @s@. This can be avoided by writing @s --- \<- memo (f \<$\> s')@ instead. However, 'memo' incurs a small --- overhead, therefore it should not be used blindly. --- --- All the functions defined in this module return memoised signals. -memo :: Signal a -- ^ the signal to cache - -> SignalGen (Signal a) -- ^ a signal observationally equivalent to the argument -memo (S s) = SG $ \pool -> do - ref <- newIORef (Ready undefined) - - let sample = s >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | A signal that is true exactly once: the first time the input --- signal is true. Afterwards, it is constantly false, and it holds --- 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 (||) 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 - ref <- newIORef (Ready undefined) - - rsmp <- mfix $ \rs -> newIORef $ do - x <- s - writeIORef ref (Updated undefined x) - when x $ writeIORef rs $ do - writeIORef ref (Updated undefined False) - return False - return x - - let sample = join (readIORef rsmp) - - addSignal (const sample) (const (() <$ sample)) 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. 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 - ref <- newIORef x - return (S (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. --- --- 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 [] - return (SG $ \pool -> do - ref <- newIORef (Ready undefined) - let sample = modifyMVar var $ \list -> memoise ref list >> return ([], list) - addSignal (const sample) (const (() <$ sample)) ref pool - ,\val -> do vals <- takeMVar var - putMVar var (val:vals) - ) - --- | 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. --- --- 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. --- --- 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 -> 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') - -{- $effectful - -The following combinators are primarily aimed at library implementors -who wish build abstractions to effectful libraries on top of Elerea. - --} - --- | An IO action executed in the 'SignalGen' monad. Can be used as --- `liftIO`. -execute :: IO a -> SignalGen a -execute act = SG $ \_ -> act - --- | A signal that executes a given IO action once at every sampling. --- --- In essence, this combinator provides cooperative multitasking --- capabilities, and its primary purpose is to assist library writers --- in wrapping effectful APIs as conceptually pure signals. If there --- are several effectful signals in the system, their order of --- execution is undefined and should not be relied on. --- --- Example: --- --- > do --- > smp <- start $ do --- > ref <- execute $ newIORef 0 --- > effectful $ do --- > x <- readIORef ref --- > putStrLn $ "Count: " ++ show x --- > writeIORef ref $! x+1 --- > return () --- > replicateM_ 5 smp --- --- Output: --- --- > Count: 0 --- > Count: 1 --- > Count: 2 --- > Count: 3 --- > Count: 4 --- --- Another example (requires mersenne-random): --- --- > do --- > smp <- start $ effectful randomIO :: IO (IO Double) --- > res <- replicateM 5 smp --- > print res --- --- Output: --- --- > [0.12067753390401374,0.8658877349182655,0.7159264443196786,0.1756941896012891,0.9513646060896676] -effectful :: IO a -- ^ the action to be executed repeatedly - -> SignalGen (Signal a) -effectful act = SG $ \pool -> do - ref <- newIORef (Ready undefined) - - let sample = act >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | A signal that executes a parametric IO action once at every --- sampling. The parameter is supplied by another signal at every --- sampling step. -effectful1 :: (t -> IO a) -- ^ the action to be executed repeatedly - -> Signal t -- ^ parameter signal - -> SignalGen (Signal a) -effectful1 act (S s) = SG $ \pool -> do - ref <- newIORef (Ready undefined) - - let sample = s >>= act >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | Like 'effectful1', but with two parameter signals. -effectful2 :: (t1 -> t2 -> IO a) -- ^ the action to be executed repeatedly - -> Signal t1 -- ^ parameter signal 1 - -> Signal t2 -- ^ parameter signal 2 - -> SignalGen (Signal a) -effectful2 act (S s1) (S s2) = SG $ \pool -> do - ref <- newIORef (Ready undefined) - - let sample = join (liftM2 act s1 s2) >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | Like 'effectful1', but with three parameter signals. -effectful3 :: (t1 -> t2 -> t3 -> IO a) -- ^ the action to be executed repeatedly - -> Signal t1 -- ^ parameter signal 1 - -> Signal t2 -- ^ parameter signal 2 - -> Signal t3 -- ^ parameter signal 3 - -> SignalGen (Signal a) -effectful3 act (S s1) (S s2) (S s3) = SG $ \pool -> do - ref <- newIORef (Ready undefined) - - let sample = join (liftM3 act s1 s2 s3) >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | Like 'effectful1', but with four parameter signals. -effectful4 :: (t1 -> t2 -> t3 -> t4 -> IO a) -- ^ the action to be executed repeatedly - -> Signal t1 -- ^ parameter signal 1 - -> Signal t2 -- ^ parameter signal 2 - -> Signal t3 -- ^ parameter signal 3 - -> Signal t4 -- ^ parameter signal 4 - -> SignalGen (Signal a) -effectful4 act (S s1) (S s2) (S s3) (S s4) = SG $ \pool -> do - ref <- newIORef (Ready undefined) - - let sample = join (liftM4 act s1 s2 s3 s4) >>= memoise ref - - addSignal (const sample) (const (() <$ sample)) ref pool - --- | The Show instance is only defined for the sake of Num... -instance Show (Signal a) where - showsPrec _ _ s = "" ++ s - --- | Equality test is impossible. -instance Eq (Signal a) where - _ == _ = False - --- | Error message for unimplemented instance functions. -unimp :: String -> a -unimp = error . ("Signal: "++) - -instance Ord t => Ord (Signal t) where - compare = unimp "compare" - min = liftA2 min - max = liftA2 max - -instance Enum t => Enum (Signal t) where - succ = fmap succ - pred = fmap pred - toEnum = pure . toEnum - fromEnum = unimp "fromEnum" - enumFrom = unimp "enumFrom" - enumFromThen = unimp "enumFromThen" - enumFromTo = unimp "enumFromTo" - enumFromThenTo = unimp "enumFromThenTo" - -instance Bounded t => Bounded (Signal t) where - minBound = pure minBound - maxBound = pure maxBound - -instance Num t => Num (Signal t) where - (+) = liftA2 (+) - (-) = liftA2 (-) - (*) = liftA2 (*) - signum = fmap signum - abs = fmap abs - negate = fmap negate - fromInteger = pure . fromInteger - -instance Real t => Real (Signal t) where - toRational = unimp "toRational" - -instance Integral t => Integral (Signal t) where - quot = liftA2 quot - rem = liftA2 rem - div = liftA2 div - mod = liftA2 mod - quotRem a b = (fst <$> qrab,snd <$> qrab) - where qrab = quotRem <$> a <*> b - divMod a b = (fst <$> dmab,snd <$> dmab) - where dmab = divMod <$> a <*> b - toInteger = unimp "toInteger" - -instance Fractional t => Fractional (Signal t) where - (/) = liftA2 (/) - recip = fmap recip - fromRational = pure . fromRational - -instance Floating t => Floating (Signal t) where - pi = pure pi - exp = fmap exp - sqrt = fmap sqrt - log = fmap log - (**) = liftA2 (**) - logBase = liftA2 logBase - sin = fmap sin - tan = fmap tan - cos = fmap cos - asin = fmap asin - atan = fmap atan - acos = fmap acos - sinh = fmap sinh - tanh = fmap tanh - cosh = fmap cosh - asinh = fmap asinh - atanh = fmap atanh - acosh = fmap acosh - -{- $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'|) -@ - --} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +{-| + +This module provides leak-free and referentially transparent +higher-order discrete signals. + +-} + +module FRP.Elerea.Simple + ( + -- * The signal abstraction + Signal + , SignalGen + -- * Embedding into I/O + , start + , external + , externalMulti + , unsafeExternal + -- * Basic building blocks + , delay + , snapshot + , generator + , memo + , till + -- * Derived combinators + , stateful + , transfer + , transfer2 + , transfer3 + , transfer4 + -- * Signals with side effects + -- $effectful + , execute + , effectful + , effectful1 + , effectful2 + , effectful3 + , effectful4 + -- * A longer example + -- $example + ) where + +import Control.Applicative +import Control.Concurrent.MVar +import Control.Monad +import Control.Monad.Base +import Control.Monad.Fix +import Control.Monad.IO.Class +import Data.IORef +import Data.Maybe +import System.Mem.Weak + +-- | 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. 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. 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. +data Phase a = Ready a | Updated a a + +instance Functor SignalGen where + fmap = liftM + +instance Applicative SignalGen where + pure = return + (<*>) = ap + +instance Monad SignalGen where + return x = SG $ \_ -> return x + SG g >>= f = SG $ \p -> g p >>= \x -> unSG (f x) p + +instance MonadFix SignalGen where + mfix f = SG $ \p -> mfix $ \x -> unSG (f x) p + +instance MonadIO SignalGen where + liftIO = execute + +instance MonadBase SignalGen SignalGen where + liftBase = id + +-- | 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. 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 + pool <- newIORef [] + S sample <- gen pool + return $ do + res <- sample + superstep pool + return res + +-- | Performing the two-phase superstep. +superstep :: IORef UpdatePool -> IO () +superstep pool = loop id [] + where + deref ptr = (fmap.fmap) ((,) ptr) (deRefWeak ptr) + loop getPtrs final = do + (ptrs,acts) <- unzip.catMaybes <$> (mapM deref =<< readIORef pool) + case acts of + [] -> do + sequence_ final + writeIORef pool (getPtrs []) + _ -> do + writeIORef pool [] + mapM_ fst acts + loop ((ptrs++) . getPtrs) (mapM_ snd acts : final) + +-- | 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 + -> IORef UpdatePool -- ^ the pool of update actions + -> IO (Signal a) -- ^ the signal created +addSignal sample update ref pool = do + let upd = readIORef ref >>= \v -> case v of + Ready x -> update x + _ -> return () + + fin = readIORef ref >>= \v -> case v of + Updated x _ -> writeIORef ref $! Ready x + _ -> error "Signal not updated!" + + sig = S $ readIORef ref >>= \v -> case v of + Ready x -> sample x + Updated _ x -> return x + {-# NOINLINE sig #-} + -- NOINLINE to prevent sig from getting inlined into the + -- argument position of mkWeak. + + updateActions <- mkWeak sig (upd,fin) Nothing + modifyIORef pool (updateActions:) + return sig + +-- | 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 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 +delay x0 (S s) = SG $ \pool -> do + ref <- newIORef (Ready x0) + + let update x = s >>= \x' -> x' `seq` writeIORef ref (Updated x' x) + + addSignal return update ref pool + +-- | A formal conversion from signals to signal generators, which +-- effectively allows for retrieving the current value of a previously +-- created signal within a generator. This includes both signals +-- defined in an external scope as well as those created earlier in +-- the same generator. In the model, it corresponds to the identity +-- function. +snapshot :: Signal a -> SignalGen a +snapshot (S s) = SG $ \_ -> s + +-- | Auxiliary function. +memoise :: IORef (Phase a) -> a -> IO a +memoise ref x = writeIORef ref (Updated undefined x) >> return x + +-- | A reactive signal that takes the value to output from a signal +-- generator carried by its input with the sampling time provided as +-- the start time for the generated structure. It is possible to +-- 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 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 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 + ref <- newIORef (Ready undefined) + + let sample = (s >>= \(SG g) -> g pool) >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | Memoising combinator. It can be used to cache results of +-- applicative combinators in case they are used in several places. +-- It is observationally equivalent to 'return' in the 'SignalGen' +-- monad. +-- +-- > memo s = <|s s s s ...|> +-- +-- For instance, if @s = f \<$\> s'@, then @f@ will be recalculated +-- once for each sampling of @s@. This can be avoided by writing @s +-- \<- memo (f \<$\> s')@ instead. However, 'memo' incurs a small +-- overhead, therefore it should not be used blindly. +-- +-- All the functions defined in this module return memoised signals. +memo :: Signal a -- ^ the signal to cache + -> SignalGen (Signal a) -- ^ a signal observationally equivalent to the argument +memo (S s) = SG $ \pool -> do + ref <- newIORef (Ready undefined) + + let sample = s >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | A signal that is true exactly once: the first time the input +-- signal is true. Afterwards, it is constantly false, and it holds +-- no reference to the input signal. For instance (assuming the rest +-- of the input is constantly @False@): +-- +-- > till <> = +-- > <| <> +-- > << --- 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): +-- +-- > till s = do +-- > step <- transfer False (||) s +-- > dstep <- delay False step +-- > memo (liftA2 (/=) step dstep) +-- +-- Example: +-- +-- > do +-- > smp <- start $ do +-- > cnt <- stateful 0 (+1) +-- > tick <- till ((>=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)] +till :: Signal Bool -- ^ the boolean input signal + -> SignalGen (Signal Bool) -- ^ a one-shot signal true only the first time the input is true +till (S s) = SG $ \pool -> do + ref <- newIORef (Ready undefined) + + rsmp <- mfix $ \rs -> newIORef $ do + x <- s + writeIORef ref (Updated undefined x) + when x $ writeIORef rs $ do + writeIORef ref (Updated undefined False) + return False + return x + + let sample = join (readIORef rsmp) + + addSignal (const sample) (const (() <$ sample)) 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. 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) <- unsafeExternal 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] +-- +-- There are two reasons why this construct is deemed unsafe. +-- Firstly, if the sink is used from another thread several times +-- during the sampling process, the observed value of the signal might +-- be inconsistent within a superstep. More interestingly, this +-- unmanaged channel can interact with 'snapshot' in strange ways. +-- See for some examples. +-- +-- Note: this function used to be called @external@ up until version 2.8.0. +unsafeExternal :: a -- ^ initial value + -> IO (Signal a, a -> IO ()) -- ^ the signal and an IO function to feed it +unsafeExternal x = do + ref <- newIORef x + return (S (readIORef ref), writeIORef ref) + +-- | A signal that can be directly fed through the sink function +-- returned. This can be used to attach the network to the outer +-- world. The signal always yields the value last written to the +-- sink at the start of the superstep. 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 +-- > (gen,snk) <- external 4 +-- > smp <- start gen +-- > 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 (SignalGen (Signal a), a -> IO ()) -- ^ the generator to create the signal and an IO function to feed it +external x = do + ref <- newIORef x + return (SG $ \pool -> do + memoRef <- newIORef (Updated undefined x) + let sample = readIORef ref >>= memoise memoRef + addSignal (const sample) (const (() <$ sample)) memoRef pool + ,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. +-- +-- 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 [] + return (SG $ \pool -> do + ref <- newIORef (Ready undefined) + let sample = modifyMVar var $ \list -> memoise ref list >> return ([], list) + addSignal (const sample) (const (() <$ sample)) ref pool + ,\val -> do vals <- takeMVar var + putMVar var (val:vals) + ) + +-- | 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. +-- +-- 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. +-- +-- 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 -> 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') + +{- $effectful + +The following combinators are primarily aimed at library implementors +who wish build abstractions to effectful libraries on top of Elerea. + +-} + +-- | An IO action executed in the 'SignalGen' monad. Can be used as +-- `liftIO`. +execute :: IO a -> SignalGen a +execute act = SG $ \_ -> act + +-- | A signal that executes a given IO action once at every sampling. +-- +-- In essence, this combinator provides cooperative multitasking +-- capabilities, and its primary purpose is to assist library writers +-- in wrapping effectful APIs as conceptually pure signals. If there +-- are several effectful signals in the system, their order of +-- execution is undefined and should not be relied on. +-- +-- Example: +-- +-- > do +-- > smp <- start $ do +-- > ref <- execute $ newIORef 0 +-- > effectful $ do +-- > x <- readIORef ref +-- > putStrLn $ "Count: " ++ show x +-- > writeIORef ref $! x+1 +-- > return () +-- > replicateM_ 5 smp +-- +-- Output: +-- +-- > Count: 0 +-- > Count: 1 +-- > Count: 2 +-- > Count: 3 +-- > Count: 4 +-- +-- Another example (requires mersenne-random): +-- +-- > do +-- > smp <- start $ effectful randomIO :: IO (IO Double) +-- > res <- replicateM 5 smp +-- > print res +-- +-- Output: +-- +-- > [0.12067753390401374,0.8658877349182655,0.7159264443196786,0.1756941896012891,0.9513646060896676] +effectful :: IO a -- ^ the action to be executed repeatedly + -> SignalGen (Signal a) +effectful act = SG $ \pool -> do + ref <- newIORef (Ready undefined) + + let sample = act >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | A signal that executes a parametric IO action once at every +-- sampling. The parameter is supplied by another signal at every +-- sampling step. +effectful1 :: (t -> IO a) -- ^ the action to be executed repeatedly + -> Signal t -- ^ parameter signal + -> SignalGen (Signal a) +effectful1 act (S s) = SG $ \pool -> do + ref <- newIORef (Ready undefined) + + let sample = s >>= act >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | Like 'effectful1', but with two parameter signals. +effectful2 :: (t1 -> t2 -> IO a) -- ^ the action to be executed repeatedly + -> Signal t1 -- ^ parameter signal 1 + -> Signal t2 -- ^ parameter signal 2 + -> SignalGen (Signal a) +effectful2 act (S s1) (S s2) = SG $ \pool -> do + ref <- newIORef (Ready undefined) + + let sample = join (liftM2 act s1 s2) >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | Like 'effectful1', but with three parameter signals. +effectful3 :: (t1 -> t2 -> t3 -> IO a) -- ^ the action to be executed repeatedly + -> Signal t1 -- ^ parameter signal 1 + -> Signal t2 -- ^ parameter signal 2 + -> Signal t3 -- ^ parameter signal 3 + -> SignalGen (Signal a) +effectful3 act (S s1) (S s2) (S s3) = SG $ \pool -> do + ref <- newIORef (Ready undefined) + + let sample = join (liftM3 act s1 s2 s3) >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | Like 'effectful1', but with four parameter signals. +effectful4 :: (t1 -> t2 -> t3 -> t4 -> IO a) -- ^ the action to be executed repeatedly + -> Signal t1 -- ^ parameter signal 1 + -> Signal t2 -- ^ parameter signal 2 + -> Signal t3 -- ^ parameter signal 3 + -> Signal t4 -- ^ parameter signal 4 + -> SignalGen (Signal a) +effectful4 act (S s1) (S s2) (S s3) (S s4) = SG $ \pool -> do + ref <- newIORef (Ready undefined) + + let sample = join (liftM4 act s1 s2 s3 s4) >>= memoise ref + + addSignal (const sample) (const (() <$ sample)) ref pool + +-- | The Show instance is only defined for the sake of Num... +instance Show (Signal a) where + showsPrec _ _ s = "" ++ s + +-- | Equality test is impossible. +instance Eq (Signal a) where + _ == _ = False + +-- | Error message for unimplemented instance functions. +unimp :: String -> a +unimp = error . ("Signal: "++) + +instance Ord t => Ord (Signal t) where + compare = unimp "compare" + min = liftA2 min + max = liftA2 max + +instance Enum t => Enum (Signal t) where + succ = fmap succ + pred = fmap pred + toEnum = pure . toEnum + fromEnum = unimp "fromEnum" + enumFrom = unimp "enumFrom" + enumFromThen = unimp "enumFromThen" + enumFromTo = unimp "enumFromTo" + enumFromThenTo = unimp "enumFromThenTo" + +instance Bounded t => Bounded (Signal t) where + minBound = pure minBound + maxBound = pure maxBound + +instance Num t => Num (Signal t) where + (+) = liftA2 (+) + (-) = liftA2 (-) + (*) = liftA2 (*) + signum = fmap signum + abs = fmap abs + negate = fmap negate + fromInteger = pure . fromInteger + +instance Real t => Real (Signal t) where + toRational = unimp "toRational" + +instance Integral t => Integral (Signal t) where + quot = liftA2 quot + rem = liftA2 rem + div = liftA2 div + mod = liftA2 mod + quotRem a b = (fst <$> qrab,snd <$> qrab) + where qrab = quotRem <$> a <*> b + divMod a b = (fst <$> dmab,snd <$> dmab) + where dmab = divMod <$> a <*> b + toInteger = unimp "toInteger" + +instance Fractional t => Fractional (Signal t) where + (/) = liftA2 (/) + recip = fmap recip + fromRational = pure . fromRational + +instance Floating t => Floating (Signal t) where + pi = pure pi + exp = fmap exp + sqrt = fmap sqrt + log = fmap log + (**) = liftA2 (**) + logBase = liftA2 logBase + sin = fmap sin + tan = fmap tan + cos = fmap cos + asin = fmap asin + atan = fmap atan + acos = fmap acos + sinh = fmap sinh + tanh = fmap tanh + cosh = fmap cosh + asinh = fmap asinh + atanh = fmap atanh + acosh = fmap acosh + +{- $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/FRP/Elerea/Simple/Pure.hs b/FRP/Elerea/Simple/Pure.hs --- a/FRP/Elerea/Simple/Pure.hs +++ b/FRP/Elerea/Simple/Pure.hs @@ -1,85 +1,85 @@ -{-| - -This module contains the reference implementation for the pure subset -of the simple variant of Elerea. I/O embedding is substituted by -conversion from and to lists. - --} - -module FRP.Elerea.Simple.Pure - ( - -- * The signal abstraction - Signal - , SignalGen - -- * Inputs and outputs - , fromList - , toList - , start - -- * Basic building blocks - , delay - , snapshot - , generator - , memo - , until - -- * Derived combinators - , stateful - , transfer - , transfer2 - , transfer3 - , transfer4 - ) where - -import Control.Applicative -import Control.Monad -import Control.Monad.Fix - -type Signal a = Int -> a - -type SignalGen a = Int -> a - -fromList :: [a] -> Signal a -fromList = (!!) - -toList :: Signal a -> [a] -toList s = map s [0..] - -start :: SignalGen (Signal a) -> [a] -start g = toList (g 0) - -delay :: a -> Signal a -> SignalGen (Signal a) -delay x0 s t_start t_sample - | t_start < t_sample = s (t_sample-1) - | t_start == t_sample = x0 - | otherwise = error "This signal doesn't exist yet." - -generator :: Signal (SignalGen a) -> SignalGen (Signal a) -generator s _t_start t_sample = s t_sample t_sample - -snapshot :: Signal a -> SignalGen a -snapshot = id - -memo :: Signal a -> SignalGen (Signal a) -memo = const - -stateful :: a -> (a -> a) -> SignalGen (Signal a) -stateful x0 f = mfix $ \sig -> delay x0 (f <$> sig) - -transfer :: a -> (t -> a -> a) -> Signal t -> SignalGen (Signal a) -transfer x0 f s = mfix $ \sig -> do - sig' <- delay x0 sig - memo (liftA2 f s sig') - -transfer2 :: a -> (t1 -> t2 -> a -> a) -> Signal t1 -> Signal t2 -> SignalGen (Signal a) -transfer2 x0 f s1 s2 = mfix $ \sig -> do - sig' <- delay x0 sig - memo (liftA3 f s1 s2 sig') - -transfer3 :: a -> (t1 -> t2 -> t3 -> a -> a) -> Signal t1 -> Signal t2 -> Signal t3 -> SignalGen (Signal a) -transfer3 x0 f s1 s2 s3 = mfix $ \sig -> do - sig' <- delay x0 sig - memo (liftM4 f s1 s2 s3 sig') - -transfer4 :: a -> (t1 -> t2 -> t3 -> t4 -> a -> a) -> Signal t1 -> Signal t2 -> Signal t3 -> Signal t4 -> 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') +{-| + +This module contains the reference implementation for the pure subset +of the simple variant of Elerea. I/O embedding is substituted by +conversion from and to lists. + +-} + +module FRP.Elerea.Simple.Pure + ( + -- * The signal abstraction + Signal + , SignalGen + -- * Inputs and outputs + , fromList + , toList + , start + -- * Basic building blocks + , delay + , snapshot + , generator + , memo + , until + -- * Derived combinators + , stateful + , transfer + , transfer2 + , transfer3 + , transfer4 + ) where + +import Control.Applicative +import Control.Monad +import Control.Monad.Fix + +type Signal a = Int -> a + +type SignalGen a = Int -> a + +fromList :: [a] -> Signal a +fromList = (!!) + +toList :: Signal a -> [a] +toList s = map s [0..] + +start :: SignalGen (Signal a) -> [a] +start g = toList (g 0) + +delay :: a -> Signal a -> SignalGen (Signal a) +delay x0 s t_start t_sample + | t_start < t_sample = s (t_sample-1) + | t_start == t_sample = x0 + | otherwise = error "This signal doesn't exist yet." + +generator :: Signal (SignalGen a) -> SignalGen (Signal a) +generator s _t_start t_sample = s t_sample t_sample + +snapshot :: Signal a -> SignalGen a +snapshot = id + +memo :: Signal a -> SignalGen (Signal a) +memo = const + +stateful :: a -> (a -> a) -> SignalGen (Signal a) +stateful x0 f = mfix $ \sig -> delay x0 (f <$> sig) + +transfer :: a -> (t -> a -> a) -> Signal t -> SignalGen (Signal a) +transfer x0 f s = mfix $ \sig -> do + sig' <- delay x0 sig + memo (liftA2 f s sig') + +transfer2 :: a -> (t1 -> t2 -> a -> a) -> Signal t1 -> Signal t2 -> SignalGen (Signal a) +transfer2 x0 f s1 s2 = mfix $ \sig -> do + sig' <- delay x0 sig + memo (liftA3 f s1 s2 sig') + +transfer3 :: a -> (t1 -> t2 -> t3 -> a -> a) -> Signal t1 -> Signal t2 -> Signal t3 -> SignalGen (Signal a) +transfer3 x0 f s1 s2 s3 = mfix $ \sig -> do + sig' <- delay x0 sig + memo (liftM4 f s1 s2 s3 sig') + +transfer4 :: a -> (t1 -> t2 -> t3 -> t4 -> a -> a) -> Signal t1 -> Signal t2 -> Signal t3 -> Signal t4 -> 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') diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,28 +1,28 @@ -Copyright (c) 2009-2010, Patai Gergely -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -1. Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - -2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. - -3. Neither the name of the author nor the names of its contributors may be - used to endorse or promote products derived from this software without - specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE -LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +Copyright (c) 2009-2010, Patai Gergely +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of its contributors may be + used to endorse or promote products derived from this software without + specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,3 +1,3 @@ -import Distribution.Simple - -main = defaultMain +import Distribution.Simple + +main = defaultMain diff --git a/elerea.cabal b/elerea.cabal --- a/elerea.cabal +++ b/elerea.cabal @@ -1,61 +1,58 @@ -Name: elerea -Version: 2.8.0 -Cabal-Version: >= 1.2 -Synopsis: A minimalistic FRP library -Category: reactivity, FRP -Description: - - 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: - . - * Simple: signals are plain discrete streams isomorphic to functions - over natural numbers; - . - * Param: adds a globally accessible input signal for convenience; - . - * 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 - 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/ - (). - . - Additional contributions: Takano Akio, Mitsutoshi Aoe - -Author: Patai Gergely -Maintainer: Patai Gergely (patai.gergely@gmail.com) -Copyright: (c) 2009-2012, Patai Gergely -License: BSD3 -License-File: LICENSE -Stability: experimental -Build-Type: Simple -Extra-Source-Files: - CHANGES - -Library - Exposed-Modules: - FRP.Elerea - FRP.Elerea.Simple - FRP.Elerea.Simple.Pure - FRP.Elerea.Param - FRP.Elerea.Clocked - - Build-Depends: base >= 4 && < 5, containers, transformers, transformers-base - ghc-options: -Wall -O2 +Name: elerea +Version: 2.9.0 +Cabal-Version: >= 1.2 +Synopsis: A minimalistic FRP library +Category: reactivity, FRP +Description: + + 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 two + major variants: + . + * Simple: signals are plain discrete streams isomorphic to functions + over natural numbers; + . + * Param: adds a globally accessible input signal for convenience; + . + This 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/ + (). + . + Additional contributions: Takano Akio, Mitsutoshi Aoe + +Author: Patai Gergely +Maintainer: Patai Gergely (patai.gergely@gmail.com) +Copyright: (c) 2009-2012, Patai Gergely +License: BSD3 +License-File: LICENSE +Stability: experimental +Build-Type: Simple +Extra-Source-Files: + CHANGES + +Library + Exposed-Modules: + FRP.Elerea + FRP.Elerea.Simple + FRP.Elerea.Simple.Pure + FRP.Elerea.Param + + Build-Depends: base >= 4 && < 5, containers, transformers, transformers-base + ghc-options: -Wall -O2