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