diff options
| author | simonpj@microsoft.com <unknown> | 2010-05-25 11:40:45 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2010-05-25 11:40:45 +0000 |
| commit | 8b6c1605e75a2482892995c6d0529911796e89dd (patch) | |
| tree | b381c10fef51ee918892bb82a9e2951b65c3b87d /compiler | |
| parent | 40612c9014ef04806cd341a12cf010db51eca2e3 (diff) | |
| download | haskell-8b6c1605e75a2482892995c6d0529911796e89dd.tar.gz | |
Improve printing of TyThings; fixes Trac #4087
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/main/GHC.hs | 4 | ||||
| -rw-r--r-- | compiler/main/PprTyThing.hs | 22 |
2 files changed, 10 insertions, 16 deletions
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index b713bc8714..64042e2c31 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -158,7 +158,7 @@ module GHC ( -- ** Data constructors DataCon, dataConSig, dataConType, dataConTyCon, dataConFieldLabels, - dataConIsInfix, isVanillaDataCon, + dataConIsInfix, isVanillaDataCon, dataConUserType, dataConStrictMarks, StrictnessMark(..), isMarkedStrict, @@ -176,7 +176,7 @@ module GHC ( pprParendType, pprTypeApp, Kind, PredType, - ThetaType, pprThetaArrow, + ThetaType, pprForAll, pprThetaArrow, -- ** Entities TyThing(..), diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs index dfa713fdc0..8bdb072d0c 100644 --- a/compiler/main/PprTyThing.hs +++ b/compiler/main/PprTyThing.hs @@ -179,21 +179,15 @@ pprDataConDecl :: PrintExplicitForalls -> Bool -> (FieldLabel -> Bool) pprDataConDecl _ gadt_style show_label dataCon | not gadt_style = ppr_fields tys_w_strs | otherwise = ppr_bndr dataCon <+> dcolon <+> - sep [ ppr_tvs, GHC.pprThetaArrow theta, pp_tau ] + sep [ GHC.pprForAll forall_tvs, GHC.pprThetaArrow theta, pp_tau ] + -- Printing out the dataCon as a type signature, in GADT style where - (tyvars, theta, argTypes, res_ty) = GHC.dataConSig dataCon - tyCon = GHC.dataConTyCon dataCon - labels = GHC.dataConFieldLabels dataCon - qualVars = filter (flip notElem (GHC.tyConTyVars tyCon)) tyvars - stricts = GHC.dataConStrictMarks dataCon - tys_w_strs = zip stricts argTypes - - ppr_tvs - | null qualVars = empty - | otherwise = ptext (sLit "forall") <+> - hsep (map ppr qualVars) <> dot - - -- printing out the dataCon as a type signature, in GADT style + (forall_tvs, theta, tau) = tcSplitSigmaTy (GHC.dataConUserType dataCon) + (arg_tys, res_ty) = tcSplitFunTys tau + labels = GHC.dataConFieldLabels dataCon + stricts = GHC.dataConStrictMarks dataCon + tys_w_strs = zip stricts arg_tys + pp_tau = foldr add (ppr res_ty) tys_w_strs add str_ty pp_ty = pprParendBangTy str_ty <+> arrow <+> pp_ty |