使用Operational Monad实现的Writer不会懒惰地工作

时间:2011-12-26 10:48:42

标签: haskell monads lazy-evaluation monad-transformers writer-monad

我使用Operational Monad方法编写了一个具有Writer功能的monad。然后我注意到它懒得工作。

在下面的代码中,有一个rogueWriter执行无限多个语句,每个语句都写一个字符串。该程序不会终止,只需要无限输出的某些字符。

经过我的分析后,我注意到流氓作家实际上非常友好(哈哈),因为当我从runMyWriter rogueWriter改为runWriter rogueWriter时,一切顺利。

问题:

  1. 如何最好地解释这种行为?
  2. 我应该如何更改代码才能使其正常工作?
  3. 什么monad变形金刚SomeMonadT出现了同样的问题 SomeMonadT Writer w resp。 WriterT w SomeMonad (也许是一些例子?)
  4. 编辑:我有可能在这里试图扭转一个无限的字符串吗? Sjoerd Visscher的解决方案与我的解决方案之间存在显着差异

    w `mappend` ws  resp.  ws `mappend` w
    

    代码:

    {-# LANGUAGE GADTs, FlexibleContexts, TypeSynonymInstances,
                        FlexibleInstances, MultiParamTypeClasses #-}
    
    module Writer where
    
    import Control.Monad.Identity
    import Control.Monad.Operational
    import Control.Monad.Writer
    import Data.Monoid
    
    data MyWriterI w a where
        Tell :: w -> MyWriterI w ()
    
    type MyWriterT w = ProgramT (MyWriterI w)
    
    type MyWriter w = (MyWriterT w) Identity
    
    runMyWriterT :: (Monad m, Monoid w) => MyWriterT w m a -> m (a, w)
    runMyWriterT prog = run prog mempty
      where
        run prog ws = viewT prog >>= flip eval ws
        eval (Return a)       ws = return (a, ws)
        eval (Tell w :>>= is) ws = run (is ()) (ws `mappend` w)
    
    runMyWriter :: (Monoid w) => MyWriter w a -> (a, w)
    runMyWriter prog = runIdentity (runMyWriterT prog)
    
    instance (Monad m, Monoid w) => MonadWriter w (MyWriterT w m) where
        tell   = singleton . Tell
        listen = undefined
        pass   = undefined
    
    -- Demonstration of the problem:
    
    rogueWriter :: MonadWriter String m => m ()
    rogueWriter = mapM_ (tell . show) [1..]
    
    main = let (_, infiniteOutput) = runMyWriter rogueWriter
           in putStrLn (take 20 infiniteOutput)
    

1 个答案:

答案 0 :(得分:6)

我不确切知道你的程序失败的原因,但这就是我写它的方式:

runMyWriterT prog = run prog
  where
    run prog = viewT prog >>= eval
    eval (Return a)       = return (a, mempty)
    eval (Tell w :>>= is) = do
      ~(r, ws) <- run (is ())
      return (r, w `mappend` ws)