X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcDeriv.lhs;h=e2ddc9d9c7d3d102b117a046d03642d02556df54;hb=67ed735fab12c12a1d48878d7bda33588c67fb78;hp=8fa8c0b3fa45c3b60535b51a5e3dd5d4fc5c9ea1;hpb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 8fa8c0b..e2ddc9d 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -830,11 +830,11 @@ type Condition = (DynFlags, TyCon) -> Maybe SDoc
 orCond :: Condition -> Condition -> Condition
 orCond c1 c2 tc 
   = case c1 tc of
-	Nothing -> Nothing		-- c1 succeeds
-	Just x  -> case c2 tc of	-- c1 fails
+	Nothing -> Nothing	    -- c1 succeeds
+	Just x  -> case c2 tc of    -- c1 fails
 		     Nothing -> Nothing
 		     Just y  -> Just (x $$ ptext (sLit "  and") $$ y)
-					-- Both fail
+			            -- Both fail
 
 andCond :: Condition -> Condition -> Condition
 andCond c1 c2 tc = case c1 tc of
@@ -845,16 +845,14 @@ cond_stdOK :: DerivContext -> Condition
 cond_stdOK (Just _) _
   = Nothing	-- Don't check these conservative conditions for
 		-- standalone deriving; just generate the code
+		-- and let the typechecker handle the result
 cond_stdOK Nothing (_, rep_tc)
-  | null data_cons      = Just (no_cons_why $$ suggestion)
+  | null data_cons      = Just (no_cons_why rep_tc $$ suggestion)
   | not (null con_whys) = Just (vcat con_whys $$ suggestion)
   | otherwise      	= Nothing
   where
     suggestion  = ptext (sLit "Possible fix: use a standalone deriving declaration instead")
     data_cons   = tyConDataCons rep_tc
-    no_cons_why	= quotes (pprSourceTyCon rep_tc) <+> 
-		  ptext (sLit "has no data constructors")
-
     con_whys = mapCatMaybes check_con data_cons
 
     check_con :: DataCon -> Maybe SDoc
@@ -863,6 +861,10 @@ cond_stdOK Nothing (_, rep_tc)
       , all isTauTy (dataConOrigArgTys con) = Nothing
       | otherwise = Just (badCon con (ptext (sLit "does not have a Haskell-98 type")))
   
+no_cons_why :: TyCon -> SDoc
+no_cons_why rep_tc = quotes (pprSourceTyCon rep_tc) <+> 
+		     ptext (sLit "has no data constructors")
+
 cond_enumOrProduct :: Condition
 cond_enumOrProduct = cond_isEnumeration `orCond` 
 		       (cond_isProduct `andCond` cond_noUnliftedArgs)
@@ -880,11 +882,13 @@ cond_noUnliftedArgs (_, tc)
 
 cond_isEnumeration :: Condition
 cond_isEnumeration (_, rep_tc)
-  | isEnumerationTyCon rep_tc = Nothing
-  | otherwise		      = Just why
+  | isEnumerationTyCon rep_tc   = Nothing
+  | otherwise		        = Just why
   where
-    why = quotes (pprSourceTyCon rep_tc) <+> 
-	  ptext (sLit "has non-nullary constructors")
+    why = sep [ quotes (pprSourceTyCon rep_tc) <+> 
+	          ptext (sLit "is not an enumeration type")
+              , nest 2 $ ptext (sLit "(an enumeration consists of one or more nullary constructors)") ]
+		  -- See Note [Enumeration types] in TyCon
 
 cond_isProduct :: Condition
 cond_isProduct (_, rep_tc)
@@ -892,7 +896,7 @@ cond_isProduct (_, rep_tc)
   | otherwise	          = Just why
   where
     why = quotes (pprSourceTyCon rep_tc) <+> 
-	  ptext (sLit "has more than one constructor")
+	  ptext (sLit "does not have precisely one constructor")
 
 cond_typeableOK :: Condition
 -- OK for Typeable class
@@ -924,7 +928,7 @@ cond_functorOK :: Bool -> Condition
 --            (d) optionally: don't use function types
 --            (e) no "stupid context" on data type
 cond_functorOK allowFunctions (dflags, rep_tc) 
-  | not (dopt Opt_DeriveFunctor dflags)
+  | not (xopt Opt_DeriveFunctor dflags)
   = Just (ptext (sLit "You need -XDeriveFunctor to derive an instance for this class"))
 
   | null tc_tvs
@@ -967,7 +971,7 @@ cond_functorOK allowFunctions (dflags, rep_tc)
 
 checkFlag :: ExtensionFlag -> Condition
 checkFlag flag (dflags, _)
-  | dopt flag dflags = Nothing
+  | xopt flag dflags = Nothing
   | otherwise        = Just why
   where
     why = ptext (sLit "You need -X") <> text flag_str 
@@ -1070,7 +1074,7 @@ mkNewTypeEqn orig dflags tvs
         | can_derive_via_isomorphism -> bale_out (non_std $$ suggest_nd) -- Try newtype deriving!
       	| otherwise                  -> bale_out non_std
   where
-        newtype_deriving = dopt Opt_GeneralizedNewtypeDeriving dflags
+        newtype_deriving = xopt Opt_GeneralizedNewtypeDeriving dflags
         go_for_it        = mk_data_eqn orig tvs cls tycon tc_args rep_tycon rep_tc_args mtheta
 	bale_out msg     = failWithTc (derivingThingErr newtype_deriving cls cls_tys inst_ty msg)