Commit b7a8d205 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

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
parent 435c5194
......@@ -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)
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment