{-# LANGUAGE GeneralizedNewtypeDeriving #-}{-|
This version differs from the simple one in adding associated freeze
control signals (\'clocks\') to stateful entities to be able to pause
entire subnetworks without having to write all the low-level logic
explicitly. The clocks are fixed to signals upon their creation, and
the 'withClock' function can be used to specify the common clock for
the signals created in a given generator.
A clock signal affects 'delay' elements the following way: if the
clock signal is true, the delay works as usual, otherwise it remembers
its current output and throws away its current input. If we consider
signals to be functions of time (natural numbers), the behaviour of
delay can be described by the following function:
@
delay x0 s (t_start,clk) t_sample
| t_start == t_sample = x0
| t_start \< t_sample = if clk t_sample
then s (t_sample-1)
else delay x0 s (t_start (t_sample-1)
| otherwise = error \"stream doesn't exist yet\"
@
A simple example to create counters operating at different rates using
the same generator:
@
divisibleBy n x = x \`mod\` n == 0
@
@
counter = stateful 0 (+1)
@
@
drift = do
time \<- counter
c1 \<- withClock (divisibleBy 2 \<$\> time) counter
c2 \<- withClock (divisibleBy 3 \<$\> time) counter
return ((,) \<$\> c1 \<*\> c2)
@
Note that if you want to slow down the drift system defined above, the
naive approach might lead to surprising results:
@
slowDrift = do
time \<- counter
withClock (divisibleBy 2 \<$\> time) drift
@
The problem is that the clocks are also slowed down, and their spikes
double in length. This may or may not be what you want. To overcome
this problem, we can define a clock oblivious edge detector to be used
within the definition of @drift@:
@
edge = withClock (pure True) . transfer False (\\b b' -> b && not b')
@
@
drift = do
time \<- counter
t2 \<- edge (divisibleBy 2 \<$\> time)
t3 \<- edge (divisibleBy 3 \<$\> time)
c1 \<- withClock t2 counter
c2 \<- withClock t3 counter
return ((,) \<$\> c1 \<*\> c2)
@
This works because the 'withClock' function overrides any clock
imposed on the generator from outside.
-}moduleFRP.Elerea.Clocked(Signal,SignalGen,start,external,externalMulti,delay,generator,memo,until,withClock,stateful,transfer,noise,getRandom,debug)whereimportControl.ApplicativeimportControl.Concurrent.MVarimportControl.MonadimportControl.Monad.FiximportData.IORefimportData.MaybeimportPreludehiding(until)importSystem.Mem.WeakimportSystem.Random.Mersenne-- | 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).newtypeSignala=S(IOa)deriving(Functor,Applicative,Monad)-- | A dynamic set of actions to update a network without breaking-- consistency.typeUpdatePool=[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.newtypeSignalGena=SG{unSG::IORefUpdatePool->SignalBool->IOa}-- | The phases every signal goes through during a superstep.dataPhasea=Readya|UpdatedaainstanceFunctorSignalGenwherefmap=(<*>).pureinstanceApplicativeSignalGenwherepure=return(<*>)=apinstanceMonadSignalGenwherereturn=SG.const.const.returnSGg>>=f=SG$\pc->gpc>>=\x->unSG(fx)pcinstanceMonadFixSignalGenwheremfixf=SG$\pc->mfix(($c).($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(Signala)-- ^ the generator of the top-level signal->IO(IOa)-- ^ the computation to sample the signalstart(SGgen)=dopool<-newIORef[]Ssample<-genpool(pureTrue)return$doletderefptr=(fmap.fmap)((,)ptr)(deRefWeakptr)res<-sample(ptrs,acts)<-unzip.catMaybes<$>(mapMderef=<<readIORefpool)writeIORefpoolptrsmapM_fstactsmapM_sndactsreturnres-- | Auxiliary function used by all the primitives that create a-- mutable variable.addSignal::(a->IOa)-- ^ sampling function->(a->IO())-- ^ aging function->IORef(Phasea)-- ^ the mutable variable behind the signal->IORefUpdatePool-- ^ the pool of update actions->IO(Signala)-- ^ the signal createdaddSignalsampleupdaterefpool=doletupd=readIORefref>>=\v->casevofReadyx->updatex_->return()fin=readIORefref>>=\v->casevofUpdatedx_->writeIORefref$!Readyx_->error"Signal not updated!"sig=S$readIORefref>>=\v->casevofReadyx->samplexUpdated_x->returnxupdateActions<-mkWeaksig(upd,fin)NothingmodifyIORefpool(updateActions:)returnsig-- | 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->Signala-- ^ the signal to delay->SignalGen(Signala)-- ^ the delayed signaldelayx0(Ss)=SG$\pool(Sclk)->doref<-newIORef(Readyx0)letupdatex=dox'<-sc<-clkx'`seq`writeIORefref(Updated(ifcthenx'elsex)x)addSignalreturnupdaterefpool-- | 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(SignalGena)-- ^ the signal of generators to run->SignalGen(Signala)-- ^ the signal of generated structuresgenerator(Ss)=SG$\poolclk->doref<-newIORef(Readyundefined)letsample=doSGg<-sx<-gpoolclkwriteIORefref(Updatedundefinedx)returnxaddSignal(constsample)(const(sample>>return()))refpool-- | Override the clock used in a generator. Note that clocks don't-- interact unless one is used in the definition of the other, i.e. it-- is possible to provide a fast clock within a generator with a slow-- associated clock.withClock::SignalBool->SignalGena->SignalGenawithClockclk(SGg)=SG$\pool_->gpoolclk-- | 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::Signala-- ^ the signal to cache->SignalGen(Signala)-- ^ a signal observationally equivalent to the argumentmemo(Ss)=SG$\pool_->doref<-newIORef(Readyundefined)letsample=s>>=\x->writeIORefref(Updatedundefinedx)>>returnxaddSignal(constsample)(const(sample>>return()))refpool-- | A signal that is true exactly once: the first time the input-- signal is true. Afterwards, it is constantly false, and it holds-- no reference to the input signal. Note that 'until' always follows-- the master clock, i.e. the fastest one, therefore it never creates-- a long spike of @True@.until::SignalBool-- ^ the boolean input signal->SignalGen(SignalBool)-- ^ a one-shot signal true only the first time the input is trueuntil(Ss)=SG$\pool_->doref<-newIORef(Readyundefined)rsmp<-mfix$\rs->newIORef$dox<-swriteIORefref(Updatedundefinedx)whenx$writeIORefrs$dowriteIORefref(UpdatedundefinedFalse)returnFalsereturnxletsample=join(readIORefrsmp)addSignal(constsample)(const(()<$sample))refpool-- | 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(Signala,a->IO())-- ^ the signal and an IO function to feed itexternalx=doref<-newIORefxreturn(S(readIORefref),writeIORefref)-- | An event-like signal that can be fed through the sink function-- returned. The signal carries a list of values fed in since the-- last sampling, i.e. it is constantly [] if the sink is never-- invoked. The order of elements is reversed, so the last value-- passed to the sink is the head of the list. Note that unlike-- 'external' this function only returns a generator to be used within-- the expression constructing the top-level stream, and this-- generator can only be used once.externalMulti::IO(SignalGen(Signal[a]),a->IO())-- ^ a generator for the event signal and the associated sinkexternalMulti=dovar<-newMVar[]return(SG$\pool_->doletsig=S$readMVarvarupdate<-mkWeaksig(return(),takeMVarvar>>putMVarvar[])NothingmodifyIORefpool(update:)returnsig,\val->dovals<-takeMVarvarputMVarvar(val:vals))-- | A pure stateful signal. The initial state is the first output,-- and every subsequent state is derived from the preceding one by-- applying a pure transformation. It is equivalent to the following-- expression:---- @-- stateful x0 f = 'mfix' $ \sig -> 'delay' x0 (f '<$>' sig)-- @stateful::a-- ^ initial state->(a->a)-- ^ state transformation->SignalGen(Signala)statefulx0f=mfix$\sig->delayx0(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->Signalt-- ^ input signal->SignalGen(Signala)transferx0fs=mfix$\sig->liftA2fs<$>delayx0sig-- | A random signal.noise::MTRandoma=>SignalGen(Signala)noise=memo(SrandomIO)-- | A random source within the 'SignalGen' monad.getRandom::MTRandoma=>SignalGenagetRandom=SG(const(constrandomIO))-- | A printing action within the 'SignalGen' monad.debug::String->SignalGen()debug=SG.const.const.putStrLn-- The Show instance is only defined for the sake of Num...instanceShow(Signala)whereshowsPrec__s="<SIGNAL>"++s-- Equality test is impossible.instanceEq(Signala)where_==_=False-- Error message for unimplemented instance functions.unimp::String->aunimp=error.("Signal: "++)instanceOrdt=>Ord(Signalt)wherecompare=unimp"compare"min=liftA2minmax=liftA2maxinstanceEnumt=>Enum(Signalt)wheresucc=fmapsuccpred=fmappredtoEnum=pure.toEnumfromEnum=unimp"fromEnum"enumFrom=unimp"enumFrom"enumFromThen=unimp"enumFromThen"enumFromTo=unimp"enumFromTo"enumFromThenTo=unimp"enumFromThenTo"instanceBoundedt=>Bounded(Signalt)whereminBound=pureminBoundmaxBound=puremaxBoundinstanceNumt=>Num(Signalt)where(+)=liftA2(+)(-)=liftA2(-)(*)=liftA2(*)signum=fmapsignumabs=fmapabsnegate=fmapnegatefromInteger=pure.fromIntegerinstanceRealt=>Real(Signalt)wheretoRational=unimp"toRational"instanceIntegralt=>Integral(Signalt)wherequot=liftA2quotrem=liftA2remdiv=liftA2divmod=liftA2modquotRemab=(fst<$>qrab,snd<$>qrab)whereqrab=quotRem<$>a<*>bdivModab=(fst<$>dmab,snd<$>dmab)wheredmab=divMod<$>a<*>btoInteger=unimp"toInteger"instanceFractionalt=>Fractional(Signalt)where(/)=liftA2(/)recip=fmaprecipfromRational=pure.fromRationalinstanceFloatingt=>Floating(Signalt)wherepi=purepiexp=fmapexpsqrt=fmapsqrtlog=fmaplog(**)=liftA2(**)logBase=liftA2logBasesin=fmapsintan=fmaptancos=fmapcosasin=fmapasinatan=fmapatanacos=fmapacossinh=fmapsinhtanh=fmaptanhcosh=fmapcoshasinh=fmapasinhatanh=fmapatanhacosh=fmapacosh