X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcDeriv.lhs;h=b994a278298bce08f124cf378c463459bc613af5;hb=762c24327f4a2f874fb8a4b2d6717d36aa6c5e02;hp=992e35e6660aee5083e7ac9ffb78c42a5ae2a0be;hpb=2fc5aa708982a414235d3aff68dea4329b546063;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 992e35e..b994a27 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -352,10 +352,8 @@ renameDeriv is_boot gen_binds insts
 	                              rm_dups [] $ concat deriv_aux_binds
               aux_val_binds = ValBindsIn (listToBag aux_binds) aux_sigs
 	; rn_aux_lhs <- rnTopBindsLHS emptyFsEnv aux_val_binds
-	; let aux_names = collectHsValBinders rn_aux_lhs
-
-	; bindLocalNames aux_names $ 
-    do	{ (rn_aux, dus_aux) <- rnTopBindsRHS (mkNameSet aux_names) rn_aux_lhs
+	; bindLocalNames (collectHsValBinders rn_aux_lhs) $ 
+    do	{ (rn_aux, dus_aux) <- rnTopBindsRHS rn_aux_lhs
 	; (rn_inst_infos, fvs_insts) <- mapAndUnzipM rn_inst_info inst_infos
 	; return (rn_inst_infos, rn_aux `plusHsValBinds` rn_gen,
                   dus_gen `plusDU` dus_aux `plusDU` usesOnly (plusFVs fvs_insts)) } }
@@ -830,15 +828,11 @@ type Condition = (DynFlags, TyCon) -> Maybe SDoc
 orCond :: Condition -> Condition -> Condition
 orCond c1 c2 tc 
   = case c1 tc of
-	Nothing -> Nothing	-- c1 succeeds
-	Just {} -> c2 tc	-- c1 fails, try c2
--- orCond produced just one error message, namely from c2
--- Getting two can be confusing.  For a zero-constructor
--- type with a standalone isntance decl, we previously got:
---    Can't make a derived instance of `Bounded (Test a)':
---      `Test' has no data constructors
---        and
---      `Test' does not have precisely one constructor
+	Nothing -> Nothing	    -- c1 succeeds
+	Just x  -> case c2 tc of    -- c1 fails
+		     Nothing -> Nothing
+		     Just y  -> Just (x $$ ptext (sLit "  and") $$ y)
+			            -- Both fail
 
 andCond :: Condition -> Condition -> Condition
 andCond c1 c2 tc = case c1 tc of
@@ -886,12 +880,13 @@ cond_noUnliftedArgs (_, tc)
 
 cond_isEnumeration :: Condition
 cond_isEnumeration (_, rep_tc)
-  | null (tyConDataCons rep_tc) = Just (no_cons_why rep_tc)
   | 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)
@@ -931,7 +926,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
@@ -974,7 +969,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 
@@ -1077,7 +1072,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)