+ newtype_deriving = dopt 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)
+
+ non_std_err = nonStdErr cls $$
+ ptext (sLit "Try -XGeneralizedNewtypeDeriving for GHC's newtype-deriving extension")
+
+ -- Here is the plan for newtype derivings. We see
+ -- newtype T a1...an = MkT (t ak+1...an) deriving (.., C s1 .. sm, ...)
+ -- where t is a type,
+ -- ak+1...an is a suffix of a1..an, and are all tyars
+ -- ak+1...an do not occur free in t, nor in the s1..sm
+ -- (C s1 ... sm) is a *partial applications* of class C
+ -- with the last parameter missing
+ -- (T a1 .. ak) matches the kind of C's last argument
+ -- (and hence so does t)
+ -- The latter kind-check has been done by deriveTyData already,
+ -- and tc_args are already trimmed
+ --
+ -- We generate the instance
+ -- instance forall ({a1..ak} u fvs(s1..sm)).
+ -- C s1 .. sm t => C s1 .. sm (T a1...ak)
+ -- where T a1...ap is the partial application of
+ -- the LHS of the correct kind and p >= k
+ --
+ -- NB: the variables below are:
+ -- tc_tvs = [a1, ..., an]
+ -- tyvars_to_keep = [a1, ..., ak]
+ -- rep_ty = t ak .. an
+ -- deriv_tvs = fvs(s1..sm) \ tc_tvs
+ -- tys = [s1, ..., sm]
+ -- rep_fn' = t
+ --
+ -- Running example: newtype T s a = MkT (ST s a) deriving( Monad )
+ -- We generate the instance
+ -- instance Monad (ST s) => Monad (T s) where
+
+ nt_eta_arity = length (fst (newTyConEtadRhs rep_tycon))
+ -- For newtype T a b = MkT (S a a b), the TyCon machinery already
+ -- eta-reduces the representation type, so we know that
+ -- T a ~ S a a
+ -- That's convenient here, because we may have to apply
+ -- it to fewer than its original complement of arguments
+
+ -- 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,
+ -- when making the Num instance of A!
+ rep_inst_ty = newTyConInstRhs rep_tycon rep_tc_args
+ rep_tys = cls_tys ++ [rep_inst_ty]
+ rep_pred = mkClassPred cls rep_tys
+ -- rep_pred is the representation dictionary, from where
+ -- we are gong to get all the methods for the newtype
+ -- dictionary
+
+
+ -- Next we figure out what superclass dictionaries to use
+ -- See Note [Newtype deriving superclasses] above
+
+ cls_tyvars = classTyVars cls
+ dfun_tvs = tyVarsOfTypes inst_tys
+ inst_ty = mkTyConApp tycon tc_args
+ inst_tys = cls_tys ++ [inst_ty]
+ sc_theta = substTheta (zipOpenTvSubst cls_tyvars inst_tys)
+ (classSCTheta cls)
+
+ -- If there are no tyvars, there's no need
+ -- to abstract over the dictionaries we need
+ -- Example: newtype T = MkT Int deriving( C )
+ -- We get the derived instance
+ -- instance C T
+ -- rather than
+ -- instance C Int => C T
+ all_preds = rep_pred : sc_theta -- NB: rep_pred comes first
+
+ -------------------------------------------------------------------
+ -- Figuring out whether we can only do this newtype-deriving thing
+
+ can_derive_via_isomorphism
+ = not (non_iso_class cls)
+ && arity_ok
+ && eta_ok
+ && ats_ok
+-- && not (isRecursiveTyCon tycon) -- Note [Recursive newtypes]
+
+ -- Never derive Read,Show,Typeable,Data by isomorphism
+ non_iso_class cls = className cls `elem` ([readClassName, showClassName, dataClassName] ++
+ typeableClassNames)
+
+ arity_ok = length cls_tys + 1 == classArity cls
+ -- Well kinded; eg not: newtype T ... deriving( ST )
+ -- because ST needs *2* type params
+
+ -- Check that eta reduction is OK
+ eta_ok = nt_eta_arity <= length rep_tc_args
+ -- The newtype can be eta-reduced to match the number
+ -- of type argument actually supplied
+ -- newtype T a b = MkT (S [a] b) deriving( Monad )
+ -- Here the 'b' must be the same in the rep type (S [a] b)
+ -- And the [a] must not mention 'b'. That's all handled
+ -- by nt_eta_rity.
+
+ ats_ok = null (classATs cls)
+ -- No associated types for the class, because we don't
+ -- currently generate type 'instance' decls; and cannot do
+ -- so for 'data' instance decls
+
+ cant_derive_err
+ = vcat [ ppUnless arity_ok arity_msg
+ , ppUnless eta_ok eta_msg
+ , ppUnless ats_ok ats_msg ]
+ arity_msg = quotes (ppr (mkClassPred cls cls_tys)) <+> ptext (sLit "does not have arity 1")
+ eta_msg = ptext (sLit "cannot eta-reduce the representation type enough")
+ ats_msg = ptext (sLit "the class has associated types")