X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FPprCore.lhs;h=1908667e1473f0fad80854433dafaf8e738c2693;hp=209ebfbea0417a847216cf02b9878aa3c5b367fb;hb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;hpb=9cb6b74e9877e19efbd4db1c6a0b94997540bb47 diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs index 209ebfb..1908667 100644 --- a/compiler/coreSyn/PprCore.lhs +++ b/compiler/coreSyn/PprCore.lhs @@ -247,7 +247,7 @@ instance OutputableBndr Var where pprCoreBinder :: BindingSite -> Var -> SDoc pprCoreBinder LetBind binder - | isTyVar binder = pprKindedTyVarBndr binder + | isTyCoVar binder = pprKindedTyVarBndr binder | otherwise = pprTypedBinder binder $$ ppIdInfo binder (idInfo binder) @@ -258,7 +258,7 @@ pprCoreBinder bind_site bndr pprUntypedBinder :: Var -> SDoc pprUntypedBinder binder - | isTyVar binder = ptext (sLit "@") <+> ppr binder -- NB: don't print kind + | isTyCoVar binder = ptext (sLit "@") <+> ppr binder -- NB: don't print kind | otherwise = pprIdBndr binder pprTypedLCBinder :: BindingSite -> Bool -> Var -> SDoc @@ -266,7 +266,7 @@ pprTypedLCBinder :: BindingSite -> Bool -> Var -> SDoc pprTypedLCBinder bind_site debug_on var | not debug_on && isDeadBinder var = char '_' | not debug_on, CaseBind <- bind_site = pprUntypedBinder var -- No parens, no kind info - | isTyVar var = parens (pprKindedTyVarBndr var) + | isTyCoVar var = parens (pprKindedTyVarBndr var) | otherwise = parens (hang (pprIdBndr var) 2 (vcat [ dcolon <+> pprType (idType var), pp_unf])) where @@ -277,7 +277,7 @@ pprTypedLCBinder bind_site debug_on var pprTypedBinder :: Var -> SDoc -- Print binder with a type or kind signature (not paren'd) pprTypedBinder binder - | isTyVar binder = pprKindedTyVarBndr binder + | isTyCoVar binder = pprKindedTyVarBndr binder | otherwise = hang (pprIdBndr binder) 2 (dcolon <+> pprType (idType binder)) pprKindedTyVarBndr :: TyVar -> SDoc @@ -386,10 +386,11 @@ instance Outputable UnfoldingSource where ppr InlineRhs = ptext (sLit "") instance Outputable Unfolding where - ppr NoUnfolding = ptext (sLit "No unfolding") - ppr (OtherCon cs) = ptext (sLit "OtherCon") <+> ppr cs - ppr (DFunUnfolding con ops) = ptext (sLit "DFun") <+> ppr con - <+> brackets (pprWithCommas pprParendExpr ops) + ppr NoUnfolding = ptext (sLit "No unfolding") + ppr (OtherCon cs) = ptext (sLit "OtherCon") <+> ppr cs + ppr (DFunUnfolding ar con ops) = ptext (sLit "DFun") <> parens (ptext (sLit "arity=") <> int ar) + <+> ppr con + <+> brackets (pprWithCommas pprParendExpr ops) ppr (CoreUnfolding { uf_src = src , uf_tmpl=rhs, uf_is_top=top, uf_is_value=hnf , uf_is_conlike=conlike, uf_is_cheap=cheap