X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FPprExternalCore.lhs;h=e33c7a018eb449eac67955882fcd03333001a376;hb=aff23274b14d6e8551e949c3290adaf265e31371;hp=ffa4675243950863ede4900e10212b7b3cca765a;hpb=2ad4df602e5bb2cff0315b945fa3201749878c30;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs
index ffa4675..e33c7a0 100644
--- a/compiler/coreSyn/PprExternalCore.lhs
+++ b/compiler/coreSyn/PprExternalCore.lhs
@@ -5,12 +5,11 @@
 \begin{code}
 module PprExternalCore () where
 
-import ExternalCore
 import Encoding
+import ExternalCore
 
 import Pretty
-import Char
-
+import Data.Char
 
 instance Show Module where
   showsPrec _ m = shows (pmodule m)
@@ -54,22 +53,10 @@ ptdef (Data tcon tbinds cdefs) =
   (text "%data" <+> pqname tcon <+> (hsep (map ptbind tbinds)) <+> char '=')
   $$ indent (braces ((vcat (punctuate (char ';') (map pcdef cdefs)))))
 
-ptdef (Newtype tcon tbinds (coercion,tbs,k) rep) =
--- Here we take apart the newtype tycon in order to get the newtype coercion,
--- which needs to be represented in the External Core file because it's not
--- straightforward to derive its definition from the newtype declaration alone.
--- At the same time, we need the newtype decl to declare the tycon itself.
--- Sigh.
-  text "%newtype" <+> pqname tcon <+> (hsep (map ptbind tbinds)) 
-    $$ indent (axiomclause $$ repclause)
-       where  axiomclause = char '^' 
-                 <+> parens (pqname coercion <+> (hsep (map ptbind tbs))
-                              <+> text "::"
-                              <+> pkind k)
-              repclause   = case rep of
-                              Just ty -> char '=' <+> pty ty 
-			      Nothing -> empty
-             
+ptdef (Newtype tcon coercion tbinds rep) =
+  text "%newtype" <+> pqname tcon <+> pqname coercion 
+   <+> (hsep (map ptbind tbinds)) $$ indent repclause
+       where repclause = char '=' <+> pty rep
 
 pcdef :: Cdef -> Doc
 pcdef (Constr dcon tbinds tys)  =
@@ -107,11 +94,23 @@ 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) = pappty t1 [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]
 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