Fix pretty-printing of type operators in imports/exports.
authorIavor S. Diatchki <iavor.diatchki@gmail.com>
Sat, 24 Mar 2012 20:27:43 +0000 (13:27 -0700)
committerIavor S. Diatchki <iavor.diatchki@gmail.com>
Sat, 24 Mar 2012 20:27:43 +0000 (13:27 -0700)
When we see a type operator in an import or an export, we tag it
with the keyword 'type' so that it is not confused with value level
operators with the same name.

compiler/basicTypes/Name.lhs
compiler/basicTypes/OccName.lhs
compiler/basicTypes/RdrName.lhs
compiler/hsSyn/HsImpExp.lhs
compiler/hsSyn/HsSyn.lhs
compiler/rename/RnNames.lhs

index e4a9c7d..a26729f 100644 (file)
@@ -168,6 +168,9 @@ Wired-in thing  => The thing (Id, TyCon) is fully known to the compiler,
 All built-in syntax is for wired-in things.
 
 \begin{code}
+instance HasOccName Name where
+  occName = nameOccName
+
 nameUnique             :: Name -> Unique
 nameOccName            :: Name -> OccName 
 nameModule             :: Name -> Module
index e160d4e..27e995a 100644 (file)
@@ -54,6 +54,7 @@ module OccName (
        mkTupleOcc, 
        setOccNameSpace,
         demoteOccName,
+        HasOccName(..),
 
        -- ** Derived 'OccName's
         isDerivedOccName,
@@ -334,6 +335,11 @@ demoteOccName :: OccName -> Maybe OccName
 demoteOccName (OccName space name) = do
   space' <- demoteNameSpace space
   return $ OccName space' name
+
+{- | Other names in the compiler add aditional information to an OccName.
+This class provides a consistent way to access the underlying OccName. -}
+class HasOccName name where
+  occName :: name -> OccName
 \end{code}
 
 
index de0ff56..22bd41f 100644 (file)
@@ -130,6 +130,10 @@ data RdrName
 %************************************************************************
 
 \begin{code}
+
+instance HasOccName RdrName where
+  occName = rdrNameOcc
+
 rdrNameOcc :: RdrName -> OccName
 rdrNameOcc (Qual _ occ) = occ
 rdrNameOcc (Unqual occ) = occ
index ee75414..7163cbf 100644 (file)
@@ -12,6 +12,7 @@ module HsImpExp where
 
 import Module           ( ModuleName )
 import HsDoc            ( HsDocString )
+import OccName          ( HasOccName(..), isTcOcc, isSymOcc )
 
 import Outputable
 import FastString
@@ -57,7 +58,7 @@ simpleImportDecl mn = ImportDecl {
 \end{code}
 
 \begin{code}
-instance (OutputableBndr name) => Outputable (ImportDecl name) where
+instance (OutputableBndr name, HasOccName name) => Outputable (ImportDecl name) where
     ppr (ImportDecl { ideclName = mod', ideclPkgQual = pkg
                     , ideclSource = from, ideclSafe = safe
                     , ideclQualified = qual, ideclImplicit = implicit
@@ -134,12 +135,20 @@ ieNames (IEDocNamed       _   ) = []
 \end{code}
 
 \begin{code}
-instance (OutputableBndr name, Outputable name) => Outputable (IE name) where
+
+pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc
+pprImpExp name = type_pref <+> pprPrefixOcc name
+    where
+    occ = occName name
+    type_pref | isTcOcc occ && isSymOcc occ = ptext (sLit "type")
+              | otherwise                   = empty
+
+instance (HasOccName name, OutputableBndr name) => Outputable (IE name) where
     ppr (IEVar          var)    = pprPrefixOcc var
-    ppr (IEThingAbs     thing)  = ppr thing
-    ppr (IEThingAll     thing)  = hcat [ppr thing, text "(..)"]
+    ppr (IEThingAbs     thing)  = pprImpExp thing
+    ppr (IEThingAll     thing)  = hcat [pprImpExp thing, text "(..)"]
     ppr (IEThingWith thing withs)
-        = pprPrefixOcc thing <> parens (fsep (punctuate comma (map pprPrefixOcc withs)))
+        = pprImpExp thing <> parens (fsep (punctuate comma (map pprImpExp withs)))
     ppr (IEModuleContents mod')
         = ptext (sLit "module") <+> ppr mod'
     ppr (IEGroup n _)           = text ("<IEGroup: " ++ (show n) ++ ">")
index a8ae81e..ba1794d 100644 (file)
@@ -46,6 +46,7 @@ import HsUtils
 import HsDoc
 
 -- others:
+import OccName          ( HasOccName )
 import IfaceSyn                ( IfaceBinding )
 import Outputable
 import SrcLoc
@@ -97,7 +98,7 @@ data HsExtCore name   -- Read from Foo.hcr
 instance Outputable Char where
   ppr c = text [c]
 
-instance (OutputableBndr name)
+instance (OutputableBndr name, HasOccName name)
        => Outputable (HsModule name) where
 
     ppr (HsModule Nothing _ imports decls _ mbDoc)
index 553c3ef..0ecefbc 100644 (file)
@@ -1612,7 +1612,7 @@ dodgyImportWarn item = dodgyMsg (ptext (sLit "import")) item
 dodgyExportWarn :: Name -> SDoc
 dodgyExportWarn item = dodgyMsg (ptext (sLit "export")) item
 
-dodgyMsg :: OutputableBndr n => SDoc -> n -> SDoc
+dodgyMsg :: (OutputableBndr n, HasOccName n) => SDoc -> n -> SDoc
 dodgyMsg kind tc
   = sep [ ptext (sLit "The") <+> kind <+> ptext (sLit "item") <+> quotes (ppr (IEThingAll tc))
                 <+> ptext (sLit "suggests that"),