Как уменьшить дублирование кода при работе с рекурсивными типами сумм

В настоящее время я работаю над простым интерпретатором языка программирования, и у меня есть такой тип данных:

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

Но я чувствую, что, вероятно, должен быть более простой способ сделать это уже. Я что-то пропустил?

— Скотт
источник

Сделайте «поднятую» версию кода. Где вы используете параметры (функции), которые решают, что делать. Затем вы можете сделать определенную функцию, передав функции в поднятую версию.

— Виллем Ван Онсем

Я думаю, что ваш язык может быть упрощен. Определить Add :: Expr -> Expr -> Exprвместо Add :: [Expr] -> Expr, и избавиться от Subвсего.

— chepner

Я просто использую это определение как упрощенную версию; хотя в этом случае это будет работать, мне нужно иметь возможность содержать списки выражений и для других частей языка

— Скотт,

Такие как? Большинство, если не все, цепочечные операторы могут быть сведены к вложенным бинарным операторам.

— chepner

Я думаю , что ваш recurseAfterIS anaв маскировке. Возможно, вы захотите посмотреть на анаморфизмы и recursion-schemes. При этом, я думаю, ваше окончательное решение настолько короткое, насколько это возможно. Переход на официальные recursion-schemesанаморфизмы не спасет много.

— Чи

Ответы:

Поздравляю, вы только что заново обнаружили анаморфизмы!

Вот ваш код, перефразированный так, чтобы он работал с 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 ..., а также аналогично для других конструкторов.

Можно также смягчить это, используя синонимы паттернов (хотя и ценой чуть большего количества шаблонов).

Обновление: я наконец-то нашел инструмент для автоматизации, использующий шаблон 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])

— чи
источник

Вы действительно должны определить Exprявно, а не что-то вроде type Expr = Fix ExprF?

— Chepner

@chepner Я кратко упомянул это как альтернативу. Немного неудобно использовать двойные конструкторы для всего: Fix+ настоящий конструктор. Использование последнего подхода с автоматизацией TH приятнее, IMO.

— Чи

В качестве альтернативного подхода это также типичный вариант использования uniplateпакета. Он может использовать Data.Dataдженерики, а не Template Haskell, чтобы сгенерировать шаблон, так что если вы получаете Dataэкземпляры для вашего Expr:

import Data.Data

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

тогда transformфункция из Data.Generics.Uniplate.Dataприменяет функцию рекурсивно к каждому вложенному 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написана для выполнения нерекурсивной замены; transformделает его рекурсивным x :: Expr, поэтому он выполняет ту же магию для вспомогательной функции, что 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]
>

Это не короче, чем решение Template Haskell от @ chi. Одним из потенциальных преимуществ является то, что он uniplateпредоставляет некоторые дополнительные функции, которые могут быть полезны. Например, если вы используете descendвместо transformнего, он преобразует только непосредственных потомков, которые могут дать вам контроль над тем, где происходит рекурсия, или вы можете использовать, rewriteчтобы повторно преобразовать результат преобразований, пока не достигнете фиксированной точки. Одним потенциальным недостатком является то, что «анаморфизм» звучит намного круче, чем «одноплатный».

Полная программа:

{-# 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]

— К. А. Бур
источник