X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=utils%2Fext-core%2FPrinter.hs;h=404fda9bc8ed5ff4320eae9490b491e0277299fb;hp=8ff4ba5ad2de3e05bbd33110c54e3a5e13c8ed7f;hb=6b085eeada6c3c93599fa4b6d77572abc419c08c;hpb=87c93cf56c83abf0148c91d5972dbe65dc72c38a

diff --git a/utils/ext-core/Printer.hs b/utils/ext-core/Printer.hs
index 8ff4ba5..404fda9 100644
--- a/utils/ext-core/Printer.hs
+++ b/utils/ext-core/Printer.hs
@@ -5,6 +5,7 @@ import Numeric (fromRat)
 import Char
 
 import Core
+import Encoding
 
 instance Show Module where
   showsPrec d m = shows (pmodule m)
@@ -61,14 +62,30 @@ pcdef (Constr qdcon tbinds tys)  =
 
 pname id = text id
 
-pqname (m,id) = pmname m <> char '.' <> pname id
+pqname (m,id) = pmname m <> pname id
 
+-- be sure to print the '.' here so we don't print out
+-- ".foo" for unqualified foo...
 pmname Nothing = empty
-pmname (Just m) = panmname m
-
-panmname (pkgName, parents, name) = pname pkgName <> char ':' 
-  <> (sep (punctuate (char '.') (map pname parents)))
-  <> char '.' <> pname name
+pmname (Just m) = panmname m <> char '.'
+
+panmname p@(pkgName, parents, name) =
+  let parentStrs = map pname parents in
+         pname pkgName <> char ':' <>
+         -- This is to be sure to not print out:
+         -- main:.Main for when there's a single module name
+         -- with no parents.
+             (case parentStrs of
+                [] -> empty
+                _  -> hcat (punctuate hierModuleSeparator 
+                        (map pname parents)) 
+                      <> hierModuleSeparator)
+             <> pname name
+
+-- note that this is not a '.' but a Z-encoded '.':
+-- GHCziIOBase.IO, not GHC.IOBase.IO.
+-- What a pain.
+hierModuleSeparator = text (zEncodeString ".")
 
 ptbind (t,Klifted) = pname t
 ptbind (t,k) = parens (pname t <> text "::" <> pkind k)