如何在处理递归求和类型时减少代码重复

Question

我目前正在为一种编程语言开发一个简单的解释器，而我有一个类似于以下的数据类型：

data Expr
  = Variable String
  | Number Int
  | Add [Expr]
  | Sub Expr Expr

我有许多函数可以执行简单的任务，比如：

-- Substitute a value for a variable
substituteName :: String -> Int -> Expr -> Expr
substituteName name newValue = go
  where
    go (Variable x)
      | x == name = Number newValue
    go (Add xs) =
      Add $ map go xs
    go (Sub x y) =
      Sub (go x) (go y)
    go other = other

-- Replace subtraction with a constant with addition by a negative number
replaceSubWithAdd :: Expr -> Expr
replaceSubWithAdd = go
  where
    go (Sub x (Number y)) =
      Add [go x, Number (-y)]
    go (Add xs) =
      Add $ map go xs
    go (Sub x y) =
      Sub (go x) (go y)
    go other = other

但在这些函数中，我必须重复调用代码的部分，并对函数的某个部分进行小的更改，以便实现递归。有没有更通用的方法来做到这一点？我不想复制和粘贴这一部分：

    go (Add xs) =
      Add $ map go xs
    go (Sub x y) =
      Sub (go x) (go y)
    go other = other

每次只更改单个案例，因为复制这样的代码似乎效率低下。

我能想到的唯一解决方法是编写一个函数，在整个数据结构上首先调用一个函数，然后递归地在结果上调用该函数，代码如下：

recurseAfter :: (Expr -> Expr) -> Expr -> Expr
recurseAfter f x =
  case f x of
    Add xs ->
      Add $ map (recurseAfter f) xs
    Sub x y ->
      Sub (recurseAfter f x) (recurseAfter f y)
    other -> other

substituteName :: String -> Int -> Expr -> Expr
substituteName name newValue =
  recurseAfter $ \case
    Variable x
      | x == name -> Number newValue
    other -> other

replaceSubWithAdd :: Expr -> Expr
replaceSubWithAdd =
  recurseAfter $ \case
    Sub x (Number y) ->
      Add [x, Number (-y)]
    other -> other

但我觉得可能已经有更简单的方法了。我错过了什么吗？

- Scott

---

我认为你的语言可以简化。定义Add :: Expr -> Expr -> Expr而不是Add :: [Expr] -> Expr，并且完全摆脱Sub。 - chepner

我只是使用这个定义作为一个简化版本；虽然在这种情况下可以工作，但我需要能够包含其他语言部分的表达式列表。 - Scott

例如？大多数，如果不是全部，链式运算符可以简化为嵌套的二元运算符。 - chepner

我认为你的 recurseAfter 是 ana 的化身。你可能想要研究一下 ana 和 recursion-schemes。话虽如此，我认为你的最终解决方案已经非常简洁了。转向官方的 recursion-schemes anamorphisms 不会节省太多代码。 - chi

这是关于编程的内容，翻译成中文为：“那就是递归方案，供您参考。” - Will Ness

Answer 1

恭喜，你刚刚重新发现了变形！以下是你的代码，改写后可以与recursive-schemes库一起使用。遗憾的是，它不会更短，因为我们需要一些样板代码来使机器运行。 (可能有一些自动化的方法来避免样板代码，例如使用generics，但我不知道。) 在下面，您的"recurseAfter"被标准的"ana"取代。首先定义递归类型以及它的functor。

{-# LANGUAGE DeriveFunctor, TypeFamilies, LambdaCase #-}
{-# OPTIONS -Wall #-}
module AnaExpr where

import Data.Functor.Foldable

data Expr
  = Variable String
  | Number Int
  | Add [Expr]
  | Sub Expr Expr
  deriving (Show)

data ExprF a
  = VariableF String
  | NumberF Int
  | AddF [a]
  | SubF a a
  deriving (Functor)

然后我们使用一些实例将两者连接起来，这样我们就可以将 Expr 展开为同构的 ExprF Expr ，然后再折叠回去。

type instance Base Expr = ExprF
instance Recursive Expr where
   project (Variable s) = VariableF s
   project (Number i) = NumberF i
   project (Add es) = AddF es
   project (Sub e1 e2) = SubF e1 e2
instance Corecursive Expr where
   embed (VariableF s) = Variable s
   embed (NumberF i) = Number i
   embed (AddF es) = Add es
   embed (SubF e1 e2) = Sub e1 e2

最后，我们调整您的原始代码，并添加一些测试。

substituteName :: String -> Int -> Expr -> Expr
substituteName name newValue = ana $ \case
    Variable x | x == name -> NumberF newValue
    other                  -> project other

testSub :: Expr
testSub = substituteName "x" 42 (Add [Add [Variable "x"], Number 0])

replaceSubWithAdd :: Expr -> Expr
replaceSubWithAdd = ana $ \case
    Sub x (Number y) -> AddF [x, Number (-y)]
    other            -> project other

testReplace :: Expr
testReplace = replaceSubWithAdd 
   (Add [Sub (Add [Variable "x", Sub (Variable "y") (Number 34)]) (Number 10), Number 4])

一个替代方案是只定义ExprF a，然后派生type Expr = Fix ExprF。这样可以节省一些模板代码（例如两个实例），但代价是必须使用Fix (VariableF ...)而不是Variable ...，以及其他构造函数类似的情况。

可以进一步通过使用模式同义词来减轻这种情况（尽管需要更多的模板代码）。

---

更新：我最终找到了自动生成工具，使用模板Haskell。这使整个代码相当简短。请注意，ExprF函子和上面的两个实例仍然存在于幕后，我们仍然必须使用它们。我们只是省去了手动定义它们的麻烦，但这已经节省了很多精力。

{-# LANGUAGE DeriveFunctor, DeriveTraversable, TypeFamilies, LambdaCase, TemplateHaskell #-}
{-# OPTIONS -Wall #-}
module AnaExpr where

import Data.Functor.Foldable
import Data.Functor.Foldable.TH

data Expr
  = Variable String
  | Number Int
  | Add [Expr]
  | Sub Expr Expr
  deriving (Show)

makeBaseFunctor ''Expr

substituteName :: String -> Int -> Expr -> Expr
substituteName name newValue = ana $ \case
    Variable x | x == name -> NumberF newValue
    other                  -> project other

testSub :: Expr
testSub = substituteName "x" 42 (Add [Add [Variable "x"], Number 0])

replaceSubWithAdd :: Expr -> Expr
replaceSubWithAdd = ana $ \case
    Sub x (Number y) -> AddF [x, Number (-y)]
    other            -> project other

testReplace :: Expr
testReplace = replaceSubWithAdd 
   (Add [Sub (Add [Variable "x", Sub (Variable "y") (Number 34)]) (Number 10), Number 4])

- chi

---

你真的需要显式地定义 Expr，而不是像 type Expr = Fix ExprF 这样吗？ - chepner

@chepner，我简要提到了这个作为一种替代方案。对于每件事情都需要使用双构造函数：Fix + 真正的构造函数，有点不方便。在我看来，使用TH自动化的最后一种方法更好。 - chi

Answer 2

作为另一种方法，这也是uniplate包的一个典型用例。它可以使用Data.Data泛型而不是模板Haskell来生成样板文件，因此如果为您的Expr派生Data实例：

import Data.Data

data Expr
  = Variable String
  | Number Int
  | Add [Expr]
  | Sub Expr Expr
  deriving (Show, Data)

然后来自 Data.Generics.Uniplate.Data 的 transform 函数对每个嵌套的 Expr 递归地应用一个函数：

import Data.Generics.Uniplate.Data

substituteName :: String -> Int -> Expr -> Expr
substituteName name newValue = transform f
  where f (Variable x) | x == name = Number newValue
        f other = other

replaceSubWithAdd :: Expr -> Expr
replaceSubWithAdd = transform f
  where f (Sub x (Number y)) = Add [x, Number (-y)]
        f other = other

请注意，在replaceSubWithAdd中，函数f被编写为执行非递归替换；在x :: Expr中，transform使其成为递归替换，因此它对辅助函数执行与ana@chi的答案中所做的相同魔术：

> substituteName "x" 42 (Add [Add [Variable "x"], Number 0])
Add [Add [Number 42],Number 0]
> replaceSubWithAdd (Add [Sub (Add [Variable "x", 
                     Sub (Variable "y") (Number 34)]) (Number 10), Number 4])
Add [Add [Add [Variable "x",Add [Variable "y",Number (-34)]],Number (-10)],Number 4]
> 

这个方案和 @chi 的 Template Haskell 解决方案一样长。其中一个潜在的优势是，uniplate 提供了一些额外的功能，可能会有所帮助。例如，如果你使用 descend 替换 transform，它只转换直接的子元素，可以让你控制递归发生的位置，或者你可以使用 rewrite 重新转换转换结果，直到达到一个固定点。潜在的缺点是，“anamorphism”听起来比“uniplate”更酷。

完整程序：

{-# LANGUAGE DeriveDataTypeable #-}

import Data.Data                     -- in base
import Data.Generics.Uniplate.Data   -- package uniplate

data Expr
  = Variable String
  | Number Int
  | Add [Expr]
  | Sub Expr Expr
  deriving (Show, Data)

substituteName :: String -> Int -> Expr -> Expr
substituteName name newValue = transform f
  where f (Variable x) | x == name = Number newValue
        f other = other

replaceSubWithAdd :: Expr -> Expr
replaceSubWithAdd = transform f
  where f (Sub x (Number y)) = Add [x, Number (-y)]
        f other = other

replaceSubWithAdd1 :: Expr -> Expr
replaceSubWithAdd1 = descend f
  where f (Sub x (Number y)) = Add [x, Number (-y)]
        f other = other

main = do
  print $ substituteName "x" 42 (Add [Add [Variable "x"], Number 0])
  print $ replaceSubWithAdd e
  print $ replaceSubWithAdd1 e
  where e = Add [Sub (Add [Variable "x", Sub (Variable "y") (Number 34)])
                     (Number 10), Number 4]

- K. A. Buhr