never executed always true always false
1 module GHC.Unit.Module.ModGuts
2 ( ModGuts (..)
3 , mg_mnwib
4 , CgGuts (..)
5 )
6 where
7
8 import GHC.Prelude
9
10 import GHC.ByteCode.Types
11 import GHC.ForeignSrcLang
12
13 import GHC.Hs
14
15 import GHC.Unit
16 import GHC.Unit.Module.Deps
17 import GHC.Unit.Module.Warnings
18
19 import GHC.Core.InstEnv ( InstEnv, ClsInst )
20 import GHC.Core.FamInstEnv
21 import GHC.Core ( CoreProgram, CoreRule )
22 import GHC.Core.TyCon
23 import GHC.Core.PatSyn
24
25 import GHC.Linker.Types ( SptEntry(..) )
26
27 import GHC.Types.Annotations ( Annotation )
28 import GHC.Types.Avail
29 import GHC.Types.CompleteMatch
30 import GHC.Types.Fixity.Env
31 import GHC.Types.ForeignStubs
32 import GHC.Types.HpcInfo
33 import GHC.Types.Name.Reader
34 import GHC.Types.SafeHaskell
35 import GHC.Types.SourceFile ( HscSource(..), hscSourceToIsBoot )
36 import GHC.Types.SrcLoc
37 import GHC.Types.CostCentre
38
39 import Data.Set (Set)
40
41
42 -- | A ModGuts is carried through the compiler, accumulating stuff as it goes
43 -- There is only one ModGuts at any time, the one for the module
44 -- being compiled right now. Once it is compiled, a 'ModIface' and
45 -- 'ModDetails' are extracted and the ModGuts is discarded.
46 data ModGuts
47 = ModGuts {
48 mg_module :: !Module, -- ^ Module being compiled
49 mg_hsc_src :: HscSource, -- ^ Whether it's an hs-boot module
50 mg_loc :: SrcSpan, -- ^ For error messages from inner passes
51 mg_exports :: ![AvailInfo], -- ^ What it exports
52 mg_deps :: !Dependencies, -- ^ What it depends on, directly or
53 -- otherwise
54 mg_usages :: ![Usage], -- ^ What was used? Used for interfaces.
55
56 mg_used_th :: !Bool, -- ^ Did we run a TH splice?
57 mg_rdr_env :: !GlobalRdrEnv, -- ^ Top-level lexical environment
58
59 -- These fields all describe the things **declared in this module**
60 mg_fix_env :: !FixityEnv, -- ^ Fixities declared in this module.
61 -- Used for creating interface files.
62 mg_tcs :: ![TyCon], -- ^ TyCons declared in this module
63 -- (includes TyCons for classes)
64 mg_insts :: ![ClsInst], -- ^ Class instances declared in this module
65 mg_fam_insts :: ![FamInst],
66 -- ^ Family instances declared in this module
67 mg_patsyns :: ![PatSyn], -- ^ Pattern synonyms declared in this module
68 mg_rules :: ![CoreRule], -- ^ Before the core pipeline starts, contains
69 -- See Note [Overall plumbing for rules] in "GHC.Core.Rules"
70 mg_binds :: !CoreProgram, -- ^ Bindings for this module
71 mg_foreign :: !ForeignStubs, -- ^ Foreign exports declared in this module
72 mg_foreign_files :: ![(ForeignSrcLang, FilePath)],
73 -- ^ Files to be compiled with the C compiler
74 mg_warns :: !Warnings, -- ^ Warnings declared in the module
75 mg_anns :: [Annotation], -- ^ Annotations declared in this module
76 mg_complete_matches :: [CompleteMatch], -- ^ Complete Matches
77 mg_hpc_info :: !HpcInfo, -- ^ Coverage tick boxes in the module
78 mg_modBreaks :: !(Maybe ModBreaks), -- ^ Breakpoints for the module
79
80 -- The next two fields are unusual, because they give instance
81 -- environments for *all* modules in the home package, including
82 -- this module, rather than for *just* this module.
83 -- Reason: when looking up an instance we don't want to have to
84 -- look at each module in the home package in turn
85 mg_inst_env :: InstEnv, -- ^ Class instance environment for
86 -- /home-package/ modules (including this
87 -- one); c.f. 'tcg_inst_env'
88 mg_fam_inst_env :: FamInstEnv, -- ^ Type-family instance environment for
89 -- /home-package/ modules (including this
90 -- one); c.f. 'tcg_fam_inst_env'
91
92 mg_safe_haskell :: SafeHaskellMode, -- ^ Safe Haskell mode
93 mg_trust_pkg :: Bool, -- ^ Do we need to trust our
94 -- own package for Safe Haskell?
95 -- See Note [Trust Own Package]
96 -- in "GHC.Rename.Names"
97
98 mg_doc_hdr :: !(Maybe HsDocString), -- ^ Module header.
99 mg_decl_docs :: !DeclDocMap, -- ^ Docs on declarations.
100 mg_arg_docs :: !ArgDocMap -- ^ Docs on arguments.
101 }
102
103 mg_mnwib :: ModGuts -> ModuleNameWithIsBoot
104 mg_mnwib mg = GWIB (moduleName (mg_module mg)) (hscSourceToIsBoot (mg_hsc_src mg))
105
106 -- The ModGuts takes on several slightly different forms:
107 --
108 -- After simplification, the following fields change slightly:
109 -- mg_rules Orphan rules only (local ones now attached to binds)
110 -- mg_binds With rules attached
111
112 ---------------------------------------------------------
113 -- The Tidy pass forks the information about this module:
114 -- * one lot goes to interface file generation (ModIface)
115 -- and later compilations (ModDetails)
116 -- * the other lot goes to code generation (CgGuts)
117
118 -- | A restricted form of 'ModGuts' for code generation purposes
119 data CgGuts
120 = CgGuts {
121 cg_module :: !Module,
122 -- ^ Module being compiled
123
124 cg_tycons :: [TyCon],
125 -- ^ Algebraic data types (including ones that started
126 -- life as classes); generate constructors and info
127 -- tables. Includes newtypes, just for the benefit of
128 -- External Core
129
130 cg_binds :: CoreProgram,
131 -- ^ The tidied main bindings, including
132 -- previously-implicit bindings for record and class
133 -- selectors, and data constructor wrappers. But *not*
134 -- data constructor workers; reason: we regard them
135 -- as part of the code-gen of tycons
136
137 cg_ccs :: [CostCentre], -- List of cost centres used in bindings and rules
138 cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs
139 cg_foreign_files :: ![(ForeignSrcLang, FilePath)],
140 cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to
141 -- generate #includes for C code gen
142 cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information
143 cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints
144 cg_spt_entries :: [SptEntry]
145 -- ^ Static pointer table entries for static forms defined in
146 -- the module.
147 -- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable"
148 }