{-|
Note: this module is likely to be deprecated in the near future,
because automatic delays are ill-defined, and not very useful in
practice anyway. Experience with the library suggests that
instantaneous loops are relatively easy to avoid.
This version differs from the parametric one in introducing automatic
delays. In practice, if a dependency loop involves a 'transfer'
primitive, it will be resolved during runtime even if transfer
functions are not delayed by default. Also, the until construct is
missing from this module.
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;
* 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.
-}moduleFRP.Elerea.Delayed(Signal,SignalGen,start,external,externalMulti,delay,stateful,transfer,memo,generator,noise,getRandom,debug)whereimportControl.ApplicativeimportControl.Concurrent.MVarimportControl.MonadimportControl.Monad.FiximportData.IORefimportData.MaybeimportSystem.Mem.WeakimportSystem.Random.Mersenne-- | 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.newtypeSignalpa=S{unS::p->IOa}-- | A dynamic set of actions to update a network without breaking-- consistency.typeUpdatePoolp=[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.newtypeSignalGenpa=SG{unSG::IORef(UpdatePoolp)->IOa}-- | The phases every signal goes through during a superstep: before-- or after sampling.dataPhasesa=Readys|Samplings|AgedsainstanceFunctor(Signalp)wherefmap=liftMinstanceApplicative(Signalp)wherepure=return(<*>)=apinstanceMonad(Signalp)wherereturn=S.const.returnSg>>=f=S$\p->gp>>=\x->unS(fx)pinstanceFunctor(SignalGenp)wherefmap=liftMinstanceApplicative(SignalGenp)wherepure=return(<*>)=apinstanceMonad(SignalGenp)wherereturn=SG.const.returnSGg>>=f=SG$\p->gp>>=\x->unSG(fx)pinstanceMonadFix(SignalGenp)wheremfixf=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::SignalGenp(Signalpa)-- ^ the generator of the top-level signal->IO(p->IOa)-- ^ the computation to sample the signalstart(SGgen)=dopool<-newIORef[](Ssample)<-genpoolptrs0<-readIORefpoolwriteIORefpool[](as0,cs0)<-unzip.mapfromJust<$>mapMdeRefWeakptrs0letageStaticparam=mapM_($param)as0commitStatic=sequence_cs0return$\param->doletupdate[]ptrsagecommit=dowriteIORefpoolptrsageStaticparam>>agecommitStatic>>commitupdate(p:ps)ptrsagecommit=dor<-deRefWeakpcaserofNothing->updatepsptrsagecommitJust(a,c)->updateps(p:ptrs)(age>>aparam)(commit>>c)res<-sampleparamptrs<-readIORefpoolupdateptrs[](return())(return())returnres-- | Auxiliary function used by all the primitives that create a-- mutable variable.addSignal::(p->Phasesa->IOa)-- ^ sampling function->(p->Phasesa->IO())-- ^ aging function->IORef(Phasesa)-- ^ the mutable variable behind the signal->IORef(UpdatePoolp)-- ^ the pool of update actions->IO(Signalpa)addSignalsampleagerefpool=doletcommit(Ageds_)=Readyscommit_=error"commit error: signal not aged"sig=S$\p->readIORefref>>=samplepupdate<-mkWeaksig(\p->readIORefref>>=agep,modifyIORefrefcommit)NothingmodifyIORefpool(update:)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.delay::a-- ^ initial output->Signalpa-- ^ the signal to delay->SignalGenp(Signalpa)delayx0(Ss)=SG$\pool->doref<-newIORef(Readyx0)letsample_(Readyx)=returnxsample_(Aged_x)=returnxsample__=error"sampling eror: delay"agep(Readyx)=sp>>=\x'->x'`seq`writeIORefref(Agedx'x)age__=return()addSignalsampleagerefpool-- | 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::Signalpa-- ^ signal to memoise->SignalGenp(Signalpa)memo(Ss)=SG$\pool->doref<-newIORef(Readyundefined)letsamplep(Ready_)=sp>>=\x->writeIORefref(Agedundefinedx)>>returnxsample_(Aged_x)=returnxsample__=error"sampling eror: memo"agep(Ready_)=sp>>=\x->writeIORefref(Agedundefinedx)age__=return()addSignalsampleagerefpool-- | 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::Signalp(SignalGenpa)-- ^ a stream of generators to potentially run->SignalGenp(Signalpa)generator(Sgen)=SG$\pool->doref<-newIORef(Readyundefined)letnextp=($pool).unSG=<<genpsamplep(Ready_)=nextp>>=\x'->writeIORefref(Agedx'x')>>returnx'sample_(Aged_x)=returnxsample__=error"sampling eror: generator"agep(Ready_)=nextp>>=\x'->writeIORefref(Agedx'x')age__=return()addSignalsampleagerefpool-- | 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(Signalpa,a->IO())-- ^ the signal and an IO function to feed itexternalx=doref<-newIORefxreturn(S(const(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(SignalGenp(Signalp[a]),a->IO())-- ^ a generator for the event signal and the associated sinkexternalMulti=dovar<-newMVar[]return(SG$\pool->doletsig=S$const(readMVarvar)update<-mkWeaksig(const(return()),takeMVarvar>>putMVarvar[])NothingmodifyIORefpool(update:)returnsig,\val->dovals<-takeMVarvarputMVarvar(val:vals))-- | 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)->SignalGenp(Signalpa)statefulx0f=SG$\pool->doref<-newIORef(Readyx0)letsample_(Readyx)=returnxsample_(Aged_x)=returnxsample__=error"sampling eror: stateful"agep(Readyx)=letx'=fpxinx'`seq`writeIORefref(Agedx'x)age__=return()addSignalsampleagerefpool-- | 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. The-- only exception is when a transfer function sits in a loop without a-- delay. In this case, a delay will be inserted at a single place-- during runtime (i.e. the previous output of the node affected will-- be reused) to resolve the circular dependency.transfer::a->(p->t->a->a)->Signalpt->SignalGenp(Signalpa)transferx0f(Ss)=SG$\pool->doref<-newIORef(Readyx0)letsamplep(Readyx)=dowriteIORefref(Samplingx)y<-spletx'=fpyxx'`seq`writeIORefref(Agedx'x')returnx'sample_(Samplingx)=returnx-- Reusing previous output: automatic delaysample_(Aged_x)=returnxagep(Readyx)=doy<-spletx'=fpyxx'`seq`writeIORefref(Agedx'x')age__=return()-- If it is Sampling, we'll error out lateraddSignalsampleagerefpool-- | A random signal.noise::MTRandoma=>SignalGenp(Signalpa)noise=memo(S(constrandomIO))-- | A random source within the 'SignalGen' monad.getRandom::MTRandoma=>SignalGenpagetRandom=SG(constrandomIO)-- | A printing action within the 'SignalGen' monad.debug::String->SignalGenp()debug=SG.const.putStrLn-- | The @Show@ instance is only defined for the sake of 'Num'...instanceShow(Signalpa)whereshowsPrec__s="<SIGNAL>"++s-- | Equality test is impossible.instanceEq(Signalpa)where_==_=False-- | Error message for unimplemented instance functions.unimp::String->aunimp=error.("Signal: "++)instanceOrdt=>Ord(Signalpt)wherecompare=unimp"compare"min=liftA2minmax=liftA2maxinstanceEnumt=>Enum(Signalpt)wheresucc=fmapsuccpred=fmappredtoEnum=pure.toEnumfromEnum=unimp"fromEnum"enumFrom=unimp"enumFrom"enumFromThen=unimp"enumFromThen"enumFromTo=unimp"enumFromTo"enumFromThenTo=unimp"enumFromThenTo"instanceBoundedt=>Bounded(Signalpt)whereminBound=pureminBoundmaxBound=puremaxBoundinstanceNumt=>Num(Signalpt)where(+)=liftA2(+)(-)=liftA2(-)(*)=liftA2(*)signum=fmapsignumabs=fmapabsnegate=fmapnegatefromInteger=pure.fromIntegerinstanceRealt=>Real(Signalpt)wheretoRational=unimp"toRational"instanceIntegralt=>Integral(Signalpt)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(Signalpt)where(/)=liftA2(/)recip=fmaprecipfromRational=pure.fromRationalinstanceFloatingt=>Floating(Signalpt)wherepi=purepiexp=fmapexpsqrt=fmapsqrtlog=fmaplog(**)=liftA2(**)logBase=liftA2logBasesin=fmapsintan=fmaptancos=fmapcosasin=fmapasinatan=fmapatanacos=fmapacossinh=fmapsinhtanh=fmaptanhcosh=fmapcoshasinh=fmapasinhatanh=fmapatanhacosh=fmapacosh