Move newImplicitBinder to from IfaceEnv to BuildTyCl
[ghc.git] / compiler / iface / IfaceEnv.hs
1 -- (c) The University of Glasgow 2002-2006
2
3 {-# LANGUAGE CPP, RankNTypes #-}
4
5 module IfaceEnv (
6 newGlobalBinder, newInteractiveBinder,
7 externaliseName,
8 lookupIfaceTop,
9 lookupOrig, lookupOrigNameCache, extendNameCache,
10 newIfaceName, newIfaceNames,
11 extendIfaceIdEnv, extendIfaceTyVarEnv,
12 tcIfaceLclId, tcIfaceTyVar, lookupIfaceTyVar,
13
14 ifaceExportNames,
15
16 -- Name-cache stuff
17 allocateGlobalBinder,
18 initNameCache, updNameCache,
19 mkNameCacheUpdater, NameCacheUpdater(..)
20 ) where
21
22 #include "HsVersions.h"
23
24 import TcRnMonad
25 import TysWiredIn
26 import HscTypes
27 import Type
28 import Var
29 import Name
30 import Avail
31 import Module
32 import UniqFM
33 import FastString
34 import UniqSupply
35 import SrcLoc
36 import Util
37
38 import Outputable
39
40 import Data.IORef ( atomicModifyIORef' )
41
42 {-
43 *********************************************************
44 * *
45 Allocating new Names in the Name Cache
46 * *
47 *********************************************************
48
49 Note [The Name Cache]
50 ~~~~~~~~~~~~~~~~~~~~~
51 The Name Cache makes sure that, during any invovcation of GHC, each
52 External Name "M.x" has one, and only one globally-agreed Unique.
53
54 * The first time we come across M.x we make up a Unique and record that
55 association in the Name Cache.
56
57 * When we come across "M.x" again, we look it up in the Name Cache,
58 and get a hit.
59
60 The functions newGlobalBinder, allocateGlobalBinder do the main work.
61 When you make an External name, you should probably be calling one
62 of them.
63 -}
64
65 newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
66 -- Used for source code and interface files, to make the
67 -- Name for a thing, given its Module and OccName
68 -- See Note [The Name Cache]
69 --
70 -- The cache may already already have a binding for this thing,
71 -- because we may have seen an occurrence before, but now is the
72 -- moment when we know its Module and SrcLoc in their full glory
73
74 newGlobalBinder mod occ loc
75 = do { mod `seq` occ `seq` return () -- See notes with lookupOrig
76 ; name <- updNameCacheTcRn $ \name_cache ->
77 allocateGlobalBinder name_cache mod occ loc
78 ; traceIf (text "newGlobalBinder" <+>
79 (vcat [ ppr mod <+> ppr occ <+> ppr loc, ppr name]))
80 ; return name }
81
82 newInteractiveBinder :: HscEnv -> OccName -> SrcSpan -> IO Name
83 -- Works in the IO monad, and gets the Module
84 -- from the interactive context
85 newInteractiveBinder hsc_env occ loc
86 = do { let mod = icInteractiveModule (hsc_IC hsc_env)
87 ; updNameCache hsc_env $ \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
114 -> (name_supply, name)
115 | otherwise
116 -> (new_name_supply, name')
117 where
118 uniq = nameUnique name
119 name' = mkExternalName uniq mod occ loc
120 -- name' is like name, but with the right SrcSpan
121 new_cache = extendNameCache (nsNames name_supply) mod occ name'
122 new_name_supply = name_supply {nsNames = new_cache}
123
124 -- Miss in the cache!
125 -- Build a completely new Name, and put it in the cache
126 _ -> (new_name_supply, name)
127 where
128 (uniq, us') = takeUniqFromSupply (nsUniqs name_supply)
129 name = mkExternalName uniq mod occ loc
130 new_cache = extendNameCache (nsNames name_supply) mod occ name
131 new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
132
133 ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo]
134 ifaceExportNames exports = return exports
135
136 -- | Look up the 'Name' for a given 'Module' and 'OccName'.
137 -- Consider alternately using 'lookupIfaceTop' if you're in the 'IfL' monad
138 -- and 'Module' is simply that of the 'ModIface' you are typechecking.
139 lookupOrig :: Module -> OccName -> TcRnIf a b Name
140 lookupOrig mod occ
141 = do { -- First ensure that mod and occ are evaluated
142 -- If not, chaos can ensue:
143 -- we read the name-cache
144 -- then pull on mod (say)
145 -- which does some stuff that modifies the name cache
146 -- This did happen, with tycon_mod in TcIface.tcIfaceAlt (DataAlt..)
147 mod `seq` occ `seq` return ()
148 -- ; traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ)
149
150 ; updNameCacheTcRn $ \name_cache ->
151 case lookupOrigNameCache (nsNames name_cache) mod occ of {
152 Just name -> (name_cache, name);
153 Nothing ->
154 case takeUniqFromSupply (nsUniqs name_cache) of {
155 (uniq, us) ->
156 let
157 name = mkExternalName uniq mod occ noSrcSpan
158 new_cache = extendNameCache (nsNames name_cache) mod occ name
159 in (name_cache{ nsUniqs = us, nsNames = new_cache }, name)
160 }}}
161
162 externaliseName :: Module -> Name -> TcRnIf m n Name
163 -- Take an Internal Name and make it an External one,
164 -- with the same unique
165 externaliseName mod name
166 = do { let occ = nameOccName name
167 loc = nameSrcSpan name
168 uniq = nameUnique name
169 ; occ `seq` return () -- c.f. seq in newGlobalBinder
170 ; updNameCacheTcRn $ \ ns ->
171 let name' = mkExternalName uniq mod occ loc
172 ns' = ns { nsNames = extendNameCache (nsNames ns) mod occ name' }
173 in (ns', name') }
174
175 {-
176 ************************************************************************
177 * *
178 Name cache access
179 * *
180 ************************************************************************
181
182 See Note [The Name Cache] above.
183
184 Note [Built-in syntax and the OrigNameCache]
185 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
186 You might think that usin isBuiltInOcc_maybe in lookupOrigNameCache is
187 unnecessary because tuple TyCon/DataCons are parsed as Exact RdrNames
188 and *don't* appear as original names in interface files (because
189 serialization gives them special treatment), so we will never look
190 them up in the original name cache.
191
192 However, there are two reasons why we might look up an Orig RdrName:
193
194 * If you use setRdrNameSpace on an Exact RdrName it may be
195 turned into an Orig RdrName.
196
197 * Template Haskell turns a BuiltInSyntax Name into a TH.NameG
198 (DsMeta.globalVar), and parses a NameG into an Orig RdrName
199 (Convert.thRdrName). So, eg $(do { reify '(,); ... }) will
200 go this route (Trac #8954).
201 -}
202
203 lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
204 lookupOrigNameCache nc mod occ
205 | Just name <- isBuiltInOcc_maybe occ
206 = -- See Note [Known-key names], 3(c) in PrelNames
207 -- Special case for tuples; there are too many
208 -- of them to pre-populate the original-name cache
209 Just name
210
211 | otherwise
212 = case lookupModuleEnv nc mod of
213 Nothing -> Nothing
214 Just occ_env -> lookupOccEnv occ_env occ
215
216 extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
217 extendOrigNameCache nc name
218 = ASSERT2( isExternalName name, ppr name )
219 extendNameCache nc (nameModule name) (nameOccName name) name
220
221 extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
222 extendNameCache nc mod occ name
223 = extendModuleEnvWith combine nc mod (unitOccEnv occ name)
224 where
225 combine _ occ_env = extendOccEnv occ_env occ name
226
227 updNameCacheTcRn :: (NameCache -> (NameCache, c)) -> TcRnIf a b c
228 updNameCacheTcRn upd_fn = do { hsc_env <- getTopEnv
229 ; liftIO (updNameCache hsc_env upd_fn) }
230
231 updNameCache :: HscEnv -> (NameCache -> (NameCache, c)) -> IO c
232 updNameCache hsc_env upd_fn = atomicModifyIORef' (hsc_NC hsc_env) upd_fn
233
234 -- | A function that atomically updates the name cache given a modifier
235 -- function. The second result of the modifier function will be the result
236 -- of the IO action.
237 newtype NameCacheUpdater
238 = 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 { hsc_env <- getTopEnv
243 ; return (NCU (updNameCache hsc_env)) }
244
245 initNameCache :: UniqSupply -> [Name] -> NameCache
246 initNameCache us names
247 = NameCache { nsUniqs = us,
248 nsNames = initOrigNames names }
249
250 initOrigNames :: [Name] -> OrigNameCache
251 initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names
252
253 {-
254 ************************************************************************
255 * *
256 Type variables and local Ids
257 * *
258 ************************************************************************
259 -}
260
261 tcIfaceLclId :: FastString -> IfL Id
262 tcIfaceLclId occ
263 = do { lcl <- getLclEnv
264 ; case (lookupUFM (if_id_env lcl) occ) of
265 Just ty_var -> return ty_var
266 Nothing -> failIfM (text "Iface id out of scope: " <+> ppr occ)
267 }
268
269 extendIfaceIdEnv :: [Id] -> IfL a -> IfL a
270 extendIfaceIdEnv ids thing_inside
271 = do { env <- getLclEnv
272 ; let { id_env' = addListToUFM (if_id_env env) pairs
273 ; pairs = [(occNameFS (getOccName id), id) | id <- ids] }
274 ; setLclEnv (env { if_id_env = id_env' }) thing_inside }
275
276
277 tcIfaceTyVar :: FastString -> IfL TyVar
278 tcIfaceTyVar occ
279 = do { lcl <- getLclEnv
280 ; case (lookupUFM (if_tv_env lcl) occ) of
281 Just ty_var -> return ty_var
282 Nothing -> failIfM (text "Iface type variable out of scope: " <+> ppr occ)
283 }
284
285 lookupIfaceTyVar :: FastString -> IfL (Maybe TyVar)
286 lookupIfaceTyVar occ
287 = do { lcl <- getLclEnv
288 ; return (lookupUFM (if_tv_env lcl) occ) }
289
290 extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a
291 extendIfaceTyVarEnv tyvars thing_inside
292 = do { env <- getLclEnv
293 ; let { tv_env' = addListToUFM (if_tv_env env) pairs
294 ; pairs = [(occNameFS (getOccName tv), tv) | tv <- tyvars] }
295 ; setLclEnv (env { if_tv_env = tv_env' }) thing_inside }
296
297 {-
298 ************************************************************************
299 * *
300 Getting from RdrNames to Names
301 * *
302 ************************************************************************
303 -}
304
305 lookupIfaceTop :: OccName -> IfL Name
306 -- Look up a top-level name from the current Iface module
307 lookupIfaceTop occ
308 = do { env <- getLclEnv; lookupOrig (if_mod env) occ }
309
310 newIfaceName :: OccName -> IfL Name
311 newIfaceName occ
312 = do { uniq <- newUnique
313 ; return $! mkInternalName uniq occ noSrcSpan }
314
315 newIfaceNames :: [OccName] -> IfL [Name]
316 newIfaceNames occs
317 = do { uniqs <- newUniqueSupply
318 ; return [ mkInternalName uniq occ noSrcSpan
319 | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }