diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,8 @@ +0.4.0 - 0904?? +* 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 diff --git a/FRP/Elerea.hs b/FRP/Elerea.hs --- a/FRP/Elerea.hs +++ b/FRP/Elerea.hs @@ -33,7 +33,7 @@ Time, DTime, Sink, Signal, - superstep, + superstep, keepAlive, (.@.), stateful, transfer, latcher, external, delay, edge, (==@), (/=@), (<@), (<=@), (>=@), (>@), @@ -47,12 +47,10 @@ infixr 3 &&@ infixr 2 ||@ -{-| The `delay` transfer function emits the value of a signal from the -previous superstep, starting with the filler value given in the first -argument. -} +{-| A short alternative name for 'keepAlive'. -} -delay :: a -> Signal a -> Signal a -delay v0 s = snd <$> transfer (v0,v0) (\_ v' (v,_) -> (v',v)) s +(.@.) :: Signal a -> Signal t -> Signal a +(.@.) = keepAlive {-| 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 diff --git a/FRP/Elerea/Graph.hs b/FRP/Elerea/Graph.hs --- a/FRP/Elerea/Graph.hs +++ b/FRP/Elerea/Graph.hs @@ -28,6 +28,7 @@ | App Id Id | Latcher Id Id Id | External + | Delay Id | Lift1 Id | Lift2 Id Id | Lift3 Id Id Id @@ -63,6 +64,12 @@ (ss',st''') <- buildStore st'' ss return (Map.insert p (Latcher s' e' ss') st''') insertSignal st p (SNR _) = return (Map.insert p External st) +insertSignal st p (SND _ s) = do + (s',st') <- buildStore (Map.insert p None st) s + return (Map.insert p (Delay s') st') +insertSignal st p (SNKA (S r) _) = do + Ready s <- readIORef r + insertSignal st p s insertSignal st p (SNL1 _ s1) = do (s1',st') <- buildStore (Map.insert p None st) s1 return (Map.insert p (Lift1 s1') st') @@ -97,6 +104,7 @@ App _ _ -> "app" Latcher _ _ _ -> "latcher" External -> "external" + Delay _ -> "delay" Lift1 _ -> "fun1" Lift2 _ _ -> "fun2" Lift3 _ _ _ -> "fun3" @@ -145,10 +153,12 @@ Latcher _ _ _ -> "99ccff" External -> "ccff99" Stateful -> "ffffcc" + Delay _ -> "ffccff" _ -> "ffffff" nodeShape = case n of Transfer _ -> "diamond" Latcher _ _ _ -> "hexagon" External -> "invtriangle" + Delay _ -> "box" _ -> "ellipse" return $ "digraph G {\n" ++ concat rules ++ "}\n" diff --git a/FRP/Elerea/Internal.hs b/FRP/Elerea/Internal.hs --- a/FRP/Elerea/Internal.hs +++ b/FRP/Elerea/Internal.hs @@ -24,21 +24,25 @@ and mutates all the variables the signal depends on. It is supposed to be called repeatedly in a loop that also takes care of user input. -To ensure consistency, a superstep has two phases: evaluation and -finalisation. During evaluation, each signal affected is sampled at -the current point of time ('sample'), advanced by the desired time -('advance'), and both of these pieces of data are stored in its +To ensure consistency, a superstep has three phases: sampling, aging +and finalisation. Each signal reachable from the top-level signal +passed to 'superstep' is sampled at the current point of time +('sample'), and the sample is stored along with the old signal in its reference. If the value of a signal is requested multiple times, the -sample is simply reused, and no further aging is performed. After -successfully sampling the top-level signal, the finalisation process +sample is simply reused. After successfully sampling the top-level +signal, the network is traversed again to advance by the desired time +('advance'), and when that's completed, the finalisation process throws away the intermediate samples and marks the aged signals as the 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. +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 initiated by the +'signalValue' function (which is used in both the sampling and the +aging phase to calculate samples and retrieve the cached values if +they are requested again), aging is performed by 'age', 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 @@ -82,12 +86,10 @@ -- | @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 + -- | @Sampled x s@ is signal @s@ paired with its current value @x@ + | Sampled a (SignalNode a) + -- | @Aged x s@ is the aged version of signal @s@ paired with its + -- current value @x@ | Aged a (SignalNode a) {-| The possible structures of a node are defined by the 'SignalNode' @@ -111,6 +113,10 @@ | SNE (Signal a) (Signal Bool) (Signal (Signal a)) -- | @SNR r@: opaque reference to connect peripherals | SNR (IORef a) + -- | @SND s@: the @s@ signal delayed by one superstep + | SND a (Signal a) + -- | @SNKA s l@: equivalent to @s@ while aging signal @l@ + | forall t . SNKA (Signal a) (Signal t) -- | @SNL1 f@: @fmap f@ | forall t . SNL1 (t -> a) (Signal t) -- | @SNL2 f@: @liftA2 f@ @@ -252,66 +258,86 @@ createSignal :: SignalNode a -> Signal a 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, -only the current value, so we sample before propagating the changes, -which might require the fresh sample because of recursive -definitions. -} +{-| Sampling the signal and all of its dependencies, at the same time. +We don't need the aged signal in the current superstep, only the +current value, so we sample before propagating the changes, which +might require the fresh sample because of recursive definitions. -} signalValue :: forall a . Signal a -> DTime -> IO a signalValue (S r) dt = do t <- readIORef r case t of - 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 + 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 (Sampled 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 (Sampled v s) + -- Since we are sampling it already, this node + -- will be overwritten by the case above when + -- the loop is closed. + return v + Sampled v _ -> return v + Aged v _ -> return v -{-| Finalising the aged signals for the next round. -} +{-| Aging the network of signals the given signal depends on. -} +age :: forall a . Signal a -> DTime -> IO () +age (S r) dt = do + t <- readIORef r + case t of + Sampled v s -> do s' <- advance s v dt + writeIORef r (Aged v s') + -- TODO: branching can be trivially parallelised + case s' of + SNT s _ _ -> age s dt + SNA sf sx -> age sf dt >> age sx dt + SNE s e ss -> age s dt >> age e dt >> age ss dt + SND _ s -> age s dt + SNKA s l -> age s dt >> age l dt + SNL1 _ s -> age s dt + SNL2 _ s1 s2 -> age s1 dt >> age s2 dt + SNL3 _ s1 s2 s3 -> age s1 dt >> age s2 dt >> age s3 dt + SNL4 _ s1 s2 s3 s4 -> age s1 dt >> age s2 dt >> age s3 dt >> age s4 dt + SNL5 _ s1 s2 s3 s4 s5 -> age s1 dt >> age s2 dt >> age s3 dt >> age s4 dt >> age s5 dt + _ -> return () + Aged _ _ -> return () + _ -> error "Inconsistent state: signal not sampled properly!" + +{-| Finalising aged signals for the next round. -} + commit :: forall a . Signal a -> IO () -commit (S s) = do - t <- readIORef s +commit (S r) = do + t <- readIORef r case t of - 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!" + Aged _ s -> do writeIORef r (Ready s) + -- TODO: branching can be trivially parallelised + case s of + SNT s _ _ -> commit s + SNA sf sx -> commit sf >> commit sx + SNE s e ss -> commit s >> commit e >> commit ss + SND _ s -> commit s + SNKA s l -> commit s >> commit l + 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 + _ -> return () + Ready _ -> return () + _ -> error "Inconsistent state: signal not aged properly!" {-| Aging the signal. Stateful signals have their state forced to prevent building up big thunks, and the latcher also does its job @@ -326,6 +352,8 @@ if b then return (SNE s' e ss) else return sw +advance (SND _ s) _ dt = do x <- signalValue s dt + return (SND x s) advance s _ _ = return s {-| Sampling the signal at the current moment. This is where static @@ -343,6 +371,9 @@ s' <- signalValue ss dt signalValue (if b then s' else s) dt sample (SNR r) _ = readIORef r +sample (SND v _) _ = return v +sample (SNKA s l) dt = do signalValue l dt + signalValue s dt sample (SNL1 f s) dt = f <$> signalValue s dt sample (SNL2 f s1 s2) dt = liftM2 f (signalValue s1 dt) (signalValue s2 dt) sample (SNL3 f s1 s2 s3) dt = liftM3 f (signalValue s1 dt) (signalValue s2 dt) (signalValue s3 dt) @@ -372,6 +403,7 @@ -> IO a -- ^ the current value of the signal superstep world dt = do snapshot <- signalValue world dt + age world dt commit world return snapshot @@ -394,8 +426,8 @@ transfer x0 f s = createSignal (SNT s x0 f) {-| Reactive signal that starts out as @s@ and can change its -behaviour to the one supplied in @ss@ whenever @e@ is true. The change -can be observed immediately, unless the signal is sampled by +behaviour to the one supplied in @ss@ whenever @e@ is true. The +change can be observed immediately, unless the signal is sampled by `sampleDelayed`, which puts a delay on the latch control (but not on the latched signal!). -} @@ -406,7 +438,7 @@ latcher s e ss = createSignal (SNE s e ss) {-| A signal that can be directly fed through the sink function -returned. This can be used to attach the network to the outer +returned. This can be used to attach the network to the outer world. -} external :: a -- ^ initial value @@ -415,3 +447,23 @@ ref <- newIORef x0 snr <- newIORef (Ready (SNR ref)) return (S snr,writeIORef ref) + +{-| 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 has to be a primitive, otherwise it could not be used to +prevent automatic delays. -} + +delay :: a -- ^ initial output + -> Signal a -- ^ the signal to delay + -> Signal a +delay x0 s = createSignal (SND x0 s) + +{-| Dependency injection to allow aging signals whose output is not +necessarily needed to produce the current sample of the first +argument. It is more or less equivalent to @liftA2 const@, the +difference being that it evaluates its second argument first. -} + +keepAlive :: Signal a -- ^ the actual output + -> Signal t -- ^ a signal guaranteed to age when this one is sampled + -> Signal a +keepAlive s l = createSignal (SNKA s l) diff --git a/elerea.cabal b/elerea.cabal --- a/elerea.cabal +++ b/elerea.cabal @@ -1,5 +1,5 @@ Name: elerea -Version: 0.3.0 +Version: 0.4.0 Cabal-Version: >= 1.2 Synopsis: A minimalistic FRP library Category: reactivity, FRP