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)