Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.6
http://hackage.haskell.org/trac/ghc/changeset/f7d9e72f4f79d3a8f635c3312ddd524a727334e4 >--------------------------------------------------------------- commit f7d9e72f4f79d3a8f635c3312ddd524a727334e4 Author: Simon Peyton Jones <simo...@microsoft.com> Date: Wed Jan 2 15:47:31 2013 +0000 Fix bug in External Core pretty printer (fixes Trac #7547) This bug was making GHC loop when printing external core from test T7239. >--------------------------------------------------------------- compiler/coreSyn/PprExternalCore.lhs | 10 ++++++++-- 1 files changed, 8 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs index 571b816..a88303d 100644 --- a/compiler/coreSyn/PprExternalCore.lhs +++ b/compiler/coreSyn/PprExternalCore.lhs @@ -95,12 +95,14 @@ pkind (Karrow k1 k2) = parens (pakind k1 <> text "->" <> pkind k2) pkind k = pakind k paty, pbty, pty :: Ty -> Doc +-- paty: print in parens, if non-atomic (like a name) +-- pbty: print in parens, if arrow (used only for lhs of arrow) +-- pty: not in parens paty (Tvar n) = pname n paty (Tcon c) = pqname c paty t = parens (pty t) pbty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = parens(fsep [pbty t1, text "->",pty t2]) -pbty (Tapp t1 t2) = parens $ pappty t1 [t2] pbty t = paty t pty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = fsep [pbty t1, text "->",pty t2] @@ -115,7 +117,11 @@ pty (NthCoercion n t) = sep [text "%nth", int n, paty t] pty (InstCoercion t1 t2) = sep [text "%inst", paty t1, paty t2] -pty t = pbty t +pty (AxiomCoercion tc i cos) = + pqname tc <+> int i <+> sep (map paty cos) +pty ty@(Tapp {}) = pappty ty [] +pty ty@(Tvar {}) = paty ty +pty ty@(Tcon {}) = paty ty pappty :: Ty -> [Ty] -> Doc pappty (Tapp t1 t2) ts = pappty t1 (t2:ts) _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
