never executed always true always false
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5 \section{Haskell abstract syntax definition}
6
7 This module glues together the pieces of the Haskell abstract syntax,
8 which is declared in the various \tr{Hs*} modules. This module,
9 therefore, is almost nothing but re-exporting.
10 -}
11
12 {-# LANGUAGE DeriveDataTypeable #-}
13 {-# LANGUAGE StandaloneDeriving #-}
14 {-# LANGUAGE FlexibleContexts #-}
15 {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
16 -- in module Language.Haskell.Syntax.Extension
17 {-# LANGUAGE ConstraintKinds #-}
18 {-# LANGUAGE TypeFamilies #-}
19 {-# LANGUAGE FlexibleInstances #-} -- For deriving instance Data
20
21 module GHC.Hs (
22 module Language.Haskell.Syntax,
23 module GHC.Hs.Binds,
24 module GHC.Hs.Decls,
25 module GHC.Hs.Expr,
26 module GHC.Hs.ImpExp,
27 module GHC.Hs.Lit,
28 module GHC.Hs.Pat,
29 module GHC.Hs.Type,
30 module GHC.Hs.Utils,
31 module GHC.Hs.Doc,
32 module GHC.Hs.Extension,
33 module GHC.Parser.Annotation,
34 Fixity,
35
36 HsModule(..), AnnsModule(..),
37 HsParsedModule(..)
38 ) where
39
40 -- friends:
41 import GHC.Prelude
42
43 import GHC.Hs.Decls
44 import GHC.Hs.Binds
45 import GHC.Hs.Expr
46 import GHC.Hs.ImpExp
47 import GHC.Hs.Lit
48 import Language.Haskell.Syntax
49 import GHC.Hs.Extension
50 import GHC.Parser.Annotation
51 import GHC.Hs.Pat
52 import GHC.Hs.Type
53 import GHC.Hs.Utils
54 import GHC.Hs.Doc
55 import GHC.Hs.Instances () -- For Data instances
56
57 -- others:
58 import GHC.Utils.Outputable
59 import GHC.Types.Fixity ( Fixity )
60 import GHC.Types.SrcLoc
61 import GHC.Unit.Module ( ModuleName )
62 import GHC.Unit.Module.Warnings ( WarningTxt )
63
64 -- libraries:
65 import Data.Data hiding ( Fixity )
66
67 -- | Haskell Module
68 --
69 -- All we actually declare here is the top-level structure for a module.
70 data HsModule
71 = HsModule {
72 hsmodAnn :: EpAnn AnnsModule,
73 hsmodLayout :: LayoutInfo,
74 -- ^ Layout info for the module.
75 -- For incomplete modules (e.g. the output of parseHeader), it is NoLayoutInfo.
76 hsmodName :: Maybe (LocatedA ModuleName),
77 -- ^ @Nothing@: \"module X where\" is omitted (in which case the next
78 -- field is Nothing too)
79 hsmodExports :: Maybe (LocatedL [LIE GhcPs]),
80 -- ^ Export list
81 --
82 -- - @Nothing@: export list omitted, so export everything
83 --
84 -- - @Just []@: export /nothing/
85 --
86 -- - @Just [...]@: as you would expect...
87 --
88 --
89 -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen'
90 -- ,'GHC.Parser.Annotation.AnnClose'
91
92 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
93 hsmodImports :: [LImportDecl GhcPs],
94 -- ^ We snaffle interesting stuff out of the imported interfaces early
95 -- on, adding that info to TyDecls/etc; so this list is often empty,
96 -- downstream.
97 hsmodDecls :: [LHsDecl GhcPs],
98 -- ^ Type, class, value, and interface signature decls
99 hsmodDeprecMessage :: Maybe (LocatedP WarningTxt),
100 -- ^ reason\/explanation for warning/deprecation of this module
101 --
102 -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen'
103 -- ,'GHC.Parser.Annotation.AnnClose'
104 --
105
106 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
107 hsmodHaddockModHeader :: Maybe LHsDocString
108 -- ^ Haddock module info and description, unparsed
109 --
110 -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen'
111 -- ,'GHC.Parser.Annotation.AnnClose'
112
113 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
114 }
115 -- ^ 'GHC.Parser.Annotation.AnnKeywordId's
116 --
117 -- - 'GHC.Parser.Annotation.AnnModule','GHC.Parser.Annotation.AnnWhere'
118 --
119 -- - 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnSemi',
120 -- 'GHC.Parser.Annotation.AnnClose' for explicit braces and semi around
121 -- hsmodImports,hsmodDecls if this style is used.
122
123 -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
124
125 deriving instance Data HsModule
126
127 data AnnsModule
128 = AnnsModule {
129 am_main :: [AddEpAnn],
130 am_decls :: AnnList
131 } deriving (Data, Eq)
132
133 instance Outputable HsModule where
134
135 ppr (HsModule _ _ Nothing _ imports decls _ mbDoc)
136 = pp_mb mbDoc $$ pp_nonnull imports
137 $$ pp_nonnull decls
138
139 ppr (HsModule _ _ (Just name) exports imports decls deprec mbDoc)
140 = vcat [
141 pp_mb mbDoc,
142 case exports of
143 Nothing -> pp_header (text "where")
144 Just es -> vcat [
145 pp_header lparen,
146 nest 8 (fsep (punctuate comma (map ppr (unLoc es)))),
147 nest 4 (text ") where")
148 ],
149 pp_nonnull imports,
150 pp_nonnull decls
151 ]
152 where
153 pp_header rest = case deprec of
154 Nothing -> pp_modname <+> rest
155 Just d -> vcat [ pp_modname, ppr d, rest ]
156
157 pp_modname = text "module" <+> ppr name
158
159 pp_mb :: Outputable t => Maybe t -> SDoc
160 pp_mb (Just x) = ppr x
161 pp_mb Nothing = empty
162
163 pp_nonnull :: Outputable t => [t] -> SDoc
164 pp_nonnull [] = empty
165 pp_nonnull xs = vcat (map ppr xs)
166
167 data HsParsedModule = HsParsedModule {
168 hpm_module :: Located HsModule,
169 hpm_src_files :: [FilePath]
170 -- ^ extra source files (e.g. from #includes). The lexer collects
171 -- these from '# <file> <line>' pragmas, which the C preprocessor
172 -- leaves behind. These files and their timestamps are stored in
173 -- the .hi file, so that we can force recompilation if any of
174 -- them change (#3589)
175 }