Skip to content

Commit

Permalink
Fix bug in External Core pretty printer (fixes Trac #7547)
Browse files Browse the repository at this point in the history
This bug was making GHC loop when printing external core from test T7239.
  • Loading branch information
Simon Peyton Jones authored and Ian Lynagh committed Jan 4, 2013
1 parent 160424c commit f7d9e72
Showing 1 changed file with 8 additions and 2 deletions.
10 changes: 8 additions & 2 deletions compiler/coreSyn/PprExternalCore.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand All @@ -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)
Expand Down

0 comments on commit f7d9e72

Please sign in to comment.