pprCoreBinder :: BindingSite -> Var -> SDoc
pprCoreBinder LetBind binder
- | isTyVar binder = pprTypedBinder binder
+ | isTyVar binder = pprKindedTyVarBndr binder
| otherwise
= vcat [sig, pprIdDetails binder, pragmas]
where
pragmas = ppIdInfo binder (idInfo binder)
-- Lambda bound type variables are preceded by "@"
-pprCoreBinder LambdaBind bndr = parens (pprTypedBinder bndr)
+pprCoreBinder LambdaBind bndr
+ | isDeadBinder bndr
+ = getPprStyle $ \ sty ->
+ if debugStyle sty then
+ parens (pprTypedBinder bndr)
+ else
+ char '_'
+ | otherwise
+ = parens (pprTypedBinder bndr)
-- Case bound things don't get a signature or a herald, unless we have debug on
pprCoreBinder CaseBind bndr
if debugStyle sty then
parens (pprTypedBinder bndr)
else
- pprUntypedBinder bndr
+ if isDeadBinder bndr then char '_'
+ else pprUntypedBinder bndr
pprUntypedBinder :: Var -> SDoc
pprUntypedBinder binder
| otherwise = pprIdBndr binder
pprTypedBinder :: Var -> SDoc
+-- Print binder with a type or kind signature (not paren'd)
pprTypedBinder binder
- | isTyVar binder = ptext (sLit "@") <+> pprTyVarBndr binder
+ | isTyVar binder = pprKindedTyVarBndr binder
| otherwise = pprIdBndr binder <+> dcolon <+> pprType (idType binder)
-pprTyVarBndr :: TyVar -> SDoc
-pprTyVarBndr tyvar
- = getPprStyle $ \ sty ->
- if debugStyle sty then
- hsep [ppr tyvar, dcolon, pprParendKind kind]
- -- See comments with ppDcolon in PprCore.lhs
- else
- ppr tyvar
+pprKindedTyVarBndr :: TyVar -> SDoc
+-- Print a type variable binder with its kind (but not if *)
+pprKindedTyVarBndr tyvar
+ = ptext (sLit "@") <+> ppr tyvar <> opt_kind
where
+ opt_kind -- Print the kind if not *
+ | isLiftedTypeKind kind = empty
+ | otherwise = dcolon <> pprKind kind
kind = tyVarKind tyvar
-- pprIdBndr does *not* print the type