X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FPprExternalCore.lhs;h=fb4fc45ecf4849f533dcbaf721b16ddf86c30ba2;hb=9f565a397c17568f725b25720a817326744777f0;hp=cb9b0e773ebb513281993ea95ba0b945729ef274;hpb=35549002886ef843f80cb265a8f14d7f9522d85d;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs
index cb9b0e7..fb4fc45 100644
--- a/compiler/coreSyn/PprExternalCore.lhs
+++ b/compiler/coreSyn/PprExternalCore.lhs
@@ -54,7 +54,8 @@ 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,k) rep) =
+ptdef (Newtype tcon tbinds (coercion,tbs,k) rep) =
+-- TODO: I think this is kind of redundant now.
 -- 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.
@@ -62,8 +63,10 @@ ptdef (Newtype tcon tbinds (coercion,k) rep) =
 -- Sigh.
   text "%newtype" <+> pqname tcon <+> (hsep (map ptbind tbinds)) 
     $$ indent (axiomclause $$ repclause)
-       where  axiomclause = char '^' <+> parens (pqname coercion <+> text "::"
-                                     <+> pkind k)
+       where  axiomclause = char '^' 
+                 <+> parens (pqname coercion <+> (hsep (map ptbind tbs))
+                              <+> text "::"
+                              <+> pkind k)
               repclause   = case rep of
                               Just ty -> char '=' <+> pty ty 
 			      Nothing -> empty
@@ -71,19 +74,16 @@ ptdef (Newtype tcon tbinds (coercion,k) rep) =
 
 pcdef :: Cdef -> Doc
 pcdef (Constr dcon tbinds tys)  =
-  (pname dcon) <+> (sep [hsep (map pattbind tbinds),sep (map paty tys)])
+  (pqname dcon) <+> (sep [hsep (map pattbind tbinds),sep (map paty tys)])
 pcdef (GadtConstr dcon ty)  =
-  (pname dcon) <+> text "::" <+> pty ty
+  (pqname dcon) <+> text "::" <+> pty ty
 
 pname :: Id -> Doc
 pname id = text (zEncodeString id)
 
 pqname :: Qual Id -> Doc
 pqname ("",id) = pname id
--- We print out a special character before a qualified name so as to
--- disambiguate unqualified names like "m" from qualified names like
--- "m:Foo.Bar.y". This makes the ext-core parser easier.
-pqname (m,id)  = char '^' <> text m <> char '.' <> pname id
+pqname (m,id)  = text m <> char '.' <> pname id
 
 ptbind, pattbind :: Tbind -> Doc
 ptbind (t,Klifted) = pname t
@@ -108,7 +108,7 @@ 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]
@@ -128,10 +128,10 @@ pvdefg (Rec vdefs) = text "%rec" $$ braces (indent (vcat (punctuate (char ';') (
 pvdefg (Nonrec vdef) = pvdef vdef
 
 pvdef :: Vdef -> Doc
--- note: at one point every vdef was getting printed out as "local".
--- I think that's manifestly wrong. Right now, the "%local" keyword
--- is never used.
-pvdef (_l,v,t,e) = sep [pname v <+> text "::" <+> pty t <+> char '=',
+-- TODO: Think about whether %local annotations are actually needed.
+-- Right now, the local flag is never used, because the Core doc doesn't
+-- explain the meaning of %local.
+pvdef (_l,v,t,e) = sep [(pqname v <+> text "::" <+> pty t <+> char '='),
 		    indent (pexp e)]
 
 paexp, pfexp, pexp :: Exp -> Doc