Haskell - 简单的构造函数比较（？）函数

Question

在我的项目中，我创建了一种数据类型，它可以保存以下几种类型的值之一：

data PhpValue = VoidValue | IntValue Integer | BoolValue Bool

我现在想做的是有一种简单的方法来检查 PhpValue 类型的两个值是否属于同一个构造函数（如果我对这里的术语感到困惑，请纠正我，但基本上我想要的例如，检查两者是否都是IntValue，而不关心特定值）。

这是我为此编写的一个函数：

sameConstructor :: PhpValue -> PhpValue -> Bool
sameConstructor VoidValue VoidValue = True
sameConstructor (IntValue _) (IntValue _) = True
sameConstructor (BoolValue _) (BoolValue _) = True
sameConstructor _ _ = False

这可以正常工作，但我不太喜欢它：如果我添加更多构造函数（如FloatValue Float），我将不得不重写函数，并且随着我的数据定义变得更大，它会变得更大.

问题：有没有办法编写这样的函数，这样当我添加更多构造函数时它的实现不会改变？

郑重声明：我不想更改data 的定义，我的其余代码中有足够的Monads ;)

Answer 1

看看Data.Data 及其toConstr 函数。这将返回构造函数的表示，可以比较其是否相等。

通过扩展（您可以将{-# LANGUAGE DeriveDataTypeable #-} 放在模块顶部），您可以自动为您派生一个Data 实例：

data PhpValue = VoidValue | IntValue Integer | BoolValue Bool 
              deriving (Typeable, Data)

然后您应该能够使用toConstr 函数通过构造函数进行比较。

现在以下将是正确的：

toConstr (BoolValue True) == toConstr (BoolValue False)

使用 Data.Function 中的 on，您现在可以将 sameConstructor 重写为：

sameConstructor = (==) `on` toConstr

这是一样的

sameConstructor l r = toConstr l == toConstr r

我认为使用on 的版本一目了然。

Answer 2

这在 Haskell 和 ML 系列语言中称为 expression problem；有许多不令人满意的解决方案（包括在 Haskell 中使用 Data.Typeable 和滥用类型类），但没有好的解决方案。

Answer 3

Data 的一个流行替代方案是Generic。我认为Data 在这种情况下可能更有意义，但我认为为了完整性添加它是有意义的。

{-# LANGUAGE DefaultSignatures, TypeOperators, FlexibleContexts #-}
module SameConstr where

import GHC.Generics
import Data.Function (on)

class EqC a where
    eqConstr :: a -> a -> Bool
    default eqConstr :: (Generic a, GEqC (Rep a)) => a -> a -> Bool
    eqConstr = geqConstr `on` from

class GEqC f where
  geqConstr :: f p -> f p -> Bool
  {-# INLINE geqConstr #-}
  geqConstr _ _ = True

instance GEqC f => GEqC (M1 i c f) where
  {-# INLINE geqConstr #-}
  geqConstr (M1 x) (M1 y) = geqConstr x y

instance GEqC (K1 i c)
instance GEqC (f :*: g)
instance GEqC U1
instance GEqC V1

instance (GEqC f, GEqC g) => GEqC (f :+: g) where
  {-# INLINE geqConstr #-}
  geqConstr (L1 x) (L1 y) = geqConstr x y
  geqConstr (R1 x) (R1 y) = geqConstr x y
  geqConstr _ _ = False

Answer 4

由于定义遵循常规格式，您可以使用 Template Haskell 为任何数据类型自动派生这样的函数。我继续为此写了simple package，因为我对现有的解决方案并不完全满意。

首先，我们定义一个类

class EqC a where
    eqConstr :: a -> a -> Bool
    default eqConstr :: Data a => a -> a -> Bool
    eqConstr = (==) `on` toConstr

然后是一个函数deriveEqC :: Name -> DecsQ，它将自动为我们生成实例。

default 是default signature，这意味着当类型是Data 的实例时，我们可以省略eqConstr 的定义，并退回到Tikhon 的实现。

Template Haskell 的好处是它产生了更高效的函数。我们可以写$(deriveEqC ''PhpValue) 并得到一个与我们手写的完全相同的实例。看看生成的核心：

$fEqCPhpValue_$ceqConstr =
  \ ds ds1 ->
    case ds of _ { 
      VoidValue ->
        case ds1 of _ { 
          __DEFAULT -> False;
          VoidValue -> True
        };  
      IntValue ds2 ->
        case ds1 of _ { 
          __DEFAULT -> False;
          IntValue ds3 -> True
        };  
      BoolValue ds2 ->
        case ds1 of _ { 
          __DEFAULT -> False;
          BoolValue ds3 -> True
        }   
    }  

相比之下，使用Data 通过在比较每个参数是否相等之前为每个参数具体化一个显式Constr 引入了大量额外的间接：

eqConstrDefault =
  \ @ a $dData eta eta1 ->
    let {
      f
      f = toConstr $dData } in
    case f eta of _ { Constr ds ds1 ds2 ds3 ds4 ->
    case f eta1 of _ { Constr ds5 ds6 ds7 ds8 ds9 ->
    $fEqConstr_$c==1 ds ds5
    }
    }

（在计算 toConstr 时还有很多其他的膨胀，不值得展示）

在实践中，这导致 Template Haskell 实现的速度大约是原来的两倍：

benchmarking EqC/TH
time                 6.906 ns   (6.896 ns .. 6.915 ns)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 6.903 ns   (6.891 ns .. 6.919 ns)
std dev              45.20 ps   (32.80 ps .. 63.00 ps)

benchmarking EqC/Data
time                 14.80 ns   (14.77 ns .. 14.82 ns)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 14.79 ns   (14.77 ns .. 14.81 ns)
std dev              60.17 ps   (43.12 ps .. 93.73 ps)

Answer 5

在您的特殊情况下，您可以使用编译器的Show 魔法：

data PhpValue = VoidValue | IntValue Integer | BoolValue Bool deriving Show

sameConstructor v1 v2 = cs v1 == cs v2 where 
   cs = takeWhile (/= ' ') . show

当然取决于编译器生成的字符串表示非常接近于破解...

Answer 6

如果您不想在其他答案中使用任何合理的方式，则可以使用完全不受支持的方式，这种方式可以保证快速但实际上不能保证给出正确的结果甚至不会崩溃。请注意，这甚至会很乐意尝试比较函数，因为它会给出完全虚假的结果。

{-# language MagicHash, BangPatterns #-}

module DangerZone where

import GHC.Exts (Int (..), dataToTag#)
import Data.Function (on)

{-# INLINE getTag #-}
getTag :: a -> Int
getTag !a = I# (dataToTag a)

sameConstr :: a -> a -> Bool
sameConstr = (==) `on` getTag

另一个问题（可以说）是它通过新类型对等。所以如果你有

newtype Foo a = Foo (Maybe a)

然后

sameConstr (Foo (Just 3)) (Foo Nothing) == False

即使它们是使用 Foo 构造函数构建的。您可以通过使用GHC.Generics 中的一些机制来解决此问题，但没有与使用未优化的泛型相关的运行时成本。这变得很毛茸茸！

{-# language MagicHash, BangPatterns, TypeFamilies, DataKinds,
             ScopedTypeVariables, DefaultSignatures #-}

import Data.Proxy (Proxy (..))
import GHC.Generics
import Data.Function (on)
import GHC.Exts (Int (..), dataToTag#)

--Define getTag as above

class EqC a where
  eqConstr :: a -> a -> Bool
  default eqConstr :: forall i q r s nt f.
                      ( Generic a
                      , Rep a ~ M1 i ('MetaData q r s nt) f
                      , GNT nt)
                   => a -> a -> Bool
  eqConstr = genEqConstr

-- This is separated out to work around a bug in GHC 8.0
genEqConstr :: forall a i q r s nt f.
                      ( Generic a
                      , Rep a ~ M1 i ('MetaData q r s nt) f
                      , GNT nt)
                   => a -> a -> Bool
genEqConstr = (==) `on` modGetTag (Proxy :: Proxy nt)

class GNT (x :: Bool) where
  modGetTag :: proxy x -> a -> Int

instance GNT 'True where
  modGetTag _ _ = 0

instance GNT 'False where
  modGetTag _ a = getTag a

这里的关键思想是我们查看与类型的通用表示相关的类型级元数据，以确定它是否是新类型。如果是，我们将其“标签”报告为0；否则我们使用它的实际标签。