-> TcRn (Maybe EarlyDerivSpec)
mkEqnHelp orig tvs cls cls_tys tc_app mtheta
| Just (tycon, tc_args) <- tcSplitTyConApp_maybe tc_app
- = do { (rep_tc, rep_tc_args) <- tcLookupFamInstExact tycon tc_args
+ = do {
+ -- For standalone deriving (mtheta /= Nothing),
+ -- check that all the data constructors are in scope
+ -- By this time we know that the thing is algebraic
+ -- because we've called checkInstHead in derivingStandalone
+ rdr_env <- getGlobalRdrEnv
+ ; let hidden_data_cons = filter not_in_scope (tyConDataCons tycon)
+ not_in_scope dc = null (lookupGRE_Name rdr_env (dataConName dc))
+ ; checkTc (isNothing mtheta || null hidden_data_cons)
+ (derivingHiddenErr tycon)
; mayDeriveDataTypeable <- doptM Opt_DeriveDataTypeable
; newtype_deriving <- doptM Opt_GeneralizedNewtypeDeriving
+ ; (rep_tc, rep_tc_args) <- tcLookupFamInstExact tycon tc_args
+
-- Be careful to test rep_tc here: in the case of families, we want
-- to check the instance tycon, not the family tycon
; if isDataTyCon rep_tc then
dataConInstOrigArgTys data_con rep_tc_args,
not (isUnLiftedType arg_ty) ] -- No constraints for unlifted types?
+ -- See Note [Superclasses of derived instance]
+ sc_constraints = substTheta (zipOpenTvSubst (classTyVars cls) inst_tys)
+ (classSCTheta cls)
+ inst_tys = [mkTyConApp tycon tc_args]
+
stupid_subst = zipTopTvSubst (tyConTyVars rep_tc) rep_tc_args
stupid_constraints = substTheta stupid_subst (tyConStupidTheta rep_tc)
- all_constraints = stupid_constraints ++ ordinary_constraints
- -- see Note [Data decl contexts] above
+ all_constraints = stupid_constraints ++ sc_constraints ++ ordinary_constraints
spec = DS { ds_loc = loc, ds_orig = orig
, ds_name = dfun_name, ds_tvs = tvs
- , ds_cls = cls, ds_tys = [mkTyConApp tycon tc_args]
+ , ds_cls = cls, ds_tys = inst_tys
, ds_theta = mtheta `orElse` all_constraints
, ds_newtype = False }
; return (if isJust mtheta then Just (Right spec) -- Specified context
else Just (Left spec)) } -- Infer context
-
mk_typeable_eqn orig tvs cls tycon tc_args rep_tc _rep_tc_args mtheta
-- The Typeable class is special in several ways
-- data T a b = ... deriving( Typeable )
-- a suitable string; hence the empty type arg list
\end{code}
+Note [Superclasses of derived instance]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In general, a derived instance decl needs the superclasses of the derived
+class too. So if we have
+ data T a = ...deriving( Ord )
+then the initial context for Ord (T a) should include Eq (T a). Often this is
+redundant; we'll also generate an Ord constraint for each constructor argument,
+and that will probably generate enough constraints to make the Eq (T a) constraint
+be satisfied too. But not always; consider:
+
+ data S a = S
+ instance Eq (S a)
+ instance Ord (S a)
+
+ data T a = MkT (S a) deriving( Ord )
+ instance Num a => Eq (T a)
+
+The derived instance for (Ord (T a)) must have a (Num a) constraint!
+Similarly consider:
+ data T a = MkT deriving( Data, Typeable )
+Here there *is* no argument field, but we must nevertheless generate
+a context for the Data instances:
+ instance Typable a => Data (T a) where ...
+
%************************************************************************
%* *
-- Want to drop 1 arg from (T s a) and (ST s a)
-- to get instance Monad (ST s) => Monad (T s)
- -- Note [newtype representation]
- -- Need newTyConRhs *not* newTyConRep to get the representation
- -- type, because the latter looks through all intermediate newtypes
- -- For example
+ -- Note [Newtype representation]
+ -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ -- Need newTyConRhs (*not* a recursive representation finder)
+ -- to get the representation type. For example
-- newtype B = MkB Int
-- newtype A = MkA B deriving( Num )
-- We want the Num instance of B, *not* the Num instance of Int,
where
pred = mkClassPred clas (tys ++ [ty])
+derivingHiddenErr :: TyCon -> SDoc
+derivingHiddenErr tc
+ = hang (ptext SLIT("The data constructors of") <+> quotes (ppr tc) <+> ptext SLIT("are not all in scope"))
+ 2 (ptext SLIT("so you cannot derive an instance for it"))
+
standaloneCtxt :: LHsType Name -> SDoc
standaloneCtxt ty = hang (ptext SLIT("In the stand-alone deriving instance for"))
2 (quotes (ppr ty))