X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcDeriv.lhs;h=2aba527a62dbedfbd5748a239aaf914245dc9d6f;hb=b7a8d2059f982599d31d14395c6628a049ec5179;hp=3bf030d8d1fff3b3a1044fd51e368ed87f34c093;hpb=435c5194b6047510d20a3d0c459c9b49e18da154;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index 3bf030d..2aba527 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -354,8 +354,11 @@ renameDeriv is_boot gen_binds insts
     		       | otherwise	      = rm_dups (b:acc) bs
 
 
-    rn_inst_info (InstInfo { iSpec = inst, iBinds = NewTypeDerived co })
-	= return (InstInfo { iSpec = inst, iBinds = NewTypeDerived co }, emptyFVs)
+    rn_inst_info :: InstInfo RdrName -> TcM (InstInfo Name, FreeVars)
+    rn_inst_info info@(InstInfo { iBinds = NewTypeDerived coi tc })
+	= return ( info { iBinds = NewTypeDerived coi tc }
+                 , mkFVs (map dataConName (tyConDataCons tc)))
+	  -- See Note [Newtype deriving and unused constructors]
 
     rn_inst_info (InstInfo { iSpec = inst, iBinds = VanillaInst binds sigs standalone_deriv })
 	= 	-- Bring the right type variables into 
@@ -384,6 +387,25 @@ mkGenericBinds is_boot tycl_decls
 		-- The predicate tyConHasGenerics finds both of these
 \end{code}
 
+Note [Newtype deriving and unused constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this (see Trac #1954):
+
+  module Bug(P) where
+  newtype P a = MkP (IO a) deriving Monad
+
+If you compile with -fwarn-unused-binds you do not expect the warning
+"Defined but not used: data consructor MkP". Yet the newtype deriving
+code does not explicitly mention MkP, but it should behave as if you
+had written
+  instance Monad P where
+     return x = MkP (return x)
+     ...etc...
+
+So we want to signal a user of the data constructor 'MkP'.  That's
+what we do in rn_inst_info, and it's the only reason we have the TyCon
+stored in NewTypeDerived.
+
 
 %************************************************************************
 %*									*
@@ -1375,7 +1397,7 @@ genInst :: Bool 	-- True <=> standalone deriving
 genInst standalone_deriv oflag spec
   | ds_newtype spec
   = return (InstInfo { iSpec  = mkInstance oflag (ds_theta spec) spec
-		     , iBinds = NewTypeDerived co }, [])
+		     , iBinds = NewTypeDerived co rep_tycon }, [])
 
   | otherwise
   = do	{ let loc  = getSrcSpan (ds_name spec)