- ------------------------------------------------------------------
- -- Deriving clauses at data declarations
- derive_data :: [DerivSpec]
- derive_data = [ (loc, DerivOrigin, nd, tycon, tyVars, tyPats, pred)
- | L loc (TyData { tcdND = nd, tcdLName = L _ tycon,
- tcdTyVars = tyVars, tcdTyPats = tyPats,
- tcdDerivs = Just preds }) <- tycl_decls,
- pred <- preds ]
-
- -- Standalone deriving declarations
- top_level_deriv :: LDerivDecl Name -> TcM (Maybe DerivSpec)
- top_level_deriv d@(L loc (DerivDecl inst ty_name)) =
- recoverM (returnM Nothing) $ setSrcSpan loc $
- do tycon <- tcLookupLocatedTyCon ty_name
- let new_or_data = if isNewTyCon tycon then NewType else DataType
- let tyVars = [ noLoc $ KindedTyVar (tyVarName tv) (tyVarKind tv)
- | tv <- tyConTyVars tycon] -- Yuk!!!
- traceTc (text "Stand-alone deriving:" <+>
- ppr (new_or_data, unLoc ty_name, inst))
- return $ Just (loc, StandAloneDerivOrigin, new_or_data,
- unLoc ty_name, tyVars, Nothing, inst)
-
- ------------------------------------------------------------------
- -- Derive equation/inst info for one deriving clause (data or standalone)
- mk_eqn :: DerivSpec -> TcM (Maybe DerivEqn, Maybe InstInfo)
- -- We swizzle the datacons out of the tycon to make the rest of the
- -- equation. We can't get the tyvars out of the constructor in case
- -- of family instances, as we already need to them to lookup the
- -- representation tycon (only that has the right set of type
- -- variables, the type variables of the family constructor are
- -- different).
- --
- -- The "deriv_ty" is a LHsType to take account of the fact that for
- -- newtype deriving we allow deriving (forall a. C [a]).
-
- mk_eqn (loc, orig, new_or_data, tycon_name, tyvars, mb_tys, hs_deriv_ty)
- = setSrcSpan loc $
- addErrCtxt (derivCtxt tycon_name mb_tys) $
- do { named_tycon <- tcLookupTyCon tycon_name
-
- -- Enable deriving preds to mention the type variables in the
- -- instance type
- ; tcTyVarBndrs tyvars $ \tvs -> do
- { traceTc (text "TcDeriv.mk_eqn: tyvars:" <+> ppr tvs)
-
- -- Lookup representation tycon in case of a family instance
- -- NB: We already need the type variables in scope here for the
- -- call to `dsHsType'.
- ; tycon <- case mb_tys of
- Nothing -> return named_tycon
- Just hsTys -> do
- tys <- mapM dsHsType hsTys
- tcLookupFamInst named_tycon tys
-
- ; (deriv_tvs, clas, tys) <- tcHsDeriv hs_deriv_ty
- ; gla_exts <- doptM Opt_GlasgowExts
- ; mk_eqn_help loc orig gla_exts new_or_data tycon deriv_tvs clas tys
- }}
-
- ------------------------------------------------------------------
- -- data/newtype T a = ... deriving( C t1 t2 )
- -- leads to a call to mk_eqn_help with
- -- tycon = T, deriv_tvs = ftv(t1,t2), clas = C, tys = [t1,t2]
-
- mk_eqn_help loc orig gla_exts DataType tycon deriv_tvs clas tys
- | Just err <- checkSideConditions gla_exts tycon deriv_tvs clas tys
- = bale_out (derivingThingErr clas tys origTyCon ttys err)
- | otherwise
- = do { eqn <- mkDataTypeEqn loc orig tycon clas
- ; returnM (Just eqn, Nothing) }
- where
- (origTyCon, ttys) = tyConOrigHead tycon
-
- mk_eqn_help loc orig gla_exts NewType tycon deriv_tvs clas tys
- | can_derive_via_isomorphism && (gla_exts || std_class_via_iso clas)
- = do { traceTc (text "newtype deriving:" <+> ppr tycon <+> ppr rep_tys)
- ; -- Go ahead and use the isomorphism
- dfun_name <- new_dfun_name clas tycon
- ; return (Nothing, Just (InstInfo { iSpec = mk_inst_spec dfun_name,
- iBinds = NewTypeDerived ntd_info })) }
- | std_class gla_exts clas
- = mk_eqn_help loc orig gla_exts DataType tycon deriv_tvs clas tys -- Go via bale-out route
-
- | otherwise -- Non-standard instance
- = bale_out (if gla_exts then
- cant_derive_err -- Too hard
- else
- non_std_err) -- Just complain about being a non-std instance
- where
- -- 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
- -- 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)
- --
- -- 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
-
- clas_tyvars = classTyVars clas
- kind = tyVarKind (last clas_tyvars)
- -- Kind of the thing we want to instance
- -- e.g. argument kind of Monad, *->*