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

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

但我觉得可能应该有一种更简单的方法来做到这一点。我错过了什么吗？

Answer 1

恭喜，您刚刚重新发现了变形!

这是您的代码，已重新表述，以便它可以与 recursion-schemes 一起使用。包裹。唉，它并不短，因为我们需要一些样板来使机器工作。 (可能有一些自动的方法来避免样板文件，例如使用泛型。我根本不知道。)

下面是您的recurseAfter替换为标准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 ... ，以及其他构造函数的类似情况。

可以使用模式同义词进一步缓解这种情况(不过，代价是增加一点样板代码)。

<小时/>

更新:我终于找到了 automagic 工具，使用模板 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])