haskellfunctional-programmingdrycode-duplicationrecursive-type

How to reduce code duplication when dealing with recursive sum types


I am currently working on a simple interpreter for a programming language and I have a data type like this:

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

And I have many functions that do simple things like:

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

But in each of these functions, I have to repeat the part that calls the code recursively with just a small change to one part of the function. Is there any existing way to do this more generically? I would rather not have to copy and paste this part:

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

And just change a single case each time because it seems inefficient to duplicate code like this.

The only solution I could come up with is to have a function that calls a function first on the whole data structure and then recursively on the result like this:

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

But I feel like there should probably be a simpler way to do this already. Am I missing something?


Solution

  • Congratulations, you just rediscovered anamorphisms!

    Here's your code, rephrased so that it works with the recursion-schemes package. Alas, it's not shorter, since we need some boilerplate to make the machinery work. (There might be some automagic way to avoid the boilerplate, e.g. using generics. I simply do not know.)

    Below, your recurseAfter is replaced with the standard ana.

    We first define your recursive type, as well as the functor it is the fixed point of.

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

    Then we connect the two with a few instances so that we can unfold Expr into the isomorphic ExprF Expr, and fold it back.

    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
    

    Finally, we adapt your original code, and add a couple of 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])
    

    An alternative could be to define ExprF a only, and then derive type Expr = Fix ExprF. This saves some of the boilerplate above (e.g. the two instances), at the cost of having to use Fix (VariableF ...) instead of Variable ..., as well as the analogous for the other constructors.

    One could further alleviate that using pattern synonyms (at the cost of a little more boilerplate, though).


    Update: I finally found the automagic tool, using template Haskell. This makes the whole code reasonably short. Note that the ExprF functor and the two instances above still exist under the hood, and we still have to use them. We only save the hassle of having to define them manually, but that alone saves a lot of effort.

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