diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -0,0 +1,8 @@ +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 @@ -23,7 +23,9 @@ integral x0 s = transfer x0 (\\dt x x0 -> x0+x*realToFrac dt) s @ -Head to "FRP.Elerea.Internal" for the implementation details. +Head to "FRP.Elerea.Internal" for the implementation details. To get +a general idea how to use the library, check out the sources in the +@elerea-examples@ package. -} @@ -32,12 +34,68 @@ Sink, Signal, superstep, - time, - stateless, - stateful, - transfer, - latcher, - external + stateful, transfer, latcher, external, + delay, edge, + (==@), (/=@), (<@), (<=@), (>=@), (>@), + (&&@), (||@) ) where +import Control.Applicative import FRP.Elerea.Internal + +infix 4 ==@, /=@, <@, <=@, >=@, >@ +infixr 3 &&@ +infixr 2 ||@ + +{-| The `delay` transfer function emits the value of a signal from the +previous superstep, starting with the filler value `v0`. -} + +delay :: a -> Signal a -> Signal a +delay v0 s = snd <$> transfer (v0,undefined) (\_ v' (v,_) -> (v',v)) s + +{-| The `edge` transfer function takes a bool signal and emits another +bool signal that turns true only at the moment when there is a rising +edge on the input. -} + +edge :: Signal Bool -> Signal Bool +edge b = (not <$> delay True b) &&@ b + +{-| Point-wise equality of two signals. -} + +(==@) :: Eq a => Signal a -> Signal a -> Signal Bool +(==@) = liftA2 (==) + +{-| Point-wise inequality of two signals. -} + +(/=@) :: Eq a => Signal a -> Signal a -> Signal Bool +(/=@) = liftA2 (/=) + +{-| Point-wise comparison of two signals. -} + +(<@) :: Ord a => Signal a -> Signal a -> Signal Bool +(<@) = liftA2 (<) + +{-| Point-wise comparison of two signals. -} + +(<=@) :: Ord a => Signal a -> Signal a -> Signal Bool +(<=@) = liftA2 (<=) + +{-| Point-wise comparison of two signals. -} + +(>=@) :: Ord a => Signal a -> Signal a -> Signal Bool +(>=@) = liftA2 (>=) + +{-| Point-wise comparison of two signals. -} + +(>@) :: Ord a => Signal a -> Signal a -> Signal Bool +(>@) = liftA2 (>) + +{-| Point-wise OR of two boolean signals. -} + +(||@) :: Signal Bool -> Signal Bool -> Signal Bool +(||@) = liftA2 (||) + +{-| Point-wise AND of two boolean signals. -} + +(&&@) :: Signal Bool -> Signal Bool -> Signal Bool +(&&@) = liftA2 (&&) diff --git a/FRP/Elerea/Internal.hs b/FRP/Elerea/Internal.hs --- a/FRP/Elerea/Internal.hs +++ b/FRP/Elerea/Internal.hs @@ -32,10 +32,13 @@ sample is simply reused, and no further aging is performed. After successfully sampling the top-level signal, the finalisation process throws away the intermediate samples and marks the aged signals as the -current ones, ready to be sampled again. Evaluation is done by the -'signalValue' function, while finalisation is done by 'commit'. Since -these functions are invoked recursively on a data structure with -existential types, their types also need to be explicity quantified. +current ones, ready to be sampled again. If there is a dependency +loop, the system tries to use the `sampleDelayed` function instead of +`sample` to get a useful value at the problematic spot instead of +entering an infinite loop. Evaluation is done by the 'signalValue' +function, while finalisation is done by 'commit'. Since these +functions are invoked recursively on a data structure with existential +types, their types also need to be explicity quantified. As a bonus, applicative nodes are automatically collapsed into lifted functions of up to five arguments. This optimisation significantly @@ -70,15 +73,22 @@ newtype Signal a = S (IORef (SignalTrans a)) -{-| A node can have two states: stable (freshly created or finalised) -or mutating (in the process of aging). -} +{-| A node can have four states that distinguish various stages of +sampling and aging. -} data SignalTrans a - -- | @Cur s@ is simply the signal @s@ - = Cur (SignalNode a) - -- | @Tra x s@ is an already sampled signal, where @x@ is the - -- current value and @s@ is the new version of the signal - | Tra a (SignalNode a) + -- | @Ready s@ is simply the signal @s@ that was not sampled yet + = Ready (SignalNode a) + -- | @Sampling s@ is still @s@ after its current value was + -- requested, but still not delivered + | Sampling (SignalNode a) + -- | @Sample x@ is just the value @x@, eventually to be replaced + -- by the aged version of its corresponding signal + | Sample a + -- | @Aged x s@ is an already sampled signal, where @x@ is the + -- current value and @s@ is the new version of the signal for the + -- next superstep + | Aged a (SignalNode a) {-| The possible structures of a node are defined by the 'SignalNode' type. Note that the @SNLx@ nodes are only needed to optimise @@ -88,8 +98,6 @@ data SignalNode a -- | @SNK x@: constantly @x@ = SNK a - -- | @SNF f@: time function @f@ (absolute time) - | SNF (Time -> a) -- | @SNS x t@: stateful generator, where @x@ is current state and -- @t@ is the update function | SNS a (DTime -> a -> a) @@ -136,20 +144,20 @@ -- | Point-wise application of a function and a data signal (like @ZipList@) f@(S rf) <*> x@(S rx) = unsafePerformIO $ do -- General fall-back case - c <- newIORef (Cur (SNA f x)) + c <- newIORef (Ready (SNA f x)) - let opt s = writeIORef c (Cur s) + let opt s = writeIORef c (Ready s) -- Optimisations might go haywire in the presence of loops, -- so we need to prepare to meeting undefined references by -- wrapping reads into exception handlers. flip catch (const (return ())) $ do - Cur nf <- readIORef rf + Ready nf <- readIORef rf merged <- flip catch (const (return False)) $ do -- Merging constant branches from the two sides - Cur nx <- readIORef rx + Ready nx <- readIORef rx case (nf,nx) of (SNK g,SNK y) -> debugLog "merge_00" $ opt (SNK (g y)) (SNK g,SNL1 h y1) -> debugLog "merge_01" $ opt (SNL1 (g.h) y1) @@ -197,7 +205,7 @@ instance Show (Signal a) where showsPrec _ _ s = "" ++ s -{-| The equality test checks whether to signals are physically the same. -} +{-| The equality test checks whether two signals are physically the same. -} instance Eq (Signal a) where S s1 == S s2 = s1 == s2 @@ -216,13 +224,33 @@ recip = fmap recip fromRational = pure . fromRational +instance Floating t => Floating (Signal t) where + pi = pure pi + exp = fmap exp + sqrt = fmap sqrt + log = fmap log + (**) = liftA2 (**) + logBase = liftA2 logBase + sin = fmap sin + tan = fmap tan + cos = fmap cos + asin = fmap asin + atan = fmap atan + acos = fmap acos + sinh = fmap sinh + tanh = fmap tanh + cosh = fmap cosh + asinh = fmap asinh + atanh = fmap atanh + acosh = fmap acosh + -- ** Internal functions to run the network {-| This function is really just a shorthand to create a reference to a given node. -} createSignal :: SignalNode a -> Signal a -createSignal = S . unsafePerformIO . newIORef . Cur +createSignal = S . unsafePerformIO . newIORef . Ready {-| Sampling and aging the signal and all of its dependencies, at the same time. We don't need the aged signal in the current superstep, @@ -234,19 +262,35 @@ signalValue (S r) dt = do t <- readIORef r case t of - Cur s -> do -- TODO: advance can be evaluated in a separate - -- thread, since we don't need its result right away, - -- only in the next superstep. - v <- sample s dt - -- We memorise the sample to handle loops nicely. - -- The undefined future signal cannot bite us, - -- because we don't need it during the evaluation - -- phase. - writeIORef r (Tra v undefined) - s' <- advance s dt - writeIORef r (Tra v s') - return v - Tra v _ -> return v + Ready s -> do writeIORef r (Sampling s) + -- TODO: advance can be evaluated in a separate + -- thread, since we don't need its result right + -- away, only in the next superstep. + v <- sample s dt + -- We memorise the sample to handle loops + -- nicely. The undefined future signal cannot + -- bite us, because we don't need it during the + -- evaluation phase. + writeIORef r (Sample v) + s' <- advance s v dt + writeIORef r (Aged v s') + return v + Sampling s -> do -- We started sampling this already, so there is + -- a dependency cycle we have to resolve by + -- adding a delay to stateful signals. Stateless + -- signals should not form a loop, which is + -- obvious... + v <- sampleDelayed s dt + writeIORef r (Sample v) + -- Since we are sampling this already, aging + -- will be performed by the case above. Also, + -- the result is memoised by the system, so we + -- are not calculating anything twice. Note + -- that this is an old value, so it shouldn't be + -- used for aging anyway. + return v + Sample v -> return v + Aged v _ -> return v {-| Finalising the aged signals for the next round. -} @@ -254,52 +298,50 @@ commit (S s) = do t <- readIORef s case t of - Tra _ s' -> do writeIORef s (Cur s') - -- TODO: branching can be trivially parallelised - case s' of - SNT s _ _ -> commit s - SNA sf sx -> commit sf >> commit sx - SNL1 _ s -> commit s - SNL2 _ s1 s2 -> commit s1 >> commit s2 - SNL3 _ s1 s2 s3 -> commit s1 >> commit s2 >> commit s3 - SNL4 _ s1 s2 s3 s4 -> commit s1 >> commit s2 >> commit s3 >> commit s4 - SNL5 _ s1 s2 s3 s4 s5 -> commit s1 >> commit s2 >> commit s3 >> commit s4 >> commit s5 - SNE s e ss -> commit s >> commit e >> commit ss - _ -> return () - _ -> return () + Aged _ s' -> do writeIORef s (Ready s') + -- TODO: branching can be trivially parallelised + case s' of + SNT s _ _ -> commit s + SNA sf sx -> commit sf >> commit sx + SNL1 _ s -> commit s + SNL2 _ s1 s2 -> commit s1 >> commit s2 + SNL3 _ s1 s2 s3 -> commit s1 >> commit s2 >> commit s3 + SNL4 _ s1 s2 s3 s4 -> commit s1 >> commit s2 >> commit s3 >> commit s4 + SNL5 _ s1 s2 s3 s4 s5 -> commit s1 >> commit s2 >> commit s3 >> commit s4 >> commit s5 + SNE s e ss -> commit s >> commit e >> commit ss + _ -> return () + Ready _ -> return () + _ -> error "Inconsistent state: signal not aged!" {-| Aging the signal. Stateful signals have their state forced to prevent building up big thunks, and the latcher also does its job here. The other nodes are structurally static. -} -advance :: SignalNode a -> DTime -> IO (SignalNode a) -advance (SNS x f) dt = x `seq` return (SNS (f dt x) f) -advance (SNT s x f) dt = x `seq` do t <- signalValue s dt - return (SNT s (f dt t x) f) -advance sw@(SNE _ e ss) dt = do b <- signalValue e dt - s' <- signalValue ss dt - if b - then return (SNE s' e ss) - else return sw -advance s _ = return s +advance :: SignalNode a -> a -> DTime -> IO (SignalNode a) +advance (SNS x f) _ dt = x `seq` return (SNS (f dt x) f) +advance (SNT s _ f) v _ = v `seq` return (SNT s v f) +advance sw@(SNE _ e ss) _ dt = do -- These are ready samples! + b <- signalValue e dt + s' <- signalValue ss dt + if b + then return (SNE s' e ss) + else return sw +advance s _ _ = return s {-| Sampling the signal at the current moment. This is where static -nodes propagate changes to those they depend on. Note the latcher -rule ('SNE'): the signal is sampled before latching takes place, -therefore even if the change is instantaneous, its effect cannot be -observed at the moment of latching. This is needed to prevent -dependency loops and make recursive definitions involving latching -possible. The stateful signals 'SNS' and 'SNT' are similar, although -it is only the transfer function where it matters that the input -signal cannot affect the current output, only the next one. -} +nodes propagate changes to those they depend on. Transfer functions +('SNT') and latchers ('SNE') work without delay, i.e. the effects of +their input signals can be observed in the same superstep. -} sample :: SignalNode a -> DTime -> IO a sample (SNK x) _ = return x -sample (SNF f) _ = f <$> readIORef timeRef sample (SNS x _) _ = return x -sample (SNT _ x _) _ = return x +sample (SNT s x f) dt = do t <- signalValue s dt + return $! f dt t x sample (SNA sf sx) dt = signalValue sf dt <*> signalValue sx dt -sample (SNE s _ _) dt = signalValue s dt +sample (SNE s e ss) dt = do b <- signalValue e dt + s' <- signalValue ss dt + signalValue (if b then s' else s) dt sample (SNR r) _ = readIORef r sample (SNL1 f s) dt = f <$> signalValue s dt sample (SNL2 f s1 s2) dt = liftM2 f (signalValue s1 dt) (signalValue s2 dt) @@ -307,53 +349,45 @@ sample (SNL4 f s1 s2 s3 s4) dt = liftM4 f (signalValue s1 dt) (signalValue s2 dt) (signalValue s3 dt) (signalValue s4 dt) sample (SNL5 f s1 s2 s3 s4 s5) dt = liftM5 f (signalValue s1 dt) (signalValue s2 dt) (signalValue s3 dt) (signalValue s4 dt) (signalValue s5 dt) -{-| The actual variable that keeps track of global time. -} +{-| Sampling the signal with some kind of delay in order to resolve +dependency loops. Transfer functions simply return their previous +output, while latchers postpone the change and pass through the +current value of their current signal even if the latch control signal +is true at the moment. Other types of signals are always handled by +the `sample` function, so it is not possible to create a stateful loop +composed of solely stateless combinators. -} -{-# NOINLINE timeRef #-} -timeRef :: IORef Time -timeRef = unsafePerformIO (newIORef 0) +sampleDelayed :: SignalNode a -> DTime -> IO a +sampleDelayed (SNT _ x _) _ = return x +sampleDelayed (SNE s _ _) dt = signalValue s dt +sampleDelayed sn dt = sample sn dt -- ** Userland primitives {-| Advancing the whole network that the given signal depends on by -the amount of time given in the second argument. Note that the shared -'time' signal is also advanced, so this function should only be used -for sampling the top level. -} +the amount of time given in the second argument. -} superstep :: Signal a -- ^ the top-level signal -> DTime -- ^ the amount of time to advance - -> IO a -- ^ the value of the signal before the update + -> IO a -- ^ the current value of the signal superstep world dt = do snapshot <- signalValue world dt commit world - t <- readIORef timeRef - let t' = t+dt - writeIORef timeRef $! t' return snapshot -{-| The global time. -} - -{-# NOINLINE time #-} -time :: Signal Time -time = createSignal (SNR timeRef) - -{-| A pure time function. -} - -stateless :: (Time -> a) -- ^ the function to wrap - -> Signal a -stateless = createSignal . SNF - -{-| A pure stateful signal. -} +{-| A pure stateful signal. The initial state is the first output. -} stateful :: a -- ^ initial state -> (DTime -> a -> a) -- ^ state transformation -> Signal a stateful x0 f = createSignal (SNS x0 f) -{-| A stateful transfer function. The current input can only affect -the next output, i.e. there is an implicit delay. -} +{-| A stateful transfer function. The current input affects the +current output, i.e. the initial state given in the first argument is +considered to appear before the first output, and can only be directly +observed by the `sampleDelayed` function. -} -transfer :: a -- ^ initial state +transfer :: a -- ^ initial internal state -> (DTime -> t -> a -> a) -- ^ state updater function -> Signal t -- ^ input signal -> Signal a @@ -377,5 +411,5 @@ -> IO (Signal a, Sink a) -- ^ the signal and an IO function to feed it external x0 = do ref <- newIORef x0 - snr <- newIORef (Cur (SNR ref)) + snr <- newIORef (Ready (SNR ref)) return (S snr,writeIORef ref) diff --git a/elerea.cabal b/elerea.cabal --- a/elerea.cabal +++ b/elerea.cabal @@ -1,5 +1,5 @@ Name: elerea -Version: 0.1.0 +Version: 0.2.0 Cabal-Version: >= 1.2 Synopsis: A minimalistic FRP library Category: reactivity, FRP @@ -13,11 +13,9 @@ . Elerea provides an easy to use applicative interface, supports recursive signals (a definition like @sine = integral 0 (integral 1 - (-sine))@ works without a hitch) and arbitrary external - input. Cycles are allowed by the implicit delay on stateful transfer - functions. For the time being it is not possible to create arbitrary - transfer functions without a delay, but this limitation can be - removed later. + (-sine))@ works without a hitch) and arbitrary external input. Cyclic + dependencies are detected on the fly and resolved by inserting delays + dynamically, unless the user does it explicitly. . This is a minimal library that defines only some basic primitives, and you are advised to install @elerea-examples@ as well to get an @@ -31,6 +29,8 @@ License-File: LICENSE Stability: experimental Build-Type: Simple +Extra-Source-Files: + CHANGES Library Exposed-Modules: