From b7a8d2059f982599d31d14395c6628a049ec5179 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Tue, 9 Mar 2010 17:35:55 +0000
Subject: [PATCH] Fix Trac #1954: newtype deriving caused 'defined but not
 used' error

We were getting a bogus claim that a newtype "data constructor" was
unused.  The fix is easy, although I had to add a field to the constructor
TcEnv.NewTypeDerived

See Note [Newtype deriving and unused constructors] in TcDeriv
---
 compiler/typecheck/TcDeriv.lhs    |   28 +++++++++++++++++++++++++---
 compiler/typecheck/TcEnv.lhs      |   23 +++++++++++++++--------
 compiler/typecheck/TcInstDcls.lhs |    2 +-
 3 files changed, 41 insertions(+), 12 deletions(-)

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)
diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index fae782a..0a369a2 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -613,13 +613,20 @@ data InstBindings a
 				-- specialised instances
 	Bool			-- True <=> This code came from a standalone deriving clause
 
-  | NewTypeDerived              -- Used for deriving instances of newtypes, where the
-	CoercionI		-- witness dictionary is identical to the argument 
-				-- dictionary.  Hence no bindings, no pragmas.
-		-- The coercion maps from newtype to the representation type
-		-- (mentioning type variables bound by the forall'd iSpec variables)
-		-- E.g.   newtype instance N [a] = N1 (Tree a)
-		-- 	  co : N [a] ~ Tree a
+  | NewTypeDerived      -- Used for deriving instances of newtypes, where the
+			-- witness dictionary is identical to the argument 
+			-- dictionary.  Hence no bindings, no pragmas.
+
+	CoercionI	-- The coercion maps from newtype to the representation type
+			-- (mentioning type variables bound by the forall'd iSpec variables)
+			-- E.g.   newtype instance N [a] = N1 (Tree a)
+			-- 	  co : N [a] ~ Tree a
+
+	TyCon		-- The TyCon is the newtype N.  If it's indexed, then it's the 
+			-- representation TyCon, so that tyConDataCons returns [N1], 
+			-- the "data constructor".
+			-- See Note [Newtype deriving and unused constructors]
+                        -- in TcDeriv
 
 pprInstInfo :: InstInfo a -> SDoc
 pprInstInfo info = vcat [ptext (sLit "InstInfo:") <+> ppr (idType (iDFunId info))]
@@ -628,7 +635,7 @@ pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
 pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
   where
     details (VanillaInst b _ _) = pprLHsBinds b
-    details (NewTypeDerived _)  = text "Derived from the representation type"
+    details (NewTypeDerived {}) = text "Derived from the representation type"
 
 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 6ffa9d9..1bc7099 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -598,7 +598,7 @@ tc_inst_decl2 :: Id -> InstBindings Name -> TcM (LHsBinds Id)
 -- If there are no superclasses, matters are simpler, because we don't need the case
 -- see Note [Newtype deriving superclasses] in TcDeriv.lhs
 
-tc_inst_decl2 dfun_id (NewTypeDerived coi)
+tc_inst_decl2 dfun_id (NewTypeDerived coi _)
   = do  { let rigid_info = InstSkol
               origin     = SigOrigin rigid_info
               inst_ty    = idType dfun_id
-- 
1.7.10.4