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