Jak ograniczyć duplikację kodu w przypadku typów sum rekurencyjnych

Obecnie pracuję nad prostym tłumaczem dla języka programowania i mam taki typ danych:

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

I mam wiele funkcji, które wykonują proste rzeczy, takie jak:

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

Ale w każdej z tych funkcji muszę powtórzyć część, która wywołuje kod rekurencyjnie, z niewielką zmianą w jednej części funkcji. Czy istnieje jakiś sposób, aby to zrobić bardziej ogólnie? Wolałbym nie kopiować i wklejać tej części:

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

I po prostu zmieniaj po jednym przypadku za każdym razem, ponieważ zduplikowanie takiego kodu wydaje się nieefektywne.

Jedyne rozwiązanie, jakie mogłem wymyślić, to mieć funkcję, która wywołuje funkcję najpierw w całej strukturze danych, a następnie rekurencyjnie w wyniku:

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

Ale wydaje mi się, że prawdopodobnie powinien istnieć już prostszy sposób, aby to zrobić. Czy coś brakuje?

— Scott
źródło

Stwórz „podniesioną” wersję kodu. Gdzie używasz parametrów (funkcji), które decydują o tym, co robić. Następnie możesz wykonać określoną funkcję, przekazując funkcje do wersji podniesionej.

— Willem Van Onsem

Myślę, że twój język można uprościć. Zdefiniuj Add :: Expr -> Expr -> Exprzamiast Add :: [Expr] -> Expri Subcałkowicie się pozbądź .

— chepner

Po prostu używam tej definicji jako wersji uproszczonej; chociaż to zadziałałoby w tym przypadku, muszę być w stanie zawierać listy wyrażeń również dla innych części języka

— Scott,

Jak na przykład? Większość, jeśli nie wszystkie, powiązane operatory można zredukować do zagnieżdżonych operatorów binarnych.

— chepner

Myślę, że twój recurseAfterjest anaw przebraniu. Możesz spojrzeć na anamorfizmy i recursion-schemes. Biorąc to pod uwagę, myślę, że twoje ostateczne rozwiązanie jest tak krótkie, jak to tylko możliwe. Przejście na oficjalne recursion-schemesanamorfizmy niewiele zaoszczędzi.

— chi

Odpowiedzi:

Gratulacje, właśnie odkryłeś anamorfizmy!

Oto twój kod, sformatowany tak, aby działał z recursion-schemespakietem. Niestety, nie jest krótszy, ponieważ potrzebujemy trochę płyty kotłowej, aby maszyna mogła działać. (Może istnieć jakiś automatyczny sposób na uniknięcie płyty kotłowej, np. Użycie leków generycznych. Po prostu nie wiem.)

Poniżej twój recurseAfterjest zastąpiony standardem ana.

Najpierw określamy twój typ rekurencyjny, a także funktor, którego jest stałym punktem.

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

Następnie łączymy je z kilkoma instancjami, abyśmy mogli rozwinąć Exprsię w izomorfię ExprF Expri złożyć ją z powrotem.

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

Na koniec dostosowujemy Twój oryginalny kod i dodajemy kilka testów.

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

Alternatywą może być ExprF atylko zdefiniowanie , a następnie wyprowadzenie type Expr = Fix ExprF. Oszczędza to część powyższego schematu (np. Dwa wystąpienia), kosztem użycia Fix (VariableF ...)zamiast niego Variable ..., a także analogiczne dla innych konstruktorów.

Można by dodatkowo złagodzić ten fakt, używając synonimów wzorców (jednak kosztem nieco więcej płyt grzewczych).

Aktualizacja: W końcu znalazłem narzędzie automagiczne, używając szablonu Haskell. To sprawia, że cały kod jest dość krótki. Zauważ, że ExprFfunktor i dwie powyższe instancje wciąż istnieją pod maską i nadal musimy ich używać. Oszczędzamy tylko kłopotów z ich ręcznym definiowaniem, ale samo to oszczędza dużo wysiłku.

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

— chi
źródło

Czy naprawdę musisz Exprwyraźnie określać , a nie coś w stylu type Expr = Fix ExprF?

— chepner

@chepner krótko wspomniałem o tym jako alternatywie. Trochę niewygodne jest używanie podwójnych konstruktorów do wszystkiego: Fix+ prawdziwy konstruktor. Zastosowanie ostatniego podejścia z automatyzacją TH jest przyjemniejsze, IMO.

— chi

Jako alternatywne podejście jest to również typowy przypadek użycia uniplatepakietu. Może używać Data.Datagenerycznych zamiast szablonu Haskell do generowania płyty bazowej, więc jeśli wyprowadzasz Datainstancje dla Expr:

import Data.Data

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

następnie transformfunkcja from Data.Generics.Uniplate.Datastosuje rekurencyjnie funkcję do każdego zagnieżdżonego 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

Należy zauważyć, że w replaceSubWithAddszczególności funkcja fjest napisana w celu wykonania nierekurencyjnego podstawienia; transformsprawia, że jest rekurencyjny x :: Expr, więc robi tę samą magię dla funkcji pomocnika, co anaw odpowiedzi @ 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]
>

To nie mniej niż rozwiązanie @ chi's Template Haskell. Jedną z potencjalnych zalet jest to, że uniplatezapewnia kilka dodatkowych funkcji, które mogą być pomocne. Na przykład, jeśli używasz descendzamiast transform, przekształca tylko bezpośrednie dzieci, które mogą dać ci kontrolę nad tym, gdzie ma miejsce rekurencja, lub możesz użyć rewritedo ponownego przekształcenia wyniku transformacji, aż dojdziesz do stałego punktu. Jedną potencjalną wadą jest to, że „anamorfizm” brzmi o wiele fajniej niż „uniplate”.

Pełny program:

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

— KA Buhr
źródło