diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,4 +1,14 @@ -2014-04-07 Ivan Perez +2014-08-29 Ivan Perez + + * Yampa.cabal: version bump (0.9.6) + * src/: Adds a substantial amount of documentation. + * src/FRP/Yampa.hs: Adds a new pause combinator. + +2014-06-04 Ivan Perez + + * Adds project to hudson-backed continuous integration server. + +2014-04-26 Ivan Perez * Yampa.cabal: version bump (0.9.5) * Adds CHANGELOG to cabal file diff --git a/Yampa.cabal b/Yampa.cabal --- a/Yampa.cabal +++ b/Yampa.cabal @@ -1,5 +1,5 @@ name: Yampa -version: 0.9.5 +version: 0.9.6 cabal-version: >= 1.6 license: BSD3 license-file: LICENSE diff --git a/src/FRP/Yampa.hs b/src/FRP/Yampa.hs --- a/src/FRP/Yampa.hs +++ b/src/FRP/Yampa.hs @@ -5,12 +5,57 @@ -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 -- License : BSD-style (see the LICENSE file in the distribution) -- --- Maintainer : nilsson@cs.yale.edu +-- Maintainer : ivan.perez@keera.co.uk -- Stability : provisional -- Portability : non-portable (GHC extensions) +-- -- --- New version using GADTs. +-- Domain-specific language embedded in Haskell for programming hybrid (mixed +-- discrete-time and continuous-time) systems. Yampa is based on the concepts +-- of Functional Reactive Programming (FRP) and is structured using arrow +-- combinators. -- +-- You can find examples, tutorials and documentation on Yampa here: +-- +-- +-- +-- Structuring a hybrid system in Yampa is done based on two main concepts: +-- +-- * Signal Functions: 'SF'. Yampa is based on the concept of Signal Functions, +-- which are functions from a typed input signal to a typed output signal. +-- Conceptually, signals are functions from Time to Value, where time are the +-- real numbers and, computationally, a very dense approximation (Double) is +-- used. +-- +-- * Events: 'Event'. Values that may or may not occur (and would probably +-- occur rarely). It is often used for incoming network messages, mouse +-- clicks, etc. Events are used as values carried by signals. +-- +-- A complete Yampa system is defined as one Signal Function from some +-- type @a@ to a type @b@. The execution of this signal transformer +-- with specific input can be accomplished by means of two functions: +-- 'reactimate' (which needs an initialization action, +-- an input sensing action and an actuation/consumer action and executes +-- until explicitly stopped), and 'react' (which executes only one cycle). +-- +-- Apart from using normal functions and arrow syntax to define 'SF's, you +-- can also use several combinators. See [<#g:4>] for basic signals combinators, +-- [<#g:11>] for ways of switching from one signal transformation to another, +-- and [<#g:16>] for ways of transforming Event-carrying signals into continuous +-- signals, [<#g:19>] for ways of delaying signals, and [<#g:21>] for ways to +-- feed a signal back to the same signal transformer. +-- +-- Ways to define Event-carrying signals are given in [<#g:7>], and +-- "FRP.Yampa.Event" defines events and event-manipulation functions. +-- +-- Finally, see [<#g:26>] for sources of randomness (useful in games). +-- +-- CHANGELOG: +-- +-- * Adds (most) documentation. +-- +-- * New version using GADTs. +-- -- ToDo: -- -- * Specialize def. of repeatedly. Could have an impact on invaders. @@ -102,13 +147,9 @@ RandomGen(..), Random(..), --- Reverse function composition and arrow plumbing aids - ( # ), -- :: (a -> b) -> (b -> c) -> (a -> c), infixl 9 - dup, -- :: a -> (a,a) - swap, -- :: (a,b) -> (b,a) - --- Main types + -- * Basic definitions Time, -- [s] Both for time w.r.t. some reference and intervals. + DTime, -- [s] Sampling interval, always > 0. SF, -- Signal Function. Event(..), -- Events; conceptually similar to Maybe (but abstract). @@ -132,8 +173,8 @@ -- (==) :: Event a -> Event a -> Bool -- (<=) :: Event a -> Event a -> Bool --- For optimization - arrPrim, arrEPrim, + -- ** Lifting + arrPrim, arrEPrim, -- For optimization -- * Signal functions @@ -248,9 +289,6 @@ trackAndHold, -- :: a -> SF (Maybe a) a -- ** Accumulators - old_accum, -- :: a -> SF (Event (a -> a)) (Event a) - old_accumBy, -- :: (b -> a -> b) -> b -> SF (Event a) (Event b) - old_accumFilter, -- :: (c -> a -> (c, Maybe b)) -> c accum, -- :: a -> SF (Event (a -> a)) (Event a) accumHold, -- :: a -> SF (Event (a -> a)) a dAccumHold, -- :: a -> SF (Event (a -> a)) a @@ -259,16 +297,22 @@ dAccumHoldBy, -- :: (b -> a -> b) -> b -> SF (Event a) b accumFilter, -- :: (c -> a -> (c, Maybe b)) -> c -- -> SF (Event a) (Event b) + old_accum, -- :: a -> SF (Event (a -> a)) (Event a) + old_accumBy, -- :: (b -> a -> b) -> b -> SF (Event a) (Event b) + old_accumFilter, -- :: (c -> a -> (c, Maybe b)) -> c -- * Delays -- ** Basic delays - old_pre, old_iPre, pre, -- :: SF a a iPre, -- :: a -> SF a a + old_pre, old_iPre, -- ** Timed delays delay, -- :: Time -> a -> SF a a +-- ** Variable delay + pause, -- :: b -> SF a b -> SF a Bool -> SF a b + -- * State keeping combinators -- ** Loops with guaranteed well-defined feedback @@ -281,6 +325,9 @@ derivative, -- :: VectorSpace a s => SF a a -- Crude! imIntegral, -- :: VectorSpace a s => a -> SF a a + -- Temporarily hidden, but will eventually be made public. + -- iterFrom, -- :: (a -> a -> DTime -> b -> b) -> b -> SF a b + -- * Noise (random signal) sources and stochastic event sources noise, -- :: noise :: (RandomGen g, Random b) => -- g -> SF a b @@ -307,13 +354,19 @@ -- * Embedding -- (tentative: will be revisited) - DTime, -- [s] Sampling interval, always > 0. embed, -- :: SF a b -> (a, [(DTime, Maybe a)]) -> [b] embedSynch, -- :: SF a b -> (a, [(DTime, Maybe a)]) -> SF Double b deltaEncode, -- :: Eq a => DTime -> [a] -> (a, [(DTime, Maybe a)]) - deltaEncodeBy -- :: (a -> a -> Bool) -> DTime -> [a] + deltaEncodeBy, -- :: (a -> a -> Bool) -> DTime -> [a] -- -> (a, [(DTime, Maybe a)]) + -- * Auxiliary definitions + -- Reverse function composition and arrow plumbing aids + ( # ), -- :: (a -> b) -> (b -> c) -> (a -> c), infixl 9 + dup, -- :: a -> (a,a) + swap, -- :: (a,b) -> (b,a) + + ) where import Control.Monad (unless) @@ -351,13 +404,15 @@ -- switch would need to remember the record, since it is the only place -- where signal functions get started. So it wouldn't cost all that much. + -- | Time is used both for time intervals (duration), and time w.r.t. some --- agreed reference point in time. Conceptually, Time = R, i.e. time can be 0 --- or even negative. +-- agreed reference point in time. + +-- Conceptually, Time = R, i.e. time can be 0 -- or even negative. type Time = Double -- [s] --- DTime is the time type for lengths of sample intervals. Conceptually, +-- | DTime is the time type for lengths of sample intervals. Conceptually, -- DTime = R+ = { x in R | x > 0 }. Don't assume Time and DTime have the -- same representation. type DTime = Double -- [s] @@ -480,7 +535,6 @@ sfNever :: SF' a (Event b) sfNever = sfConst NoEvent - -- Assumption: fne = f NoEvent sfArrE :: (Event a -> b) -> b -> SF' (Event a) b sfArrE f fne = sf @@ -680,13 +734,15 @@ -- Lifting. + +-- | Lifts a pure function into a signal function (applied pointwise). {-# NOINLINE arrPrim #-} arrPrim :: (a -> b) -> SF a b arrPrim f = SF {sfTF = \a -> (sfArrG f, f a)} - +-- | Lifts a pure function into a signal function applied to events +-- (applied pointwise). {-# RULES "arrPrim/arrEPrim" arrPrim = arrEPrim #-} - arrEPrim :: (Event a -> b) -> SF (Event a) b arrEPrim f = SF {sfTF = \a -> (sfArrE f (f NoEvent), f a)} @@ -1679,52 +1735,68 @@ -- Basic signal functions ------------------------------------------------------------------------------ --- Identity: identity = arr id +-- | Identity: identity = arr id +-- +-- Using 'identity' is preferred over lifting id, since the arrow combinators +-- know how to optimise certain networks based on the transformations being +-- applied. identity :: SF a a identity = SF {sfTF = \a -> (sfId, a)} - --- Identity: constant b = arr (const b) +-- | Identity: constant b = arr (const b) +-- +-- Using 'constant' is preferred over lifting const, since the arrow combinators +-- know how to optimise certain networks based on the transformations being +-- applied. constant :: b -> SF a b constant b = SF {sfTF = \_ -> (sfConst b, b)} - --- Outputs the time passed since the signal function instance was started. +-- | Outputs the time passed since the signal function instance was started. localTime :: SF a Time localTime = constant 1.0 >>> integral - --- Alternative name for localTime. +-- | Alternative name for localTime. time :: SF a Time time = localTime - ------------------------------------------------------------------------------ -- Initialization ------------------------------------------------------------------------------ --- Initialization operator (cf. Lustre/Lucid Synchrone). +-- | Initialization operator (cf. Lustre/Lucid Synchrone). +-- +-- The output at time zero is the first argument, and from +-- that point on it behaves like the signal function passed as +-- second argument. (-->) :: b -> SF a b -> SF a b b0 --> (SF {sfTF = tf10}) = SF {sfTF = \a0 -> (fst (tf10 a0), b0)} - --- Input initialization operator. +-- | Input initialization operator. +-- +-- The input at time zero is the first argument, and from +-- that point on it behaves like the signal function passed as +-- second argument. (>--) :: a -> SF a b -> SF a b a0 >-- (SF {sfTF = tf10}) = SF {sfTF = \_ -> tf10 a0} --- Transform initial output value. +-- | Transform initial output value. +-- +-- Applies a transformation 'f' only to the first output value at +-- time zero. (-=>) :: (b -> b) -> SF a b -> SF a b f -=> (SF {sfTF = tf10}) = SF {sfTF = \a0 -> let (sf1, b0) = tf10 a0 in (sf1, f b0)} --- Transform initial input value. +-- | Transform initial input value. +-- +-- Applies a transformation 'f' only to the first input value at +-- time zero. (>=-) :: (a -> a) -> SF a b -> SF a b f >=- (SF {sfTF = tf10}) = SF {sfTF = \a0 -> tf10 (f a0)} - --- Override initial value of input signal. +-- | Override initial value of input signal. initially :: a -> SF a a initially = (--> identity) @@ -1838,11 +1910,17 @@ t' = t + dt -} --- Or keep old def. for efficiency reasons? +-- | Event source with consecutive occurrences at the given intervals. +-- Should more than one event be scheduled to occur in any sampling interval, +-- only the first will in fact occur to avoid an event backlog. + -- After all, after, repeatedly etc. are defined in terms of afterEach. afterEach :: [(Time,b)] -> SF a (Event b) afterEach qxs = afterEachCat qxs >>> arr (fmap head) +-- | Event source with consecutive occurrences at the given intervals. +-- Should more than one event be scheduled to occur in any sampling interval, +-- the output list will contain all events produced during that interval. -- Guaranteed not to miss any events. afterEachCat :: [(Time,b)] -> SF a (Event [b]) @@ -1870,7 +1948,8 @@ where t' = t + dt --- Delay for events. (Consider it a triggered after, hence "basic".) +-- | Delay for events. (Consider it a triggered after, hence /basic/.) + -- Can be implemented fairly cheaply as long as the events are sparse. -- It is a question of rescheduling events for later. Not unlike "afterEach". -- @@ -1946,7 +2025,8 @@ (x' : rxs) -} --- This version is not strict in the input event. +-- | Delay an event by a given delta and catenate events that occur so closely +-- so as to be /inseparable/. delayEventCat :: Time -> SF (Event a) (Event [a]) delayEventCat q | q < 0 = usrErr "AFRP" "delayEventCat" "Negative delay." | q == 0 = arr (fmap (:[])) @@ -2029,7 +2109,9 @@ edge :: SF Bool (Event ()) edge = iEdge True - +-- | A rising edge detector that can be initialized as up ('True', meaning +-- that events occurring at time 0 will not be detected) or down +-- ('False', meaning that events ocurring at time 0 will be detected). iEdge :: Bool -> SF Bool (Event ()) -- iEdge i = edgeBy (isBoolRaisingEdge ()) i iEdge b = sscanPrim f (if b then 2 else 0) NoEvent @@ -2043,7 +2125,7 @@ f 2 True = Nothing f _ _ = undefined --- Like edge, but parameterized on the tag value. +-- | Like 'edge', but parameterized on the tag value. edgeTag :: a -> SF Bool (Event a) -- edgeTag a = edgeBy (isBoolRaisingEdge a) True edgeTag a = edge >>> arr (`tag` a) @@ -2057,6 +2139,9 @@ -- isBoolRaisingEdge _ True False = Nothing +-- | Edge detector particularized for detecting transtitions +-- on a 'Maybe' signal from 'Nothing' to 'Just'. + -- !!! 2005-07-09: To be done or eliminated -- !!! Maybe could be kept as is, but could be easy to implement directly -- !!! in terms of sscan? @@ -2069,7 +2154,7 @@ isJustEdge (Just _) Nothing = Nothing --- Edge detector parameterized on the edge detection function and initial +-- | Edge detector parameterized on the edge detection function and initial -- state, i.e., the previous input sample. The first argument to the -- edge detection function is the previous sample, the second the current one. @@ -2090,17 +2175,17 @@ -- Stateful event suppression ------------------------------------------------------------------------------ --- Suppression of initial (at local time 0) event. +-- | Suppression of initial (at local time 0) event. notYet :: SF (Event a) (Event a) notYet = initially NoEvent --- Suppress all but first event. +-- | Suppress all but the first event. once :: SF (Event a) (Event a) once = takeEvents 1 --- Suppress all but first n events. +-- | Suppress all but the first n events. takeEvents :: Int -> SF (Event a) (Event a) takeEvents n | n <= 0 = never takeEvents n = dSwitch (arr dup) (const (NoEvent >-- takeEvents (n - 1))) @@ -2117,7 +2202,8 @@ -} --- Suppress first n events. +-- | Suppress first n events. + -- Here dSwitch or switch does not really matter. dropEvents :: Int -> SF (Event a) (Event a) dropEvents n | n <= 0 = identity @@ -2179,7 +2265,26 @@ (_, Event c) -> sfTF (k c) a -} --- Basic switch. +-- | Basic switch. +-- +-- By default, the first signal function is applied. +-- +-- Whenever the second value in the pair actually is an event, +-- the value carried by the event is used to obtain a new signal +-- function to be applied *at that time and at future times*. +-- +-- Until that happens, the first value in the pair is produced +-- in the output signal. +-- +-- Important note: at the time of switching, the second +-- signal function is applied immediately. If that second +-- SF can also switch at time zero, then a double (nested) +-- switch might take place. If the second SF refers to the +-- first one, the switch might take place infinitely many +-- times and never be resolved. +-- +-- Remember: The continuation is evaluated strictly at the time +-- of switching! switch :: SF a (b, Event c) -> (c -> SF a b) -> SF a b switch (SF {sfTF = tf10}) k = SF {sfTF = tf0} where @@ -2234,8 +2339,31 @@ (_, Event c) -> sfTF (k c) a --- Switch with delayed observation. --- Or "decoupled switch"? +-- | Switch with delayed observation. +-- +-- By default, the first signal function is applied. +-- +-- Whenever the second value in the pair actually is an event, +-- the value carried by the event is used to obtain a new signal +-- function to be applied *at future times*. +-- +-- Until that happens, the first value in the pair is produced +-- in the output signal. +-- +-- Important note: at the time of switching, the second +-- signal function is used immediately, but the current +-- input is fed by it (even though the actual output signal +-- value at time 0 is discarded). +-- +-- If that second SF can also switch at time zero, then a +-- double (nested) -- switch might take place. If the second SF refers to the +-- first one, the switch might take place infinitely many times and never be +-- resolved. +-- +-- Remember: The continuation is evaluated strictly at the time +-- of switching! + +-- Alternative name: "decoupled switch"? -- (The SFId optimization is highly unlikley to be of much use, but it -- does raise an interesting typing issue.) dSwitch :: SF a (b, Event c) -> (c -> SF a b) -> SF a b @@ -2302,7 +2430,11 @@ b) --- Recurring switch. +-- | Recurring switch. +-- +-- See for more +-- information on how this switch works. + -- !!! Suboptimal. Overall, the constructor is invarying since rSwitch is -- !!! being invoked recursively on a switch. In fact, we don't even care -- !!! whether the subordinate signal function is invarying or not. @@ -2322,7 +2454,10 @@ -} --- Recurring switch with delayed observation. +-- | Recurring switch with delayed observation. +-- +-- See for more +-- information on how this switch works. drSwitch :: SF a b -> SF (a, Event (SF a b)) b drSwitch sf = dSwitch (first sf) ((noEventSnd >=-) . drSwitch) @@ -2335,7 +2470,11 @@ -} --- "Call-with-current-continuation" switch. +-- | "Call-with-current-continuation" switch. +-- +-- See for more +-- information on how this switch works. + -- !!! Has not been optimized properly. -- !!! Nor has opts been tested! -- !!! Don't forget Inv opts! @@ -2450,7 +2589,11 @@ Event c -> sfTF (k (arr f1) c) a --- kSwitch with delayed observation. +-- | 'kSwitch' with delayed observation. +-- +-- See for more +-- information on how this switch works. + -- !!! Has not been optimized properly. Should be like kSwitch. dkSwitch :: SF a b -> SF (a,b) (Event c) -> (SF a b -> c -> SF a b) -> SF a b dkSwitch sf10@(SF {sfTF = tf10}) (SF {sfTF = tfe0}) k = SF {sfTF = tf0} @@ -2477,6 +2620,8 @@ -- Parallel composition and switching over collections with broadcasting ------------------------------------------------------------------------------ +-- | Tuple a value up with every element of a collection of signal +-- functions. broadcast :: Functor col => a -> col sf -> col (a, sf) broadcast a sfs = fmap (\sf -> (a, sf)) sfs @@ -2506,30 +2651,45 @@ -- !!! = arr1 &&& (arr23CcpXcpX) >>> arrX -- !!! = arr123CcpXcpXcpX --- Spatial parallel composition of a signal function collection. +-- | Spatial parallel composition of a signal function collection. +-- Given a collection of signal functions, it returns a signal +-- function that 'broadcast's its input signal to every element +-- of the collection, to return a signal carrying a collection +-- of outputs. See 'par'. +-- +-- For more information on how parallel composition works, check +-- parB :: Functor col => col (SF a b) -> SF a (col b) parB = par broadcast - --- Parallel switch (dynamic collection of signal functions spatially composed --- in parallel). +-- | Parallel switch (dynamic collection of signal functions spatially composed +-- in parallel). See 'pSwitch'. +-- +-- For more information on how parallel composition works, check +-- pSwitchB :: Functor col => col (SF a b) -> SF (a,col b) (Event c) -> (col (SF a b)->c-> SF a (col b)) -> SF a (col b) pSwitchB = pSwitch broadcast - +-- | Delayed parallel switch with broadcasting (dynamic collection of +-- signal functions spatially composed in parallel). See 'dpSwitch'. +-- +-- For more information on how parallel composition works, check +-- dpSwitchB :: Functor col => col (SF a b) -> SF (a,col b) (Event c) -> (col (SF a b)->c->SF a (col b)) -> SF a (col b) dpSwitchB = dpSwitch broadcast - +-- For more information on how parallel composition works, check +-- rpSwitchB :: Functor col => col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b) rpSwitchB = rpSwitch broadcast - +-- For more information on how parallel composition works, check +-- drpSwitchB :: Functor col => col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b) drpSwitchB = drpSwitch broadcast @@ -2539,17 +2699,15 @@ -- Parallel composition and switching over collections with general routing ------------------------------------------------------------------------------ --- Spatial parallel composition of a signal function collection parameterized +-- | Spatial parallel composition of a signal function collection parameterized -- on the routing function. --- rf ......... Routing function: determines the input to each signal function --- in the collection. IMPORTANT! The routing function MUST --- preserve the structure of the signal function collection. --- sfs0 ....... Signal function collection. --- Returns the spatial parallel composition of the supplied signal functions. - +-- par :: Functor col => - (forall sf . (a -> col sf -> col (b, sf))) - -> col (SF b c) + (forall sf . (a -> col sf -> col (b, sf))) -- ^ Determines the input to each signal function + -- in the collection. IMPORTANT! The routing function MUST + -- preserve the structure of the signal function collection. + + -> col (SF b c) -- ^ Signal function collection. -> SF a (col c) par rf sfs0 = SF {sfTF = tf0} where @@ -2578,13 +2736,15 @@ (parAux rf sfs', cs) --- Parallel switch parameterized on the routing function. This is the most +-- | Parallel switch parameterized on the routing function. This is the most -- general switch from which all other (non-delayed) switches in principle -- can be derived. The signal function collection is spatially composed in -- parallel and run until the event signal function has an occurrence. Once -- the switching event occurs, all signal function are "frozen" and their -- continuations are passed to the continuation function, along with the -- event value. +-- + -- rf ......... Routing function: determines the input to each signal function -- in the collection. IMPORTANT! The routing function has an -- obligation to preserve the structure of the signal function @@ -2595,12 +2755,15 @@ -- Returns the resulting signal function. -- -- !!! Could be optimized on the event source being SFArr, SFArrE, SFArrEE --- -pSwitch :: Functor col => - (forall sf . (a -> col sf -> col (b, sf))) - -> col (SF b c) - -> SF (a, col c) (Event d) - -> (col (SF b c) -> d -> SF a (col c)) +pSwitch :: Functor col + => (forall sf . (a -> col sf -> col (b, sf))) -- ^ Routing function: determines the input to each signal function + -- in the collection. IMPORTANT! The routing function has an + -- obligation to preserve the structure of the signal function + -- collection. + + -> col (SF b c) -- ^ Signal function collection. + -> SF (a, col c) (Event d) -- ^ Signal function generating the switching event. + -> (col (SF b c) -> d -> SF a (col c)) -- ^ Continuation to be invoked once event occurs. -> SF a (col c) pSwitch rf sfs0 sfe0 k = SF {sfTF = tf0} where @@ -2628,16 +2791,36 @@ (_, Event d) -> sfTF (k (freezeCol sfs dt) d) a --- Parallel switch with delayed observation parameterized on the routing +-- | Parallel switch with delayed observation parameterized on the routing -- function. -- +-- The collection argument to the function invoked on the +-- switching event is of particular interest: it captures the +-- continuations of the signal functions running in the collection +-- maintained by 'dpSwitch' at the time of the switching event, +-- thus making it possible to preserve their state across a switch. +-- Since the continuations are plain, ordinary signal functions, +-- they can be resumed, discarded, stored, or combined with +-- other signal functions. + -- !!! Could be optimized on the event source being SFArr, SFArrE, SFArrEE. -- dpSwitch :: Functor col => - (forall sf . (a -> col sf -> col (b, sf))) - -> col (SF b c) - -> SF (a, col c) (Event d) - -> (col (SF b c) -> d -> SF a (col c)) + (forall sf . (a -> col sf -> col (b, sf))) -- ^ Routing function. Its purpose is + -- to pair up each running signal function in the collection + -- maintained by 'dpSwitch' with the input it is going to see + -- at each point in time. All the routing function can do is specify + -- how the input is distributed. + -> col (SF b c) -- ^ Initial collection of signal functions. + -> SF (a, col c) (Event d) -- ^ Signal function that observes the external + -- input signal and the output signals from the collection in order + -- to produce a switching event. + -> (col (SF b c) -> d -> SF a (col c)) -- ^ The fourth argument is a function that is invoked when the + -- switching event occurs, yielding a new signal function to switch + -- into based on the collection of signal functions previously + -- running and the value carried by the switching event. This + -- allows the collection to be updated and then switched back + -- in, typically by employing 'dpSwitch' again. -> SF a (col c) dpSwitch rf sfs0 sfe0 k = SF {sfTF = tf0} where @@ -2707,18 +2890,19 @@ drpSwitch' sfs = dpSwitch (rf . fst) sfs (NoEvent-->arr (snd . fst)) k -} - ------------------------------------------------------------------------------ -- Wave-form generation ------------------------------------------------------------------------------ --- Zero-order hold. +-- | Zero-order hold. + -- !!! Should be redone using SFSScan? -- !!! Otherwise, we are missing an invarying case. old_hold :: a -> SF (Event a) a old_hold a_init = switch (constant a_init &&& identity) ((NoEvent >--) . old_hold) +-- | Zero-order hold. hold :: a -> SF (Event a) a hold a_init = epPrim f () a_init where @@ -2740,7 +2924,9 @@ -- !!! and ep + sscan = sscan, then things might work, and -- !!! it might be possible to define dHold simply as hold >>> iPre -- !!! without any performance penalty. --- Zero-order hold with delay. + +-- | Zero-order hold with delay. +-- -- Identity: dHold a0 = hold a0 >>> iPre a0). dHold :: a -> SF (Event a) a dHold a0 = hold a0 >>> iPre a0 @@ -2751,7 +2937,8 @@ f a' a = (a, a', a) -} --- Tracks input signal when available, holds last value when disappears. +-- | Tracks input signal when available, holds last value when disappears. +-- -- !!! DANGER!!! Event used inside arr! Probably OK because arr will not be -- !!! optimized to arrE. But still. Maybe rewrite this using, say, scan? -- !!! or switch? Switching (in hold) for every input sample does not @@ -2764,24 +2951,37 @@ -- Accumulators ------------------------------------------------------------------------------ +-- | See 'accum'. old_accum :: a -> SF (Event (a -> a)) (Event a) old_accum = accumBy (flip ($)) +-- | Given an initial value in an accumulator, +-- it returns a signal function that processes +-- an event carrying transformation functions. +-- Every time an 'Event' is received, the function +-- inside it is applied to the accumulator, +-- whose new value is outputted in an 'Event'. +-- accum :: a -> SF (Event (a -> a)) (Event a) accum a_init = epPrim f a_init NoEvent where - f a g = (a', Event a', NoEvent) + f a g = (a', Event a', NoEvent) -- Accumulator, output if Event, output if no event where a' = g a +-- | Zero-order hold accumulator (always produces the last outputted value +-- until an event arrives). accumHold :: a -> SF (Event (a -> a)) a accumHold a_init = epPrim f a_init a_init where - f a g = (a', a', a') + f a g = (a', a', a') -- Accumulator, output if Event, output if no event where a' = g a +-- | Zero-order hold accumulator with delayed initialization (always produces +-- the last outputted value until an event arrives, but the very initial output +-- is always the given accumulator). dAccumHold :: a -> SF (Event (a -> a)) a dAccumHold a_init = accumHold a_init >>> iPre a_init {- @@ -2797,11 +2997,13 @@ -} +-- | See 'accumBy'. old_accumBy :: (b -> a -> b) -> b -> SF (Event a) (Event b) old_accumBy f b_init = switch (never &&& identity) $ \a -> abAux (f b_init a) where abAux b = switch (now b &&& notYet) $ \a -> abAux (f b a) +-- | Accumulator parameterized by the accumulation function. accumBy :: (b -> a -> b) -> b -> SF (Event a) (Event b) accumBy g b_init = epPrim f b_init NoEvent where @@ -2809,6 +3011,7 @@ where b' = g b a +-- | Zero-order hold accumulator parameterized by the accumulation function. accumHoldBy :: (b -> a -> b) -> b -> SF (Event a) b accumHoldBy g b_init = epPrim f b_init b_init where @@ -2820,6 +3023,9 @@ -- !!! on the input at every time step. -- !!! Add a test case to check for this! +-- | Zero-order hold accumulator parameterized by the accumulation function +-- with delayed initialization (initial output sample is always the +-- given accumulator). dAccumHoldBy :: (b -> a -> b) -> b -> SF (Event a) b dAccumHoldBy f a_init = accumHoldBy f a_init >>> iPre a_init {- @@ -2879,13 +3085,17 @@ (c', Just b) -> (afAux c', Event b) -} - +-- | See 'accumFilter'. old_accumFilter :: (c -> a -> (c, Maybe b)) -> c -> SF (Event a) (Event b) old_accumFilter f c_init = switch (never &&& identity) $ \a -> afAux (f c_init a) where afAux (c, Nothing) = switch (never &&& notYet) $ \a -> afAux (f c a) afAux (c, Just b) = switch (now b &&& notYet) $ \a -> afAux (f c a) +-- | Accumulator parameterized by the accumulator function with filtering, +-- possibly discarding some of the input events based on whether the second +-- component of the result of applying the accumulation function is +-- 'Nothing' or 'Just' x for some x. accumFilter :: (c -> a -> (c, Maybe b)) -> c -> SF (Event a) (Event b) accumFilter g c_init = epPrim f c_init NoEvent where @@ -2898,7 +3108,8 @@ -- Delays ------------------------------------------------------------------------------ --- Uninitialized delay operator. +-- | Uninitialized delay operator (old implementation). + -- !!! The seq helps in the dynamic delay line example. But is it a good -- !!! idea in general? Are there other accumulators which should be seq'ed -- !!! as well? E.g. accum? Switch? Anywhere else? What's the underlying @@ -2913,12 +3124,14 @@ where tf _ a = {- a_prev `seq` -} (preAux a, a_prev) --- Initialized delay operator. +-- | Initialized delay operator (old implementation). old_iPre :: a -> SF a a old_iPre = (--> old_pre) +-- | Uninitialized delay operator. + -- !!! Redefined using SFSScan -- !!! About 20% slower than old_pre on its own. pre :: SF a a @@ -2928,7 +3141,7 @@ uninit = usrErr "AFRP" "pre" "Uninitialized pre operator." --- Initialized delay operator. +-- | Initialized delay operator. iPre :: a -> SF a a iPre = (--> pre) @@ -2937,6 +3150,8 @@ -- Timed delays ------------------------------------------------------------------------------ +-- | Delay a signal by a fixed time 't', using the second parameter +-- to fill in the initial 't' seconds. -- Invariants: -- t_diff measure the time since the latest output sample ideally @@ -2986,10 +3201,55 @@ ------------------------------------------------------------------------------ +-- Variable pause in signal +------------------------------------------------------------------------------ + +-- | Given a value in an accumulator (b), a predicate signal function (sfC), +-- and a second signal function (sf), pause will produce the accumulator b +-- if sfC input is True, and will transform the signal using sf otherwise. +-- It acts as a pause with an accumulator for the moments when the +-- transformation is paused. +pause :: b -> SF a Bool -> SF a b -> SF a b +pause b_init (SF { sfTF = tfP}) (SF {sfTF = tf10}) = SF {sfTF = tf0} + where + -- Initial transformation (no time delta): + -- If the condition is True, return the accumulator b_init) + -- Otherwise transform the input normally and recurse. + tf0 a0 = case tfP a0 of + (c, True) -> (pauseInit b_init tf10 c, b_init) + (c, False) -> let (k, b0) = tf10 a0 + in (pause' b0 k c, b0) + + -- Similar deal, but with a time delta + pauseInit :: b -> (a -> Transition a b) -> SF' a Bool -> SF' a b + pauseInit b_init' tf10' c = SF' tf0' + where tf0' dt a = + case (sfTF' c) dt a of + (c', True) -> (pauseInit b_init' tf10' c', b_init') + (c', False) -> let (k, b0) = tf10' a + in (pause' b0 k c', b0) + + -- Very same deal (almost alpha-renameable) + pause' :: b -> SF' a b -> SF' a Bool -> SF' a b + pause' b_init' tf10' tfP' = SF' tf0' + where tf0' dt a = + case (sfTF' tfP') dt a of + (tfP'', True) -> (pause' b_init' tf10' tfP'', b_init') + (tfP'', False) -> let (tf10'', b0') = (sfTF' tf10') dt a + in (pause' b0' tf10'' tfP'', b0') + +-- if_then_else :: SF a Bool -> SF a b -> SF a b -> SF a b +-- if_then_else condSF sfThen sfElse = proc (i) -> do +-- cond <- condSF -< i +-- ok <- sfThen -< i +-- notOk <- sfElse -< i +-- returnA -< if cond then ok else notOk + +------------------------------------------------------------------------------ -- Integration and differentiation ------------------------------------------------------------------------------ --- Integration using the rectangle rule. +-- | Integration using the rectangle rule. {-# INLINE integral #-} integral :: VectorSpace a s => SF a a integral = SF {sfTF = tf0} @@ -3014,8 +3274,9 @@ -- iterAux b a = (SF' (\ dt a' -> iterAux (f a a' dt b) a') True, b) iterAux b a = (SF' (\ dt a' -> iterAux (f a a' dt b) a'), b) - --- This is extremely crude. Use at your own risk. +-- | A very crude version of a derivative. It simply divides the +-- value difference by the time difference. As such, it is very +-- crude. Use at your own risk. derivative :: VectorSpace a s => SF a a derivative = SF {sfTF = tf0} where @@ -3030,11 +3291,13 @@ -- Loops with guaranteed well-defined feedback ------------------------------------------------------------------------------ +-- | Loop with an initial value for the signal being fed back. loopPre :: c -> SF (a,c) (b,c) -> SF a b loopPre c_init sf = loop (second (iPre c_init) >>> sf) - - +-- | Loop by integrating the second value in the pair and feeding the +-- result back. Because the integral at time 0 is zero, this is always +-- well defined. loopIntegral :: VectorSpace c s => SF (a,c) (b,c) -> SF a b loopIntegral sf = loop (second integral >>> sf) @@ -3043,13 +3306,13 @@ -- Noise (i.e. random signal generators) and stochastic processes ------------------------------------------------------------------------------ --- Noise (random signal) with default range for type in question; +-- | Noise (random signal) with default range for type in question; -- based on "randoms". noise :: (RandomGen g, Random b) => g -> SF a b noise g0 = streamToSF (randoms g0) --- Noise (random signal) with specified range; based on "randomRs". +-- | Noise (random signal) with specified range; based on "randomRs". noiseR :: (RandomGen g, Random b) => (b,b) -> g -> SF a b noiseR range g0 = streamToSF (randomRs range g0) @@ -3081,11 +3344,12 @@ -} --- Stochastic event source with events occurring on average once every t_avg +-- | Stochastic event source with events occurring on average once every t_avg -- seconds. However, no more than one event results from any one sampling -- interval in the case of relatively sparse sampling, thus avoiding an -- "event backlog" should sampling become more frequent at some later -- point in time. + -- !!! Maybe it would better to give a frequency? But like this to make -- !!! consitent with "repeatedly". occasionally :: RandomGen g => g -> Time -> b -> SF a (Event b) @@ -3198,9 +3462,10 @@ rsB :: b } +-- | A reference to reactimate's state, maintained across samples. type ReactHandle a b = IORef (ReactState a b) --- initialize top-level reaction handle +-- | Initialize a top-level reaction handle. reactInit :: IO a -- init -> (ReactHandle a b -> Bool -> b -> IO Bool) -- actuate -> SF a b @@ -3214,7 +3479,7 @@ _ <- actuate r True b0 return r --- process a single input sample: +-- | Process a single input sample. react :: ReactHandle a b -> (DTime,Maybe a) -> IO Bool @@ -3233,7 +3498,7 @@ -- New embed interface. We will probably have to revisit this. To run an -- embedded signal function while retaining full control (e.g. start and --- stop at will), one would probably need a continuation based interface +-- stop at will), one would probably need a continuation-based interface -- (as well as a continuation based underlying implementation). -- -- E.g. here are interesting alternative (or maybe complementary) @@ -3255,6 +3520,12 @@ -- subSample :: DTime -> SF a b -> SF (Event a) (Event b) -- Time advanced by dt for each event, not synchronized with the outer clock. +-- | Given a signal function and a pair with an initial +-- input sample for the input signal, and a list of sampling +-- times, possibly with new input samples at those times, +-- it produces a list of output samples. +-- +-- This is a simplified, purely-functional version of 'reactimate'. embed :: SF a b -> (a, [(DTime, Maybe a)]) -> [b] embed sf0 (a0, dtas) = b0 : loop a0 sf dtas where @@ -3268,10 +3539,10 @@ (sf', b) = (sfTF' sf) dt a --- Synchronous embedding. The embedded signal function is run on the supplied +-- | Synchronous embedding. The embedded signal function is run on the supplied -- input and time stream at a given (but variable) ratio >= 0 to the outer -- time flow. When the ratio is 0, the embedded signal function is paused. --- + -- What about running an embedded signal function at a fixed (guaranteed) -- sampling frequency? E.g. super sampling if the outer sampling is slower, -- subsampling otherwise. AS WELL as at a given ratio to the outer one. @@ -3314,11 +3585,15 @@ | t' <= tp = advance tp tbtbs advance _ _ = undefined +-- | Spaces a list of samples by a fixed time delta, avoiding +-- unnecessary samples when the input has not changed since +-- the last sample. deltaEncode :: Eq a => DTime -> [a] -> (a, [(DTime, Maybe a)]) deltaEncode _ [] = usrErr "AFRP" "deltaEncode" "Empty input list." deltaEncode dt aas@(_:_) = deltaEncodeBy (==) dt aas +-- | 'deltaEncode' parameterized by the equality test. deltaEncodeBy :: (a -> a -> Bool) -> DTime -> [a] -> (a, [(DTime, Maybe a)]) deltaEncodeBy _ _ [] = usrErr "AFRP" "deltaEncodeBy" "Empty input list." deltaEncodeBy eq dt (a0:as) = (a0, zip (repeat dt) (debAux a0 as)) diff --git a/src/FRP/Yampa/Event.hs b/src/FRP/Yampa/Event.hs --- a/src/FRP/Yampa/Event.hs +++ b/src/FRP/Yampa/Event.hs @@ -256,17 +256,17 @@ mapMerge _ rf _ NoEvent (Event r) = Event (rf r) mapMerge _ _ lrf (Event l) (Event r) = Event (lrf l r) --- Merging of a list of events; foremost event has priority. +-- | Merge a list of events; foremost event has priority. mergeEvents :: [Event a] -> Event a mergeEvents = foldr lMerge NoEvent --- | Collects simultaneous event occurrences; no event if none. +-- | Collect simultaneous event occurrences; no event if none. catEvents :: [Event a] -> Event [a] catEvents eas = case [ a | Event a <- eas ] of [] -> NoEvent as -> Event as --- | Join (conjucntion) of two events. Only produces an event +-- | Join (conjunction) of two events. Only produces an event -- if both events exist. joinE :: Event a -> Event b -> Event (a,b) joinE NoEvent _ = NoEvent