Commit 8b6c1605 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Improve printing of TyThings; fixes Trac #4087

parent 40612c90
......@@ -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(..),
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment