Eliminating code duplication between similar sum type methods

Viewed 73

Question

I'm implementing Scheme, and part of my numerical tower looks something like this:

data MyNumber
  = MyInt Integer
  | MyFloat Float

instance Num MyNumber where
  abs = \case
    MyInt val -> MyInt $ abs val
    MyFloat val -> MyFloat $ abs val

  signum = \case
    MyInt val -> MyInt $ signum val
    MyFloat val -> MyFloat $ signum val

  negate = \case
    MyInt val -> MyInt $ negate val
    MyFloat val -> MyFloat $ negate val

  (+) a b = case (a, b) of
    (MyInt a', MyInt b')     -> MyInt $ a' + b'
    (MyInt a', MyFloat b')   -> MyFloat $ fromInteger a' + b'
    (MyFloat a', MyInt b')   -> MyFloat $ a' + fromInteger b'
    (MyFloat a', MyFloat b') -> MyFloat $ a' + b'

  (*) a b = case (a, b) of
    (MyInt a', MyInt b')     -> MyInt $ a' * b'
    (MyInt a', MyFloat b')   -> MyFloat $ fromInteger a' * b'
    (MyFloat a', MyInt b')   -> MyFloat $ a' * fromInteger b'
    (MyFloat a', MyFloat b') -> MyFloat $ a' * b'

  fromInteger = MyInt

As you can see, abs, signum, and negate are identical except for the underlying operation. The same is true of (+) and (*). How can I factor out this repetitive logic?

Attempted Solution

myNumberMonoOp :: (a -> a) -> (MyNumber -> MyNumber)
myNumberMonoOp op = \case
  MyInt val -> MyInt $ op val
  MyFloat val -> MyFloat $ op val

myNumberBinOp :: (a -> a -> a) -> (MyNumber -> MyNumber -> MyNumber)
myNumberBinOp op a b = case (a, b) of
    (MyInt a', MyInt b')     -> MyInt $ a' `op` b'
    (MyInt a', MyFloat b')   -> MyFloat $ fromInteger a' `op` b'
    (MyFloat a', MyInt b')   -> MyFloat $ a' `op` fromInteger b'
    (MyFloat a', MyFloat b') -> MyFloat $ a' `op` b'

instance Num MyNumber where
  abs = myNumberMonoOp abs
  signum = myNumberMonoOp signum
  negate = myNumberMonoOp negate
  (+) = myNumberBinOp (+)
  (*) = myNumberBinOp (*)

This doesn't type check:

/path/to/Main.hs:44:27:error:
    • Couldn't match expected type ‘a’ with actual type ‘Integer’
      ‘a’ is a rigid type variable bound by
        the type signature for:
          myNumberMonoOp :: forall a. (a -> a) -> MyNumber -> MyNumber
        at src/Main.hs:42:1-52
    • In the first argument of ‘op’, namely ‘val’
      In the second argument of ‘($)’, namely ‘op val’
      In the expression: MyInt $ op val
    • Relevant bindings include
        op :: a -> a (bound at src/Main.hs:43:16)
        myNumberMonoOp :: (a -> a) -> MyNumber -> MyNumber
          (bound at src/Main.hs:43:1)
   |
44 |   MyInt val -> MyInt $ op val
   |                           ^^^

I (think I) understand why this isn't allowed: if it were, op may not be defined for Integer and Float, which would clearly be an issue. But still, I don't see the solution. Is there a way to do this? I'm wondering if I'd need to rewrite my type system in terms of type classes in order to avoid this sort of duplication.

1 Answers

The solution will not work since the abs for the MyInt and MyFloat case are not the same. Indeed, the abs for MyInt has type abs :: Int -> Int, whereas for the MyFloat it has type abs :: Float -> Float.

You can make a function that works with two functions, one for the Ints, and one for the Floats:

mapNumber :: (Int -> Int) -> (Float -> Float) -> MyNumber -> MyNumber
mapNumber f g = go
  where go (MyInt x) = MyInt (f x)
        go (MyFloat x) = MyFloat (g x)

and then implement this as:

instance Num MyNumber where
  abs = mapNumber abs abs
  signum = mapNumber signum signum
  negate = mapNumber negate negate
  # …

for the two-parameter operations, we do something similar:

mapNumber2 :: (Int -> Int -> Int) -> (Float -> Float -> Float) -> MyNumber -> MyNumber
mapNumber2 f g = go
  where go (MyInt x) (MyInt y) = MyInt (f x y)
        go x y = g (go' x) (go' y)
        go' (MyInt x) = fromIntegral x
        go' (MyFloat x) = x

Another option is to work with a the RankNTypes language extension here:

{-# LANGUAGE RankNTypes #-}

mapNumber :: (forall a. Num a => a -> a) -> MyNumber -> MyNumber
mapNumber f = go
  where go (MyInt x) = MyInt (f x)
        go (MyFloat x) = MyFloat (f x)

Then you can implement this with:

instance Num MyNumber where
  abs = mapNumber abs
  signum = mapNumber signum
  negate = mapNumber negate
  # …
Related