Commit 00448643 authored by Iavor S. Diatchki's avatar Iavor S. Diatchki
Browse files

Fix pretty-printing of type operators in imports/exports.

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.
parent d3b43108
......@@ -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
......
......@@ -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}
......
......@@ -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
......
......@@ -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) ++ ">")
......
......@@ -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)
......
......@@ -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"),
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment