Add Template Haskell support for overloaded labels
[ghc.git] / compiler / hsSyn / HsImpExp.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5
6 HsImpExp: Abstract syntax: imports, exports, interfaces
7 -}
8
9 {-# LANGUAGE DeriveDataTypeable #-}
10 {-# LANGUAGE FlexibleContexts #-}
11 {-# LANGUAGE StandaloneDeriving #-}
12 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
13 -- in module PlaceHolder
14
15 module HsImpExp where
16
17 import Module ( ModuleName )
18 import HsDoc ( HsDocString )
19 import OccName ( HasOccName(..), isTcOcc, isSymOcc )
20 import BasicTypes ( SourceText(..), StringLiteral(..), pprWithSourceText )
21 import FieldLabel ( FieldLbl(..) )
22
23 import Outputable
24 import FastString
25 import SrcLoc
26 import HsExtension
27
28 import Data.Data
29
30 {-
31 ************************************************************************
32 * *
33 \subsection{Import and export declaration lists}
34 * *
35 ************************************************************************
36
37 One per \tr{import} declaration in a module.
38 -}
39
40 -- | Located Import Declaration
41 type LImportDecl name = Located (ImportDecl name)
42 -- ^ When in a list this may have
43 --
44 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
45
46 -- For details on above see note [Api annotations] in ApiAnnotation
47
48 -- | Import Declaration
49 --
50 -- A single Haskell @import@ declaration.
51 data ImportDecl name
52 = ImportDecl {
53 ideclSourceSrc :: SourceText,
54 -- Note [Pragma source text] in BasicTypes
55 ideclName :: Located ModuleName, -- ^ Module name.
56 ideclPkgQual :: Maybe StringLiteral, -- ^ Package qualifier.
57 ideclSource :: Bool, -- ^ True <=> {-\# SOURCE \#-} import
58 ideclSafe :: Bool, -- ^ True => safe import
59 ideclQualified :: Bool, -- ^ True => qualified
60 ideclImplicit :: Bool, -- ^ True => implicit import (of Prelude)
61 ideclAs :: Maybe (Located ModuleName), -- ^ as Module
62 ideclHiding :: Maybe (Bool, Located [LIE name])
63 -- ^ (True => hiding, names)
64 }
65 -- ^
66 -- 'ApiAnnotation.AnnKeywordId's
67 --
68 -- - 'ApiAnnotation.AnnImport'
69 --
70 -- - 'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnClose' for ideclSource
71 --
72 -- - 'ApiAnnotation.AnnSafe','ApiAnnotation.AnnQualified',
73 -- 'ApiAnnotation.AnnPackageName','ApiAnnotation.AnnAs',
74 -- 'ApiAnnotation.AnnVal'
75 --
76 -- - 'ApiAnnotation.AnnHiding','ApiAnnotation.AnnOpen',
77 -- 'ApiAnnotation.AnnClose' attached
78 -- to location in ideclHiding
79
80 -- For details on above see note [Api annotations] in ApiAnnotation
81 deriving instance (DataId name) => Data (ImportDecl name)
82
83 simpleImportDecl :: ModuleName -> ImportDecl name
84 simpleImportDecl mn = ImportDecl {
85 ideclSourceSrc = NoSourceText,
86 ideclName = noLoc mn,
87 ideclPkgQual = Nothing,
88 ideclSource = False,
89 ideclSafe = False,
90 ideclImplicit = False,
91 ideclQualified = False,
92 ideclAs = Nothing,
93 ideclHiding = Nothing
94 }
95
96 instance (OutputableBndrId pass) => Outputable (ImportDecl pass) where
97 ppr (ImportDecl { ideclSourceSrc = mSrcText, ideclName = mod'
98 , ideclPkgQual = pkg
99 , ideclSource = from, ideclSafe = safe
100 , ideclQualified = qual, ideclImplicit = implicit
101 , ideclAs = as, ideclHiding = spec })
102 = hang (hsep [text "import", ppr_imp from, pp_implicit implicit, pp_safe safe,
103 pp_qual qual, pp_pkg pkg, ppr mod', pp_as as])
104 4 (pp_spec spec)
105 where
106 pp_implicit False = empty
107 pp_implicit True = ptext (sLit ("(implicit)"))
108
109 pp_pkg Nothing = empty
110 pp_pkg (Just (StringLiteral st p))
111 = pprWithSourceText st (doubleQuotes (ftext p))
112
113 pp_qual False = empty
114 pp_qual True = text "qualified"
115
116 pp_safe False = empty
117 pp_safe True = text "safe"
118
119 pp_as Nothing = empty
120 pp_as (Just a) = text "as" <+> ppr a
121
122 ppr_imp True = case mSrcText of
123 NoSourceText -> text "{-# SOURCE #-}"
124 SourceText src -> text src <+> text "#-}"
125 ppr_imp False = empty
126
127 pp_spec Nothing = empty
128 pp_spec (Just (False, (L _ ies))) = ppr_ies ies
129 pp_spec (Just (True, (L _ ies))) = text "hiding" <+> ppr_ies ies
130
131 ppr_ies [] = text "()"
132 ppr_ies ies = char '(' <+> interpp'SP ies <+> char ')'
133
134 {-
135 ************************************************************************
136 * *
137 \subsection{Imported and exported entities}
138 * *
139 ************************************************************************
140 -}
141
142 -- | A name in an import or export specification which may have adornments. Used
143 -- primarily for accurate pretty printing of ParsedSource, and API Annotation
144 -- placement.
145 data IEWrappedName name
146 = IEName (Located name) -- ^ no extra
147 | IEPattern (Located name) -- ^ pattern X
148 | IEType (Located name) -- ^ type (:+:)
149 deriving (Eq,Data)
150
151 -- | Located name with possible adornment
152 -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnType',
153 -- 'ApiAnnotation.AnnPattern'
154 type LIEWrappedName name = Located (IEWrappedName name)
155 -- For details on above see note [Api annotations] in ApiAnnotation
156
157
158 -- | Located Import or Export
159 type LIE name = Located (IE name)
160 -- ^ When in a list this may have
161 --
162 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'
163
164 -- For details on above see note [Api annotations] in ApiAnnotation
165
166 -- | Imported or exported entity.
167 data IE name
168 = IEVar (LIEWrappedName (IdP name))
169 -- ^ Imported or Exported Variable
170
171 | IEThingAbs (LIEWrappedName (IdP name))
172 -- ^ Imported or exported Thing with Absent list
173 --
174 -- The thing is a Class/Type (can't tell)
175 -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnPattern',
176 -- 'ApiAnnotation.AnnType','ApiAnnotation.AnnVal'
177
178 -- For details on above see note [Api annotations] in ApiAnnotation
179 -- See Note [Located RdrNames] in HsExpr
180 | IEThingAll (LIEWrappedName (IdP name))
181 -- ^ Imported or exported Thing with All imported or exported
182 --
183 -- The thing is a Class/Type and the All refers to methods/constructors
184 --
185 -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',
186 -- 'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose',
187 -- 'ApiAnnotation.AnnType'
188
189 -- For details on above see note [Api annotations] in ApiAnnotation
190 -- See Note [Located RdrNames] in HsExpr
191
192 | IEThingWith (LIEWrappedName (IdP name))
193 IEWildcard
194 [LIEWrappedName (IdP name)]
195 [Located (FieldLbl (IdP name))]
196 -- ^ Imported or exported Thing With given imported or exported
197 --
198 -- The thing is a Class/Type and the imported or exported things are
199 -- methods/constructors and record fields; see Note [IEThingWith]
200 -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen',
201 -- 'ApiAnnotation.AnnClose',
202 -- 'ApiAnnotation.AnnComma',
203 -- 'ApiAnnotation.AnnType'
204
205 -- For details on above see note [Api annotations] in ApiAnnotation
206 | IEModuleContents (Located ModuleName)
207 -- ^ Imported or exported module contents
208 --
209 -- (Export Only)
210 --
211 -- - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnModule'
212
213 -- For details on above see note [Api annotations] in ApiAnnotation
214 | IEGroup Int HsDocString -- ^ Doc section heading
215 | IEDoc HsDocString -- ^ Some documentation
216 | IEDocNamed String -- ^ Reference to named doc
217 -- deriving (Eq, Data)
218 deriving instance (Eq name, Eq (IdP name)) => Eq (IE name)
219 deriving instance (DataId name) => Data (IE name)
220
221 -- | Imported or Exported Wildcard
222 data IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data)
223
224 {-
225 Note [IEThingWith]
226 ~~~~~~~~~~~~~~~~~~
227
228 A definition like
229
230 module M ( T(MkT, x) ) where
231 data T = MkT { x :: Int }
232
233 gives rise to
234
235 IEThingWith T [MkT] [FieldLabel "x" False x)] (without DuplicateRecordFields)
236 IEThingWith T [MkT] [FieldLabel "x" True $sel:x:MkT)] (with DuplicateRecordFields)
237
238 See Note [Representing fields in AvailInfo] in Avail for more details.
239 -}
240
241 ieName :: IE pass -> IdP pass
242 ieName (IEVar (L _ n)) = ieWrappedName n
243 ieName (IEThingAbs (L _ n)) = ieWrappedName n
244 ieName (IEThingWith (L _ n) _ _ _) = ieWrappedName n
245 ieName (IEThingAll (L _ n)) = ieWrappedName n
246 ieName _ = panic "ieName failed pattern match!"
247
248 ieNames :: IE pass -> [IdP pass]
249 ieNames (IEVar (L _ n) ) = [ieWrappedName n]
250 ieNames (IEThingAbs (L _ n) ) = [ieWrappedName n]
251 ieNames (IEThingAll (L _ n) ) = [ieWrappedName n]
252 ieNames (IEThingWith (L _ n) _ ns _) = ieWrappedName n
253 : map (ieWrappedName . unLoc) ns
254 ieNames (IEModuleContents _ ) = []
255 ieNames (IEGroup _ _ ) = []
256 ieNames (IEDoc _ ) = []
257 ieNames (IEDocNamed _ ) = []
258
259 ieWrappedName :: IEWrappedName name -> name
260 ieWrappedName (IEName (L _ n)) = n
261 ieWrappedName (IEPattern (L _ n)) = n
262 ieWrappedName (IEType (L _ n)) = n
263
264 ieLWrappedName :: LIEWrappedName name -> Located name
265 ieLWrappedName (L l n) = L l (ieWrappedName n)
266
267 replaceWrappedName :: IEWrappedName name1 -> name2 -> IEWrappedName name2
268 replaceWrappedName (IEName (L l _)) n = IEName (L l n)
269 replaceWrappedName (IEPattern (L l _)) n = IEPattern (L l n)
270 replaceWrappedName (IEType (L l _)) n = IEType (L l n)
271
272 replaceLWrappedName :: LIEWrappedName name1 -> name2 -> LIEWrappedName name2
273 replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n')
274
275 instance (OutputableBndrId pass) => Outputable (IE pass) where
276 ppr (IEVar var) = ppr (unLoc var)
277 ppr (IEThingAbs thing) = ppr (unLoc thing)
278 ppr (IEThingAll thing) = hcat [ppr (unLoc thing), text "(..)"]
279 ppr (IEThingWith thing wc withs flds)
280 = ppr (unLoc thing) <> parens (fsep (punctuate comma
281 (ppWiths ++
282 map (ppr . flLabel . unLoc) flds)))
283 where
284 ppWiths =
285 case wc of
286 NoIEWildcard ->
287 map (ppr . unLoc) withs
288 IEWildcard pos ->
289 let (bs, as) = splitAt pos (map (ppr . unLoc) withs)
290 in bs ++ [text ".."] ++ as
291 ppr (IEModuleContents mod')
292 = text "module" <+> ppr mod'
293 ppr (IEGroup n _) = text ("<IEGroup: " ++ show n ++ ">")
294 ppr (IEDoc doc) = ppr doc
295 ppr (IEDocNamed string) = text ("<IEDocNamed: " ++ string ++ ">")
296
297 instance (HasOccName name) => HasOccName (IEWrappedName name) where
298 occName w = occName (ieWrappedName w)
299
300 instance (OutputableBndr name) => OutputableBndr (IEWrappedName name) where
301 pprBndr bs w = pprBndr bs (ieWrappedName w)
302 pprPrefixOcc w = pprPrefixOcc (ieWrappedName w)
303 pprInfixOcc w = pprInfixOcc (ieWrappedName w)
304
305 instance (OutputableBndr name) => Outputable (IEWrappedName name) where
306 ppr (IEName n) = pprPrefixOcc (unLoc n)
307 ppr (IEPattern n) = text "pattern" <+> pprPrefixOcc (unLoc n)
308 ppr (IEType n) = text "type" <+> pprPrefixOcc (unLoc n)
309
310 pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc
311 pprImpExp name = type_pref <+> pprPrefixOcc name
312 where
313 occ = occName name
314 type_pref | isTcOcc occ && isSymOcc occ = text "type"
315 | otherwise = empty