[commit: ghc] master: Suggest -fprint-explicit-kinds when only kind variables are ambiguous (4b4d81a)
git at git.haskell.org
git at git.haskell.org
Mon Jun 9 13:08:07 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/4b4d81a6b97555a8dbeda2e6387ee151af962473/ghc
>---------------------------------------------------------------
commit 4b4d81a6b97555a8dbeda2e6387ee151af962473
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Mon Jun 9 14:07:54 2014 +0100
Suggest -fprint-explicit-kinds when only kind variables are ambiguous
This was triggered by looking at Trac #9171. See
Note [Suggest -fprint-explicit-kinds] in TcErrors
>---------------------------------------------------------------
4b4d81a6b97555a8dbeda2e6387ee151af962473
compiler/typecheck/TcErrors.lhs | 46 ++++++++++++++++------
testsuite/tests/indexed-types/should_fail/T9171.hs | 10 +++++
.../tests/indexed-types/should_fail/T9171.stderr | 23 +++++++++++
testsuite/tests/indexed-types/should_fail/all.T | 1 +
4 files changed, 68 insertions(+), 12 deletions(-)
diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index 88894b4..6992fa9 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -1285,26 +1285,48 @@ flattening any further. After all, there can be no instance declarations
that match such things. And flattening under a for-all is problematic
anyway; consider C (forall a. F a)
+Note [Suggest -fprint-explicit-kinds]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It can be terribly confusing to get an error message like (Trac #9171)
+ Couldn't match expected type ‘GetParam Base (GetParam Base Int)’
+ with actual type ‘GetParam Base (GetParam Base Int)’
+The reason may be that the kinds don't match up. Typically you'll get
+more useful information, but not when it's as a result of ambiguity.
+This test suggests -fprint-explicit-kinds when all the ambiguous type
+variables are kind variables.
+
\begin{code}
mkAmbigMsg :: Ct -> (Bool, SDoc)
mkAmbigMsg ct
- | isEmptyVarSet ambig_tv_set = (False, empty)
- | otherwise = (True, msg)
+ | null ambig_tkvs = (False, empty)
+ | otherwise = (True, msg)
where
- ambig_tv_set = filterVarSet isAmbiguousTyVar (tyVarsOfCt ct)
- ambig_tvs = varSetElems ambig_tv_set
-
- is_or_are | isSingleton ambig_tvs = text "is"
- | otherwise = text "are"
+ ambig_tkv_set = filterVarSet isAmbiguousTyVar (tyVarsOfCt ct)
+ ambig_tkvs = varSetElems ambig_tkv_set
+ (ambig_kvs, ambig_tvs) = partition isKindVar ambig_tkvs
- msg | any isRuntimeUnkSkol ambig_tvs -- See Note [Runtime skolems]
+ msg | any isRuntimeUnkSkol ambig_tkvs -- See Note [Runtime skolems]
= vcat [ ptext (sLit "Cannot resolve unknown runtime type") <> plural ambig_tvs
<+> pprQuotedList ambig_tvs
, ptext (sLit "Use :print or :force to determine these types")]
- | otherwise
- = vcat [ text "The type variable" <> plural ambig_tvs
- <+> pprQuotedList ambig_tvs
- <+> is_or_are <+> text "ambiguous" ]
+
+ | not (null ambig_tvs)
+ = pp_ambig (ptext (sLit "type")) ambig_tvs
+
+ | otherwise -- All ambiguous kind variabes; suggest -fprint-explicit-kinds
+ = vcat [ pp_ambig (ptext (sLit "kind")) ambig_kvs
+ , sdocWithDynFlags suggest_explicit_kinds ]
+
+ pp_ambig what tkvs
+ = ptext (sLit "The") <+> what <+> ptext (sLit "variable") <> plural tkvs
+ <+> pprQuotedList tkvs <+> is_or_are tkvs <+> ptext (sLit "ambiguous")
+
+ is_or_are [_] = text "is"
+ is_or_are _ = text "are"
+
+ suggest_explicit_kinds dflags -- See Note [Suggest -fprint-explicit-kinds]
+ | gopt Opt_PrintExplicitKinds dflags = empty
+ | otherwise = ptext (sLit "Use -fprint-explicit-kinds to see the kind arguments")
pprSkol :: SkolemInfo -> SrcLoc -> SDoc
pprSkol UnkSkol _
diff --git a/testsuite/tests/indexed-types/should_fail/T9171.hs b/testsuite/tests/indexed-types/should_fail/T9171.hs
new file mode 100644
index 0000000..72a2d70
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9171.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE PolyKinds, TypeFamilies #-}
+
+module T9171 where
+data Base
+
+type family GetParam (p::k1) (t::k2) :: k3
+
+type instance GetParam Base t = t
+
+foo = undefined :: GetParam Base (GetParam Base Int)
diff --git a/testsuite/tests/indexed-types/should_fail/T9171.stderr b/testsuite/tests/indexed-types/should_fail/T9171.stderr
new file mode 100644
index 0000000..1751d40
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9171.stderr
@@ -0,0 +1,23 @@
+
+T9171.hs:10:1:
+ Couldn't match expected type ‘GetParam Base (GetParam Base Int)’
+ with actual type ‘GetParam Base (GetParam Base Int)’
+ NB: ‘GetParam’ is a type function, and may not be injective
+ The kind variable ‘k0’ is ambiguous
+ Use -fprint-explicit-kinds to see the kind arguments
+ When checking that ‘foo’
+ has the inferred type ‘forall (k :: BOX).
+ GetParam Base (GetParam Base Int)’
+ Probable cause: the inferred type is ambiguous
+
+T9171.hs:10:20:
+ Couldn't match expected type ‘GetParam Base (GetParam Base Int)’
+ with actual type ‘GetParam Base (GetParam Base Int)’
+ NB: ‘GetParam’ is a type function, and may not be injective
+ The kind variable ‘k0’ is ambiguous
+ Use -fprint-explicit-kinds to see the kind arguments
+ In the ambiguity check for:
+ forall (k :: BOX). GetParam Base (GetParam Base Int)
+ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+ In an expression type signature: GetParam Base (GetParam Base Int)
+ In the expression: undefined :: GetParam Base (GetParam Base Int)
diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T
index d60f15f..a5adfaa 100644
--- a/testsuite/tests/indexed-types/should_fail/all.T
+++ b/testsuite/tests/indexed-types/should_fail/all.T
@@ -121,4 +121,5 @@ test('T8368a', normal, compile_fail, [''])
test('T8518', normal, compile_fail, [''])
test('T9036', normal, compile_fail, [''])
test('T9167', normal, compile_fail, [''])
+test('T9171', normal, compile_fail, [''])
More information about the ghc-commits
mailing list