[Haskell-cafe] FRP, arrows and loops

Miguel Mitrofanov miguelimo38 at yandex.ru
Fri Apr 2 04:13:24 EDT 2010


1) Haven't look closely, but your second ArrowLoop instance seems righter. The question really is the same as with MonadFix instances; you can always define an instance like this

data M = ... -- whatever
instance Monad M where ...
instance MonadFix M where mfix f = mfix f >>= f

...but this generally won't do any good.

Maciej Piechotka wrote:
> Hello. I'm trying to understand the FRP (by implementing FRP system on
> my own) and I think I'm slowly getting it.
> 
> 1. How to interpret ArrowLoop? I have two possible implementations:
> 
> type RunSF a = a Dynamic ()
> 
> data SF a b c =
>   SF (a (Dynamic, b, RunSF, Set Unique) (c, Set Unique, SF a b c))
> 
> (...)
> 
> instance ArrowLoop (SF a) where
>   loop (SF f) = loop' f undefined
>                 where loop' g d = proc (dyn, b, r, s) -> do
>                         ((c, d'), s, g') <- g <- (dyn, (b, d), r, s)
>                         returnA -< (c, s, loop' g' d')
> 
> instance ArrowLoop a => ArrowLoop (SF a) where
>   loop (SF f) =  SF $! proc (d, b, r, s) -> do
>     rec ((c, d), s, f') <- f -< (d, (b, d), r, s)
>     returnA -< (c, s, loop f')
> 
> Since the first is not unlike ArrayCircuit from arrays I guess second
> one but I'm not quite sure.
> 
> 2. Why there is no ArrowIO in arrows? I.e.
> 
> class Arrow a => ArrowIO a where
>   liftAIO :: Kleisli IO b c -> a b c
> 
> (possibly
> 
> class Arrow a => ArrowST a where
>   liftAST :: Kleisli ST b c -> a b c
> )
> 
> 3. Why switch is needed? How to interpret switch with current
> continuation?
> 
> I think switch is equivalent to ArrowChoice but do I miss something?
> 
> Regards
> 
> 
> ------------------------------------------------------------------------
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe


More information about the Haskell-Cafe mailing list