Fix #11723 and #11724.
authorRichard Eisenberg <eir@cis.upenn.edu>
Sat, 19 Mar 2016 21:19:04 +0000 (17:19 -0400)
committerRichard Eisenberg <eir@cis.upenn.edu>
Mon, 21 Mar 2016 18:32:39 +0000 (14:32 -0400)
Test cases: typecheck/should_fail/T1172{3,4}

compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcValidity.hs
docs/users_guide/glasgow_exts.rst
testsuite/tests/dependent/should_fail/T11473.stderr
testsuite/tests/typecheck/should_fail/T11723.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T11723.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T11724.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T11724.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/all.T

index 0a3c5aa..88110b7 100644 (file)
@@ -29,7 +29,10 @@ module TcHsSyn (
         zonkTopBndrs, zonkTyBndrsX, zonkTyBinders,
         emptyZonkEnv, mkEmptyZonkEnv,
         zonkTcTypeToType, zonkTcTypeToTypes, zonkTyVarOcc,
-        zonkCoToCo, zonkTcKindToKind
+        zonkCoToCo, zonkTcKindToKind,
+
+        -- * Validity checking
+        checkForRepresentationPolymorphism
   ) where
 
 #include "HsVersions.h"
@@ -45,6 +48,7 @@ import TysPrim
 import TysWiredIn
 import Type
 import TyCoRep  ( TyBinder(..) )
+import TyCon
 import Coercion
 import ConLike
 import DataCon
@@ -1665,16 +1669,38 @@ ensureNotRepresentationPolymorphic
 ensureNotRepresentationPolymorphic id ty
   = whenNoErrs $   -- sometimes we end up zonking bogus definitions of type
                    -- forall a. a. See, for example, test ghci/scripts/T9140
-    unless (isEmptyVarSet (tyCoVarsOfType ki)) $
-    addErrAt (nameSrcSpan $ idName id) $
-    vcat [ text "The following variable has an unknown runtime representation:"
-         , text "    Var name:" <+> ppr id
-         , text "    Var type:" <+> ppr tidy_ty
-         , text " Type's kind:" <+> ppr tidy_ki
-         , text "Perhaps add a type or kind signature to fix the representation."
-         ]
+    checkForRepresentationPolymorphism
+      (text "In the type of binder" <+> quotes (ppr id)) ty
+
+checkForRepresentationPolymorphism :: SDoc -> Type -> TcM ()
+checkForRepresentationPolymorphism extra ty
+  | Just (tc, tys) <- splitTyConApp_maybe ty
+  , isUnboxedTupleTyCon tc
+  = mapM_ (checkForRepresentationPolymorphism extra) (dropRuntimeRepArgs tys)
+      -- You might think that we can just check the RuntimeRep args themselves.
+      -- But this would fail in the case of nested unboxed tuples, for which
+      -- one of the RuntimeRep args would be UnboxedTupleRep. So we just check
+      -- the type args directly.
+
+  | runtime_rep `eqType` unboxedTupleRepDataConTy
+  = addErr (vcat [ text "The type" <+> quotes (ppr tidy_ty) <+>
+                     text "is not an unboxed tuple,"
+                 , text "and yet its kind suggests that it has the representation"
+                 , text "of an unboxed tuple. This is not allowed." ] $$
+            extra)
+
+  | not (isEmptyVarSet (tyCoVarsOfType runtime_rep))
+  = addErr $
+    hang (text "A representation-polymorphic type is not allowed here:")
+       2 (vcat [ text "Type:" <+> ppr tidy_ty
+               , text "Kind:" <+> ppr tidy_ki ]) $$
+    extra
+
+  | otherwise
+  = return ()
   where
-    ki = typeKind ty
+    ki          = typeKind ty
+    runtime_rep = getRuntimeRepFromKind "check_type" ki
 
     (tidy_env, tidy_ty) = tidyOpenType emptyTidyEnv ty
-    tidy_ki             = tidyType tidy_env ki
+    tidy_ki             = tidyType tidy_env (typeKind ty)
index 868524f..dbb3d74 100644 (file)
@@ -37,6 +37,7 @@ import TyCon
 -- others:
 import HsSyn            -- HsType
 import TcRnMonad        -- TcType, amongst others
+import TcHsSyn     ( checkForRepresentationPolymorphism )
 import FunDeps
 import FamInstEnv  ( isDominatedBy, injectiveBranches,
                      InjectivityCheckResult(..) )
@@ -444,6 +445,16 @@ forAllAllowed ArbitraryRank             = True
 forAllAllowed (LimitedRank forall_ok _) = forall_ok
 forAllAllowed _                         = False
 
+-- The zonker issues errors if it zonks a representation-polymorphic binder
+-- But sometimes it's nice to check a little more eagerly, trying to report
+-- errors earlier.
+representationPolymorphismForbidden :: UserTypeCtxt -> Bool
+representationPolymorphismForbidden = go
+  where
+    go (ConArgCtxt _) = True     -- A rep-polymorphic datacon won't be useful
+    go (PatSynCtxt _) = True     -- Similar to previous case
+    go _              = False    -- Other cases are caught by zonker
+
 ----------------------------------------
 -- | Fail with error message if the type is unlifted
 check_lifted :: Type -> TcM ()
@@ -498,6 +509,8 @@ check_type _ _ _ (TyVarTy _) = return ()
 
 check_type env ctxt rank (ForAllTy (Anon arg_ty) res_ty)
   = do  { check_type env ctxt arg_rank arg_ty
+        ; when (representationPolymorphismForbidden ctxt) $
+          checkForRepresentationPolymorphism empty arg_ty
         ; check_type env ctxt res_rank res_ty }
   where
     (arg_rank, res_rank) = funArgResRank rank
index f5f266a..a4a0830 100644 (file)
@@ -7638,7 +7638,7 @@ your program, we encourage you to turn on these flags, especially
 
 .. index::
    single: TYPE
-   single: runtime representation polymorphism
+   single: representation polymorphism
    
 .. _runtime-rep:
 
index 7a7cc32..431c2df 100644 (file)
@@ -1,7 +1,6 @@
 
 T11473.hs:19:7: error:
-    The following variable has an unknown runtime representation:
-        Var name: x
-        Var type: a
-     Type's kind: TYPE r
-    Perhaps add a type or kind signature to fix the representation.
+    A representation-polymorphic type is not allowed here:
+      Type: a
+      Kind: TYPE r
+    In the type of binder ‘x’
diff --git a/testsuite/tests/typecheck/should_fail/T11723.hs b/testsuite/tests/typecheck/should_fail/T11723.hs
new file mode 100644 (file)
index 0000000..4761cc4
--- /dev/null
@@ -0,0 +1,8 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+module Example where
+
+import Data.Typeable
+import GHC.Exts
+
+data Wat (a :: TYPE 'UnboxedTupleRep) = Wat a
diff --git a/testsuite/tests/typecheck/should_fail/T11723.stderr b/testsuite/tests/typecheck/should_fail/T11723.stderr
new file mode 100644 (file)
index 0000000..b63a182
--- /dev/null
@@ -0,0 +1,7 @@
+
+T11723.hs:8:41: error:
+    • The type ‘a’ is not an unboxed tuple,
+      and yet its kind suggests that it has the representation
+      of an unboxed tuple. This is not allowed.
+    • In the definition of data constructor ‘Wat’
+      In the data type declaration for ‘Wat’
diff --git a/testsuite/tests/typecheck/should_fail/T11724.hs b/testsuite/tests/typecheck/should_fail/T11724.hs
new file mode 100644 (file)
index 0000000..df575bd
--- /dev/null
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeInType #-}
+
+module T11724 where
+
+import GHC.Exts
+
+data Foo (r :: RuntimeRep) (a :: TYPE r) = Foo a
diff --git a/testsuite/tests/typecheck/should_fail/T11724.stderr b/testsuite/tests/typecheck/should_fail/T11724.stderr
new file mode 100644 (file)
index 0000000..2971b27
--- /dev/null
@@ -0,0 +1,7 @@
+
+T11724.hs:7:44: error:
+    • A representation-polymorphic type is not allowed here:
+        Type: a
+        Kind: TYPE r
+    • In the definition of data constructor ‘Foo’
+      In the data type declaration for ‘Foo’
index c4510ea..f24736e 100644 (file)
@@ -409,3 +409,5 @@ test('T11464', normal, compile_fail, [''])
 test('T11563', normal, compile_fail, [''])
 test('T11541', normal, compile_fail, [''])
 test('T11313', normal, compile_fail, [''])
+test('T11723', normal, compile_fail, [''])
+test('T11724', normal, compile_fail, [''])