diff options
| author | Jose Pedro Magalhaes <jpm@cs.uu.nl> | 2011-05-25 11:57:44 +0200 |
|---|---|---|
| committer | Jose Pedro Magalhaes <jpm@cs.uu.nl> | 2011-05-25 11:57:44 +0200 |
| commit | 74e1e73af872e63fbbec2bc9442494c3657053c3 (patch) | |
| tree | c88954533081012b7a64ae04a510397adb1ce026 | |
| parent | 99e9c36b2df186dc28c946517579487373d8659a (diff) | |
| download | haskell-74e1e73af872e63fbbec2bc9442494c3657053c3.tar.gz | |
Better output for -ddump-deriv when using generics.
| -rw-r--r-- | compiler/typecheck/TcDeriv.lhs | 27 | ||||
| -rw-r--r-- | 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 b278ab4f62..fab7c61ff0 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 57b26556c8..323da41d66 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 |