diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2012-10-01 10:31:25 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2012-10-01 10:31:25 +0100 |
| commit | c35c5d0262bfb18e58e7fd249c03e23cc9ff64c9 (patch) | |
| tree | ac59044573a96e114a38dc08e18ef13cd673e710 /compiler | |
| parent | 7fdc2a39d5c9a7d1be45b6314d480d16810a75ef (diff) | |
| download | haskell-c35c5d0262bfb18e58e7fd249c03e23cc9ff64c9.tar.gz | |
Improve pretty printing for coercions (exp transistivity chains)
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/types/Coercion.lhs | 13 |
1 files changed, 9 insertions, 4 deletions
diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index fab8fa5de4..4599ddf04a 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -418,10 +418,11 @@ ppr_co p co@(ForAllCo {}) = ppr_forall_co p co ppr_co _ (CoVarCo cv) = parenSymOcc (getOccName cv) (ppr cv) ppr_co p (AxiomInstCo con cos) = pprTypeNameApp p ppr_co (getName con) cos -ppr_co p (TransCo co1 co2) = maybeParen p FunPrec $ - ppr_co FunPrec co1 - <+> ptext (sLit ";") - <+> ppr_co FunPrec co2 +ppr_co p co@(TransCo {}) = maybeParen p FunPrec $ + case trans_co_list co [] of + [] -> panic "ppr_co" + (co:cos) -> sep ( ppr_co FunPrec co + : [ char ';' <+> ppr_co FunPrec co | co <- cos]) ppr_co p (InstCo co ty) = maybeParen p TyConPrec $ pprParendCo co <> ptext (sLit "@") <> pprType ty @@ -431,6 +432,10 @@ ppr_co p (SymCo co) = pprPrefixApp p (ptext (sLit "Sym")) [pprParendCo c ppr_co p (NthCo n co) = pprPrefixApp p (ptext (sLit "Nth:") <> int n) [pprParendCo co] ppr_co p (LRCo sel co) = pprPrefixApp p (ppr sel) [pprParendCo co] +trans_co_list :: Coercion -> [Coercion] -> [Coercion] +trans_co_list (TransCo co1 co2) cos = trans_co_list co1 (trans_co_list co2 cos) +trans_co_list co cos = co : cos + instance Outputable LeftOrRight where ppr CLeft = ptext (sLit "Left") ppr CRight = ptext (sLit "Right") |