阴阳谜题的 Haskell 版本：种类不兼容错误

Question

我想在 Haskell 中实现 yin-yang puzzle。这是我的尝试（不成功）：

-- The data type in use is recursive, so we must have a newtype defined
newtype Cl m = Cl { goOn :: MonadCont m => Cl m -> m (Cl m) }

yinyang :: (MonadIO m, MonadCont m) => m (Cl m)
yinyang = do
    yin <-  (callCC $ \k -> return (Cl k)) >>= (\c -> liftIO (putStr "@") >> goOn c)
    yang <- (callCC $ \k -> return (Cl k)) >>= (\c -> liftIO (putStr "*") >> goOn c)
    goOn yin yang

查看类型时，显然callCC $ \k -> return (Cl k) 给出了m (Cl m)，因此yin 的类型为Cl m。 yang 是一回事。所以我希望goOn yin yang 给出最终类型m (Cl m)。

这个实现看起来不错，但问题是它无法编译！这是我得到的错误：

Couldn't match kind `*' against `* -> *'
Kind incompatibility when matching types:
  m0 :: * -> *
  Cl :: (* -> *) -> *
In the first argument of `goOn', namely `yin'
In a stmt of a 'do' block: goOn yin yang

有办法解决这个问题吗？

更新

虽然我自己找到了答案，但我还是不明白那个错误信息是什么意思。谁能给我解释一下？我已经知道的是，在有问题的版本中，goOn c 返回类似Cl m -> m (Cl m) 的内容，而不是预期的m (Cl m)。但这不是您可以从错误消息中得到的。

Answer 1

代码中有一个愚蠢的错误。这是正确的实现

newtype CFix m = CFix { goOn :: CFix m -> m (CFix m) }

yinyang :: (MonadIO m, MonadCont m) => m (CFix m)
yinyang = do
    yin <-  (\c -> liftIO (putStr "@") >> return c) =<< (callCC $ \k -> return (CFix k)) 
    yang <- (\c -> liftIO (putStr "*") >> return c) =<< (callCC $ \k -> return (CFix k)) 
    goOn yin yang

运行它非常容易。

main :: IO ()
main = runContT yinyang $ void.return

甚至

main :: IO ()
main = runContT yinyang undefined

虽然后面看起来很吓人，但它是安全的，因为续集永远没有机会被评估。 （整个表达式，将被评估为值_|_，因为它永远不会停止）

它输出预期的结果

@*@**@***...

解释

最初的尝试是直接翻译Scheme版本

(let* (
 (yin
    ((lambda (cc) (display #\@) cc) (call-with-current-continuation (lambda (c) c))))
 (yang
    ((lambda (cc) (display #\*) cc) (call-with-current-continuation (lambda (c) c)))))
(yin yang))

进入 Haskell。对于类型化语言，进行上述类型检查的关键是要有一个与t -> t 同构的类型t。在 Haskell 中，这是通过使用 newtype 关键字来完成的。另外，为了产生副作用，我们需要IO，但它不支持callCC。为了支持后者，我们需要MonadCont。所以要同时使用我们需要MonadIO 和MonadCont。此外，newtype 必须知道它正在处理哪个Monad，因此它应该携带Monad 作为其类型参数。所以现在我们写

newtype CFix m = ...

yinyang :: (MonadIO m, MonadCont m) => m (CFix m)

由于我们正在处理Monad，因此使用do 表示法很方便。所以let* 的赋值应该被翻译成yin <- 和yang <-。在MonadIO 到display 中，我们使用liftIO.putStr。 call-with-current-continuation 转换为 callCC 但显然我们不能转换为 id 或类似的。让我们暂时搁置一下。

我的错误是将显示块和callCC 块的组合运算符天真地转换为>>=。在 Scheme 或其他严格的语言中，参数要在表达式之前求值，所以 callCC 块应该在显示块之前执行。因此，我们将使用=<< 而不是>>=。代码现在看起来

newtype CFix m = ...

yinyang :: (MonadIO m, MonadCont m) => m (CFix m)
yinyang = do
    yin <- (\c -> liftIO (putStr "@") >> return c) =<< (callCC $ ...)
    yang <- (\c -> liftIO (putStr "*") >> return c) =<< (callCC $ ...)
    ...

现在是时候进行类型检查了，看看我们应该在...s 中输入什么。 callCCs 签名是

MonadCont m => ((a -> m b) -> m a) -> m a

所以它的参数有类型

MonadCont m => (a -> m b) -> m a

对于某些类型 a 和 b。通过查看到目前为止编写的代码，我们很容易得出结论，yin 和yang 应该具有相同类型的callCCs 返回值m a。但是，原始模式版本使用yin 和yang 作为函数，因此它们的类型为p -> r。所以这里是我们需要递归类型和newtype的地方。

要获得m a，直接的方法是使用return，我们需要有a类型的东西。假设这是来自我们要定义的类型构造函数。现在要为callCC 提供参数，我们需要从(a -> m b) 构造一个a。所以这就是构造函数的样子。但是b 是什么？一个简单的选择是使用相同的a。所以我们有了CFix的定义：

newtype CFix m = CFix { goOn :: CFix m -> m (CFix m) }

以及callCC的参数的实现

\k -> return (CFix k)

我们使用CFix 构造函数从给定参数构造CFix，并使用return 将其包装为所需的类型。

现在，我们如何将yin（m (CFix m) 类型）用作函数？类型析构函数goOn 允许我们提取内部函数，因此我们有最后一个... 的定义。

newtype CFix m = CFix { goOn :: CFix m -> m (CFix m) }

yinyang :: (MonadIO m, MonadCont m) => m (CFix m)
yinyang = do
    yin <-  (\c -> liftIO (putStr "@") >> return c) =<< (callCC $ \k -> return (CFix k)) 
    yang <- (\c -> liftIO (putStr "*") >> return c) =<< (callCC $ \k -> return (CFix k)) 
    goOn yin yang

这是程序的最终版本。