Comment réduire la duplication de code lorsqu'il s'agit de types de somme récursive

Je travaille actuellement sur un interpréteur simple pour un langage de programmation et j'ai un type de données comme celui-ci:

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

Et j'ai de nombreuses fonctions qui font des choses simples comme:

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

Mais dans chacune de ces fonctions, je dois répéter la partie qui appelle le code récursivement avec juste un petit changement à une partie de la fonction. Existe-t-il un moyen existant de procéder de manière plus générique? Je préfère ne pas avoir à copier et coller cette partie:

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

Et il suffit de changer un seul cas à chaque fois car il semble inefficace de dupliquer du code comme celui-ci.

La seule solution que je pourrais trouver est d'avoir une fonction qui appelle d'abord une fonction sur toute la structure de données, puis récursivement sur le résultat comme ceci:

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

Mais je pense qu'il devrait probablement déjà y avoir un moyen plus simple de le faire. Suis-je en train de manquer quelque chose?

Félicitations, vous venez de redécouvrir les anamorphismes!

Voici votre code, reformulé pour qu'il fonctionne avec le recursion-schemespackage. Hélas, ce n'est pas plus court, car nous avons besoin d'un passe-partout pour faire fonctionner les machines. (Il pourrait y avoir un moyen automagique d'éviter le passe-partout, par exemple en utilisant des génériques. Je ne sais tout simplement pas.)

Ci-dessous, votre recurseAfterest remplacé par le standard ana.

Nous définissons d'abord votre type récursif, ainsi que le foncteur dont il est le point fixe.

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

Ensuite, nous connectons les deux avec quelques instances afin de pouvoir nous déplier Exprdans l'isomorphe ExprF Expret le replier.

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

Enfin, nous adaptons votre code d'origine et ajoutons quelques tests.

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

Une alternative pourrait être de définir ExprF auniquement, puis de dériver type Expr = Fix ExprF. Cela permet d'économiser une partie du passe-partout ci-dessus (par exemple les deux instances), au prix d'avoir à utiliser à la Fix (VariableF ...)place de Variable ..., ainsi que l'analogue pour les autres constructeurs.

On pourrait encore atténuer cela en utilisant des synonymes de modèle (au prix d'un peu plus de passe-partout, cependant).

Mise à jour: j'ai enfin trouvé l'outil automagique, en utilisant le modèle Haskell. Cela rend l'ensemble du code raisonnablement court. Notez que le ExprFfoncteur et les deux instances ci-dessus existent toujours sous le capot, et nous devons encore les utiliser. Nous économisons seulement les tracas d'avoir à les définir manuellement, mais cela à lui seul économise beaucoup d'efforts.

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

En tant qu'approche alternative, il s'agit également d'un cas d'utilisation typique pour le uniplatepackage. Il peut utiliser des Data.Datagénériques plutôt que Template Haskell pour générer le passe-partout, donc si vous dérivez des Datainstances pour votre Expr:

import Data.Data

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

alors la transformfonction de Data.Generics.Uniplate.Dataapplique une fonction récursivement à chaque imbriqué 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

Notez qu'en replaceSubWithAddparticulier, la fonction fest écrite pour effectuer une substitution non récursive; transformle rend récursif x :: Expr, il fait donc la même magie à la fonction d'assistance que anadans la réponse de @ 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]
> 

Ce n'est pas plus court que la solution Template Haskell de @ chi. Un avantage potentiel est qu'il uniplatefournit des fonctions supplémentaires qui peuvent être utiles. Par exemple, si vous utilisez descendà la place de transform, il transforme uniquement les enfants immédiats, ce qui peut vous donner le contrôle de l'endroit où la récursivité se produit, ou vous pouvez utiliser rewritepour re-transformer le résultat des transformations jusqu'à ce que vous atteigniez un point fixe. Un inconvénient potentiel est que "l'anamorphisme" semble beaucoup plus frais que "uniplate".

Programme complet:

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