X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcBinds.lhs;h=59cd315e0bf703e053856f2b11a09b9c4305c996;hp=59ae266473282f94dce35490c7c93482b58dc14b;hb=831a35dd00faff195cf938659c2dd736192b865f;hpb=7936b988d6d0a5f9a9b439c7d4a6adf616ddb9b5

diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 59ae266..59cd315 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -475,6 +475,11 @@ checkStrictBinds top_lvl rec_group mbind mono_tys infos
                   (strictBindErr "Recursive" unlifted mbind)
         ; checkTc (isSingletonBag mbind)
                   (strictBindErr "Multiple" unlifted mbind) 
+        -- This should be a checkTc, not a warnTc, but as of GHC 6.11
+        -- the versions of alex and happy available have non-conforming
+        -- templates, so the GHC build fails if it's an error:
+        ; warnTc (not bang_pat)
+                 (unliftedMustBeBang mbind)
         ; mapM_ check_sig infos
         ; return True }
   | otherwise
@@ -486,6 +491,11 @@ checkStrictBinds top_lvl rec_group mbind mono_tys infos
                                          (badStrictSig unlifted sig)
     check_sig _                = return ()
 
+unliftedMustBeBang :: LHsBindsLR Var Var -> SDoc
+unliftedMustBeBang mbind
+  = hang (text "Bindings containing unlifted types must use an outermost bang pattern:")
+         4 (pprLHsBinds mbind)
+
 strictBindErr :: String -> Bool -> LHsBindsLR Var Var -> SDoc
 strictBindErr flavour unlifted mbind
   = hang (text flavour <+> msg <+> ptext (sLit "aren't allowed:"))