X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FPprExternalCore.lhs;h=3c4b25e420e3754168a615db229a85ed1751884d;hb=372a8c47e84ee0de43e9e03d5becb8276a4e148c;hp=c34f7b842a45140ab8df52fd97e657b0dfdfbc4c;hpb=e4417dcd4679da9c6b18c02ff667199c572bed89;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs
index c34f7b8..3c4b25e 100644
--- a/compiler/coreSyn/PprExternalCore.lhs
+++ b/compiler/coreSyn/PprExternalCore.lhs
@@ -5,12 +5,12 @@
 \begin{code}
 module PprExternalCore () where
 
-import ExternalCore
 import Encoding
+import ExternalCore
 
 import Pretty
-import Char
-
+import Data.Char
+import Data.Ratio
 
 instance Show Module where
   showsPrec _ m = shows (pmodule m)
@@ -57,10 +57,7 @@ ptdef (Data tcon tbinds cdefs) =
 ptdef (Newtype tcon coercion tbinds rep) =
   text "%newtype" <+> pqname tcon <+> pqname coercion 
    <+> (hsep (map ptbind tbinds)) $$ indent repclause
-       where repclause = case rep of
-                           Just ty -> char '=' <+> pty ty 
-			   Nothing -> empty
-             
+       where repclause = char '=' <+> pty rep
 
 pcdef :: Cdef -> Doc
 pcdef (Constr dcon tbinds tys)  =
@@ -103,6 +100,18 @@ pbty t = paty t
 
 pty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = fsep [pbty t1, text "->",pty t2]
 pty (Tforall tb t) = text "%forall" <+> pforall [tb] t
+pty (TransCoercion t1 t2) =
+  sep [text "%trans", paty t1, paty t2]
+pty (SymCoercion t) =
+  sep [text "%sym", paty t]
+pty (UnsafeCoercion t1 t2) =
+  sep [text "%unsafe", paty t1, paty t2]
+pty (LeftCoercion t) =
+  sep [text "%left", paty t]
+pty (RightCoercion t) =
+  sep [text "%right", paty t]
+pty (InstCoercion t1 t2) =
+  sep [text "%inst", paty t1, paty t2]
 pty t = pbty t
 
 pappty :: Ty -> [Ty] -> Doc
@@ -180,9 +189,12 @@ palt (Adefault e) =
 
 plit :: Lit -> Doc
 plit (Lint i t) = parens (integer i <> text "::" <> pty t)
--- we use (text (show r)) because "(rational r)" was printing out things
--- like "2.0e-2" (which isn't External Core)
-plit (Lrational r t) = parens (text (show r) <>  text "::" <> pty t)
+-- we use (text (show (numerator r))) (and the same for denominator)
+-- because "(rational r)" was printing out things like "2.0e-2" (which
+-- isn't External Core), and (text (show r)) was printing out things
+-- like "((-1)/5)" which isn't either (it should be "(-1/5)").
+plit (Lrational r t) = parens (text (show (numerator r)) <+> char '%'
+   <+> text (show (denominator r)) <>  text "::" <> pty t)
 plit (Lchar c t) = parens (text ("\'" ++ escape [c] ++ "\'") <> text "::" <> pty t)
 plit (Lstring s t) = parens (pstring s <> text "::" <> pty t)