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

Reply via email to