[commit: ghc] wip/type-app: Tidy classes before printing during validity checks (97ef728)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/type-app
Link       : http://ghc.haskell.org/trac/ghc/changeset/97ef728fa2a796d3917d262298e76dbd3a95805f/ghc

>---------------------------------------------------------------

commit 97ef728fa2a796d3917d262298e76dbd3a95805f
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Thu Aug 6 21:08:32 2015 -0400

    Tidy classes before printing during validity checks


>---------------------------------------------------------------

97ef728fa2a796d3917d262298e76dbd3a95805f
 compiler/typecheck/FunDeps.hs                   |  6 +++++-
 compiler/typecheck/TcValidity.hs                | 21 ++++++++++++++-------
 testsuite/tests/polykinds/TidyClassKinds.hs     | 13 +++++++++++++
 testsuite/tests/polykinds/TidyClassKinds.stderr |  8 ++++++++
 testsuite/tests/polykinds/all.T                 |  1 +
 5 files changed, 41 insertions(+), 8 deletions(-)

diff --git a/compiler/typecheck/FunDeps.hs b/compiler/typecheck/FunDeps.hs
index fd347a1..5b5ffb5 100644
--- a/compiler/typecheck/FunDeps.hs
+++ b/compiler/typecheck/FunDeps.hs
@@ -382,7 +382,11 @@ checkInstCoverage be_liberal clas theta inst_taus
          conserv_undet_tvs = rs_tvs `minusVarSet` closeOverKinds ls_tvs
             -- closeOverKinds: see Note [Closing over kinds in coverage]
 
-         undet_list = varSetElemsKvsFirst undetermined_tvs
+           -- we do need to tidy, because it's possible that we're about
+           -- to report about a GHC-generated kind variable
+           -- for example, test case polykinds/T10570
+         undet_list = snd $ tidyOpenTyVars emptyTidyEnv $
+                      varSetElemsKvsFirst undetermined_tvs
 
          msg = vcat [ -- text "ls_tvs" <+> ppr ls_tvs
                       -- , text "closed ls_tvs" <+> ppr (closeOverKinds ls_tvs)
diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs
index 9eba27d..189e3d3 100644
--- a/compiler/typecheck/TcValidity.hs
+++ b/compiler/typecheck/TcValidity.hs
@@ -964,8 +964,15 @@ checkValidInstance :: UserTypeCtxt -> LHsType Name -> Type
 checkValidInstance ctxt hs_type ty
   | Just (clas,inst_tys) <- getClassPredTys_maybe tau
   , inst_tys `lengthIs` classArity clas
-  = do  { setSrcSpan head_loc (checkValidInstHead ctxt clas inst_tys)
-        ; checkValidTheta ctxt theta
+  = do  { let (tidy_env0, tidy_tys)   = tidyOpenTypes emptyTidyEnv inst_tys
+              (tidy_env1, tidy_theta) = tidyOpenTypes tidy_env0 theta
+              (_,         tidy_ty)    = tidyOpenType  tidy_env1 ty
+           -- even though the inst_tys are user-specified, we still must
+           -- tidy, because of the possibility of kind variables. See,
+           -- for example, test case polykinds/TidyClassKinds
+
+        ; setSrcSpan head_loc (checkValidInstHead ctxt clas tidy_tys)
+        ; checkValidTheta ctxt tidy_theta
 
         -- The Termination and Coverate Conditions
         -- Check that instance inference will terminate (if we care)
@@ -979,12 +986,12 @@ checkValidInstance ctxt hs_type ty
         --   in the constraint than in the head
         ; undecidable_ok <- xoptM Opt_UndecidableInstances
         ; if undecidable_ok
-          then checkAmbiguity ctxt ty
-          else checkInstTermination inst_tys theta
+          then checkAmbiguity ctxt tidy_ty
+          else checkInstTermination tidy_tys tidy_theta
 
-        ; case (checkInstCoverage undecidable_ok clas theta inst_tys) of
-            IsValid  -> return ()   -- Check succeeded
-            NotValid msg -> addErrTc (instTypeErr clas inst_tys msg)
+        ; case (checkInstCoverage undecidable_ok clas tidy_theta tidy_tys) of
+            IsValid      -> return ()   -- Check succeeded
+            NotValid msg -> addErrTc (instTypeErr clas tidy_tys msg)
 
         ; return (tvs, theta, clas, inst_tys) }
 
diff --git a/testsuite/tests/polykinds/TidyClassKinds.hs b/testsuite/tests/polykinds/TidyClassKinds.hs
new file mode 100644
index 0000000..83f6eaa
--- /dev/null
+++ b/testsuite/tests/polykinds/TidyClassKinds.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE MultiParamTypeClasses, PolyKinds #-}
+{-# OPTIONS_GHC -fprint-explicit-kinds #-}
+
+module TidyClassKinds where
+
+import Data.Proxy
+
+class Poly a b
+
+type ProxySyn = Proxy
+
+instance Poly ProxySyn ProxySyn
+  -- output should really talk about k1 and k2, not about k and k!
diff --git a/testsuite/tests/polykinds/TidyClassKinds.stderr b/testsuite/tests/polykinds/TidyClassKinds.stderr
new file mode 100644
index 0000000..e9ff41f
--- /dev/null
+++ b/testsuite/tests/polykinds/TidyClassKinds.stderr
@@ -0,0 +1,8 @@
+
+TidyClassKinds.hs:12:10: error:
+    Illegal instance declaration for
+      ‘Poly (k0 -> *) (k1 -> *) (ProxySyn k0) (ProxySyn k1)’
+      (All instance types must be of the form (T t1 ... tn)
+       where T is not a synonym.
+       Use TypeSynonymInstances if you want to disable this.)
+    In the instance declaration for ‘Poly ProxySyn ProxySyn’
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index c073c1b..8a71d45 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -121,3 +121,4 @@ test('T10670', normal, compile, [''])
 test('T10670a', normal, compile, [''])
 test('T10134', normal, multimod_compile, ['T10134.hs','-v0'])
 test('T10742', normal, compile, [''])
+test('TidyClassKinds', normal, compile_fail, ['-fprint-explicit-kinds'])