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