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

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

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

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

我有很多函数可以做一些简单的事情，比如：

-- 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

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

我能想到的唯一解决方案是使用一个函数，该函数首先对整个数据结构调用函数，然后递归调用结果，如下所示：

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

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

---

但我觉得应该有一个更简单的方法来做到这一点。我遗漏了什么吗？

恭喜你，你刚刚重新发现了变形

这是您的代码，经过重新表述，可以与

递归方案

包一起使用。唉，它并不短，因为我们需要一些样板来让机器工作。（可能有一些自动控制的方法来避免样板文件，例如使用仿制药。我只是不知道。）

下面，您的

递归在

被标准的

ana

替换之后

我们首先定义递归类型，以及它的不动点函子

{-# 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找到了automagic工具。这使得整个代码相当简短。请注意，

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])

---

作为替代方法，这也是

uniplate

包的典型用例。它可以使用

Data.Data

泛型而不是模板Haskell来生成样板文件，因此如果您为

Expr

派生

Data

实例：

import Data.Data

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

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

然后来自

Data.Generics.Uniplate.Data

的

transform

函数递归地将函数应用于每个嵌套的

Expr

：

import Data.Data

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

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

被编写为执行非递归替换

transform

使其在

x:：Expr

中递归，因此它对helper函数的作用与@chi的答案中的

ana

相同：

> 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的模板Haskell解决方案短。一个潜在优势是

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]

---

制作代码的“提升”版本。在这里，您可以使用决定执行操作的参数（函数）。然后你可以通过将函数传递给提升版本来生成特定的函数。我认为你的语言可以简化。定义

Add:：Expr->Expr->Expr

，而不是

Add:：[Expr]->Expr

，并完全去掉

Sub

；虽然这在本例中有效，但我需要能够包含语言其他部分的表达式列表，例如？大多数（如果不是全部的话）链式运算符都可以简化为嵌套的二进制运算符。我认为您的

递归后的
是
ana
伪装的。您可能想看看同构和
递归方案
。尽管如此，我认为你的最终解决方案是尽可能短的。切换到官方的
递归模式
同构不会节省太多。你真的必须明确定义
Expr
，而不是像
type Expr=Fix ExprF
这样的东西吗？@chepner我简单地提到了这一点作为替代。对任何事情都必须使用双构造函数有点不方便：
Fix
+真正的构造函数。IMO说，将最后一种方法与TH自动化结合使用更好。