我在玩 Free
的多类无标签编码
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeOperators #-}
module Free where
import GHC.Types
type (a :: k) ~> (b :: k) = Morphism k a b
newtype Natural (f :: j -> k) (g :: j -> k) =
Natural { getNatural :: forall (x :: j). f x ~> g x }
type family Morphism k :: k -> k -> Type where
Morphism Type = (->)
Morphism (j -> k) = Natural
class DataKind k where
data Free :: (k -> Constraint) -> k -> k
interpret :: forall (cls :: k -> Constraint) (u :: k) (v :: k).
cls v => (u ~> v) -> (Free cls u ~> v)
call :: forall (cls :: k -> Constraint) (u :: k).
u ~> Free cls u
instance DataKind Type where
newtype Free cls u = Free0
{ runFree0 :: forall v. cls v => (u ~> v) -> v }
interpret f = \(Free0 g) -> g f
call = \u -> Free0 $ \f -> f u
我可以毫无问题地为
Semigroup
和 Free Semigroup
编写 Free Monoid
实例:instance Semigroup (Free Semigroup u) where
Free0 g <> Free0 g' = Free0 $ \f -> g f <> g' f
instance Semigroup (Free Monoid u) where
Free0 g <> Free0 g' = Free0 $ \f -> g f <> g' f
这些实例是相同的,并且将用于
Semigroup
的任何其他子类。我想使用
QuantifiedConstraints
以便我可以为 Semigroup
的所有子类编写一个实例:instance (forall v. cls v => Semigroup v) => Semigroup (Free cls u) where
Free0 g <> Free0 g' = Free0 $ \f -> g f <> g' f
但是编译器 (GHC-8.6.3) 提示它无法推断
cls (Free cls u)
:Free.hs:57:10: error:
• Could not deduce: cls (Free cls u)
arising from a use of ‘GHC.Base.$dmsconcat’
from the context: forall v. cls v => Semigroup v
bound by the instance declaration at Free.hs:57:10-67
• In the expression: GHC.Base.$dmsconcat @(Free cls u)
In an equation for ‘GHC.Base.sconcat’:
GHC.Base.sconcat = GHC.Base.$dmsconcat @(Free cls u)
In the instance declaration for ‘Semigroup (Free cls u)’
• Relevant bindings include
sconcat :: GHC.Base.NonEmpty (Free cls u) -> Free cls u
(bound at Free.hs:57:10)
|
57 | instance (forall v. cls v => Semigroup v) => Semigroup (Free cls u) where
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Free.hs:57:10: error:
• Could not deduce: cls (Free cls u)
arising from a use of ‘GHC.Base.$dmstimes’
from the context: forall v. cls v => Semigroup v
bound by the instance declaration at Free.hs:57:10-67
or from: Integral b
bound by the type signature for:
GHC.Base.stimes :: forall b.
Integral b =>
b -> Free cls u -> Free cls u
at Free.hs:57:10-67
• In the expression: GHC.Base.$dmstimes @(Free cls u)
In an equation for ‘GHC.Base.stimes’:
GHC.Base.stimes = GHC.Base.$dmstimes @(Free cls u)
In the instance declaration for ‘Semigroup (Free cls u)’
• Relevant bindings include
stimes :: b -> Free cls u -> Free cls u (bound at Free.hs:57:10)
|
57 | instance (forall v. cls v => Semigroup v) => Semigroup (Free cls u) where
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
当我将它添加为实例的上下文时,它编译得很好:
instance (cls (Free cls u), forall v. cls v => Semigroup v) => Semigroup (Free cls u) where
Free0 g <> Free0 g' = Free0 $ \f -> g f <> g' f
添加的上下文有点冗长,但由于
Free
的全部意义在于 cls (Free cls u)
始终为真,而不是繁琐。我不明白的是,为什么 GHC 需要能够为
cls (Free cls u)
实例的 Semigroup
子类得出 Semigroup
以进行编译。我尝试用 (<>)
替换 undefined
的定义并得到相同的错误,所以我认为问题不在于实现本身,而在于实例的声明;可能是由于 QuantifiedConstraints
的某些方面我不明白。 最佳答案
错误消息指出这些错误来自 sconcat
和 stimes
的默认定义。量化上下文就像 instance
s:在你的 instance Semigroup (Free cls v)
中,就好像有一个 instance cls v => Semigroup v
在范围内。 instance
是通过匹配选择的。 sconcat
和 stimes
需要 Semigroup (Free cls v)
,因此它们将需要的内容与上下文 instance forall z. cls z => Semigroup z
相匹配,使用 z ~ Free cls v
取得成功,并进一步需要 cls (Free cls v)
。即使我们周围还有一个递归的 instance _etc => Semigroup (Free cls v)
也会发生这种情况。请记住,我们假设类型类实例是一致的;使用量化上下文还是使用当前定义的实例应该没有区别,所以 GHC 只是选择它觉得使用哪个实例。
然而,这并不是一个好的情况。量化上下文与我们的实例重叠(实际上,它与每个 Semigroup
实例重叠),这令人担忧。如果你尝试类似 (<>) = const (Free0 _etc) ([1, 2] <> [3, 4])
的东西,你会得到一个类似的错误,因为量化的上下文掩盖了库中的真实 instance Semigroup [a]
。我认为包含来自 issue 14877 的一些想法可以使这不那么不舒服:
class (a => b) => Implies a b
instance (a => b) => Implies a b
instance (forall v. cls v `Implies` Semigroup v) => Semigroup (Free cls u) where
Free0 g <> Free0 g' = Free0 $ \f -> g f <> g' f
在这里使用
Implies
意味着量化上下文不再匹配 Semigroup (Free cls v)
的需求,而是通过递归释放。但是,约束背后的要求不会改变。本质上,我们保留了量化约束的需求片段,对于用户来说,Semigroup v
应该由 cls v
隐含,同时为实现在放电片段上打安全措施,所以它不会破坏我们的约束解决方案。 Implies
约束仍然可以并且必须用于证明 Semigroup v
中的 (<>)
约束,但它被认为是在显式 Semigroup
实例耗尽后的最后手段。