Неправильное понимание ArrowLoop при использовании с Netwire

Question

Следуя превосходному ответу в этом посте, я пытаюсь получить рабочий пример ArrowLoop это не использует обозначение стрелки. Мне неудобно использовать стрелки, пока я полностью не понимаю, как стрелки работают под капотом. При этом я создал небольшую программу, основанную на моем (ограниченном) понимании стрелок. Однако, это заканчивается тем, что заканчивается <<loop>> исключение:

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)

Моя интуиция говорит мне, что <<loop>> Исключение обычно возникает, когда вы не вводите начальное значение в цикл. Разве я не сделал это со строкой, содержащей fn i 0.0? Вывод не согласен:

$ ./test
s: f+i: 0.0
test.exe: <<loop>>

Кто-нибудь знает, что я делаю не так?

Answer 1

Главной причиной путаницы, казалось, была неразрывная связь между ArrowLoop а также mfix, Для непосвященных, fix это функция, которая находит фиксированную точку данной функции:

fix :: (a -> a) -> a
fix f = let x = f x in x

mfix монадическое расширение этой функции, чья сигнатура типа неудивительно:

mfix :: (a -> m a) -> m a

Так какое это имеет отношение к ArrowLoop? Ну, то ArrowLoop экземпляр для Netwire работает mfix на втором аргументе пропущенного провода. Другими словами, рассмотрим сигнатуру типа для loop:

loop :: a (b, d) (c, d) -> a b c

В Netwire, экземпляр ArrowLoop является:

instance MonadFix m => ArrowLoop (Wire s e m)

Это означает, что loop Тип функции при использовании с проводами:

loop :: MonadFix m => Wire s e m (b, d) (c, d) -> Wire s e m b c

поскольку loop не принимает начальный аргумент типа dэто означает, что не существует способа инициализации какого-либо обычного "зацикливания" по проводу. Единственный способ получить значение из него - это продолжать применять вывод в качестве входных данных до тех пор, пока он не найдет условие завершения, которое аналогично тому, как fix работает. Провод, который передается в качестве аргумента loop никогда не ступает больше одного раза, так как stepWire применяется к одному и тому же проводу снова и снова с разными входами. Только когда провод фактически выдает фиксированное значение, функция выполняет шаг и производит другой провод (который ведет себя так же, как и первый).

Для полноты, вот код для моей первоначальной интуиции о том, как loop должен был работать, который я назвал 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

редактировать

После чудесного ответа Петра delay комбинатор имеет важное значение для предотвращения loop комбинатор от расходящихся. delay просто создает буфер с одним значением между ленью использования следующего значения в mfix часть цикла описана выше. Идентичное определение semiLoop поэтому выше:

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