root/compiler/hsSyn/HsImpExp.lhs

Revision 00448643b9ac5ae0be89a31fa48d41ff66181d7d, 5.6 KB (checked in by Iavor S. Diatchki <iavor.diatchki@…>, 2 months ago)

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.

  • Property mode set to 100644
Line 
1%
2% (c) The University of Glasgow 2006
3% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4%
5
6HsImpExp: Abstract syntax: imports, exports, interfaces
7
8\begin{code}
9{-# LANGUAGE DeriveDataTypeable #-}
10
11module HsImpExp where
12
13import Module           ( ModuleName )
14import HsDoc            ( HsDocString )
15import OccName          ( HasOccName(..), isTcOcc, isSymOcc )
16
17import Outputable
18import FastString
19import SrcLoc
20
21import Data.Data
22\end{code}
23
24%************************************************************************
25%*                                                                      *
26\subsection{Import and export declaration lists}
27%*                                                                      *
28%************************************************************************
29
30One per \tr{import} declaration in a module.
31\begin{code}
32type LImportDecl name = Located (ImportDecl name)
33
34-- | A single Haskell @import@ declaration.
35data ImportDecl name
36  = ImportDecl {
37      ideclName      :: Located ModuleName, -- ^ Module name.
38      ideclPkgQual   :: Maybe FastString,   -- ^ Package qualifier.
39      ideclSource    :: Bool,               -- ^ True <=> {-# SOURCE #-} import
40      ideclSafe      :: Bool,               -- ^ True => safe import
41      ideclQualified :: Bool,               -- ^ True => qualified
42      ideclImplicit  :: Bool,               -- ^ True => implicit import (of Prelude)
43      ideclAs        :: Maybe ModuleName,   -- ^ as Module
44      ideclHiding    :: Maybe (Bool, [LIE name]) -- ^ (True => hiding, names)
45    } deriving (Data, Typeable)
46
47simpleImportDecl :: ModuleName -> ImportDecl name
48simpleImportDecl mn = ImportDecl {
49      ideclName      = noLoc mn,
50      ideclPkgQual   = Nothing,
51      ideclSource    = False,
52      ideclSafe      = False,
53      ideclImplicit  = False,
54      ideclQualified = False,
55      ideclAs        = Nothing,
56      ideclHiding    = Nothing
57    }
58\end{code}
59
60\begin{code}
61instance (OutputableBndr name, HasOccName name) => Outputable (ImportDecl name) where
62    ppr (ImportDecl { ideclName = mod', ideclPkgQual = pkg
63                    , ideclSource = from, ideclSafe = safe
64                    , ideclQualified = qual, ideclImplicit = implicit
65                    , ideclAs = as, ideclHiding = spec })
66      = hang (hsep [ptext (sLit "import"), ppr_imp from, pp_implicit implicit, pp_safe safe,
67                    pp_qual qual, pp_pkg pkg, ppr mod', pp_as as])
68             4 (pp_spec spec)
69      where
70        pp_implicit False = empty
71        pp_implicit True = ptext (sLit ("(implicit)"))
72
73        pp_pkg Nothing  = empty
74        pp_pkg (Just p) = doubleQuotes (ftext p)
75
76        pp_qual False   = empty
77        pp_qual True    = ptext (sLit "qualified")
78
79        pp_safe False   = empty
80        pp_safe True    = ptext (sLit "safe")
81
82        pp_as Nothing   = empty
83        pp_as (Just a)  = ptext (sLit "as") <+> ppr a
84
85        ppr_imp True  = ptext (sLit "{-# SOURCE #-}")
86        ppr_imp False = empty
87
88        pp_spec Nothing             = empty
89        pp_spec (Just (False, ies)) = ppr_ies ies
90        pp_spec (Just (True,  ies)) = ptext (sLit "hiding") <+> ppr_ies ies
91
92        ppr_ies []  = ptext (sLit "()")
93        ppr_ies ies = char '(' <+> interpp'SP ies <+> char ')'
94\end{code}
95
96%************************************************************************
97%*                                                                      *
98\subsection{Imported and exported entities}
99%*                                                                      *
100%************************************************************************
101
102\begin{code}
103type LIE name = Located (IE name)
104
105-- | Imported or exported entity.
106data IE name
107  = IEVar               name
108  | IEThingAbs          name             -- ^ Class/Type (can't tell)
109  | IEThingAll          name             -- ^ Class/Type plus all methods/constructors
110  | IEThingWith         name [name]      -- ^ Class/Type plus some methods/constructors
111  | IEModuleContents    ModuleName       -- ^ (Export Only)
112  | IEGroup             Int HsDocString  -- ^ Doc section heading
113  | IEDoc               HsDocString      -- ^ Some documentation
114  | IEDocNamed          String           -- ^ Reference to named doc
115  deriving (Eq, Data, Typeable)
116\end{code}
117
118\begin{code}
119ieName :: IE name -> name
120ieName (IEVar n)         = n
121ieName (IEThingAbs  n)   = n
122ieName (IEThingWith n _) = n
123ieName (IEThingAll  n)   = n
124ieName _ = panic "ieName failed pattern match!"
125
126ieNames :: IE a -> [a]
127ieNames (IEVar            n   ) = [n]
128ieNames (IEThingAbs       n   ) = [n]
129ieNames (IEThingAll       n   ) = [n]
130ieNames (IEThingWith      n ns) = n : ns
131ieNames (IEModuleContents _   ) = []
132ieNames (IEGroup          _ _ ) = []
133ieNames (IEDoc            _   ) = []
134ieNames (IEDocNamed       _   ) = []
135\end{code}
136
137\begin{code}
138
139pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc
140pprImpExp name = type_pref <+> pprPrefixOcc name
141    where
142    occ = occName name
143    type_pref | isTcOcc occ && isSymOcc occ = ptext (sLit "type")
144              | otherwise                   = empty
145
146instance (HasOccName name, OutputableBndr name) => Outputable (IE name) where
147    ppr (IEVar          var)    = pprPrefixOcc var
148    ppr (IEThingAbs     thing)  = pprImpExp thing
149    ppr (IEThingAll     thing)  = hcat [pprImpExp thing, text "(..)"]
150    ppr (IEThingWith thing withs)
151        = pprImpExp thing <> parens (fsep (punctuate comma (map pprImpExp withs)))
152    ppr (IEModuleContents mod')
153        = ptext (sLit "module") <+> ppr mod'
154    ppr (IEGroup n _)           = text ("<IEGroup: " ++ (show n) ++ ">")
155    ppr (IEDoc doc)             = ppr doc
156    ppr (IEDocNamed string)     = text ("<IEDocNamed: " ++ string ++ ">")
157\end{code}
158
Note: See TracBrowser for help on using the browser.