我最近发布了一个关于语法2.0关于共享定义的问题。我已经有这个工作在GHC 7.6:

{-# LANGUAGE GADTs, TypeOperators, FlexibleContexts #-}

import Data.Syntactic
import Data.Syntactic.Sugar.BindingT

data Let a where
    Let :: Let (a :-> (a -> b) :-> Full b)

share :: (Let :<: sup,
          sup ~ Domain b, sup ~ Domain a,
          Syntactic a, Syntactic b,
          Syntactic (a -> b),
          SyntacticN (a -> (a -> b) -> b) 
                     fi)
           => a -> (a -> b) -> b
share = sugarSym Let

然而,GHC 7.8希望- xallowambiguousttypes使用该签名进行编译。或者,我可以用

(ASTF sup (Internal a) -> AST sup ((Internal a) :-> Full (Internal b)) -> ASTF sup (Internal b))

这是SyntacticN上的fundep所暗示的类型。这让我避免了扩展。当然这是

在已经很大的签名中添加一个非常长的类型 手动推导很累人 由于资金原因,没有必要

我的问题是:

Is this an acceptable use of -XAllowAmbiguousTypes? In general, when should this extension be used? An answer here suggests "it is almost never a good idea". Though I've read the docs, I'm still having trouble deciding if a constraint is ambiguous or not. Specifically, consider this function from Data.Syntactic.Sugar: sugarSym :: (sub :<: AST sup, ApplySym sig fi sup, SyntacticN f fi) => sub sig -> f sugarSym = sugarN . appSym It appears to me that fi (and possibly sup) should be ambiguous here, but it compiles without the extension. Why is sugarSym unambiguous while share is? Since share is an application of sugarSym, the share constraints all come straight from sugarSym.


我没有看到任何已发布的语法版本的sugarSym的签名使用了这些确切的类型名称,所以我将使用提交8cfd02^的开发分支,这是仍然使用这些名称的最后一个版本。

那么,为什么GHC抱怨你的类型签名中的fi,而不是sugarSym?您所链接到的文档解释了,如果一个类型没有出现在约束的右边,那么它就是二义性的,除非约束使用函数依赖关系从其他非二义性类型推断出其他二义性类型。因此,让我们比较这两个函数的上下文,并寻找函数依赖性。

class ApplySym sig f sym | sig sym -> f, f -> sig sym
class SyntacticN f internal | f -> internal

sugarSym :: ( sub :<: AST sup
            , ApplySym sig fi sup
            , SyntacticN f fi
            ) 
         => sub sig -> f

share :: ( Let :<: sup
         , sup ~ Domain b
         , sup ~ Domain a
         , Syntactic a
         , Syntactic b
         , Syntactic (a -> b)
         , SyntacticN (a -> (a -> b) -> b) fi
         )
      => a -> (a -> b) -> b

So for sugarSym, the non-ambiguous types are sub, sig and f, and from those we should be able to follow functional dependencies in order to disambiguate all the other types used in the context, namely sup and fi. And indeed, the f -> internal functional dependency in SyntacticN uses our f to disambiguate our fi, and thereafter the f -> sig sym functional dependency in ApplySym uses our newly-disambiguated fi to disambiguate sup (and sig, which was already non-ambiguous). So that explains why sugarSym doesn't require the AllowAmbiguousTypes extension.

现在让我们来看看糖。我注意到的第一件事是,编译器并没有抱怨模棱两可的类型,而是抱怨重叠的实例:

Overlapping instances for SyntacticN b fi
  arising from the ambiguity check for ‘share’
Matching givens (or their superclasses):
  (SyntacticN (a -> (a -> b) -> b) fi1)
Matching instances:
  instance [overlap ok] (Syntactic f, Domain f ~ sym,
                         fi ~ AST sym (Full (Internal f))) =>
                        SyntacticN f fi
    -- Defined in ‘Data.Syntactic.Sugar’
  instance [overlap ok] (Syntactic a, Domain a ~ sym,
                         ia ~ Internal a, SyntacticN f fi) =>
                        SyntacticN (a -> f) (AST sym (Full ia) -> fi)
    -- Defined in ‘Data.Syntactic.Sugar’
(The choice depends on the instantiation of ‘b, fi’)
To defer the ambiguity check to use sites, enable AllowAmbiguousTypes

所以如果我没看错的话,并不是GHC认为你的类型有歧义,而是在检查你的类型是否有歧义时,GHC遇到了一个不同的、单独的问题。然后它告诉您,如果您告诉GHC不要执行歧义检查,它就不会遇到这个单独的问题。这解释了为什么启用allowambiguousttypes可以让你的代码编译。

但是,实例重叠的问题仍然存在。GHC列出的两个实例(SyntacticN f fi和SyntacticN (a -> f)…)确实彼此重叠。奇怪的是,这其中的第一个似乎与其他任何实例都有重叠,这是可疑的。重叠ok是什么意思?

我怀疑Syntactic是用OverlappingInstances编译的。看看代码,确实是这样。

经过一点实验,GHC似乎可以接受重叠的实例,当一个实例明显比另一个更普遍时:

{-# LANGUAGE FlexibleInstances, OverlappingInstances #-}

class Foo a where
  whichOne :: a -> String

instance Foo a where
  whichOne _ = "a"

instance Foo [a] where
  whichOne _ = "[a]"

-- |
-- >>> main
-- [a]
main :: IO ()
main = putStrLn $ whichOne (undefined :: [Int])

但GHC不接受重叠的实例,当两者都不明显比另一个更适合时:

{-# LANGUAGE FlexibleInstances, OverlappingInstances #-}

class Foo a where
  whichOne :: a -> String

instance Foo (f Int) where  -- this is the line which changed
  whichOne _ = "f Int"

instance Foo [a] where
  whichOne _ = "[a]"

-- |
-- >>> main
-- Error: Overlapping instances for Foo [Int]
main :: IO ()
main = putStrLn $ whichOne (undefined :: [Int])

您的类型签名使用SyntacticN (a -> (a -> b) -> b) fi,而SyntacticN f fi和SyntacticN (a -> f) (AST sym (Full ia) -> fi)都不是更好的匹配。如果我将类型签名的这部分更改为SyntacticN a fi或SyntacticN (a -> (a -> b) -> b) (AST sym (Full ia) -> fi), GHC将不再抱怨重叠。

如果我是您,我会查看这两个可能实例的定义,并确定这两个实现中是否有一个是您想要的。


我发现allowambiguousttypes非常方便与TypeApplications一起使用。考虑函数natVal:: forall n proxy。KnownNat n => proxy n ->来自GHC.TypeLits的整数。

要使用这个函数,我可以编写natVal (Proxy::Proxy5)。另一种风格是使用TypeApplications: natVal @5 Proxy。代理的类型是由类型应用程序推断出来的,每次调用natVal时都必须编写它,这很烦人。因此,我们可以启用歧义类型,并写:

{-# Language AllowAmbiguousTypes, ScopedTypeVariables, TypeApplications #-}

ambiguousNatVal :: forall n . (KnownNat n) => Integer
ambiguousNatVal = natVal @n Proxy

five = ambiguousNatVal @5 -- no `Proxy ` needed!

然而,请注意,一旦你变得暧昧,你就不能回头了!