So reduzieren Sie die Codeduplizierung beim Umgang mit rekursiven Summentypen

Ich arbeite derzeit an einem einfachen Interpreter für eine Programmiersprache und habe einen Datentyp wie diesen:

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

Und ich habe viele Funktionen, die einfache Dinge tun wie:

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

Aber in jeder dieser Funktionen muss ich den Teil, der den Code rekursiv aufruft, mit nur einer kleinen Änderung an einem Teil der Funktion wiederholen. Gibt es eine Möglichkeit, dies allgemeiner zu tun? Ich möchte diesen Teil lieber nicht kopieren und einfügen:

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

Und ändern Sie jedes Mal einen einzelnen Fall, da es ineffizient erscheint, Code wie diesen zu duplizieren.

Die einzige Lösung, die ich finden könnte, besteht darin, eine Funktion zu haben, die zuerst eine Funktion für die gesamte Datenstruktur und dann rekursiv für das Ergebnis wie folgt aufruft:

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

Aber ich denke, es sollte wahrscheinlich schon einen einfacheren Weg geben, dies zu tun. Vermisse ich etwas

Herzlichen Glückwunsch, Sie haben gerade Anamorphismen wiederentdeckt!

Hier ist Ihr Code, der so umformuliert wurde, dass er mit dem recursion-schemesPaket funktioniert . Leider ist es nicht kürzer, da wir eine Kesselplatte brauchen, damit die Maschinen funktionieren. (Es könnte einen automatischen Weg geben, um das Boilerplate zu vermeiden, z. B. mit Generika. Ich weiß es einfach nicht.)

Unten wird Ihr recurseAfterdurch den Standard ersetzt ana.

Wir definieren zunächst Ihren rekursiven Typ sowie den Funktor, dessen Fixpunkt er ist.

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

Dann verbinden wir die beiden mit einigen Instanzen, damit wir uns Exprin das Isomorphe entfalten ExprF Exprund es zurückfalten können.

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

Schließlich passen wir Ihren ursprünglichen Code an und fügen einige Tests hinzu.

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

Eine Alternative könnte darin bestehen, ExprF anur zu definieren und dann abzuleiten type Expr = Fix ExprF. Dies spart einen Teil der oben genannten Kesselplatte (z. B. die beiden Instanzen) auf Kosten der Verwendung Fix (VariableF ...)anstelle Variable ...der analogen für die anderen Konstruktoren.

Man könnte dies weiter mildern, indem man Mustersynonyme verwendet (allerdings auf Kosten von etwas mehr Boilerplate).

Update: Ich habe endlich das Automagic-Tool mit der Vorlage Haskell gefunden. Dies macht den gesamten Code ziemlich kurz. Beachten Sie, dass der ExprFFunktor und die beiden oben genannten Instanzen noch unter der Haube vorhanden sind und wir sie weiterhin verwenden müssen. Wir sparen nur den Aufwand, sie manuell definieren zu müssen, aber das allein spart viel Aufwand.

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

Als alternativer Ansatz ist dies auch ein typischer Anwendungsfall für das uniplatePaket. Es kann Data.DataGenerika anstelle von Template Haskell verwenden, um das Boilerplate zu generieren. Wenn Sie also DataInstanzen für Folgendes ableiten Expr:

import Data.Data

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

dann wendet die transformFunktion von Data.Generics.Uniplate.Dataeine Funktion rekursiv auf jedes verschachtelte an 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

Beachten Sie, dass replaceSubWithAddinsbesondere die Funktion fso geschrieben ist, dass sie eine nicht rekursive Substitution durchführt. transformmacht es rekursiv in x :: Expr, so dass es der Helferfunktion dieselbe Magie verleiht wie anain @ chis Antwort:

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

Dies ist nicht kürzer als die Template Haskell-Lösung von @ chi. Ein möglicher Vorteil besteht darin, dass uniplateeinige zusätzliche Funktionen bereitgestellt werden, die hilfreich sein können. Wenn Sie beispielsweise descendanstelle von verwenden transform, werden nur die unmittelbaren untergeordneten Elemente transformiert, wodurch Sie steuern können, wo die Rekursion stattfindet, oder Sie können rewritedas Ergebnis von Transformationen erneut transformieren, bis Sie einen festen Punkt erreichen. Ein möglicher Nachteil ist, dass "Anamorphismus" viel cooler klingt als "uniplate".

Vollständiges Programm:

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