Haskell - простая функция сравнения конструкторов (?)

Ответ 1

Взгляните на 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, легче читать с первого взгляда.

Ответ 2

Это называется проблема выражения на языках Haskell и ML; существует ряд неудовлетворительных решений (в том числе использование Data.Typeable и злоупотребление классными классами в Haskell), но нет хороших решений.

Ответ 3

Поскольку определение следует за правильным форматом, вы можете использовать Template Haskell для автоматического получения такой функции для любого типа данных. Я пошел вперед и написал простой пакет для этого, так как я не был полностью удовлетворен существующими решениями.

Сначала определим класс

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

а затем функцию deriveEqC :: Name -> DecsQ, которая будет автоматически генерировать экземпляры для нас.

default является сигнатурой по умолчанию и означает, что когда тип является экземпляром Data, мы можем опустить определение от eqConstr и вернуться к реализации Тихона.

Преимущество 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)

Ответ 4

Одна из популярных альтернатив 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

Ответ 5

В вашем специальном случае вы можете использовать магию Show компилятора:

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

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

Конечно, в зависимости от строкового представления, сгенерированного компилятором, очень близко к взлому...

Ответ 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; в противном случае мы используем его фактический тег.