X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcTyClsDecls.lhs;h=12fb28d7aecd70ca0dfdde36cf238fc24aa6d173;hb=4c6a3f787abcaed009a574196d82237d9ae64fc8;hp=c1e58161d14f51dfda749061805e0517d98e9df7;hpb=cbcc6ec44ae3d8c17a54c0d4e5e6dac622019428;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index c1e5816..12fb28d 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -51,6 +51,7 @@ import SrcLoc
 import ListSetOps
 import Digraph
 import DynFlags
+import FastString
 
 import Data.List
 import Control.Monad    ( mplus )
@@ -724,15 +725,17 @@ tcTyClDecl1 calc_isrec
 	-- Check that the stupid theta is empty for a GADT-style declaration
   ; checkTc (null stupid_theta || h98_syntax) (badStupidTheta tc_name)
 
+	-- Check that a newtype has exactly one constructor
+	-- Do this before checking for empty data decls, so that
+	-- we don't suggest -XEmptyDataDecls for newtypes
+  ; checkTc (new_or_data == DataType || isSingleton cons) 
+	    (newtypeConError tc_name (length cons))
+
 	-- Check that there's at least one condecl,
 	-- or else we're reading an hs-boot file, or -XEmptyDataDecls
   ; checkTc (not (null cons) || empty_data_decls || is_boot)
 	    (emptyConDeclsErr tc_name)
     
-	-- Check that a newtype has exactly one constructor
-  ; checkTc (new_or_data == DataType || isSingleton cons) 
-	    (newtypeConError tc_name (length cons))
-
   ; tycon <- fixM (\ tycon -> do 
 	{ data_cons <- mapM (addLocM (tcConDecl unbox_strict ex_ok tycon final_tvs))
 			     cons
@@ -774,7 +777,8 @@ tcTyClDecl1 calc_isrec
 		    tycon_name = tyConName (classTyCon clas)
 		    tc_isrec = calc_isrec tycon_name
 		in
-		buildClass class_name tvs' ctxt' fds' ats'
+		buildClass False {- Must include unfoldings for selectors -}
+			   class_name tvs' ctxt' fds' ats'
 			   sig_stuff tc_isrec)
   ; return (AClass clas : ats')
       -- NB: Order is important due to the call to `mkGlobalThings' when
@@ -812,7 +816,8 @@ tcConDecl :: Bool 		-- True <=> -funbox-strict_fields
 
 tcConDecl unbox_strict existential_ok tycon tc_tvs	-- Data types
 	  (ConDecl name _ tvs ctxt details res_ty _)
-  = tcTyVarBndrs tvs		$ \ tvs' -> do 
+  = addErrCtxt (dataConCtxt name)	$ 
+    tcTyVarBndrs tvs			$ \ tvs' -> do 
     { ctxt' <- tcHsKindedContext ctxt
     ; checkTc (existential_ok || (null tvs && null (unLoc ctxt)))
 	      (badExistential name)