Following the lead of the excellent answer in this post, I'm trying to get a working example of ArrowLoop
that doesn't use arrow notation. I'm uncomfortable using arrow notation until I fully understand how arrows work under the hood. That being said, I've constructed a small program that based on my (limited) understanding of Arrows should work. However, it ends up terminating with the dreaded <<loop>>
exception:
module Main where
import Control.Wire
import FRP.Netwire
farr :: SimpleWire (Int, Float) (String, Float)
farr = let
fn :: Int -> Float -> ((String, Float), SimpleWire (Int, Float) (String, Float))
fn i f = (("f+i: " ++ (show (fromIntegral i + f)), f + 0.1), loopFn)
loopFn :: SimpleWire (Int, Float) (String, Float)
loopFn = mkSFN $ \(i, f) -> fn i f
in
mkSFN $ \(i, _) -> fn i 0.0
main :: IO ()
main = do
let sess = clockSession_ :: Session IO (Timed NominalDiffTime ())
(ts, sess2) <- stepSession sess
let wire = loop farr
(Right s, wire2) = runIdentity $ stepWire wire ts (Right 0)
putStrLn ("s: " ++ s)
(ts2, _) <- stepSession sess2
let (Right s2, _) = runIdentity $ stepWire wire2 ts (Right 1)
putStrLn ("s2: " ++ s2)
My intuition tells me that the <<loop>>
exception usually comes when you don't supply the initial value to the loop. Haven't I done that with the line containing fn i 0.0
? The output disagrees:
$ ./test
s: f+i: 0.0
test.exe: <<loop>>
Does anyone know what I'm doing wrong?
The main point of confusion seemed to be the integral relationship between ArrowLoop
and mfix
. For the uninitiated, fix
is a function that finds the fixed point of a given function:
fix :: (a -> a) -> a
fix f = let x = f x in x
mfix
is the monadic extension of this function, whose type signature is, unsurprisingly:
mfix :: (a -> m a) -> m a
So what does this have to do with ArrowLoop
? Well, the ArrowLoop
instance for Netwire runs mfix
on the second argument of the passed wire. To put it another way, consider the type signature for loop
:
loop :: a (b, d) (c, d) -> a b c
In Netwire, the instance of ArrowLoop
is:
instance MonadFix m => ArrowLoop (Wire s e m)
This means that the loop
function's type when used with wires is:
loop :: MonadFix m => Wire s e m (b, d) (c, d) -> Wire s e m b c
Since loop
does not take an initial argument of type d
, this means that there is no way to initialize any sort of conventional "looping" over the wire. The only way to get a value out of it is to keep applying the output as the input until it finds a termination condition, which is analogous to the way fix
works. The wire that gets passed as an argument to loop
never actually steps more than once, since stepWire
is applied to the same wire over and over with different inputs. Only when the wire actually produces a fixed value, does the function step and produce another wire (which behaves the same way as the first).
For completeness, here is code for my original intuition for how loop
was supposed to work, which I have named semiLoop
:
semiLoop :: (Monad m, Monoid s, Monoid e) => c -> Wire s e m (a, c) (b, c) -> Wire s e m a b
semiLoop initialValue loopWire = let
runLoop :: (Monad m, Monoid s, Monoid e) =>
Wire s e m (a, c) (b, c) -> s -> a -> c -> m (Either e b, Wire s e m a b)
runLoop wire ts ipt x = do
(result, nextWire) <- stepWire wire ts (Right (ipt, x))
case result of
Left i -> return (Left i, mkEmpty)
Right (value, nextX) ->
return (Right value, mkGen $ \ts' ipt' -> runLoop nextWire ts' ipt' nextX)
in
mkGen $ \ts input -> runLoop loopWire ts input initialValue
After the wonderful answer provided by Petr, the delay
combinator is essential to preventing the loop
combinator from diverging. delay
simply creates a single-value buffer between the laziness of using the next value in the mfix
portion of the loop described above. An identical definition of semiLoop
above is therefore:
semiLoop :: (MonadFix m, Monoid s, Monoid e) =>
c -> Wire s e m (a, c) (b, c) -> Wire s e m a b
semiLoop initialValue loopWire = loop $ second (delay initialValue) >>> loopWire