题

我正在实施 Scheme，我的数字塔的一部分看起来像这样：

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

如您所见，除了底层操作外，abs、signum、 和negate是相同的。(+)和也是如此(*)。我怎样才能排除这种重复的逻辑？

尝试的解决方案

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 (*)

这不会类型检查：

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

我（认为我）理解为什么不允许这样做：如果是这样，则op可能不会为Integerand定义Float，这显然是一个问题。但是，我仍然没有看到解决方案。有没有办法做到这一点？我想知道是否需要根据类型类重写我的类型系统以避免这种重复。

回答

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

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

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

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

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