From f7d9e72f4f79d3a8f635c3312ddd524a727334e4 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Wed, 2 Jan 2013 15:47:31 +0000
Subject: [PATCH] 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 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs
index 571b816e594b..a88303d35827 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)
-- 
GitLab