never executed always true always false
1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE DeriveDataTypeable #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# LANGUAGE FlexibleInstances #-}
5 {-# LANGUAGE TypeApplications #-}
6 {-# LANGUAGE TypeFamilies #-}
7 {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
8 -- in module Language.Haskell.Syntax.Extension
9 {-
10 (c) The University of Glasgow 2006
11 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
12
13
14 GHC.Hs.ImpExp: Abstract syntax: imports, exports, interfaces
15 -}
16
17 module GHC.Hs.ImpExp where
18
19 import GHC.Prelude
20
21 import GHC.Unit.Module ( ModuleName, IsBootInterface(..) )
22 import GHC.Hs.Doc ( HsDocString )
23 import GHC.Types.SourceText ( SourceText(..) )
24 import GHC.Types.FieldLabel ( FieldLabel )
25
26 import GHC.Utils.Outputable
27 import GHC.Utils.Panic
28 import GHC.Types.SrcLoc
29 import Language.Haskell.Syntax.Extension
30 import GHC.Hs.Extension
31 import GHC.Parser.Annotation
32 import GHC.Types.Name
33 import GHC.Types.PkgQual
34
35 import Data.Data
36 import Data.Maybe
37
38 {-
39 ************************************************************************
40 * *
41 \subsection{Import and export declaration lists}
42 * *
43 ************************************************************************
44
45 One per \tr{import} declaration in a module.
46 -}
47
48 -- | Located Import Declaration
49 type LImportDecl pass = XRec pass (ImportDecl pass)
50 -- ^ When in a list this may have
51 --
52 -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi'
53
54 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
55 type instance Anno (ImportDecl (GhcPass p)) = SrcSpanAnnA
56
57 -- | If/how an import is 'qualified'.
58 data ImportDeclQualifiedStyle
59 = QualifiedPre -- ^ 'qualified' appears in prepositive position.
60 | QualifiedPost -- ^ 'qualified' appears in postpositive position.
61 | NotQualified -- ^ Not qualified.
62 deriving (Eq, Data)
63
64 -- | Given two possible located 'qualified' tokens, compute a style
65 -- (in a conforming Haskell program only one of the two can be not
66 -- 'Nothing'). This is called from "GHC.Parser".
67 importDeclQualifiedStyle :: Maybe EpaLocation
68 -> Maybe EpaLocation
69 -> (Maybe EpaLocation, ImportDeclQualifiedStyle)
70 importDeclQualifiedStyle mPre mPost =
71 if isJust mPre then (mPre, QualifiedPre)
72 else if isJust mPost then (mPost,QualifiedPost) else (Nothing, NotQualified)
73
74 -- | Convenience function to answer the question if an import decl. is
75 -- qualified.
76 isImportDeclQualified :: ImportDeclQualifiedStyle -> Bool
77 isImportDeclQualified NotQualified = False
78 isImportDeclQualified _ = True
79
80 -- | Import Declaration
81 --
82 -- A single Haskell @import@ declaration.
83 data ImportDecl pass
84 = ImportDecl {
85 ideclExt :: XCImportDecl pass,
86 ideclSourceSrc :: SourceText,
87 -- Note [Pragma source text] in GHC.Types.SourceText
88 ideclName :: XRec pass ModuleName, -- ^ Module name.
89 ideclPkgQual :: ImportDeclPkgQual pass, -- ^ Package qualifier.
90 ideclSource :: IsBootInterface, -- ^ IsBoot <=> {-\# SOURCE \#-} import
91 ideclSafe :: Bool, -- ^ True => safe import
92 ideclQualified :: ImportDeclQualifiedStyle, -- ^ If/how the import is qualified.
93 ideclImplicit :: Bool, -- ^ True => implicit import (of Prelude)
94 ideclAs :: Maybe (XRec pass ModuleName), -- ^ as Module
95 ideclHiding :: Maybe (Bool, XRec pass [LIE pass])
96 -- ^ (True => hiding, names)
97 }
98 | XImportDecl !(XXImportDecl pass)
99 -- ^
100 -- 'GHC.Parser.Annotation.AnnKeywordId's
101 --
102 -- - 'GHC.Parser.Annotation.AnnImport'
103 --
104 -- - 'GHC.Parser.Annotation.AnnOpen', 'GHC.Parser.Annotation.AnnClose' for ideclSource
105 --
106 -- - 'GHC.Parser.Annotation.AnnSafe','GHC.Parser.Annotation.AnnQualified',
107 -- 'GHC.Parser.Annotation.AnnPackageName','GHC.Parser.Annotation.AnnAs',
108 -- 'GHC.Parser.Annotation.AnnVal'
109 --
110 -- - 'GHC.Parser.Annotation.AnnHiding','GHC.Parser.Annotation.AnnOpen',
111 -- 'GHC.Parser.Annotation.AnnClose' attached
112 -- to location in ideclHiding
113
114 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
115
116 type family ImportDeclPkgQual pass
117 type instance ImportDeclPkgQual GhcPs = RawPkgQual
118 type instance ImportDeclPkgQual GhcRn = PkgQual
119 type instance ImportDeclPkgQual GhcTc = PkgQual
120
121 type instance XCImportDecl GhcPs = EpAnn EpAnnImportDecl
122 type instance XCImportDecl GhcRn = NoExtField
123 type instance XCImportDecl GhcTc = NoExtField
124
125 type instance XXImportDecl (GhcPass _) = NoExtCon
126
127 type instance Anno ModuleName = SrcSpanAnnA
128 type instance Anno [LocatedA (IE (GhcPass p))] = SrcSpanAnnL
129
130 -- ---------------------------------------------------------------------
131
132 -- API Annotations types
133
134 data EpAnnImportDecl = EpAnnImportDecl
135 { importDeclAnnImport :: EpaLocation
136 , importDeclAnnPragma :: Maybe (EpaLocation, EpaLocation)
137 , importDeclAnnSafe :: Maybe EpaLocation
138 , importDeclAnnQualified :: Maybe EpaLocation
139 , importDeclAnnPackage :: Maybe EpaLocation
140 , importDeclAnnAs :: Maybe EpaLocation
141 } deriving (Data)
142
143 -- ---------------------------------------------------------------------
144
145 simpleImportDecl :: ModuleName -> ImportDecl GhcPs
146 simpleImportDecl mn = ImportDecl {
147 ideclExt = noAnn,
148 ideclSourceSrc = NoSourceText,
149 ideclName = noLocA mn,
150 ideclPkgQual = NoRawPkgQual,
151 ideclSource = NotBoot,
152 ideclSafe = False,
153 ideclImplicit = False,
154 ideclQualified = NotQualified,
155 ideclAs = Nothing,
156 ideclHiding = Nothing
157 }
158
159 instance (OutputableBndrId p
160 , Outputable (Anno (IE (GhcPass p)))
161 , Outputable (ImportDeclPkgQual (GhcPass p)))
162 => Outputable (ImportDecl (GhcPass p)) where
163 ppr (ImportDecl { ideclSourceSrc = mSrcText, ideclName = mod'
164 , ideclPkgQual = pkg
165 , ideclSource = from, ideclSafe = safe
166 , ideclQualified = qual, ideclImplicit = implicit
167 , ideclAs = as, ideclHiding = spec })
168 = hang (hsep [text "import", ppr_imp from, pp_implicit implicit, pp_safe safe,
169 pp_qual qual False, ppr pkg, ppr mod', pp_qual qual True, pp_as as])
170 4 (pp_spec spec)
171 where
172 pp_implicit False = empty
173 pp_implicit True = text "(implicit)"
174
175 pp_qual QualifiedPre False = text "qualified" -- Prepositive qualifier/prepositive position.
176 pp_qual QualifiedPost True = text "qualified" -- Postpositive qualifier/postpositive position.
177 pp_qual QualifiedPre True = empty -- Prepositive qualifier/postpositive position.
178 pp_qual QualifiedPost False = empty -- Postpositive qualifier/prepositive position.
179 pp_qual NotQualified _ = empty
180
181 pp_safe False = empty
182 pp_safe True = text "safe"
183
184 pp_as Nothing = empty
185 pp_as (Just a) = text "as" <+> ppr a
186
187 ppr_imp IsBoot = case mSrcText of
188 NoSourceText -> text "{-# SOURCE #-}"
189 SourceText src -> text src <+> text "#-}"
190 ppr_imp NotBoot = empty
191
192 pp_spec Nothing = empty
193 pp_spec (Just (False, (L _ ies))) = ppr_ies ies
194 pp_spec (Just (True, (L _ ies))) = text "hiding" <+> ppr_ies ies
195
196 ppr_ies [] = text "()"
197 ppr_ies ies = char '(' <+> interpp'SP ies <+> char ')'
198
199 {-
200 ************************************************************************
201 * *
202 \subsection{Imported and exported entities}
203 * *
204 ************************************************************************
205 -}
206
207 -- | A name in an import or export specification which may have
208 -- adornments. Used primarily for accurate pretty printing of
209 -- ParsedSource, and API Annotation placement. The
210 -- 'GHC.Parser.Annotation' is the location of the adornment in
211 -- the original source.
212 data IEWrappedName name
213 = IEName (LocatedN name) -- ^ no extra
214 | IEPattern EpaLocation (LocatedN name) -- ^ pattern X
215 | IEType EpaLocation (LocatedN name) -- ^ type (:+:)
216 deriving (Eq,Data)
217
218 -- | Located name with possible adornment
219 -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnType',
220 -- 'GHC.Parser.Annotation.AnnPattern'
221 type LIEWrappedName name = LocatedA (IEWrappedName name)
222 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
223
224
225 -- | Located Import or Export
226 type LIE pass = XRec pass (IE pass)
227 -- ^ When in a list this may have
228 --
229 -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma'
230
231 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
232 type instance Anno (IE (GhcPass p)) = SrcSpanAnnA
233
234 -- | Imported or exported entity.
235 data IE pass
236 = IEVar (XIEVar pass) (LIEWrappedName (IdP pass))
237 -- ^ Imported or Exported Variable
238
239 | IEThingAbs (XIEThingAbs pass) (LIEWrappedName (IdP pass))
240 -- ^ Imported or exported Thing with Absent list
241 --
242 -- The thing is a Class/Type (can't tell)
243 -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnPattern',
244 -- 'GHC.Parser.Annotation.AnnType','GHC.Parser.Annotation.AnnVal'
245
246 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
247 -- See Note [Located RdrNames] in GHC.Hs.Expr
248 | IEThingAll (XIEThingAll pass) (LIEWrappedName (IdP pass))
249 -- ^ Imported or exported Thing with All imported or exported
250 --
251 -- The thing is a Class/Type and the All refers to methods/constructors
252 --
253 -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen',
254 -- 'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose',
255 -- 'GHC.Parser.Annotation.AnnType'
256
257 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
258 -- See Note [Located RdrNames] in GHC.Hs.Expr
259
260 | IEThingWith (XIEThingWith pass)
261 (LIEWrappedName (IdP pass))
262 IEWildcard
263 [LIEWrappedName (IdP pass)]
264 -- ^ Imported or exported Thing With given imported or exported
265 --
266 -- The thing is a Class/Type and the imported or exported things are
267 -- methods/constructors and record fields; see Note [IEThingWith]
268 -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen',
269 -- 'GHC.Parser.Annotation.AnnClose',
270 -- 'GHC.Parser.Annotation.AnnComma',
271 -- 'GHC.Parser.Annotation.AnnType'
272
273 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
274 | IEModuleContents (XIEModuleContents pass) (XRec pass ModuleName)
275 -- ^ Imported or exported module contents
276 --
277 -- (Export Only)
278 --
279 -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnModule'
280
281 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
282 | IEGroup (XIEGroup pass) Int HsDocString -- ^ Doc section heading
283 | IEDoc (XIEDoc pass) HsDocString -- ^ Some documentation
284 | IEDocNamed (XIEDocNamed pass) String -- ^ Reference to named doc
285 | XIE !(XXIE pass)
286
287 type instance XIEVar GhcPs = NoExtField
288 type instance XIEVar GhcRn = NoExtField
289 type instance XIEVar GhcTc = NoExtField
290
291 type instance XIEThingAbs (GhcPass _) = EpAnn [AddEpAnn]
292 type instance XIEThingAll (GhcPass _) = EpAnn [AddEpAnn]
293
294 -- See Note [IEThingWith]
295 type instance XIEThingWith (GhcPass 'Parsed) = EpAnn [AddEpAnn]
296 type instance XIEThingWith (GhcPass 'Renamed) = [Located FieldLabel]
297 type instance XIEThingWith (GhcPass 'Typechecked) = NoExtField
298
299 type instance XIEModuleContents GhcPs = EpAnn [AddEpAnn]
300 type instance XIEModuleContents GhcRn = NoExtField
301 type instance XIEModuleContents GhcTc = NoExtField
302
303 type instance XIEGroup (GhcPass _) = NoExtField
304 type instance XIEDoc (GhcPass _) = NoExtField
305 type instance XIEDocNamed (GhcPass _) = NoExtField
306 type instance XXIE (GhcPass _) = NoExtCon
307
308 type instance Anno (LocatedA (IE (GhcPass p))) = SrcSpanAnnA
309
310 -- | Imported or Exported Wildcard
311 data IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data)
312
313 {-
314 Note [IEThingWith]
315 ~~~~~~~~~~~~~~~~~~
316 A definition like
317
318 {-# LANGUAGE DuplicateRecordFields #-}
319 module M ( T(MkT, x) ) where
320 data T = MkT { x :: Int }
321
322 gives rise to this in the output of the parser:
323
324 IEThingWith NoExtField T [MkT, x] NoIEWildcard
325
326 But in the renamer we need to attach the correct field label,
327 because the selector Name is mangled (see Note [FieldLabel] in
328 GHC.Types.FieldLabel). Hence we change this to:
329
330 IEThingWith [FieldLabel "x" True $sel:x:MkT)] T [MkT] NoIEWildcard
331
332 using the TTG extension field to store the list of fields in renamed syntax
333 only. (Record fields always appear in this list, regardless of whether
334 DuplicateRecordFields was in use at the definition site or not.)
335
336 See Note [Representing fields in AvailInfo] in GHC.Types.Avail for more details.
337 -}
338
339 ieName :: IE (GhcPass p) -> IdP (GhcPass p)
340 ieName (IEVar _ (L _ n)) = ieWrappedName n
341 ieName (IEThingAbs _ (L _ n)) = ieWrappedName n
342 ieName (IEThingWith _ (L _ n) _ _) = ieWrappedName n
343 ieName (IEThingAll _ (L _ n)) = ieWrappedName n
344 ieName _ = panic "ieName failed pattern match!"
345
346 ieNames :: IE (GhcPass p) -> [IdP (GhcPass p)]
347 ieNames (IEVar _ (L _ n) ) = [ieWrappedName n]
348 ieNames (IEThingAbs _ (L _ n) ) = [ieWrappedName n]
349 ieNames (IEThingAll _ (L _ n) ) = [ieWrappedName n]
350 ieNames (IEThingWith _ (L _ n) _ ns) = ieWrappedName n
351 : map (ieWrappedName . unLoc) ns
352 -- NB the above case does not include names of field selectors
353 ieNames (IEModuleContents {}) = []
354 ieNames (IEGroup {}) = []
355 ieNames (IEDoc {}) = []
356 ieNames (IEDocNamed {}) = []
357
358 ieWrappedLName :: IEWrappedName name -> LocatedN name
359 ieWrappedLName (IEName ln) = ln
360 ieWrappedLName (IEPattern _ ln) = ln
361 ieWrappedLName (IEType _ ln) = ln
362
363 ieWrappedName :: IEWrappedName name -> name
364 ieWrappedName = unLoc . ieWrappedLName
365
366
367 lieWrappedName :: LIEWrappedName name -> name
368 lieWrappedName (L _ n) = ieWrappedName n
369
370 ieLWrappedName :: LIEWrappedName name -> LocatedN name
371 ieLWrappedName (L _ n) = ieWrappedLName n
372
373 replaceWrappedName :: IEWrappedName name1 -> name2 -> IEWrappedName name2
374 replaceWrappedName (IEName (L l _)) n = IEName (L l n)
375 replaceWrappedName (IEPattern r (L l _)) n = IEPattern r (L l n)
376 replaceWrappedName (IEType r (L l _)) n = IEType r (L l n)
377
378 replaceLWrappedName :: LIEWrappedName name1 -> name2 -> LIEWrappedName name2
379 replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n')
380
381 instance OutputableBndrId p => Outputable (IE (GhcPass p)) where
382 ppr (IEVar _ var) = ppr (unLoc var)
383 ppr (IEThingAbs _ thing) = ppr (unLoc thing)
384 ppr (IEThingAll _ thing) = hcat [ppr (unLoc thing), text "(..)"]
385 ppr (IEThingWith flds thing wc withs)
386 = ppr (unLoc thing) <> parens (fsep (punctuate comma
387 (ppWiths ++ ppFields) ))
388 where
389 ppWiths =
390 case wc of
391 NoIEWildcard ->
392 map (ppr . unLoc) withs
393 IEWildcard pos ->
394 let (bs, as) = splitAt pos (map (ppr . unLoc) withs)
395 in bs ++ [text ".."] ++ as
396 ppFields =
397 case ghcPass @p of
398 GhcRn -> map ppr flds
399 _ -> []
400 ppr (IEModuleContents _ mod')
401 = text "module" <+> ppr mod'
402 ppr (IEGroup _ n _) = text ("<IEGroup: " ++ show n ++ ">")
403 ppr (IEDoc _ doc) = ppr doc
404 ppr (IEDocNamed _ string) = text ("<IEDocNamed: " ++ string ++ ">")
405
406 instance (HasOccName name) => HasOccName (IEWrappedName name) where
407 occName w = occName (ieWrappedName w)
408
409 instance (OutputableBndr name) => OutputableBndr (IEWrappedName name) where
410 pprBndr bs w = pprBndr bs (ieWrappedName w)
411 pprPrefixOcc w = pprPrefixOcc (ieWrappedName w)
412 pprInfixOcc w = pprInfixOcc (ieWrappedName w)
413
414 instance (OutputableBndr name) => Outputable (IEWrappedName name) where
415 ppr (IEName n) = pprPrefixOcc (unLoc n)
416 ppr (IEPattern _ n) = text "pattern" <+> pprPrefixOcc (unLoc n)
417 ppr (IEType _ n) = text "type" <+> pprPrefixOcc (unLoc n)
418
419 pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc
420 pprImpExp name = type_pref <+> pprPrefixOcc name
421 where
422 occ = occName name
423 type_pref | isTcOcc occ && isSymOcc occ = text "type"
424 | otherwise = empty