Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/3f7b147c41a83bb69e2cd2337994434bf2507ef3 >--------------------------------------------------------------- commit 3f7b147c41a83bb69e2cd2337994434bf2507ef3 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 2290810..a1c0fc5 100644 --- a/compiler/coreSyn/PprExternalCore.lhs +++ b/compiler/coreSyn/PprExternalCore.lhs @@ -96,12 +96,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] @@ -120,7 +122,11 @@ pty (LRCoercion CRight t) = sep [text "%right", 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
