Commit 3f7b147c authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Fix bug in External Core pretty printer (fixes Trac #7547)

This bug was making GHC loop when printing external core from test T7239.
parent 5f77b315
......@@ -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)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment