Comments about the Name Cache
[ghc.git] / compiler / iface / IfaceEnv.lhs
1 (c) The University of Glasgow 2002-2006
2
3 \begin{code}
4 {-# OPTIONS -fno-warn-tabs #-}
5 -- The above warning supression flag is a temporary kludge.
6 -- While working on this module you are encouraged to remove it and
7 -- detab the module (please do the detabbing in a separate patch). See
8 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
9 -- for details
10
11 module IfaceEnv (
12         newGlobalBinder, newImplicitBinder, 
13         lookupIfaceTop,
14         lookupOrig, lookupOrigNameCache, extendNameCache,
15         newIfaceName, newIfaceNames,
16         extendIfaceIdEnv, extendIfaceTyVarEnv, 
17         tcIfaceLclId, tcIfaceTyVar, lookupIfaceTyVar,
18
19         ifaceExportNames,
20
21         -- Name-cache stuff
22         allocateGlobalBinder, initNameCache, updNameCache,
23         getNameCache, mkNameCacheUpdater, NameCacheUpdater(..)
24    ) where
25
26 #include "HsVersions.h"
27
28 import TcRnMonad
29 import TysWiredIn
30 import HscTypes
31 import TyCon
32 import Type
33 import DataCon
34 import Var
35 import Name
36 import Avail
37 import PrelNames
38 import Module
39 import UniqFM
40 import FastString
41 import UniqSupply
42 import SrcLoc
43 import Util
44
45 import Outputable
46 import Exception     ( evaluate )
47
48 import Data.IORef    ( atomicModifyIORef, readIORef )
49 \end{code}
50
51
52 %*********************************************************
53 %*                                                      *
54         Allocating new Names in the Name Cache
55 %*                                                      *
56 %*********************************************************
57
58 Note [The Name Cache]
59 ~~~~~~~~~~~~~~~~~~~~~
60 The Name Cache makes sure that, during any invovcation of GHC, each
61 External Name "M.x" has one, and only one globally-agreed Unique.
62
63 * The first time we come across M.x we make up a Unique and record that
64   association in the Name Cache.
65
66 * When we come across "M.x" again, we look it up in the Name Cache,
67   and get a hit.
68
69 The functions newGlobalBinder, allocateGlobalBinder do the main work.
70 When you make an External name, you should probably be calling one
71 of them.
72
73
74 \begin{code}
75 newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
76 -- Used for source code and interface files, to make the
77 -- Name for a thing, given its Module and OccName
78 -- See Note [The Name Cache]
79 --
80 -- The cache may already already have a binding for this thing,
81 -- because we may have seen an occurrence before, but now is the
82 -- moment when we know its Module and SrcLoc in their full glory
83
84 newGlobalBinder mod occ loc
85   = do mod `seq` occ `seq` return ()    -- See notes with lookupOrig
86 --     traceIf (text "newGlobalBinder" <+> ppr mod <+> ppr occ <+> ppr loc)
87        updNameCache $ \name_cache ->
88          allocateGlobalBinder name_cache mod occ loc
89
90 allocateGlobalBinder
91   :: NameCache 
92   -> Module -> OccName -> SrcSpan
93   -> (NameCache, Name)
94 -- See Note [The Name Cache]
95 allocateGlobalBinder name_supply mod occ loc
96   = case lookupOrigNameCache (nsNames name_supply) mod occ of
97         -- A hit in the cache!  We are at the binding site of the name.
98         -- This is the moment when we know the SrcLoc
99         -- of the Name, so we set this field in the Name we return.
100         --
101         -- Then (bogus) multiple bindings of the same Name
102         -- get different SrcLocs can can be reported as such.
103         --
104         -- Possible other reason: it might be in the cache because we
105         --      encountered an occurrence before the binding site for an
106         --      implicitly-imported Name.  Perhaps the current SrcLoc is
107         --      better... but not really: it'll still just say 'imported'
108         --
109         -- IMPORTANT: Don't mess with wired-in names.
110         --            Their wired-in-ness is in their NameSort
111         --            and their Module is correct.
112
113         Just name | isWiredInName name -> (name_supply, name)
114                   | mod /= iNTERACTIVE -> (new_name_supply, name')
115                      -- Note [interactive name cache]
116                   where
117                     uniq            = nameUnique name
118                     name'           = mkExternalName uniq mod occ loc
119                     new_cache       = extendNameCache (nsNames name_supply) mod occ name'
120                     new_name_supply = name_supply {nsNames = new_cache}
121
122         -- Miss in the cache!
123         -- Build a completely new Name, and put it in the cache
124         _ -> (new_name_supply, name)
125                   where
126                     (uniq, us')     = takeUniqFromSupply (nsUniqs name_supply)
127                     name            = mkExternalName uniq mod occ loc
128                     new_cache       = extendNameCache (nsNames name_supply) mod occ name
129                     new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
130
131 {- Note [interactive name cache]
132
133 In GHCi we always create Names with the same Module, ":Interactive".
134 However, we want to be able to shadow older declarations with newer
135 ones, and we don't want the Name cache giving us back the same Unique
136 for the new Name as for the old, hence this special case.
137
138 See also Note [Outputable Orig RdrName] in HscTypes.
139 -}
140
141 newImplicitBinder :: Name                       -- Base name
142                   -> (OccName -> OccName)       -- Occurrence name modifier
143                   -> TcRnIf m n Name            -- Implicit name
144 -- Called in BuildTyCl to allocate the implicit binders of type/class decls
145 -- For source type/class decls, this is the first occurrence
146 -- For iface ones, the LoadIface has alrady allocated a suitable name in the cache
147 newImplicitBinder base_name mk_sys_occ
148   | Just mod <- nameModule_maybe base_name
149   = newGlobalBinder mod occ loc
150   | otherwise           -- When typechecking a [d| decl bracket |], 
151                         -- TH generates types, classes etc with Internal names,
152                         -- so we follow suit for the implicit binders
153   = do  { uniq <- newUnique
154         ; return (mkInternalName uniq occ loc) }
155   where
156     occ = mk_sys_occ (nameOccName base_name)
157     loc = nameSrcSpan base_name
158
159 ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo]
160 ifaceExportNames exports = return exports
161
162 lookupOrig :: Module -> OccName ->  TcRnIf a b Name
163 lookupOrig mod occ
164   = do  {       -- First ensure that mod and occ are evaluated
165                 -- If not, chaos can ensue:
166                 --      we read the name-cache
167                 --      then pull on mod (say)
168                 --      which does some stuff that modifies the name cache
169                 -- This did happen, with tycon_mod in TcIface.tcIfaceAlt (DataAlt..)
170           mod `seq` occ `seq` return () 
171 --      ; traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ)
172
173         ; updNameCache $ \name_cache ->
174             case lookupOrigNameCache (nsNames name_cache) mod occ of {
175               Just name -> (name_cache, name);
176               Nothing   ->
177               case takeUniqFromSupply (nsUniqs name_cache) of {
178               (uniq, us) ->
179                   let
180                     name      = mkExternalName uniq mod occ noSrcSpan
181                     new_cache = extendNameCache (nsNames name_cache) mod occ name
182                   in (name_cache{ nsUniqs = us, nsNames = new_cache }, name)
183     }}}
184 \end{code}
185
186 %************************************************************************
187 %*                                                                      *
188                 Name cache access
189 %*                                                                      *
190 %************************************************************************
191
192 See Note [The Name Cache] above.
193
194 \begin{code}
195 lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
196 lookupOrigNameCache _ mod occ
197   -- Don't need to mention gHC_UNIT here because it is explicitly
198   -- included in TysWiredIn.wiredInTyCons
199   | mod == gHC_TUPLE || mod == gHC_PRIM,                -- Boxed tuples from one, 
200     Just tup_info <- isTupleOcc_maybe occ       -- unboxed from the other
201   =     -- Special case for tuples; there are too many
202         -- of them to pre-populate the original-name cache
203     Just (mk_tup_name tup_info)
204   where
205     mk_tup_name (ns, sort, arity)
206         | ns == tcName   = tyConName (tupleTyCon sort arity)
207         | ns == dataName = dataConName (tupleCon sort arity)
208         | otherwise      = Var.varName (dataConWorkId (tupleCon sort arity))
209
210 lookupOrigNameCache nc mod occ  -- The normal case
211   = case lookupModuleEnv nc mod of
212         Nothing      -> Nothing
213         Just occ_env -> lookupOccEnv occ_env occ
214
215 extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
216 extendOrigNameCache nc name 
217   = ASSERT2( isExternalName name, ppr name ) 
218     extendNameCache nc (nameModule name) (nameOccName name) name
219
220 extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
221 extendNameCache nc mod occ name
222   = extendModuleEnvWith combine nc mod (unitOccEnv occ name)
223   where
224     combine _ occ_env = extendOccEnv occ_env occ name
225
226 getNameCache :: TcRnIf a b NameCache
227 getNameCache = do { HscEnv { hsc_NC = nc_var } <- getTopEnv; 
228                     readMutVar nc_var }
229
230 updNameCache :: (NameCache -> (NameCache, c)) -> TcRnIf a b c
231 updNameCache upd_fn = do
232   HscEnv { hsc_NC = nc_var } <- getTopEnv
233   atomicUpdMutVar' nc_var upd_fn
234
235 -- | A function that atomically updates the name cache given a modifier
236 -- function.  The second result of the modifier function will be the result
237 -- of the IO action.
238 data NameCacheUpdater = NCU { updateNameCache :: forall c. (NameCache -> (NameCache, c)) -> IO c }
239
240 -- | Return a function to atomically update the name cache.
241 mkNameCacheUpdater :: TcRnIf a b NameCacheUpdater
242 mkNameCacheUpdater = do
243   nc_var <- hsc_NC `fmap` getTopEnv
244   let update_nc f = do r <- atomicModifyIORef nc_var f
245                        _ <- evaluate =<< readIORef nc_var
246                        return r
247   return (NCU update_nc)
248 \end{code}
249
250
251 \begin{code}
252 initNameCache :: UniqSupply -> [Name] -> NameCache
253 initNameCache us names
254   = NameCache { nsUniqs = us,
255                 nsNames = initOrigNames names }
256
257 initOrigNames :: [Name] -> OrigNameCache
258 initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names
259 \end{code}
260
261
262
263 %************************************************************************
264 %*                                                                      *
265                 Type variables and local Ids
266 %*                                                                      *
267 %************************************************************************
268
269 \begin{code}
270 tcIfaceLclId :: FastString -> IfL Id
271 tcIfaceLclId occ
272   = do  { lcl <- getLclEnv
273         ; case (lookupUFM (if_id_env lcl) occ) of
274             Just ty_var -> return ty_var
275             Nothing     -> failIfM (text "Iface id out of scope: " <+> ppr occ)
276         }
277
278 extendIfaceIdEnv :: [Id] -> IfL a -> IfL a
279 extendIfaceIdEnv ids thing_inside
280   = do  { env <- getLclEnv
281         ; let { id_env' = addListToUFM (if_id_env env) pairs
282               ; pairs   = [(occNameFS (getOccName id), id) | id <- ids] }
283         ; setLclEnv (env { if_id_env = id_env' }) thing_inside }
284
285
286 tcIfaceTyVar :: FastString -> IfL TyVar
287 tcIfaceTyVar occ
288   = do  { lcl <- getLclEnv
289         ; case (lookupUFM (if_tv_env lcl) occ) of
290             Just ty_var -> return ty_var
291             Nothing     -> failIfM (text "Iface type variable out of scope: " <+> ppr occ)
292         }
293
294 lookupIfaceTyVar :: FastString -> IfL (Maybe TyVar)
295 lookupIfaceTyVar occ
296   = do  { lcl <- getLclEnv
297         ; return (lookupUFM (if_tv_env lcl) occ) }
298
299 extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a
300 extendIfaceTyVarEnv tyvars thing_inside
301   = do  { env <- getLclEnv
302         ; let { tv_env' = addListToUFM (if_tv_env env) pairs
303               ; pairs   = [(occNameFS (getOccName tv), tv) | tv <- tyvars] }
304         ; setLclEnv (env { if_tv_env = tv_env' }) thing_inside }
305 \end{code}
306
307
308 %************************************************************************
309 %*                                                                      *
310                 Getting from RdrNames to Names
311 %*                                                                      *
312 %************************************************************************
313
314 \begin{code}
315 lookupIfaceTop :: OccName -> IfL Name
316 -- Look up a top-level name from the current Iface module
317 lookupIfaceTop occ
318   = do  { env <- getLclEnv; lookupOrig (if_mod env) occ }
319
320 newIfaceName :: OccName -> IfL Name
321 newIfaceName occ
322   = do  { uniq <- newUnique
323         ; return $! mkInternalName uniq occ noSrcSpan }
324
325 newIfaceNames :: [OccName] -> IfL [Name]
326 newIfaceNames occs
327   = do  { uniqs <- newUniqueSupply
328         ; return [ mkInternalName uniq occ noSrcSpan
329                  | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
330 \end{code}