[commit: ghc] wip/rae: Check for rep poly on wildcard binders. (b840ab7)

[git at git.haskell.org]

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

On branch  : wip/rae
Link       : http://ghc.haskell.org/trac/ghc/changeset/b840ab75d800f19d9bfba5d413bc93e545e1cebc/ghc

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

commit b840ab75d800f19d9bfba5d413bc93e545e1cebc
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Fri Mar 25 16:18:09 2016 -0400

    Check for rep poly on wildcard binders.
    
    I had just missed this case when adding my test.
    This is relevant to ticket #11473.


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

b840ab75d800f19d9bfba5d413bc93e545e1cebc
 compiler/typecheck/TcHsSyn.hs                              | 14 ++++++++------
 testsuite/tests/typecheck/should_fail/BadUnboxedTuple.hs   | 10 ++++++++++
 .../tests/typecheck/should_fail/BadUnboxedTuple.stderr     |  6 ++++++
 testsuite/tests/typecheck/should_fail/all.T                |  1 +
 4 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs
index 88110b7..1baa4a3 100644
--- a/compiler/typecheck/TcHsSyn.hs
+++ b/compiler/typecheck/TcHsSyn.hs
@@ -283,7 +283,8 @@ zonkIdOccs env ids = map (zonkIdOcc env) ids
 zonkIdBndr :: ZonkEnv -> TcId -> TcM Id
 zonkIdBndr env id
   = do ty' <- zonkTcTypeToType env (idType id)
-       ensureNotRepresentationPolymorphic id ty'
+       ensureNotRepresentationPolymorphic ty'
+         (text "In the type of binder" <+> quotes (ppr id))
        return (setIdType id ty')
 
 zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id]
@@ -1160,6 +1161,8 @@ zonk_pat env (ParPat p)
 
 zonk_pat env (WildPat ty)
   = do  { ty' <- zonkTcTypeToType env ty
+        ; ensureNotRepresentationPolymorphic ty'
+            (text "In a wildcard pattern")
         ; return (env, WildPat ty') }
 
 zonk_pat env (VarPat (L l v))
@@ -1663,14 +1666,13 @@ zonkTypeZapping tv
 -- isn't really a compositional property of a type system, so it's
 -- not a terrible surprise that the check has to go in an awkward spot.
 ensureNotRepresentationPolymorphic
-  :: TcId  -- the id we're checking (for errors only)
-  -> Type  -- its zonked type
+  :: Type  -- its zonked type
+  -> SDoc  -- where this happened
   -> TcM ()
-ensureNotRepresentationPolymorphic id ty
+ensureNotRepresentationPolymorphic ty doc
   = whenNoErrs $   -- sometimes we end up zonking bogus definitions of type
                    -- forall a. a. See, for example, test ghci/scripts/T9140
-    checkForRepresentationPolymorphism
-      (text "In the type of binder" <+> quotes (ppr id)) ty
+    checkForRepresentationPolymorphism doc ty
 
 checkForRepresentationPolymorphism :: SDoc -> Type -> TcM ()
 checkForRepresentationPolymorphism extra ty
diff --git a/testsuite/tests/typecheck/should_fail/BadUnboxedTuple.hs b/testsuite/tests/typecheck/should_fail/BadUnboxedTuple.hs
new file mode 100644
index 0000000..2935416
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/BadUnboxedTuple.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies, KindSignatures, TypeInType #-}
+
+module BadUnboxedTuple where
+
+import GHC.Exts
+
+type family F :: TYPE UnboxedTupleRep
+
+foo :: F -> ()
+foo _ = ()
diff --git a/testsuite/tests/typecheck/should_fail/BadUnboxedTuple.stderr b/testsuite/tests/typecheck/should_fail/BadUnboxedTuple.stderr
new file mode 100644
index 0000000..7c5ad57
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/BadUnboxedTuple.stderr
@@ -0,0 +1,6 @@
+
+BadUnboxedTuple.hs:10:5: error:
+    The type ‘F’ is not an unboxed tuple,
+    and yet its kind suggests that it has the representation
+    of an unboxed tuple. This is not allowed.
+    In a wildcard pattern
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index f24736e..867ea38 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -411,3 +411,4 @@ test('T11541', normal, compile_fail, [''])
 test('T11313', normal, compile_fail, [''])
 test('T11723', normal, compile_fail, [''])
 test('T11724', normal, compile_fail, [''])
+test('BadUnboxedTuple', normal, compile_fail, [''])