Remove GADT refinements, part 2

[ghc-hetmet.git] / compiler / typecheck / TcTyClsDecls.lhs

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index c1e5816..6657e16 100644 (file)
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -724,15 +724,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
@@ -812,7 +814,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)