Haskell中的类型安全联合？

我可以在Haskell中使用类型安全的联合（如C的

联合

）吗？这是我尝试过的最好的，这里是以C++的std:：Variant命名的

Variant

：

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module Emulation.CPlusPlus.Variant (
    Variant, singleton
) where

import Data.Type.Bool
import Data.Type.Equality
import Type.Reflection

data Variant :: [*] -> * where
    Singleton :: a -> Variant (a ': as)
    Arbitrary :: Variant as -> Variant (a ': as)

singleton :: (Not (bs == '[]) || a == b) ~ 'True => forall a b. a -> Variant (b ': bs)
singleton x = case eqTypeRep (typeRep :: TypeRep a) (typeRep :: TypeRep b) of
    Nothing    -> Arbitrary (singleton x)
    Just HRefl -> Singleton x

这将产生如下错误消息：

Prelude> :load Variant.hs
[1 of 1] Compiling Emulation.CPlusPlus.Variant ( Variant.hs, interpreted )

Variant.hs:19:14: error:
    • Could not deduce: (Not (bs == '[]) || (a0 == b0)) ~ 'True
      from the context: (Not (bs == '[]) || (a == b)) ~ 'True
        bound by the type signature for:
                   singleton :: forall (bs :: [*]) a b.
                                ((Not (bs == '[]) || (a == b)) ~ 'True) =>
                                forall a1 b1. a1 -> Variant (b1 : bs)
        at Variant.hs:19:14-85
      The type variables ‘a0’, ‘b0’ are ambiguous
    • In the ambiguity check for ‘singleton’
      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
      In the type signature:
        singleton :: (Not (bs == '[]) || a == b) ~ True =>
                     forall a b. a -> Variant (b : bs)
   |
19 | singleton :: (Not (bs == '[]) || a == b) ~ True => forall a b. a -> Variant (b ': bs)
   |              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Failed, no modules loaded.

---

我不明白这种歧义是怎么出现的。

构造函数的传统名称是

Inl

和

Inr

：

import Data.Kind

data Sum :: [Type] -> Type where
  Inl :: a -> Sum (a : as) -- INject Left
  Inr :: !(Sum as) -> Sum (a : as) -- INject Right

Inr

中的额外严格性是可选的。考虑<代码>或者B<代码>。此类型具有值

未定义

、

左未定义

、和

右未定义

，以及所有其他值。考虑你的<代码>变量[a，b] < /代码>。这有

未定义

，

单例未定义

，

变量未定义

，和

变量（单例未定义）

。还有一个额外的部分未定义的值，它既不随

出现，也不随
出现
Inr
的严格性将
Inr undefined
和
undefined
挤压在一起。这意味着您不能有一个只有“部分已知”变量的值。下面所有的严格注释都是为了“正确性”。它们在你可能不想要底部的地方压扁底部

现在，@rampion指出，
singleton
的签名在定义错误之前有一个用途。它“应该”是：

但这并不完全正确。如果
a~b
，太好了，这就行了。如果没有，编译器将无法确保
a
位于
bs
中，因为您没有对此进行约束。这个新签名仍然失败。对于最强大的功能，特别是对于未来的定义，您需要

-- Elem x xs has the structure of a Nat, but doubles as a proof that x is in xs
-- or: Elem x xs is the type of numbers n such that the nth element of xs is x
data Elem (x :: k) (xs :: [k]) where
  Here  :: Elem x (x : xs)
  There :: !(Elem x xs) -> Elem x (y : xs) -- strictness optional
-- boilerplate; use singletons or similar to dodge this mechanical tedium
-- EDIT: singletons doesn't support GADTs just yet, so this must be handwritten
-- See https://github.com/goldfirere/singletons/issues/150
data SElem x xs (e :: Elem x xs) where
  SHere  :: SElem x (x : xs) Here
  SThere :: SElem x xs e -> SElem x (y : xs) (There e)
class KElem x xs (e :: Elem x xs) | e -> x xs where kElem :: SElem x xs e
instance KElem x (x : xs) Here where kElem = SHere
instance KElem x xs e => KElem x (y : xs) (There e) where kElem = SThere kElem
demoteElem :: SElem x xs e -> Elem x xs
demoteElem SHere = Here
demoteElem (SThere e) = There (demoteElem e)

-- inj puts a value into a Sum at the given index
inj :: Elem t ts -> t -> Sum ts
inj Here x = Inl x
inj (There e) x = Inr $ inj e x

-- try to find the first index where x occurs in xs
type family FirstIndexOf (x :: k) (xs :: [k]) :: Elem x xs where
  FirstIndexOf x (x:xs) = Here
  FirstIndexOf x (y:xs) = There (FirstIndexOf x xs)
-- INJect First
-- calculate the target index as a type
-- require it as an implicit value
-- defer to inj
injF :: forall as a.
        KElem a as (FirstIndexOf a as) =>
        a -> Sum as
injF = inj (demoteElem $ kElem @a @as @(FirstIndexOf a as))
-- or injF = inj (kElem :: SElem a as (FirstIndexOf a as))

您也可以将
元素
粘贴在
总和
内：

data Sum :: [Type] -> Type where
  Sum :: !(Elem t ts) -> t -> Sum ts -- strictness optional

您可以将
Inl
和
Inr
恢复为模式同义词

pattern Inl :: forall ts. () =>
               forall t ts'. (ts ~ (t : ts')) =>
               t -> Sum ts
pattern Inl x = Sum Here x

data Inr' ts = forall t ts'. (ts ~ (t : ts')) => Inr' (Sum ts')
_Inr :: Sum ts -> Maybe (Inr' ts)
_Inr (Sum Here _) = Nothing
_Inr (Sum (There tag) x) = Just $ Inr' $ Sum tag x
pattern Inr :: forall ts. () =>
               forall t ts'. (ts ~ (t : ts')) =>
               Sum ts' -> Sum ts
pattern Inr x <- (_Inr -> Just (Inr' x))
  where Inr (Sum tag x) = Sum (There tag) x

然后写

data Sum :: [Type] -> Type where
  Sum :: forall t ts (e :: Elem t ts). !(SElem t ts e) -> t -> Sum ts

它接近整数标记和联合的结构，除了所述标记有点过大。
构造函数的常规名称是
Inl
和
Inr
：

import Data.Kind

data Sum :: [Type] -> Type where
  Inl :: a -> Sum (a : as) -- INject Left
  Inr :: !(Sum as) -> Sum (a : as) -- INject Right

Inr
中的额外严格性是可选的。考虑<代码>或者B<代码>。此类型具有值
未定义
、
左未定义
、和
右未定义
，以及所有其他值。考虑你的<代码>变量[a，b] < /代码>。这有
未定义
，
单例未定义
，
变量未定义
，和
变量（单例未定义）
。还有一个额外的部分未定义的值，它既不随
出现，也不随
出现
Inr
的严格性将
Inr undefined
和
undefined
挤压在一起。这意味着您不能有一个只有“部分已知”变量的值。下面所有的严格注释都是为了“正确性”。它们在你可能不想要底部的地方压扁底部

现在，@rampion指出，
singleton
的签名在定义错误之前有一个用途。它“应该”是：

但这并不完全正确。如果
a~b
，太好了，这就行了。如果没有，编译器将无法确保
a
位于
bs
中，因为您没有对此进行约束。这个新签名仍然失败。对于最强大的功能，特别是对于未来的定义，您需要

-- Elem x xs has the structure of a Nat, but doubles as a proof that x is in xs
-- or: Elem x xs is the type of numbers n such that the nth element of xs is x
data Elem (x :: k) (xs :: [k]) where
  Here  :: Elem x (x : xs)
  There :: !(Elem x xs) -> Elem x (y : xs) -- strictness optional
-- boilerplate; use singletons or similar to dodge this mechanical tedium
-- EDIT: singletons doesn't support GADTs just yet, so this must be handwritten
-- See https://github.com/goldfirere/singletons/issues/150
data SElem x xs (e :: Elem x xs) where
  SHere  :: SElem x (x : xs) Here
  SThere :: SElem x xs e -> SElem x (y : xs) (There e)
class KElem x xs (e :: Elem x xs) | e -> x xs where kElem :: SElem x xs e
instance KElem x (x : xs) Here where kElem = SHere
instance KElem x xs e => KElem x (y : xs) (There e) where kElem = SThere kElem
demoteElem :: SElem x xs e -> Elem x xs
demoteElem SHere = Here
demoteElem (SThere e) = There (demoteElem e)

-- inj puts a value into a Sum at the given index
inj :: Elem t ts -> t -> Sum ts
inj Here x = Inl x
inj (There e) x = Inr $ inj e x

-- try to find the first index where x occurs in xs
type family FirstIndexOf (x :: k) (xs :: [k]) :: Elem x xs where
  FirstIndexOf x (x:xs) = Here
  FirstIndexOf x (y:xs) = There (FirstIndexOf x xs)
-- INJect First
-- calculate the target index as a type
-- require it as an implicit value
-- defer to inj
injF :: forall as a.
        KElem a as (FirstIndexOf a as) =>
        a -> Sum as
injF = inj (demoteElem $ kElem @a @as @(FirstIndexOf a as))
-- or injF = inj (kElem :: SElem a as (FirstIndexOf a as))

您也可以将
元素
粘贴在
总和
内：

data Sum :: [Type] -> Type where
  Sum :: !(Elem t ts) -> t -> Sum ts -- strictness optional

您可以将
Inl
和
Inr
恢复为模式同义词

pattern Inl :: forall ts. () =>
               forall t ts'. (ts ~ (t : ts')) =>
               t -> Sum ts
pattern Inl x = Sum Here x

data Inr' ts = forall t ts'. (ts ~ (t : ts')) => Inr' (Sum ts')
_Inr :: Sum ts -> Maybe (Inr' ts)
_Inr (Sum Here _) = Nothing
_Inr (Sum (There tag) x) = Just $ Inr' $ Sum tag x
pattern Inr :: forall ts. () =>
               forall t ts'. (ts ~ (t : ts')) =>
               Sum ts' -> Sum ts
pattern Inr x <- (_Inr -> Just (Inr' x))
  where Inr (Sum tag x) = Sum (There tag) x

然后写

data Sum :: [Type] -> Type where
  Sum :: forall t ts (e :: Elem t ts). !(SElem t ts e) -> t -> Sum ts

除了所说的标记有点过大之外，它接近整数标记和联合的
结构。
你的
因为所有的ab
都在
的右边（不是（bs='[]）| a==b）
，所以你在
a>变体（b）：bs中提到的
a
和
b
独立于约束中的
a
和
b
。也就是说，GHC的读取方式与所有xy的
singleton:：（Not（bs=='[]）|a==b）~'True=>读取方式相同。x->Variant（y）：bs）
你的
因为所有的ab
都在
的右边（而不是（bs='[]）|a==b
，所以你在
a->Variant（b）：bs
中提到的
a
和
b
独立于约束中的
a
和
b
。也就是说，GHC的读取方式与所有xy的
singleton:：（Not（bs=='[]）|a==b）~'True=>读取方式相同。x->变量（y）：bs）