Haskell - 简单的构造函数比较(?)函数

时间:2012-04-11 19:36:57

标签: haskell

在我的项目中,我创建了一种数据类型,它可以包含几种类型的值之一:

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

6 个答案:

答案 0 :(得分:20)

查看Data.Data及其toConstr功能。这将返回构造函数的表示形式,可以对其进行相等性比较。

使用扩展程序(您可以将{-# LANGUAGE DeriveDataTypeable #-}放在模块的顶部),您可以自动为您导出Data个实例:

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

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

现在以下情况属实:

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

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

sameConstructor = (==) `on` toConstr

这与

相同
sameConstructor l r = toConstr l == toConstr r

我认为使用on的版本一目了然更容易阅读。

答案 1 :(得分:4)

这在Haskell和ML家族语言中被称为expression problem;有许多令人不满意的解决方案(包括在Haskell中使用Data.Typeable和滥用类型类)但没有很好的解决方案。

答案 2 :(得分:2)

由于定义遵循常规格式,因此您可以使用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,它将自动为我们生成实例。

defaultdefault 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涉及很多其他不值得展示的臃肿)

在实践中,这导致模板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)

答案 3 :(得分:1)

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

答案 4 :(得分:0)

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

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

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

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

答案 5 :(得分:0)

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

{-# 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;否则我们会使用它的实际标签。