为什么Haskell中箭头函数的递归绑定无限循环？

Question

我正在通过为comm 语言实现一个简单的解释器来学习如何在 Haskell 中使用 Arrows。

我有一个 eval 函数，可以将表达式计算为一个值，但是在输入任何表达式时 eval 会无限循环。

-- Interp.hs

eval :: A Expr Val
eval = proc e -> case e of
    Lit x -> returnA -< Num x
    Var s -> do
        lookup -< s
    Add e1 e2 -> do
        v1 <- eval -< e1
        v2 <- eval -< e2
        case (v1, v2) of
            (Num x, Num y) -> returnA -< Num (x + y)

在 GHCI 中执行这个会导致无限循环

*Interp> unpack eval M.empty (Lit 1)

在 Add 表达式的情况下注释掉 eval 确实会导致表达式给出结果

例如

-- Interp.hs

eval :: A Expr Val
eval = proc e -> case e of
    Lit x -> returnA -< Num x
    Var s -> do
        lookup -< s
    Add e1 e2 -> do
        returnA -< Num 1
--        v1 <- eval -< e1
--        v2 <- eval -< e2
--        case (v1, v2) of
--            (Num x, Num y) -> returnA -< Num (x + y)

*Interp> unpack eval M.empty (Lit 1)
(Right (Num 1),fromList [])

这是有问题的代码
使用的箭头是一种状态函数，在失败后继续传递上下文。

{-# LANGUAGE Arrows #-}
{-# OPTIONS_GHC -Wall #-}
module Interp where

import Prelude hiding (lookup, fail)

import qualified Data.Map as M
import Control.Arrow
import Control.Category

data Expr
    = Lit Int
    | Var String
    | Add Expr Expr
    deriving (Show, Eq)

data Val
    = Num Int
    deriving (Show, Eq)

type Env = M.Map String Val

data A b c = A { unpack :: (Env -> b -> (Either String c, Env)) }

instance Category A where
    id = A (\env b -> (Right b, env))
    A g . A f = A $ \env b -> case f env b of
        (Left err, env') -> (Left err, env')
        (Right c, env') -> g env' c

instance Arrow A where
    arr f = A $ \env b -> (Right (f b), env)
    first (A f) = A $ \env (b, d) -> case f env b of
        (Left err, env') -> (Left err, env')
        (Right c, env') -> (Right (c, d), env')

instance ArrowChoice A where
    left (A f) = A $ \env e -> case e of
        Left b -> case f env b of
            (Left err, env') -> (Left err, env')
            (Right c, env') -> (Right (Left c), env')
        Right d -> (Right (Right d), env)

lookup :: A String Val
lookup = A $ \env k -> case M.lookup k env of
    Nothing -> (Left "Variable not bound", env)
    Just v -> (Right v, env)

eval :: A Expr Val
eval = proc e -> case e of
    Lit x -> returnA -< Num x
    Var s -> do
        lookup -< s
    Add e1 e2 -> do
        v1 <- eval -< e1
        v2 <- eval -< e2
        case (v1, v2) of
            (Num x, Num y) -> returnA -< Num (x + y)

Answer 1

有两种方法可以解决未终止的问题：

1. 将 A 从 data 声明更改为 newtype 声明。

2. 将first和left定义中的模式匹配改为惰性，即：

   first ~(A f) = A $ ...same as before...
   left ~(A f) = A $ ...same as before...
   

这两个修复都解决了相同的根本问题。来自another StackOverflow answer:

[使用data 声明]，当与值构造函数进行模式匹配时，[thunks] 将至少被评估为弱头范式 (WHNF)。 [...] [使用 newtype 声明，] 当与值构造函数进行模式匹配时，[thunks] 根本不会被评估。

接下来，我将解释newtype 和data 声明之间的主要区别，然后我将解释它如何适用于您的情况。

newtype 和 data 的严格属性

以下大部分内容是从the HaskellWiki article on the same topic转述和改编的。

newtype 旨在引入与现有类型完全同构的类型。给定声明newtype T1 = T1 { unpack :: Int }，我们希望unpack . T1 和id 在Int -> Int 类型上相等，同样T1 . unpack 和id 在T1 -> T1 类型上相等。

但是为什么这对data T2 = T2 { unpack :: Int } 不成立；也就是说，为什么T2 . unpack 和id 不一样？原因是不终止。 T2 (unpack _|_) 计算结果为 T2 _|_，但 id _|_ 计算结果为 _|_（我使用 _|_ 代表非终止计算“底部”，按照惯例）。我们可以用下面的表达式区分_|_和T2 _|_：

\x -> case x of T2 _ -> ()

将此 lambda 应用于_|_ 会产生_|_，但将此 lambda 应用于T2 _|_ 会产生()。也就是说，由于构造函数T2 可能包含非终止值，因此该语言可以区分_|_ 和T2 _|_。

newtype 声明为我们提供了一个可能令人惊讶的属性：T1 (unpack _|_) 的计算结果为 _|_，但 case _|_ of T1 _ -> () 的计算结果为 ()！也就是说，因为T1 _|_ 不打算与_|_ 区分开来，所以当与T1 值构造函数进行模式匹配时，该语言不会强制评估T1 类型的值。而且，我们很快就会看到，这个属性对于递归定义很重要。

懒惰模式

有一种方法可以恢复data 声明的类似新类型的行为：使用惰性模式匹配。给定一个类似的函数：

f x = case x of ~(T2 y) -> \() -> y

您会发现f (T2 _|_) 和f _|_ 都计算为一个值（即，Unit -> Int 类型的函数一旦应用于参数就会发散）。这是因为惰性模式匹配与函数相同：

f = \x -> case x of t -> \() -> unpack t

因此，作为x 传递的thunk 的评估是“延迟的”，因为它仅在评估unpack t 时评估，在lambda \() -> unpack t 的主体中。

您的示例的新类型与数据声明

我现在将对您示例中的箭头符号进行脱糖，然后确定未终止的来源。

为了使箭头符号脱糖，我使用了arrowp program。这就是它在您的程序中产生的结果：

$ arrowp-ext interp.hs
eval :: A Expr Val
eval
       = (arr
       (\ e ->
          case e of
              Lit x -> (Left) (x)
              Var s -> (Right) ((Left) (s))
              Add e1 e2 -> (Right) ((Right) ((e1, e2))))
       >>>
       (((arr (\ x -> Num x)) >>> (returnA)) |||
          (((arr (\ s -> s)) >>> (lookup)) |||
             (((first ((arr (\ e1 -> e1)) >>> (eval))) >>>
                 (arr (\ (v1, e2) -> (e2, v1))))
                >>>
                (first ((arr (\ e2 -> e2)) >>> (eval))) >>>
                  (arr
                     (\ (v2, v1) ->
                        case
                          case (v1, v2) of
                              (Num x, Num y) -> (x, y)
                          of
                            (x, y) -> Num (x + y)))
                    >>> (returnA)))))

您发现eval 在应用于参数时不会终止，但问题比这更严重：eval 发散，句号。这可以在 ghci 中观察到：

*Interp> eval `seq` 0

未终止的近端原因是表达式first ((arr (\ e1 -> e1)) >>> (eval))，与first eval 相同。 first 定义中的第一个参数涉及与值构造函数 (first (A f)) 的严格模式匹配，而 A 源自数据声明，因此，重新引用 @wonder.mice：

[使用数据声明]，当与值构造函数进行模式匹配时，[thunks] 将至少被评估为弱头范式 (WHNF)。

当 eval 的定义中遇到表达式 first eval 时，eval 的 thunk 尚未计算为 WHNF，因此当 first eval 尝试将其参数计算为 WHNF 时，它不会终止。

解决此问题的一种方法是将A 更改为newtype 声明。 （“1. 将 A 从 data 声明更改为 newtype 声明。”）然后，

...当与值构造函数进行模式匹配时，[thunks] 根本不会被评估。

解决此问题的另一种方法是使first 使用惰性模式匹配而不是严格模式匹配（“2. 将first 和left 定义中的模式匹配更改为惰性”）。这将产生使模式匹配行为与 newtype 声明相同的净效果，其中“根本不会评估 thunk”。

可以使用类似的解释来解释为什么 ||| 在您的示例中没有以懒惰的方式表现，即使它对于例如(->) 的 Arrow 实例。将 left 更改为使用惰性模式匹配将解决此问题，或者仅使用 newtype 声明就足够了。