elerea 1.0.0 → 1.1.0
raw patch · 7 files changed
+891/−2 lines, 7 filesdep +ghc-primPVP ok
version bump matches the API change (PVP)
Dependencies added: ghc-prim
API changes (from Hackage documentation)
+ FRP.Elerea.Experimental: (&&@) :: Signal p Bool -> Signal p Bool -> Signal p Bool
+ FRP.Elerea.Experimental: (/=@) :: (Eq a) => Signal p a -> Signal p a -> Signal p Bool
+ FRP.Elerea.Experimental: (<=@) :: (Ord a) => Signal p a -> Signal p a -> Signal p Bool
+ FRP.Elerea.Experimental: (<@) :: (Ord a) => Signal p a -> Signal p a -> Signal p Bool
+ FRP.Elerea.Experimental: (==@) :: (Eq a) => Signal p a -> Signal p a -> Signal p Bool
+ FRP.Elerea.Experimental: (>=@) :: (Ord a) => Signal p a -> Signal p a -> Signal p Bool
+ FRP.Elerea.Experimental: (>@) :: (Ord a) => Signal p a -> Signal p a -> Signal p Bool
+ FRP.Elerea.Experimental: (||@) :: Signal p Bool -> Signal p Bool -> Signal p Bool
+ FRP.Elerea.Experimental: edge :: Signal p Bool -> SignalGen p (Signal p Bool)
+ FRP.Elerea.Experimental: storeJust :: a -> Signal p (Maybe a) -> SignalGen p (Signal p a)
+ FRP.Elerea.Experimental.Param: data Signal p a
+ FRP.Elerea.Experimental.Param: data SignalGen p a
+ FRP.Elerea.Experimental.Param: debug :: String -> SignalGen p ()
+ FRP.Elerea.Experimental.Param: delay :: a -> Signal p a -> SignalGen p (Signal p a)
+ FRP.Elerea.Experimental.Param: external :: a -> IO (Signal p a, a -> IO ())
+ FRP.Elerea.Experimental.Param: generator :: Signal p (SignalGen p a) -> SignalGen p (Signal p a)
+ FRP.Elerea.Experimental.Param: instance (Bounded t) => Bounded (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Enum t) => Enum (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Floating t) => Floating (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Fractional t) => Fractional (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Integral t) => Integral (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Num t) => Num (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Ord t) => Ord (Signal p t)
+ FRP.Elerea.Experimental.Param: instance (Real t) => Real (Signal p t)
+ FRP.Elerea.Experimental.Param: instance Applicative (Signal p)
+ FRP.Elerea.Experimental.Param: instance Applicative (SignalGen p)
+ FRP.Elerea.Experimental.Param: instance Eq (Signal p a)
+ FRP.Elerea.Experimental.Param: instance Functor (Signal p)
+ FRP.Elerea.Experimental.Param: instance Functor (SignalGen p)
+ FRP.Elerea.Experimental.Param: instance Monad (Signal p)
+ FRP.Elerea.Experimental.Param: instance Monad (SignalGen p)
+ FRP.Elerea.Experimental.Param: instance MonadFix (SignalGen p)
+ FRP.Elerea.Experimental.Param: instance Show (Signal p a)
+ FRP.Elerea.Experimental.Param: memo :: Signal p a -> SignalGen p (Signal p a)
+ FRP.Elerea.Experimental.Param: start :: SignalGen p (Signal p a) -> IO (p -> IO a)
+ FRP.Elerea.Experimental.Param: stateful :: a -> (p -> a -> a) -> SignalGen p (Signal p a)
+ FRP.Elerea.Experimental.Param: transfer :: a -> (p -> t -> a -> a) -> Signal p t -> SignalGen p (Signal p a)
+ FRP.Elerea.Experimental.Simple: data Signal a
+ FRP.Elerea.Experimental.Simple: data SignalGen a
+ FRP.Elerea.Experimental.Simple: delay :: a -> Signal a -> SignalGen (Signal a)
+ FRP.Elerea.Experimental.Simple: external :: a -> IO (Signal a, a -> IO ())
+ FRP.Elerea.Experimental.Simple: generator :: Signal (SignalGen a) -> SignalGen (Signal a)
+ FRP.Elerea.Experimental.Simple: instance (Bounded t) => Bounded (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Enum t) => Enum (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Floating t) => Floating (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Fractional t) => Fractional (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Integral t) => Integral (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Num t) => Num (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Ord t) => Ord (Signal t)
+ FRP.Elerea.Experimental.Simple: instance (Real t) => Real (Signal t)
+ FRP.Elerea.Experimental.Simple: instance Applicative Signal
+ FRP.Elerea.Experimental.Simple: instance Applicative SignalGen
+ FRP.Elerea.Experimental.Simple: instance Eq (Signal a)
+ FRP.Elerea.Experimental.Simple: instance Functor Signal
+ FRP.Elerea.Experimental.Simple: instance Functor SignalGen
+ FRP.Elerea.Experimental.Simple: instance Monad Signal
+ FRP.Elerea.Experimental.Simple: instance Monad SignalGen
+ FRP.Elerea.Experimental.Simple: instance MonadFix SignalGen
+ FRP.Elerea.Experimental.Simple: instance Show (Signal a)
+ FRP.Elerea.Experimental.Simple: memo :: Signal a -> SignalGen (Signal a)
+ FRP.Elerea.Experimental.Simple: start :: SignalGen (Signal a) -> IO (IO a)
+ FRP.Elerea.Experimental.Simple: stateful :: a -> (a -> a) -> SignalGen (Signal a)
+ FRP.Elerea.Experimental.Simple: transfer :: a -> (t -> a -> a) -> Signal t -> SignalGen (Signal a)
Files
- CHANGES +3/−0
- FRP/Elerea.hs +4/−0
- FRP/Elerea/Experimental.hs +116/−0
- FRP/Elerea/Experimental/Param.hs +342/−0
- FRP/Elerea/Experimental/Simple.hs +417/−0
- FRP/Elerea/Internal.hs +4/−0
- elerea.cabal +5/−2
CHANGES view
@@ -1,3 +1,6 @@+1.1.0 - 091126+* added experimental branch with a cleaner semantics+ 1.0.0 - 090726 * completely renewed interface by introducing the SignalMonad
FRP/Elerea.hs view
@@ -31,6 +31,10 @@ a general idea how to use the library, check out the sources in the @elerea-examples@ package. +The "FRP.Elerea.Experimental" branch provides a similar interface with+a rather different underlying structure, which is likely to be more+efficient.+ -} module FRP.Elerea
+ FRP/Elerea/Experimental.hs view
@@ -0,0 +1,116 @@+{-|++This branch is an experimental version of Elerea that does not build+an actual graph of the dataflow network, just maintains a list of+actions to update signals. Each signal consists of a mutable+variable, an aging action and a finalising action. The variables can+only be accessed through a sampling action, and they are only referred+to in the corresponding aging and finalising action. These actions+can be accessed through weak pointers that get invalidated when all+other references to the corresponding variable are lost.++This approach has both advantages and disadvantages. On the plus+side, we don't have to create nodes for the applicative operations any+more, because they can be encoded in the sampling actions in an+efficient way. Also, since we have a list of independent actions to+update the network, we can achieve nearly perfect parallelism, just+like with a raytracer: all we need is a clever way of assigning+actions to processing units. The downside is that we have to+explicitly memoise the results of applicative operations in case they+are used more than once.++The modules below implement the basic idea in two variations:++* "FRP.Elerea.Experimental.Simple" provides discrete signals,+ i.e. streams;++* "FRP.Elerea.Experimental.Param" adds an extra parameter that's+ accessible to every node during the update, which can be used to+ provide a time step between samplings, or any other input necessary;++An extension of the second version with automatic delays will be+released later.++This module exports the parametric version along with a few utility+functions.++-}++{-+* "FRP.Elerea.Experimental.Delayed" adds automatic delays, which+ violates referential transparency in a limited way, but improves the+ usability of the API when this doesn't matter.+-}++module FRP.Elerea.Experimental+ ( module FRP.Elerea.Experimental.Param+ , storeJust+ , edge+ , (==@), (/=@), (<@), (<=@), (>=@), (>@)+ , (&&@), (||@)+ ) where++import Control.Applicative+import FRP.Elerea.Experimental.Param++infix 4 ==@, /=@, <@, <=@, >=@, >@+infixr 3 &&@+infixr 2 ||@++{-| The 'edge' transfer function takes a bool signal and emits another+bool signal that turns true only at the moment when there is a rising+edge on the input. -}++edge :: Signal p Bool -> SignalGen p (Signal p Bool)+edge b = delay True b >>= \db -> return $ (not <$> db) &&@ b++{-| The 'storeJust' transfer function behaves as a latch on a 'Maybe'+input: it keeps its state when the input is 'Nothing', and replaces it+with the input otherwise. -}++storeJust :: a -- ^ Initial output+ -> Signal p (Maybe a) -- ^ Maybe signal to latch on+ -> SignalGen p (Signal p a)+storeJust x0 s = transfer x0 store s+ where store _ Nothing x = x+ store _ (Just x) _ = x++{-| Point-wise equality of two signals. -}++(==@) :: Eq a => Signal p a -> Signal p a -> Signal p Bool+(==@) = liftA2 (==)++{-| Point-wise inequality of two signals. -}++(/=@) :: Eq a => Signal p a -> Signal p a -> Signal p Bool+(/=@) = liftA2 (/=)++{-| Point-wise comparison of two signals. -}++(<@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool+(<@) = liftA2 (<)++{-| Point-wise comparison of two signals. -}++(<=@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool+(<=@) = liftA2 (<=)++{-| Point-wise comparison of two signals. -}++(>=@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool+(>=@) = liftA2 (>=)++{-| Point-wise comparison of two signals. -}++(>@) :: Ord a => Signal p a -> Signal p a -> Signal p Bool+(>@) = liftA2 (>)++{-| Point-wise OR of two boolean signals. -}++(||@) :: Signal p Bool -> Signal p Bool -> Signal p Bool+(||@) = liftA2 (||)++{-| Point-wise AND of two boolean signals. -}++(&&@) :: Signal p Bool -> Signal p Bool -> Signal p Bool+(&&@) = liftA2 (&&)
+ FRP/Elerea/Experimental/Param.hs view
@@ -0,0 +1,342 @@+{-|++This version differs from the simple one in providing an extra+argument to the sampling action that will be globally distributed to+every node and can be used to update the state. For instance, it can+hold the time step between the two samplings, but it could also encode+all the external input to the system.++The interface of this module differs from the old Elerea in the+following ways:++* the delta time argument is generalised to an arbitrary type, so it+ is possible to do without 'external' altogether in case someone+ wants to do so;++* there is no 'sampler' any more, it is substituted by 'join', as+ signals are monads;++* 'generator' has been conceptually simplified, so it's a more basic+ primitive now;++* there is no automatic delay in order to preserve semantic soundness+ (e.g. the monad laws for signals);++* all signals are aged regardless of whether they are sampled+ (i.e. their behaviour doesn't depend on the context any more);++* the user needs to cache the results of applicative operations to be+ reused in multiple places explicitly using the 'memo' combinator.++-}++module FRP.Elerea.Experimental.Param+ ( Signal+ , SignalGen+ , start+ , external+ , delay+ , stateful+ , transfer+ , memo+ , generator+ , debug+ ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Data.IORef+import Data.Maybe+import System.Mem.Weak++--import FRP.Elerea.Experimental.WeakRef++{-| A signal can be thought of as a function of type @Nat -> a@, and+its 'Monad' instance agrees with that intuition. Internally, is+represented by a sampling computation. -}++newtype Signal p a = S { unS :: p -> IO a }++{-| A dynamic set of actions to update a network without breaking+consistency. -}++type UpdatePool p = [Weak (p -> IO (), IO ())]++{-| A signal generator is the only source of stateful signals.+Internally, computes a signal structure and adds the new variables to+an existing update pool. -}++newtype SignalGen p a = SG { unSG :: IORef (UpdatePool p) -> IO a }++{-| The phases every signal goes through during a superstep: before or+after sampling. -}++data Phase s a = Ready s | Aged s a++instance Functor (Signal p) where+ fmap = liftM++instance Applicative (Signal p) where+ pure = return+ (<*>) = ap++instance Monad (Signal p) where+ return = S . const . return+ S g >>= f = S $ \p -> g p >>= \x -> unS (f x) p++instance Functor (SignalGen p) where+ fmap = liftM++instance Applicative (SignalGen p) where+ pure = return+ (<*>) = ap++instance Monad (SignalGen p) where+ return = SG . const . return+ SG g >>= f = SG $ \p -> g p >>= \x -> unSG (f x) p++instance MonadFix (SignalGen p) where+ mfix f = SG $ \p -> mfix (($p).unSG.f)++{-| Embedding a signal into an 'IO' environment. Repeated calls to+the computation returned cause the whole network to be updated, and+the current sample of the top-level signal is produced as a+result. The computation accepts a global parameter that will be+distributed to all signals. For instance, this can be the time step,+if we want to model continuous-time signals. -}++start :: SignalGen p (Signal p a) -- ^ the generator of the top-level signal+ -> IO (p -> IO a) -- ^ the computation to sample the signal+start (SG gen) = do+ pool <- newIORef []+ (S sample) <- gen pool++ ptrs0 <- readIORef pool+ writeIORef pool []+ (as0,cs0) <- unzip . map fromJust <$> mapM deRefWeak ptrs0+ let ageStatic param = mapM_ ($param) as0+ commitStatic = sequence_ cs0++ return $ \param -> do+ let update [] ptrs age commit = do+ writeIORef pool ptrs+ ageStatic param >> age+ commitStatic >> commit+ update (p:ps) ptrs age commit = do+ r <- deRefWeak p+ case r of+ Nothing -> update ps ptrs age commit+ Just (a,c) -> update ps (p:ptrs) (age >> a param) (commit >> c)++ res <- sample param+ ptrs <- readIORef pool+ update ptrs [] (return ()) (return ())+ return res++{-| Auxiliary function used by all the primitives that create a+mutable variable. -}++addSignal :: (p -> Phase s a -> IO a) -- ^ sampling function+ -> (p -> Phase s a -> IO ()) -- ^ aging function+ -> IORef (Phase s a) -- ^ the mutable variable behind the signal+ -> IORef (UpdatePool p) -- ^ the pool of update actions+ -> IO (Signal p a)+addSignal sample age ref pool = do+ let commit (Aged s _) = Ready s+ commit _ = error "commit error: signal not aged"++ sig = S $ \p -> readIORef ref >>= sample p+ + update <- mkWeak sig (\p -> readIORef ref >>= age p, modifyIORef ref commit) Nothing+ modifyIORef pool (update:)+ return sig++{-| The 'delay' transfer function emits the value of a signal from the+previous superstep, starting with the filler value given in the first+argument. -}++delay :: a -- ^ initial output+ -> Signal p a -- ^ the signal to delay+ -> SignalGen p (Signal p a)+delay x0 (S s) = SG $ \pool -> do+ ref <- newIORef (Ready x0)++ let sample _ (Ready x) = return x+ sample _ (Aged _ x) = return x++ age p (Ready x) = s p >>= \x' -> x' `seq` writeIORef ref (Aged x' x)+ age _ _ = return ()++ addSignal sample age ref pool++{-| Memoising combinator. It can be used to cache results of+applicative combinators in case they are used in several places. Other+than that, it is equivalent to 'return'. -}++memo :: Signal p a -- ^ signal to memoise+ -> SignalGen p (Signal p a)+memo (S s) = SG $ \pool -> do+ ref <- newIORef (Ready undefined)++ let sample p (Ready _) = s p >>= \x -> writeIORef ref (Aged undefined x) >> return x+ sample _ (Aged _ x) = return x++ age p (Ready _) = s p >>= \x -> writeIORef ref (Aged undefined x)+ age _ _ = return ()++ addSignal sample age ref pool++{-| A reactive signal that takes the value to output from a monad+carried by its input. It is possible to create new signals in the+monad. -}++generator :: Signal p (SignalGen p a) -- ^ a stream of generators to potentially run+ -> SignalGen p (Signal p a)+generator (S gen) = SG $ \pool -> do+ ref <- newIORef (Ready undefined)++ let next p = ($pool).unSG =<< gen p+ + sample p (Ready _) = next p >>= \x' -> writeIORef ref (Aged x' x') >> return x'+ sample _ (Aged _ x) = return x++ age p (Ready _) = next p >>= \x' -> writeIORef ref (Aged x' x')+ age _ _ = return ()++ addSignal sample age ref pool++{-| A signal that can be directly fed through the sink function+returned. This can be used to attach the network to the outer world.+Note that this is optional, as all the input of the network can be fed+in through the global parameter, although that is not really+convenient for many signals. -}++external :: a -- ^ initial value+ -> IO (Signal p a, a -> IO ()) -- ^ the signal and an IO function to feed it+external x = do+ ref <- newIORef x+ return (S (const (readIORef ref)), writeIORef ref)++{-| A pure stateful signal. The initial state is the first output,+and every following output is calculated from the previous one and the+value of the global parameter. -}++stateful :: a -> (p -> a -> a) -> SignalGen p (Signal p a)+stateful x0 f = SG $ \pool -> do+ ref <- newIORef (Ready x0)++ let sample _ (Ready x) = return x+ sample _ (Aged _ x) = return x++ age p (Ready x) = let x' = f p x in x' `seq` writeIORef ref (Aged x' x)+ age _ _ = return ()++ addSignal sample age ref pool++{-| A stateful transfer function. The current input affects the+current output, i.e. the initial state given in the first argument is+considered to appear before the first output, and can never be+observed. Every output is derived from the current value of the input+signal, the global parameter and the previous output. -}++transfer :: a -> (p -> t -> a -> a) -> Signal p t -> SignalGen p (Signal p a)+transfer x0 f (S s) = SG $ \pool -> do+ ref <- newIORef (Ready x0)++ let sample p (Ready x) = s p >>= \y -> let x' = f p y x in+ x' `seq` writeIORef ref (Aged x' x') >> return x'+ sample _ (Aged _ x) = return x++ age p (Ready x) = s p >>= \y -> let x' = f p y x in+ x' `seq` writeIORef ref (Aged x' x')+ age _ _ = return ()++ addSignal sample age ref pool++{-| A printing action within the |SignalGen| monad. -}++debug :: String -> SignalGen p ()+debug = SG . const . putStrLn++{-| The @Show@ instance is only defined for the sake of 'Num'... -}++instance Show (Signal p a) where+ showsPrec _ _ s = "<SIGNAL>" ++ s++{-| Equality test is impossible. -}++instance Eq (Signal p a) where+ _ == _ = False+ +{-| Error message for unimplemented instance functions. -}++unimp :: String -> a+unimp = error . ("Signal: "++)++instance Ord t => Ord (Signal p t) where+ compare = unimp "compare"+ min = liftA2 min+ max = liftA2 max++instance Enum t => Enum (Signal p t) where+ succ = fmap succ+ pred = fmap pred+ toEnum = pure . toEnum+ fromEnum = unimp "fromEnum"+ enumFrom = unimp "enumFrom"+ enumFromThen = unimp "enumFromThen"+ enumFromTo = unimp "enumFromTo"+ enumFromThenTo = unimp "enumFromThenTo"++instance Bounded t => Bounded (Signal p t) where+ minBound = pure minBound+ maxBound = pure maxBound++instance Num t => Num (Signal p t) where+ (+) = liftA2 (+)+ (-) = liftA2 (-)+ (*) = liftA2 (*)+ signum = fmap signum+ abs = fmap abs+ negate = fmap negate+ fromInteger = pure . fromInteger++instance Real t => Real (Signal p t) where+ toRational = unimp "toRational"++instance Integral t => Integral (Signal p t) where+ quot = liftA2 quot+ rem = liftA2 rem+ div = liftA2 div+ mod = liftA2 mod+ quotRem a b = (fst <$> qrab,snd <$> qrab)+ where qrab = quotRem <$> a <*> b+ divMod a b = (fst <$> dmab,snd <$> dmab)+ where dmab = divMod <$> a <*> b+ toInteger = unimp "toInteger"++instance Fractional t => Fractional (Signal p t) where+ (/) = liftA2 (/)+ recip = fmap recip+ fromRational = pure . fromRational++instance Floating t => Floating (Signal p t) where+ pi = pure pi+ exp = fmap exp+ sqrt = fmap sqrt+ log = fmap log+ (**) = liftA2 (**)+ logBase = liftA2 logBase+ sin = fmap sin+ tan = fmap tan+ cos = fmap cos+ asin = fmap asin+ atan = fmap atan+ acos = fmap acos+ sinh = fmap sinh+ tanh = fmap tanh+ cosh = fmap cosh+ asinh = fmap asinh+ atanh = fmap atanh+ acosh = fmap acosh
+ FRP/Elerea/Experimental/Simple.hs view
@@ -0,0 +1,417 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++{-|++This module provides efficient higher-order discrete signals. For a+non entirely trivial example, let's create a dynamic collection of+countdown timers, where each expired timer is removed from the+collection. First of all, we'll need a simple tester function:++@+ 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+(<http://personal.cis.strath.ac.uk/~conor/pub/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'|)+@++-}++module FRP.Elerea.Experimental.Simple+ ( Signal+ , SignalGen+ , start+ , external+ , delay+ , generator+ , memo+ , stateful+ , transfer+ ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Data.IORef+import Data.Maybe+import System.Mem.Weak++{-| A signal can be thought of as a function of type @Nat -> a@, where+the argument is the sampling time, and the 'Monad' instance agrees+with the intuition (bind corresponds to extracting the current+sample). -}++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. -}++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 = (<*>).pure++instance Applicative SignalGen where+ pure = return+ (<*>) = ap+ +instance Monad SignalGen where+ return = SG . const . return+ SG g >>= f = SG $ \p -> g p >>= \x -> unSG (f x) p++instance MonadFix SignalGen where+ mfix f = SG $ \p -> mfix (($p).unSG.f)++{-| Embedding a signal into an 'IO' environment. Repeated calls to+the computation returned cause the whole network to be updated, and+the current sample of the top-level signal is produced as a result.+This is the only way to extract a signal generator outside the+network, and it is equivalent to passing zero to the function+representing the generator. -}++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+ let deref ptr = (fmap.fmap) ((,) ptr) (deRefWeak ptr)+ res <- sample+ (ptrs,acts) <- unzip.catMaybes <$> (mapM deref =<< readIORef pool)+ writeIORef pool ptrs+ mapM_ fst acts+ mapM_ snd acts+ return res++{-| Auxiliary function used by all the primitives that create a+mutable variable. -}++addSignal :: (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+ + updateActions <- mkWeak sig (upd,fin) Nothing+ modifyIORef pool (updateActions:)+ return sig++{-| The 'delay' transfer function emits the value of a signal from the+previous superstep, starting with the filler value given in the first+argument. It can be thought of as the following function (which+should also make it clear why the return value is 'SignalGen'):++@+ delay x0 s t_start t_sample+ | t_start == t_sample = x0+ | t_start < t_sample = s (t_sample-1)+ | otherwise = error \"Premature sample!\"+@++The way signal generators are extracted ensures that the error can+never happen. -}++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 reactive signal that takes the value to output from a signal+generator carried by its input with the sampling time provided as the+time of generation. It is possible to create new signals in the+monad. It can be thought of as the following function:++@+ generator g t_start t_sample = g t_sample t_sample+@++It has to live in the 'SignalGen' monad, because it needs to maintain+an internal state to be able to cache the current sample for+efficiency reasons. However, this state is not carried between+samples, therefore starting time doesn't matter and can be ignored.++-}++generator :: Signal (SignalGen a) -- ^ the signal of generators to run+ -> SignalGen (Signal a) -- ^ the signal of generated structures+generator (S s) = SG $ \pool -> do+ ref <- newIORef (Ready undefined)+ + let sample = do SG g <- s+ x <- g pool+ writeIORef ref (Updated undefined x)+ return x++ addSignal (const sample) (const (sample >> return ())) ref pool++{-| Memoising combinator. It can be used to cache results of+applicative combinators in case they are used in several places. It+is observationally equivalent to 'return' in the 'SignalGen' monad. -}++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 >>= \x -> writeIORef ref (Updated undefined x) >> return x++ addSignal (const sample) (const (sample >> return ())) ref pool++{-| A signal that can be directly fed through the sink function+returned. This can be used to attach the network to the outer+world. -}++external :: a -- ^ initial value+ -> IO (Signal a, a -> IO ()) -- ^ the signal and an IO function to feed it+external x = do+ ref <- newIORef x+ return (S (readIORef ref), writeIORef ref)++{-| A pure stateful signal. The initial state is the first output,+and every subsequent state is derived from the preceding one by+applying a pure transformation. It is equivalent to the following+expression:++@+ stateful x0 f = 'mfix' $ \sig -> 'delay' x0 (f '<$>' sig)+@+-}++stateful :: a -- ^ initial state+ -> (a -> a) -- ^ state transformation+ -> SignalGen (Signal a)+stateful x0 f = mfix $ \sig -> delay x0 (f <$> sig)++{-| A stateful transfer function. The current input affects the+current output, i.e. the initial state given in the first argument is+considered to appear before the first output, and can never be+observed, and subsequent states are determined by combining the+preceding state with the current output of the input signal using the+function supplied. It is equivalent to the following expression:++@+ transfer x0 f s = 'mfix' $ \sig -> 'liftA2' f s '<$>' 'delay' x0 sig+@+-}++transfer :: a -- ^ initial internal state+ -> (t -> a -> a) -- ^ state updater function+ -> Signal t -- ^ input signal+ -> SignalGen (Signal a)+transfer x0 f s = mfix $ \sig -> liftA2 f s <$> delay x0 sig++{-| The @Show@ instance is only defined for the sake of 'Num'... -}++instance Show (Signal a) where+ showsPrec _ _ s = "<SIGNAL>" ++ 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
FRP/Elerea/Internal.hs view
@@ -166,6 +166,10 @@ -- | A constant signal pure = makeSignalUnsafe . SNK -- | Point-wise application of a function and a data signal (like @ZipList@)++-- --mf <*> mx = sampler (fmap (\f -> sampler (fmap (pure . f) mx)) mf)+-- sf <*> sx = sampler (makeSignalUnsafe (SNF1 (\f -> sampler (makeSignalUnsafe (SNF1 (pure . f) sx))) sf))+ f@(S rf) <*> x@(S rx) = unsafePerformIO $ do -- General fall-back case c <- newIORef (Ready (SNA f x))
elerea.cabal view
@@ -1,5 +1,5 @@ Name: elerea-Version: 1.0.0+Version: 1.1.0 Cabal-Version: >= 1.2 Synopsis: A minimalistic FRP library Category: reactivity, FRP@@ -40,6 +40,9 @@ FRP.Elerea FRP.Elerea.Internal FRP.Elerea.Graph+ FRP.Elerea.Experimental+ FRP.Elerea.Experimental.Simple+ FRP.Elerea.Experimental.Param - Build-Depends: base >= 3 && < 5, containers+ Build-Depends: base >= 3 && < 5, containers, ghc-prim ghc-options: -Wall -O2