haskell - 是否可以使用 GHC 泛型重新实现 `Enum` 派生

Question

是否可以使用 GHC 重新实现 Enum 类型类的派生泛型？

乍一看，它看起来很简单:

data Foo -- representation without metadata (wrong):
  = Foo  -- L1 U1
  | Bar  -- R1 (L1 U1)
  | Baz  -- R1 (R1 (L1 U1))
  | Quux -- R1 (R1 (R1 U1))
  deriving (Show, Eq, Generic)

-- Rep Foo p = (U1 :+: (U1 :+: (U1 :+: U1))) p

instance Enum Foo where
  toEnum   = undefined -- FIXME
  fromEnum = gfromEnum . from

class GEnum f where
  gfromEnum :: f p -> Int

instance GEnum U1 where
  gfromEnum U1 = 0

instance GEnum f => GEnum (M1 i t f) where
  gfromEnum (M1 x) = gfromEnum x

instance (GEnum x, GEnum y) => GEnum (x :+: y) where
  gfromEnum (L1 x) = gfromEnum x
  gfromEnum (R1 y) = 1 + gfromEnum y

但是，这是行不通的:

λ> fromEnum Foo
0
λ> fromEnum Bar
1
λ> fromEnum Baz
1
λ> fromEnum Quux
2

这是因为我们不能依赖 (:+:) 的参数如何分组。在在这种情况下，它们似乎是这样嵌套的:

((U1 :+: U1) :+: (U1 :+: U1)) p

那么，是否可以使用泛型派生Enum？如果是，怎么办？

Answer 1

GHC 派生出Generic，使得 L 和 R 变体形成一棵树，其中叶子按 Enum 顺序排列。考虑以下示例(经过修剪的输出):

ghci> data D = A | B | C | D | E deriving (Generic)
ghci> from A
L1 (L1 U1)
ghci> from B
L1 (R1 U1)
ghci> from C
R1 (L1 U1)
ghci> from D
R1 (R1 (L1 U1))
ghci> from E
R1 (R1 (R1 U1)))

请注意，如果将它们排列为树，toEnum `map` [1..] 将是从左到右遍历叶子。凭借这种直觉，我们将首先定义一个 GLaves 类，该类计算泛型类型(不是值!)在其树中的叶子数量。

{-# LANGUAGE ScopedTypeVariables, PolyKinds, TypeApplications, TypeOperators,
             DefaultSignatures, FlexibleContexts, TypeFamilies #-}

import GHC.Generics
import Data.Proxy

class GLeaves f where
  -- | Counts the number of "leaves" (i.e. U1's) in the type `f`
  gSize :: Proxy f -> Int

instance GLeaves U1 where
  gSize _ = 1

instance GLeaves x => GLeaves (M1 i t x) where
  gSize _ = gSize (Proxy :: Proxy x)

instance (GLeaves x, GLeaves y) => GLeaves (x :+: y) where
  gSize _ = gSize (Proxy :: Proxy x) + gSize (Proxy :: Proxy y)

现在，我们已经准备好定义GEnum了。与此设置一样，我们定义类 Enum' 并具有依赖于 GEnum 的默认签名。

class Enum' a where
  toEnum' :: Int -> a
  fromEnum' :: a -> Int

  default toEnum' :: (Generic a, GEnum (Rep a)) => Int -> a
  toEnum' = to . gToEnum

  default fromEnum' :: (Generic a, GEnum (Rep a)) => a -> Int
  fromEnum' = gFromEnum . from

class GEnum f where
  gFromEnum :: f p -> Int
  gToEnum :: Int -> f p

最后，我们迎来了好东西。对于 U1 和 M1，gFromEnum 和 gToEnum 都很简单。对于 :+:，gFromEnum 需要找到它左边的所有叶子，所以如果它是右子树，我们添加左子树的大小(并且如果它是左子树，我们什么也不添加)。类似地，gToEnum通过检查它是否小于左子树中的叶子数来检查它属于左子树还是右子树。

instance GEnum U1 where
  gFromEnum U1 = 0

  gToEnum n = if n == 0 then U1 else error "Outside enumeration range"

instance GEnum f => GEnum (M1 i t f) where
  gFromEnum (M1 x) = gFromEnum x

  gToEnum n = M1 (gToEnum n)

instance (GLeaves x, GEnum x, GEnum y) => GEnum (x :+: y) where
  gFromEnum (L1 x) = gFromEnum x
  gFromEnum (R1 y) = gSize (Proxy :: Proxy x) + gFromEnum y

  gToEnum n = let s = gSize (Proxy :: Proxy x)
              in if n < s then L1 (gToEnum n) else R1 (gToEnum (n - s))

最后，您可以在 GHCi 中对此进行测试:

ghci> :set -XDeriveAnyClass -XDeriveGeneric
ghci> data D = A | B | C | D | E deriving (Show, Generic, Enum, Enum')
ghci> toEnum `map` [0 .. 4] :: [D]
[A,B,C,D,E]
ghci> toEnum' `map` [0 .. 4] :: [D]
[A,B,C,D,E]
ghci> fromEnum `map` [A .. E] :: [Int]
[A,B,C,D,E]
ghci> fromEnum' `map` [A .. E] :: [Int]
[A,B,C,D,E]

性能

你可能会想:这效率太低了!我们最终一遍又一遍地重新计算一堆大小 - 最坏情况下的性能至少是 O(n^2)。问题是(希望)GHC 将能够优化/内联我们特定的 Enum' 实例，直到初始 Generic 没有任何剩余。 > 结构。