never executed always true always false
    1 
    2 {-# LANGUAGE RankNTypes #-}
    3 
    4 -- | The Name Cache
    5 module GHC.Types.Name.Cache
    6   ( NameCache (..)
    7   , initNameCache
    8   , takeUniqFromNameCache
    9   , updateNameCache'
   10   , updateNameCache
   11 
   12   -- * OrigNameCache
   13   , OrigNameCache
   14   , lookupOrigNameCache
   15   , extendOrigNameCache'
   16   , extendOrigNameCache
   17   )
   18 where
   19 
   20 import GHC.Prelude
   21 
   22 import GHC.Unit.Module
   23 import GHC.Types.Name
   24 import GHC.Types.Unique.Supply
   25 import GHC.Builtin.Types
   26 import GHC.Builtin.Names
   27 
   28 import GHC.Utils.Outputable
   29 import GHC.Utils.Panic
   30 
   31 import Control.Concurrent.MVar
   32 import Control.Monad
   33 
   34 {-
   35 
   36 Note [The Name Cache]
   37 ~~~~~~~~~~~~~~~~~~~~~
   38 The Name Cache makes sure that, during any invocation of GHC, each
   39 External Name "M.x" has one, and only one globally-agreed Unique.
   40 
   41 * The first time we come across M.x we make up a Unique and record that
   42   association in the Name Cache.
   43 
   44 * When we come across "M.x" again, we look it up in the Name Cache,
   45   and get a hit.
   46 
   47 The functions newGlobalBinder, allocateGlobalBinder do the main work.
   48 When you make an External name, you should probably be calling one
   49 of them.
   50 
   51 Names in a NameCache are always stored as a Global, and have the SrcLoc of their
   52 binding locations.  Actually that's not quite right.  When we first encounter
   53 the original name, we might not be at its binding site (e.g. we are reading an
   54 interface file); so we give it 'noSrcLoc' then.  Later, when we find its binding
   55 site, we fix it up.
   56 
   57 
   58 Note [Built-in syntax and the OrigNameCache]
   59 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   60 
   61 Built-in syntax like tuples and unboxed sums are quite ubiquitous. To lower
   62 their cost we use two tricks,
   63 
   64   a. We specially encode tuple and sum Names in interface files' symbol tables
   65      to avoid having to look up their names while loading interface files.
   66      Namely these names are encoded as by their Uniques. We know how to get from
   67      a Unique back to the Name which it represents via the mapping defined in
   68      the SumTupleUniques module. See Note [Symbol table representation of names]
   69      in GHC.Iface.Binary and for details.
   70 
   71   b. We don't include them in the Orig name cache but instead parse their
   72      OccNames (in isBuiltInOcc_maybe) to avoid bloating the name cache with
   73      them.
   74 
   75 Why is the second measure necessary? Good question; afterall, 1) the parser
   76 emits built-in syntax directly as Exact RdrNames, and 2) built-in syntax never
   77 needs to looked-up during interface loading due to (a). It turns out that there
   78 are two reasons why we might look up an Orig RdrName for built-in syntax,
   79 
   80   * If you use setRdrNameSpace on an Exact RdrName it may be
   81     turned into an Orig RdrName.
   82 
   83   * Template Haskell turns a BuiltInSyntax Name into a TH.NameG
   84     (GHC.HsToCore.Quote.globalVar), and parses a NameG into an Orig RdrName
   85     (GHC.ThToHs.thRdrName).  So, e.g. $(do { reify '(,); ... }) will
   86     go this route (#8954).
   87 
   88 -}
   89 -- | The NameCache makes sure that there is just one Unique assigned for
   90 -- each original name; i.e. (module-name, occ-name) pair and provides
   91 -- something of a lookup mechanism for those names.
   92 data NameCache = NameCache
   93   { nsUniqChar :: {-# UNPACK #-} !Char
   94   , nsNames    :: {-# UNPACK #-} !(MVar OrigNameCache)
   95   }
   96 
   97 -- | Per-module cache of original 'OccName's given 'Name's
   98 type OrigNameCache   = ModuleEnv (OccEnv Name)
   99 
  100 takeUniqFromNameCache :: NameCache -> IO Unique
  101 takeUniqFromNameCache (NameCache c _) = uniqFromMask c
  102 
  103 lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
  104 lookupOrigNameCache nc mod occ
  105   | mod == gHC_TYPES || mod == gHC_PRIM || mod == gHC_TUPLE
  106   , Just name <- isBuiltInOcc_maybe occ
  107   =     -- See Note [Known-key names], 3(c) in GHC.Builtin.Names
  108         -- Special case for tuples; there are too many
  109         -- of them to pre-populate the original-name cache
  110     Just name
  111 
  112   | otherwise
  113   = case lookupModuleEnv nc mod of
  114         Nothing      -> Nothing
  115         Just occ_env -> lookupOccEnv occ_env occ
  116 
  117 extendOrigNameCache' :: OrigNameCache -> Name -> OrigNameCache
  118 extendOrigNameCache' nc name
  119   = assertPpr (isExternalName name) (ppr name) $
  120     extendOrigNameCache nc (nameModule name) (nameOccName name) name
  121 
  122 extendOrigNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
  123 extendOrigNameCache nc mod occ name
  124   = extendModuleEnvWith combine nc mod (unitOccEnv occ name)
  125   where
  126     combine _ occ_env = extendOccEnv occ_env occ name
  127 
  128 initNameCache :: Char -> [Name] -> IO NameCache
  129 initNameCache c names = NameCache c <$> newMVar (initOrigNames names)
  130 
  131 initOrigNames :: [Name] -> OrigNameCache
  132 initOrigNames names = foldl' extendOrigNameCache' emptyModuleEnv names
  133 
  134 -- | Update the name cache with the given function
  135 updateNameCache'
  136   :: NameCache
  137   -> (OrigNameCache -> IO (OrigNameCache, c))  -- The updating function
  138   -> IO c
  139 updateNameCache' (NameCache _c nc) upd_fn = modifyMVar' nc upd_fn
  140 
  141 -- this should be in `base`
  142 modifyMVar' :: MVar a -> (a -> IO (a,b)) -> IO b
  143 modifyMVar' m f = modifyMVar m $ f >=> \c -> fst c `seq` pure c
  144 
  145 -- | Update the name cache with the given function
  146 --
  147 -- Additionally, it ensures that the given Module and OccName are evaluated.
  148 -- If not, chaos can ensue:
  149 --      we read the name-cache
  150 --      then pull on mod (say)
  151 --      which does some stuff that modifies the name cache
  152 -- This did happen, with tycon_mod in GHC.IfaceToCore.tcIfaceAlt (DataAlt..)
  153 updateNameCache
  154   :: NameCache
  155   -> Module
  156   -> OccName
  157   -> (OrigNameCache -> IO (OrigNameCache, c))
  158   -> IO c
  159 updateNameCache name_cache !_mod !_occ upd_fn
  160   = updateNameCache' name_cache upd_fn