Commit 3c3ce829 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Modularise pretty-printing for foralls

See TypeRep.pprUserForAll.  This just makes forall-printing a bit more
consistent.  In particular, I wasn't seeing the kind foralls when
displaying a CoAxiom or CoAxBranch

The output on T7939 is just possible a bit too verbose now, but even if so
that's an error in the right direction.
parent 675c5478
......@@ -32,14 +32,13 @@ import CoAxiom( CoAxiom(..), brListMap )
import HscTypes( tyThingParent_maybe )
import Type( tidyTopType, tidyOpenType, splitForAllTys, funResultTy )
import Kind( synTyConResKind )
import TypeRep( pprTvBndrs, pprForAll, suppressKinds )
import TypeRep( pprTvBndrs, pprUserForAll, suppressKinds )
import TysPrim( alphaTyVars )
import MkIface ( tyThingToIfaceDecl )
import TcType
import Name
import VarEnv( emptyTidyEnv )
import StaticFlags( opt_PprStyle_Debug )
import DynFlags
import Outputable
import FastString
......@@ -234,7 +233,7 @@ pprDataConDecl :: ShowSub -> Bool -> DataCon -> SDoc
pprDataConDecl ss gadt_style dataCon
| not gadt_style = ppr_fields tys_w_strs
| otherwise = ppr_bndr dataCon <+> dcolon <+>
sep [ pp_foralls, pprThetaArrowTy theta, pp_tau ]
sep [ pprUserForAll forall_tvs, pprThetaArrowTy theta, pp_tau ]
-- Printing out the dataCon as a type signature, in GADT style
where
(forall_tvs, theta, tau) = tcSplitSigmaTy (dataConUserType dataCon)
......@@ -242,9 +241,6 @@ pprDataConDecl ss gadt_style dataCon
labels = dataConFieldLabels dataCon
stricts = dataConStrictMarks dataCon
tys_w_strs = zip (map user_ify stricts) arg_tys
pp_foralls = sdocWithDynFlags $ \dflags ->
ppWhen (gopt Opt_PrintExplicitForalls dflags)
(pprForAll forall_tvs)
pp_tau = foldr add (ppr res_ty) tys_w_strs
add str_ty pp_ty = pprParendBangTy str_ty <+> arrow <+> pp_ty
......
......@@ -724,7 +724,7 @@ pprCoAxBranch :: TyCon -> CoAxBranch -> SDoc
pprCoAxBranch fam_tc (CoAxBranch { cab_tvs = tvs
, cab_lhs = lhs
, cab_rhs = rhs })
= hang (ifPprDebug (pprForAll tvs))
= hang (pprUserForAll tvs)
2 (hang (pprTypeApp fam_tc lhs) 2 (equals <+> (ppr rhs)))
pprCoAxBranchHdr :: CoAxiom br -> BranchIndex -> SDoc
......
......@@ -128,7 +128,7 @@ module Type (
-- * Pretty-printing
pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprTyThing,
pprTvBndr, pprTvBndrs, pprForAll, pprSigmaType,
pprTvBndr, pprTvBndrs, pprForAll, pprUserForAll, pprSigmaType,
pprEqPred, pprTheta, pprThetaArrowTy, pprClassPred,
pprKind, pprParendKind, pprSourceTyCon,
......
......@@ -39,7 +39,8 @@ module TypeRep (
-- Pretty-printing
pprType, pprParendType, pprTypeApp, pprTvBndr, pprTvBndrs,
pprTyThing, pprTyThingCategory, pprSigmaType,
pprEqPred, pprTheta, pprForAll, pprThetaArrowTy, pprClassPred,
pprEqPred, pprTheta, pprForAll, pprUserForAll,
pprThetaArrowTy, pprClassPred,
pprKind, pprParendKind, pprTyLit, suppressKinds,
Prec(..), maybeParen, pprTcApp,
pprPrefixApp, pprArrowChain, ppr_type,
......@@ -618,11 +619,11 @@ ppr_tylit _ tl =
-------------------
ppr_sigma_type :: Bool -> Type -> SDoc
-- Bool <=> Show the foralls
ppr_sigma_type show_foralls ty
= sep [ ppWhen (show_foralls || any tv_has_kind_var tvs)
(pprForAll tvs)
-- See Note [When to print foralls]
-- Bool <=> Show the foralls unconditionally
ppr_sigma_type show_foralls_unconditionally ty
= sep [ if show_foralls_unconditionally
then pprForAll tvs
else pprUserForAll tvs
, pprThetaArrowTy ctxt
, pprType tau ]
where
......@@ -631,15 +632,21 @@ ppr_sigma_type show_foralls ty
split1 tvs (ForAllTy tv ty) = split1 (tv:tvs) ty
split1 tvs ty = (reverse tvs, ty)
split2 ps (ty1 `FunTy` ty2) | isPredTy ty1 = split2 (ty1:ps) ty2
split2 ps ty = (reverse ps, ty)
tv_has_kind_var tv = not (isEmptyVarSet (tyVarsOfType (tyVarKind tv)))
pprSigmaType :: Type -> SDoc
pprSigmaType ty = sdocWithDynFlags $ \dflags ->
ppr_sigma_type (gopt Opt_PrintExplicitForalls dflags) ty
pprSigmaType ty = ppr_sigma_type False ty
pprUserForAll :: [TyVar] -> SDoc
-- Print a user-level forall; see Note [WHen to print foralls]
pprUserForAll tvs
= sdocWithDynFlags $ \dflags ->
ppWhen (any tv_has_kind_var tvs || gopt Opt_PrintExplicitForalls dflags) $
pprForAll tvs
where
tv_has_kind_var tv = not (isEmptyVarSet (tyVarsOfType (tyVarKind tv)))
pprForAll :: [TyVar] -> SDoc
pprForAll [] = empty
......
......@@ -13,11 +13,11 @@ type family H (a :: Bool) :: Bool where H 'False = 'True
H :: Bool -> Bool
type family J (a :: [k]) :: Bool where
J '[] = 'False
J (h : t) = 'True
forall (k :: BOX) (h :: k) (t :: [k]). J (h : t) = 'True
-- Defined at T7939.hs:17:1
J :: [k] -> Bool
type family K (a :: [k]) :: Maybe k where
K '[] = 'Nothing
K (h : t) = 'Just h
forall (k :: BOX) (h :: k) (t :: [k]). K (h : t) = 'Just h
-- Defined at T7939.hs:21:1
K :: [k] -> Maybe k
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