never executed always true always false
1
2
3 module GHC.StgToCmm.Types
4 ( CgInfos (..)
5 , LambdaFormInfo (..)
6 , ModuleLFInfos
7 , Liveness
8 , ArgDescr (..)
9 , StandardFormInfo (..)
10 , WordOff
11 ) where
12
13 import GHC.Prelude
14
15 import GHC.Types.Basic
16 import GHC.Types.ForeignStubs
17 import GHC.Core.DataCon
18 import GHC.Types.Name.Env
19 import GHC.Types.Name.Set
20 import GHC.Utils.Outputable
21
22
23 {-
24 Note [Conveying CAF-info and LFInfo between modules]
25 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
26
27 Some information about an Id is generated in the code generator, and is not
28 available earlier. Namely:
29
30 * CAF info. Code motion in Cmm or earlier phases may move references around so
31 we compute information about which bits of code refer to which CAF late in the
32 Cmm pipeline.
33
34 * LambdaFormInfo. This records the details of a closure representation,
35 including
36 - the final arity (for functions)
37 - whether it is a data constructor, and if so its tag
38
39 Collectively we call this CgInfo (see GHC.StgToCmm.Types).
40
41 It's very useful for importing modules to have this information. We can always
42 make a conservative assumption, but that is bad: e.g.
43
44 * For CAF info, if we know nothing we have to assume it is a CAF which bloats
45 the SRTs of the importing module.
46
47 Conservative assumption here is made when creating new Ids.
48
49 * For data constructors, we really like having well-tagged pointers. See #14677,
50 #16559, #15155, and wiki: commentary/rts/haskell-execution/pointer-tagging
51
52 Conservative assumption here is made when we import an Id without a
53 LambdaFormInfo in the interface, in GHC.StgToCmm.Closure.mkLFImported.
54
55 So we arrange to always serialise this information into the interface file. The
56 moving parts are:
57
58 * We record the CgInfo in the IdInfo of the Id.
59
60 * GHC.Driver.Pipeline: the call to updateModDetailsIdInfos augments the
61 ModDetails constructed at the end of the Core pipeline, with CgInfo
62 gleaned from the back end. The hard work is done in GHC.Iface.UpdateIdInfos.
63
64 * For ModIface we generate the final ModIface with CgInfo in
65 GHC.Iface.Make.mkFullIface.
66
67 * We don't absolutely guarantee to serialise the CgInfo: we won't if you have
68 -fomit-interface-pragmas or -fno-code; and we won't read it in if you have
69 -fignore-interface-pragmas. (We could revisit this decision.)
70 -}
71
72 -- | Codegen-generated Id infos, to be passed to downstream via interfaces.
73 --
74 -- This stuff is for optimization purposes only, they're not compulsory.
75 --
76 -- * When CafInfo of an imported Id is not known it's safe to treat it as CAFFY.
77 -- * When LambdaFormInfo of an imported Id is not known it's safe to treat it as
78 -- `LFUnknown True` (which just says "it could be anything" and we do slow
79 -- entry).
80 --
81 -- See also Note [Conveying CAF-info and LFInfo between modules] above.
82 --
83 data CgInfos = CgInfos
84 { cgNonCafs :: !NonCaffySet
85 -- ^ Exported Non-CAFFY closures in the current module. Everything else is
86 -- either not exported of CAFFY.
87 , cgLFInfos :: !ModuleLFInfos
88 -- ^ LambdaFormInfos of exported closures in the current module.
89 , cgIPEStub :: !CStub
90 -- ^ The C stub which is used for IPE information
91 }
92
93 --------------------------------------------------------------------------------
94 -- LambdaFormInfo
95 --------------------------------------------------------------------------------
96
97 -- | Maps names in the current module to their LambdaFormInfos
98 type ModuleLFInfos = NameEnv LambdaFormInfo
99
100 -- | Information about an identifier, from the code generator's point of view.
101 -- Every identifier is bound to a LambdaFormInfo in the environment, which gives
102 -- the code generator enough info to be able to tail call or return that
103 -- identifier.
104 data LambdaFormInfo
105 = LFReEntrant -- Reentrant closure (a function)
106 !TopLevelFlag -- True if top level
107 !RepArity -- Arity. Invariant: always > 0
108 !Bool -- True <=> no fvs
109 !ArgDescr -- Argument descriptor (should really be in ClosureInfo)
110
111 | LFThunk -- Thunk (zero arity)
112 !TopLevelFlag
113 !Bool -- True <=> no free vars
114 !Bool -- True <=> updatable (i.e., *not* single-entry)
115 !StandardFormInfo
116 !Bool -- True <=> *might* be a function type
117
118 | LFCon -- A saturated constructor application
119 !DataCon -- The constructor
120
121 | LFUnknown -- Used for function arguments and imported things.
122 -- We know nothing about this closure.
123 -- Treat like updatable "LFThunk"...
124 -- Imported things which we *do* know something about use
125 -- one of the other LF constructors (eg LFReEntrant for
126 -- known functions)
127 !Bool -- True <=> *might* be a function type
128 -- The False case is good when we want to enter it,
129 -- because then we know the entry code will do
130 -- For a function, the entry code is the fast entry point
131
132 | LFUnlifted -- A value of unboxed type;
133 -- always a value, needs evaluation
134
135 | LFLetNoEscape -- See LetNoEscape module for precise description
136
137 instance Outputable LambdaFormInfo where
138 ppr (LFReEntrant top rep fvs argdesc) =
139 text "LFReEntrant" <> brackets
140 (ppr top <+> ppr rep <+> pprFvs fvs <+> ppr argdesc)
141 ppr (LFThunk top hasfv updateable sfi m_function) =
142 text "LFThunk" <> brackets
143 (ppr top <+> pprFvs hasfv <+> pprUpdateable updateable <+>
144 ppr sfi <+> pprFuncFlag m_function)
145 ppr (LFCon con) =
146 text "LFCon" <> brackets (ppr con)
147 ppr (LFUnknown m_func) =
148 text "LFUnknown" <> brackets (pprFuncFlag m_func)
149 ppr LFUnlifted =
150 text "LFUnlifted"
151 ppr LFLetNoEscape =
152 text "LFLetNoEscape"
153
154 pprFvs :: Bool -> SDoc
155 pprFvs True = text "no-fvs"
156 pprFvs False = text "fvs"
157
158 pprFuncFlag :: Bool -> SDoc
159 pprFuncFlag True = text "mFunc"
160 pprFuncFlag False = text "value"
161
162 pprUpdateable :: Bool -> SDoc
163 pprUpdateable True = text "updateable"
164 pprUpdateable False = text "oneshot"
165
166 --------------------------------------------------------------------------------
167
168 -- | We represent liveness bitmaps as a Bitmap (whose internal representation
169 -- really is a bitmap). These are pinned onto case return vectors to indicate
170 -- the state of the stack for the garbage collector.
171 --
172 -- In the compiled program, liveness bitmaps that fit inside a single word
173 -- (StgWord) are stored as a single word, while larger bitmaps are stored as a
174 -- pointer to an array of words.
175
176 type Liveness = [Bool] -- One Bool per word; True <=> non-ptr or dead
177 -- False <=> ptr
178
179 --------------------------------------------------------------------------------
180 -- | An ArgDescr describes the argument pattern of a function
181
182 data ArgDescr
183 = ArgSpec -- Fits one of the standard patterns
184 !Int -- RTS type identifier ARG_P, ARG_N, ...
185
186 | ArgGen -- General case
187 Liveness -- Details about the arguments
188
189 | ArgUnknown -- For imported binds.
190 -- Invariant: Never Unknown for binds of the module
191 -- we are compiling.
192 deriving (Eq)
193
194 instance Outputable ArgDescr where
195 ppr (ArgSpec n) = text "ArgSpec" <+> ppr n
196 ppr (ArgGen ls) = text "ArgGen" <+> ppr ls
197 ppr ArgUnknown = text "ArgUnknown"
198
199 --------------------------------------------------------------------------------
200 -- | StandardFormInfo tells whether this thunk has one of a small number of
201 -- standard forms
202
203 data StandardFormInfo
204 = NonStandardThunk
205 -- The usual case: not of the standard forms
206
207 | SelectorThunk
208 -- A SelectorThunk is of form
209 -- case x of
210 -- con a1,..,an -> ak
211 -- and the constructor is from a single-constr type.
212 !WordOff -- 0-origin offset of ak within the "goods" of
213 -- constructor (Recall that the a1,...,an may be laid
214 -- out in the heap in a non-obvious order.)
215
216 | ApThunk
217 -- An ApThunk is of form
218 -- x1 ... xn
219 -- The code for the thunk just pushes x2..xn on the stack and enters x1.
220 -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
221 -- in the RTS to save space.
222 !RepArity -- Arity, n
223 deriving (Eq)
224
225 -- | Word offset, or word count
226 type WordOff = Int
227
228 instance Outputable StandardFormInfo where
229 ppr NonStandardThunk = text "RegThunk"
230 ppr (SelectorThunk w) = text "SelThunk:" <> ppr w
231 ppr (ApThunk n) = text "ApThunk:" <> ppr n