Repository : http://darcs.haskell.org/ghc.git/
On branch : master https://github.com/ghc/ghc/commit/6cc5bd790b5a498108e3131cd6c5f5ba6334942e >--------------------------------------------------------------- commit 6cc5bd790b5a498108e3131cd6c5f5ba6334942e Author: Jose Pedro Magalhaes <[email protected]> Date: Tue May 21 10:12:01 2013 +0100 Make AutoDeriveTypeable derive Typeable instances for promoted data constructors >--------------------------------------------------------------- compiler/typecheck/TcDeriv.lhs | 26 ++++++++++++++++++++------ docs/users_guide/glasgow_exts.xml | 4 +++- 2 files changed, 23 insertions(+), 7 deletions(-) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 9b82ed6..d7cb08d 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -475,7 +475,7 @@ makeDerivSpecs :: Bool -> [LDerivDecl Name] -> TcM [EarlyDerivSpec] makeDerivSpecs is_boot tycl_decls inst_decls deriv_decls - = do { eqns1 <- concatMapM (recoverM (return []) . deriveTyDecl) tycl_decls + = do { eqns1 <- concatMapM (recoverM (return []) . deriveTyDecl) tycl_decls ; eqns2 <- concatMapM (recoverM (return []) . deriveInstDecl) inst_decls ; eqns3 <- mapAndRecoverM deriveStandalone deriv_decls ; let eqns = eqns1 ++ eqns2 ++ eqns3 @@ -514,13 +514,27 @@ makeDerivSpecs is_boot tycl_decls inst_decls deriv_decls ------------------------------------------------------------------ deriveTyDecl :: LTyClDecl Name -> TcM [EarlyDerivSpec] -deriveTyDecl (L _ decl@(DataDecl { tcdLName = L _ tc_name - , tcdDataDefn = HsDataDefn { dd_derivs = Just preds } })) +deriveTyDecl (L _ decl@(DataDecl { tcdLName = L loc tc_name + , tcdDataDefn = HsDataDefn { dd_derivs = preds } })) = tcAddDeclCtxt decl $ do { tc <- tcLookupTyCon tc_name - ; let tvs = tyConTyVars tc - tys = mkTyVarTys tvs - ; mapM (deriveTyData tvs tc tys) preds } + ; let tvs = tyConTyVars tc + tys = mkTyVarTys tvs + pdcs :: [LDerivDecl Name] + pdcs = [ L loc (DerivDecl (L loc (HsAppTy (noLoc (HsTyVar typeableClassName)) + (L loc (HsTyVar (tyConName pdc)))))) + | Just pdc <- map promoteDataCon_maybe (tyConDataCons tc) ] + -- If AutoDeriveTypeable and DataKinds is set, we add Typeable instances + -- for every promoted data constructor of datatypes in this module + ; isAutoTypeable <- xoptM Opt_AutoDeriveTypeable + ; isDataKinds <- xoptM Opt_DataKinds + ; prom_dcs_Typeable_instances <- if isAutoTypeable && isDataKinds + then mapM deriveStandalone pdcs + else return [] + ; other_instances <- case preds of + Just preds' -> mapM (deriveTyData tvs tc tys) preds' + Nothing -> return [] + ; return (prom_dcs_Typeable_instances ++ other_instances) } deriveTyDecl _ = return [] diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index c97489b..47c8ab0 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -3418,7 +3418,9 @@ can be mentioned in the <literal>deriving</literal> clause. <para> The flag <option>-XAutoDeriveTypeable</option> triggers the generation of derived <literal>Typeable</literal> instances for every datatype and type -class declaration in the module it is used. This flag implies +class declaration in the module it is used. It will also generate +<literal>Typeable</literal> instances for any promoted data constructors +(<xref linkend="promotion"/>). This flag implies <option>-XDeriveDataTypeable</option> (<xref linkend="deriving-typeable"/>). </para> _______________________________________________ ghc-commits mailing list [email protected] http://www.haskell.org/mailman/listinfo/ghc-commits
