Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/74e1e73af872e63fbbec2bc9442494c3657053c3 >--------------------------------------------------------------- commit 74e1e73af872e63fbbec2bc9442494c3657053c3 Author: Jose Pedro Magalhaes <[email protected]> Date: Wed May 25 11:57:44 2011 +0200 Better output for -ddump-deriv when using generics. >--------------------------------------------------------------- compiler/typecheck/TcDeriv.lhs | 27 +++++++++++++++++++++------ compiler/types/Generics.lhs | 2 +- 2 files changed, 22 insertions(+), 7 deletions(-) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index b278ab4..fab7c61 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -332,7 +332,7 @@ tcDeriving tycl_decls inst_decls deriv_decls ; dflags <- getDOpts ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances" - (ddump_deriving inst_info rn_binds)) + (ddump_deriving inst_info rn_binds repMetaTys repTyCons metaInsts)) {- ; when (not (null inst_info)) $ dumpDerivingInfo (ddump_deriving inst_info rn_binds) @@ -340,11 +340,26 @@ tcDeriving tycl_decls inst_decls deriv_decls ; return ( inst_info, rn_binds, rn_dus , concat (map metaTyCons2TyCons repMetaTys), repTyCons) } where - ddump_deriving :: [InstInfo Name] -> HsValBinds Name -> SDoc - ddump_deriving inst_infos extra_binds - = hang (ptext (sLit "Derived instances")) - 2 (vcat (map (\i -> pprInstInfoDetails i $$ text "") inst_infos) - $$ ppr extra_binds) + ddump_deriving :: [InstInfo Name] -> HsValBinds Name + -> [MetaTyCons] -- ^ Empty data constructors + -> [TyCon] -- ^ Rep type family instances + -> [[(InstInfo RdrName, DerivAuxBinds)]] + -- ^ Instances for the repMetaTys + -> SDoc + ddump_deriving inst_infos extra_binds repMetaTys repTyCons metaInsts + = hang (ptext (sLit "Derived instances")) + 2 (vcat (map (\i -> pprInstInfoDetails i $$ text "") inst_infos) + $$ ppr extra_binds) + $$ hangP "Generic representation" ( + hangP "Generated datatypes for meta-information" + (vcat (map ppr repMetaTys)) + -- The Outputable instance for TyCon unfortunately only prints the name... + $$ hangP "Representation types" + (vcat (map ppr repTyCons)) + $$ hangP "Meta-information instances" + (vcat (map (pprInstInfoDetails . fst) (concat metaInsts)))) + + hangP s x = text "" $$ hang (ptext (sLit s)) 2 x renameDeriv :: Bool -> LHsBinds RdrName diff --git a/compiler/types/Generics.lhs b/compiler/types/Generics.lhs index 57b2655..323da41 100644 --- a/compiler/types/Generics.lhs +++ b/compiler/types/Generics.lhs @@ -218,7 +218,7 @@ data MetaTyCons = MetaTyCons { -- One meta datatype per dataype , metaS :: [[TyCon]] } instance Outputable MetaTyCons where - ppr (MetaTyCons d c s) = ppr d <+> ppr c <+> ppr s + ppr (MetaTyCons d c s) = ppr d $$ vcat (map ppr c) $$ vcat (map ppr (concat s)) metaTyCons2TyCons :: MetaTyCons -> [TyCon] metaTyCons2TyCons (MetaTyCons d c s) = d : c ++ concat s _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
