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
6 {-# LANGUAGE BangPatterns #-}
7 {-# LANGUAGE CPP #-}
8 {-# LANGUAGE MagicHash #-}
9 {-# LANGUAGE PatternSynonyms #-}
10 {-# LANGUAGE UnboxedTuples #-}
11
12 module GHC.Types.Unique.Supply (
13 -- * Main data type
14 UniqSupply, -- Abstractly
15
16 -- ** Operations on supplies
17 uniqFromSupply, uniqsFromSupply, -- basic ops
18 takeUniqFromSupply, uniqFromMask,
19
20 mkSplitUniqSupply,
21 splitUniqSupply, listSplitUniqSupply,
22
23 -- * Unique supply monad and its abstraction
24 UniqSM, MonadUnique(..),
25
26 -- ** Operations on the monad
27 initUs, initUs_,
28
29 -- * Set supply strategy
30 initUniqSupply
31 ) where
32
33 import GHC.Prelude
34
35 import GHC.Types.Unique
36 import GHC.Utils.Panic.Plain
37
38 import GHC.IO
39
40 import GHC.Utils.Monad
41 import Control.Monad
42 import Data.Char
43 import GHC.Exts( Ptr(..), noDuplicate#, oneShot )
44 #if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
45 import GHC.Exts( Int(..), word2Int#, fetchAddWordAddr#, plusWord#, readWordOffAddr# )
46 #endif
47 import Foreign.Storable
48
49 #include "Unique.h"
50
51 {-
52 ************************************************************************
53 * *
54 \subsection{Splittable Unique supply: @UniqSupply@}
55 * *
56 ************************************************************************
57 -}
58
59 {- Note [How the unique supply works]
60 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
61 The basic idea (due to Lennart Augustsson) is that a UniqSupply is
62 lazily-evaluated infinite tree.
63
64 * At each MkSplitUniqSupply node is a unique Int, and two
65 sub-trees (see data UniqSupply)
66
67 * takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)
68 returns the unique Int and one of the sub-trees
69
70 * splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply)
71 returns the two sub-trees
72
73 * When you poke on one of the thunks, it does a foreign call
74 to get a fresh Int from a thread-safe counter, and returns
75 a fresh MkSplitUniqSupply node. This has to be as efficient
76 as possible: it should allocate only
77 * The fresh node
78 * A thunk for each sub-tree
79
80 Note [How unique supplies are used]
81 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
82 The general design (used throughout GHC) is to:
83
84 * For creating new uniques either a UniqSupply is used and threaded through
85 or for monadic code a MonadUnique instance might conjure up uniques using
86 `uniqFromMask`.
87 * Different parts of the compiler will use a UniqSupply or MonadUnique instance
88 with a specific mask. This way the different parts of the compiler will
89 generate uniques with different masks.
90
91 If different code shares the same mask then care has to be taken that all uniques
92 still get distinct numbers. Usually this is done by relying on genSym which
93 has *one* counter per GHC invocation that is relied on by all calls to it.
94 But using something like the address for pinned objects works as well and in fact is done
95 for fast strings.
96
97 This is important for example in the simplifier. Most passes of the simplifier use
98 the same mask 's'. However in some places we create a unique supply using `mkSplitUniqSupply`
99 and thread it through the code, while in GHC.Core.Opt.Simplify.Monad we use the
100 `instance MonadUnique SimplM`, which uses `mkSplitUniqSupply` in getUniqueSupplyM
101 and `uniqFromMask` in getUniqeM.
102
103 Ultimately all these boil down to each new unique consisting of the mask and the result from
104 a call to `genSym`. The later producing a distinct number for each invocation ensuring
105 uniques are distinct.
106
107 Note [Optimising the unique supply]
108 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
109 The inner loop of mkSplitUniqSupply is a function closure
110
111 mk_supply s0 =
112 case noDuplicate# s0 of { s1 ->
113 case unIO genSym s1 of { (# s2, u #) ->
114 case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s2 of { (# s3, x #) ->
115 case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s3 of { (# s4, y #) ->
116 (# s4, MkSplitUniqSupply (mask .|. u) x y #)
117 }}}}
118
119 It's a classic example of an IO action that is captured and then called
120 repeatedly (see #18238 for some discussion). It mustn't allocate! The test
121 perf/should_run/UniqLoop keeps track of this loop. Watch it carefully.
122
123 We used to write it as:
124
125 mk_supply :: IO UniqSupply
126 mk_supply = unsafeInterleaveIO $
127 genSym >>= \ u ->
128 mk_supply >>= \ s1 ->
129 mk_supply >>= \ s2 ->
130 return (MkSplitUniqSupply (mask .|. u) s1 s2)
131
132 and to rely on -fno-state-hack, full laziness and inlining to get the same
133 result. It was very brittle and required enabling -fno-state-hack globally. So
134 it has been rewritten using lower level constructs to explicitly state what we
135 want.
136
137 Note [Optimising use of unique supplies]
138 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
139 When it comes to having a way to generate new Uniques
140 there are generally three ways to deal with this:
141
142 For pure code the only good approach is to take an UniqSupply
143 as argument. Then thread it through the code splitting it
144 for sub-passes or when creating uniques.
145 The code for this is about as optimized as it gets, but we can't
146 get around the need to allocate one `UniqSupply` for each Unique
147 we need.
148
149 For code in IO we can improve on this by threading only the *mask*
150 we are going to use for Uniques. Using `uniqFromMask` to
151 generate uniques as needed. This gets rid of the overhead of
152 allocating a new UniqSupply for each unique generated. It also avoids
153 frequent state updates when the Unique/Mask is part of the state in a
154 state monad.
155
156 For monadic code in IO which always uses the same mask we can go further
157 and hardcode the mask into the MonadUnique instance. On top of all the
158 benefits of threading the mask this *also* has the benefit of avoiding
159 the mask getting captured in thunks, or being passed around at runtime.
160 It does however come at the cost of having to use a fixed Mask for all
161 code run in this Monad. But rememeber, the Mask is purely cosmetic:
162 See Note [Uniques and masks].
163
164 NB: It's *not* an optimization to pass around the UniqSupply inside an
165 IORef instead of the mask. While this would avoid frequent state updates
166 it still requires allocating one UniqSupply per Unique. On top of some
167 overhead for reading/writing to/from the IORef.
168
169 All of this hinges on the assumption that UniqSupply and
170 uniqFromMask use the same source of distinct numbers (`genSym`) which
171 allows both to be used at the same time, with the same mask, while still
172 ensuring distinct uniques.
173 One might consider this fact to be an "accident". But GHC worked like this
174 as far back as source control history goes. It also allows the later two
175 optimizations to be used. So it seems safe to depend on this fact.
176
177 -}
178
179
180 -- | Unique Supply
181 --
182 -- A value of type 'UniqSupply' is unique, and it can
183 -- supply /one/ distinct 'Unique'. Also, from the supply, one can
184 -- also manufacture an arbitrary number of further 'UniqueSupply' values,
185 -- which will be distinct from the first and from all others.
186 data UniqSupply
187 = MkSplitUniqSupply {-# UNPACK #-} !Int -- make the Unique with this
188 UniqSupply UniqSupply
189 -- when split => these two supplies
190
191 mkSplitUniqSupply :: Char -> IO UniqSupply
192 -- ^ Create a unique supply out of thin air.
193 -- The "mask" (Char) supplied is purely cosmetic, making it easier
194 -- to figure out where a Unique was born. See
195 -- Note [Uniques and masks].
196 --
197 -- The payload part of the Uniques allocated from this UniqSupply are
198 -- guaranteed distinct wrt all other supplies, regardless of their "mask".
199 -- This is achieved by allocating the payload part from
200 -- a single source of Uniques, namely `genSym`, shared across
201 -- all UniqSupply's.
202
203 -- See Note [How the unique supply works]
204 -- See Note [Optimising the unique supply]
205 mkSplitUniqSupply c
206 = unsafeDupableInterleaveIO (IO mk_supply)
207
208 where
209 !mask = ord c `unsafeShiftL` uNIQUE_BITS
210
211 -- Here comes THE MAGIC: see Note [How the unique supply works]
212 -- This is one of the most hammered bits in the whole compiler
213 -- See Note [Optimising the unique supply]
214 -- NB: Use noDuplicate# for thread-safety.
215 mk_supply s0 =
216 case noDuplicate# s0 of { s1 ->
217 case unIO genSym s1 of { (# s2, u #) ->
218 -- deferred IO computations
219 case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s2 of { (# s3, x #) ->
220 case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s3 of { (# s4, y #) ->
221 (# s4, MkSplitUniqSupply (mask .|. u) x y #)
222 }}}}
223
224 #if !MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
225 foreign import ccall unsafe "genSym" genSym :: IO Int
226 #else
227 genSym :: IO Int
228 genSym = do
229 let !mask = (1 `unsafeShiftL` uNIQUE_BITS) - 1
230 let !(Ptr counter) = ghc_unique_counter
231 let !(Ptr inc_ptr) = ghc_unique_inc
232 u <- IO $ \s0 -> case readWordOffAddr# inc_ptr 0# s0 of
233 (# s1, inc #) -> case fetchAddWordAddr# counter inc s1 of
234 (# s2, val #) ->
235 let !u = I# (word2Int# (val `plusWord#` inc)) .&. mask
236 in (# s2, u #)
237 #if defined(DEBUG)
238 -- Uh oh! We will overflow next time a unique is requested.
239 -- (Note that if the increment isn't 1 we may miss this check)
240 massert (u /= mask)
241 #endif
242 return u
243 #endif
244
245 foreign import ccall unsafe "&ghc_unique_counter" ghc_unique_counter :: Ptr Word
246 foreign import ccall unsafe "&ghc_unique_inc" ghc_unique_inc :: Ptr Int
247
248 initUniqSupply :: Word -> Int -> IO ()
249 initUniqSupply counter inc = do
250 poke ghc_unique_counter counter
251 poke ghc_unique_inc inc
252
253 uniqFromMask :: Char -> IO Unique
254 uniqFromMask !mask
255 = do { uqNum <- genSym
256 ; return $! mkUnique mask uqNum }
257 {-# NOINLINE uniqFromMask #-} -- We'll unbox everything, but we don't want to inline it
258
259 splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply)
260 -- ^ Build two 'UniqSupply' from a single one, each of which
261 -- can supply its own 'Unique'.
262 listSplitUniqSupply :: UniqSupply -> [UniqSupply]
263 -- ^ Create an infinite list of 'UniqSupply' from a single one
264 uniqFromSupply :: UniqSupply -> Unique
265 -- ^ Obtain the 'Unique' from this particular 'UniqSupply'
266 uniqsFromSupply :: UniqSupply -> [Unique] -- Infinite
267 -- ^ Obtain an infinite list of 'Unique' that can be generated by constant splitting of the supply
268 takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)
269 -- ^ Obtain the 'Unique' from this particular 'UniqSupply', and a new supply
270
271 splitUniqSupply (MkSplitUniqSupply _ s1 s2) = (s1, s2)
272 listSplitUniqSupply (MkSplitUniqSupply _ s1 s2) = s1 : listSplitUniqSupply s2
273
274 uniqFromSupply (MkSplitUniqSupply n _ _) = mkUniqueGrimily n
275 uniqsFromSupply (MkSplitUniqSupply n _ s2) = mkUniqueGrimily n : uniqsFromSupply s2
276 takeUniqFromSupply (MkSplitUniqSupply n s1 _) = (mkUniqueGrimily n, s1)
277
278 {-
279 ************************************************************************
280 * *
281 \subsubsection[UniqSupply-monad]{@UniqSupply@ monad: @UniqSM@}
282 * *
283 ************************************************************************
284 -}
285
286 type UniqResult result = (# result, UniqSupply #)
287
288 pattern UniqResult :: a -> b -> (# a, b #)
289 pattern UniqResult x y = (# x, y #)
290 {-# COMPLETE UniqResult #-}
291
292 -- | A monad which just gives the ability to obtain 'Unique's
293 newtype UniqSM result = USM { unUSM :: UniqSupply -> UniqResult result }
294
295 -- See Note [The one-shot state monad trick] for why we don't derive this.
296 instance Functor UniqSM where
297 fmap f (USM m) = mkUniqSM $ \us ->
298 case m us of
299 (# r, us' #) -> UniqResult (f r) us'
300
301 -- | Smart constructor for 'UniqSM', as described in Note [The one-shot state
302 -- monad trick].
303 mkUniqSM :: (UniqSupply -> UniqResult a) -> UniqSM a
304 mkUniqSM f = USM (oneShot f)
305 {-# INLINE mkUniqSM #-}
306
307 instance Monad UniqSM where
308 (>>=) = thenUs
309 (>>) = (*>)
310
311 instance Applicative UniqSM where
312 pure = returnUs
313 (USM f) <*> (USM x) = mkUniqSM $ \us0 -> case f us0 of
314 UniqResult ff us1 -> case x us1 of
315 UniqResult xx us2 -> UniqResult (ff xx) us2
316 (*>) = thenUs_
317
318 -- TODO: try to get rid of this instance
319 instance MonadFail UniqSM where
320 fail = panic
321
322 -- | Run the 'UniqSM' action, returning the final 'UniqSupply'
323 initUs :: UniqSupply -> UniqSM a -> (a, UniqSupply)
324 initUs init_us m = case unUSM m init_us of { UniqResult r us -> (r, us) }
325
326 -- | Run the 'UniqSM' action, discarding the final 'UniqSupply'
327 initUs_ :: UniqSupply -> UniqSM a -> a
328 initUs_ init_us m = case unUSM m init_us of { UniqResult r _ -> r }
329
330 {-# INLINE thenUs #-}
331 {-# INLINE returnUs #-}
332 {-# INLINE splitUniqSupply #-}
333
334 -- @thenUs@ is where we split the @UniqSupply@.
335
336 liftUSM :: UniqSM a -> UniqSupply -> (a, UniqSupply)
337 liftUSM (USM m) us0 = case m us0 of UniqResult a us1 -> (a, us1)
338
339 instance MonadFix UniqSM where
340 mfix m = mkUniqSM (\us0 -> let (r,us1) = liftUSM (m r) us0 in UniqResult r us1)
341
342 thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b
343 thenUs (USM expr) cont
344 = mkUniqSM (\us0 -> case (expr us0) of
345 UniqResult result us1 -> unUSM (cont result) us1)
346
347 thenUs_ :: UniqSM a -> UniqSM b -> UniqSM b
348 thenUs_ (USM expr) (USM cont)
349 = mkUniqSM (\us0 -> case (expr us0) of { UniqResult _ us1 -> cont us1 })
350
351 returnUs :: a -> UniqSM a
352 returnUs result = mkUniqSM (\us -> UniqResult result us)
353
354 getUs :: UniqSM UniqSupply
355 getUs = mkUniqSM (\us0 -> case splitUniqSupply us0 of (us1,us2) -> UniqResult us1 us2)
356
357 -- | A monad for generating unique identifiers
358 class Monad m => MonadUnique m where
359 -- | Get a new UniqueSupply
360 getUniqueSupplyM :: m UniqSupply
361 -- | Get a new unique identifier
362 getUniqueM :: m Unique
363 -- | Get an infinite list of new unique identifiers
364 getUniquesM :: m [Unique]
365
366 -- This default definition of getUniqueM, while correct, is not as
367 -- efficient as it could be since it needlessly generates and throws away
368 -- an extra Unique. For your instances consider providing an explicit
369 -- definition for 'getUniqueM' which uses 'takeUniqFromSupply' directly.
370 getUniqueM = liftM uniqFromSupply getUniqueSupplyM
371 getUniquesM = liftM uniqsFromSupply getUniqueSupplyM
372
373 instance MonadUnique UniqSM where
374 getUniqueSupplyM = getUs
375 getUniqueM = getUniqueUs
376 getUniquesM = getUniquesUs
377
378 getUniqueUs :: UniqSM Unique
379 getUniqueUs = mkUniqSM (\us0 -> case takeUniqFromSupply us0 of
380 (u,us1) -> UniqResult u us1)
381
382 getUniquesUs :: UniqSM [Unique]
383 getUniquesUs = mkUniqSM (\us0 -> case splitUniqSupply us0 of
384 (us1,us2) -> UniqResult (uniqsFromSupply us1) us2)