1 (c) The University of Glasgow 2002-2006
5 newGlobalBinder, newIPName, newImplicitBinder,
7 lookupOrig, lookupOrigNameCache, extendNameCache,
8 newIfaceName, newIfaceNames,
9 extendIfaceIdEnv, extendIfaceTyVarEnv,
10 tcIfaceLclId, tcIfaceTyVar,
16 allocateGlobalBinder, initNameCache,
17 getNameCache, setNameCache
20 #include "HsVersions.h"
44 %*********************************************************
46 Allocating new Names in the Name Cache
48 %*********************************************************
51 newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
52 -- Used for source code and interface files, to make the
53 -- Name for a thing, given its Module and OccName
55 -- The cache may already already have a binding for this thing,
56 -- because we may have seen an occurrence before, but now is the
57 -- moment when we know its Module and SrcLoc in their full glory
59 newGlobalBinder mod occ loc
60 = do { mod `seq` occ `seq` return () -- See notes with lookupOrig_help
61 -- ; traceIf (text "newGlobalBinder" <+> ppr mod <+> ppr occ <+> ppr loc)
62 ; name_supply <- getNameCache
63 ; let (name_supply', name) = allocateGlobalBinder
66 ; setNameCache name_supply'
71 -> Module -> OccName -> SrcSpan
73 allocateGlobalBinder name_supply mod occ loc
74 = case lookupOrigNameCache (nsNames name_supply) mod occ of
75 -- A hit in the cache! We are at the binding site of the name.
76 -- This is the moment when we know the SrcLoc
77 -- of the Name, so we set this field in the Name we return.
79 -- Then (bogus) multiple bindings of the same Name
80 -- get different SrcLocs can can be reported as such.
82 -- Possible other reason: it might be in the cache because we
83 -- encountered an occurrence before the binding site for an
84 -- implicitly-imported Name. Perhaps the current SrcLoc is
85 -- better... but not really: it'll still just say 'imported'
87 -- IMPORTANT: Don't mess with wired-in names.
88 -- Their wired-in-ness is in their NameSort
89 -- and their Module is correct.
91 Just name | isWiredInName name -> (name_supply, name)
92 | otherwise -> (new_name_supply, name')
94 uniq = nameUnique name
95 name' = mkExternalName uniq mod occ loc
96 new_cache = extendNameCache (nsNames name_supply) mod occ name'
97 new_name_supply = name_supply {nsNames = new_cache}
100 -- Build a completely new Name, and put it in the cache
101 Nothing -> (new_name_supply, name)
103 (us', us1) = splitUniqSupply (nsUniqs name_supply)
104 uniq = uniqFromSupply us1
105 name = mkExternalName uniq mod occ loc
106 new_cache = extendNameCache (nsNames name_supply) mod occ name
107 new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
110 newImplicitBinder :: Name -- Base name
111 -> (OccName -> OccName) -- Occurrence name modifier
112 -> TcRnIf m n Name -- Implicit name
113 -- Called in BuildTyCl to allocate the implicit binders of type/class decls
114 -- For source type/class decls, this is the first occurrence
115 -- For iface ones, the LoadIface has alrady allocated a suitable name in the cache
116 newImplicitBinder base_name mk_sys_occ
117 = newGlobalBinder (nameModule base_name)
118 (mk_sys_occ (nameOccName base_name))
119 (nameSrcSpan base_name)
121 ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo]
122 ifaceExportNames exports = do
123 mod_avails <- mapM (\(mod,avails) -> mapM (lookupAvail mod) avails) exports
124 return (concat mod_avails)
126 -- Convert OccNames in GenAvailInfo to Names.
127 lookupAvail :: Module -> GenAvailInfo OccName -> TcRnIf a b AvailInfo
128 lookupAvail mod (Avail n) = do
129 n' <- lookupOrig mod n
131 lookupAvail mod (AvailTC p_occ occs) = do
132 p_name <- lookupOrig mod p_occ
133 let lookup_sub occ | occ == p_occ = return p_name
134 | otherwise = lookupOrig mod occ
135 subs <- mapM lookup_sub occs
136 return (AvailTC p_name subs)
137 -- Remember that 'occs' is all the exported things, including
138 -- the parent. It's possible to export just class ops without
139 -- the class, which shows up as C( op ) here. If the class was
140 -- exported too we'd have C( C, op )
142 lookupOrig :: Module -> OccName -> TcRnIf a b Name
144 = do { -- First ensure that mod and occ are evaluated
145 -- If not, chaos can ensue:
146 -- we read the name-cache
147 -- then pull on mod (say)
148 -- which does some stuff that modifies the name cache
149 -- This did happen, with tycon_mod in TcIface.tcIfaceAlt (DataAlt..)
150 mod `seq` occ `seq` return ()
151 -- ; traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ)
153 ; name_cache <- getNameCache
154 ; case lookupOrigNameCache (nsNames name_cache) mod occ of {
155 Just name -> return name;
158 us = nsUniqs name_cache
159 uniq = uniqFromSupply us
160 name = mkExternalName uniq mod occ noSrcSpan
161 new_cache = extendNameCache (nsNames name_cache) mod occ name
163 case splitUniqSupply us of { (us',_) -> do
164 setNameCache name_cache{ nsUniqs = us', nsNames = new_cache }
168 newIPName :: IPName OccName -> TcRnIf m n (IPName Name)
169 newIPName occ_name_ip = do
170 name_supply <- getNameCache
172 ipcache = nsIPs name_supply
173 case lookupFM ipcache key of
174 Just name_ip -> return name_ip
175 Nothing -> do setNameCache new_ns
178 (us', us1) = splitUniqSupply (nsUniqs name_supply)
179 uniq = uniqFromSupply us1
180 name_ip = mapIPName (mkIPName uniq) occ_name_ip
181 new_ipcache = addToFM ipcache key name_ip
182 new_ns = name_supply {nsUniqs = us', nsIPs = new_ipcache}
184 key = occ_name_ip -- Ensures that ?x and %x get distinct Names
187 Local helper functions (not exported)
190 lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
191 lookupOrigNameCache _ mod occ
192 | mod == dATA_TUP || mod == gHC_PRIM, -- Boxed tuples from one,
193 Just tup_info <- isTupleOcc_maybe occ -- unboxed from the other
194 = -- Special case for tuples; there are too many
195 -- of them to pre-populate the original-name cache
196 Just (mk_tup_name tup_info)
198 mk_tup_name (ns, boxity, arity)
199 | ns == tcName = tyConName (tupleTyCon boxity arity)
200 | ns == dataName = dataConName (tupleCon boxity arity)
201 | otherwise = Var.varName (dataConWorkId (tupleCon boxity arity))
203 lookupOrigNameCache nc mod occ -- The normal case
204 = case lookupModuleEnv nc mod of
206 Just occ_env -> lookupOccEnv occ_env occ
208 extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
209 extendOrigNameCache nc name
210 = extendNameCache nc (nameModule name) (nameOccName name) name
212 extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
213 extendNameCache nc mod occ name
214 = extendModuleEnv_C combine nc mod (unitOccEnv occ name)
216 combine occ_env _ = extendOccEnv occ_env occ name
218 getNameCache :: TcRnIf a b NameCache
219 getNameCache = do { HscEnv { hsc_NC = nc_var } <- getTopEnv;
222 setNameCache :: NameCache -> TcRnIf a b ()
223 setNameCache nc = do { HscEnv { hsc_NC = nc_var } <- getTopEnv;
224 writeMutVar nc_var nc }
229 initNameCache :: UniqSupply -> [Name] -> NameCache
230 initNameCache us names
231 = NameCache { nsUniqs = us,
232 nsNames = initOrigNames names,
235 initOrigNames :: [Name] -> OrigNameCache
236 initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names
241 %************************************************************************
243 Type variables and local Ids
245 %************************************************************************
248 tcIfaceLclId :: FastString -> IfL Id
250 = do { lcl <- getLclEnv
251 ; case (lookupUFM (if_id_env lcl) occ) of
252 Just ty_var -> return ty_var
253 Nothing -> failIfM (text "Iface id out of scope: " <+> ppr occ)
256 extendIfaceIdEnv :: [Id] -> IfL a -> IfL a
257 extendIfaceIdEnv ids thing_inside
258 = do { env <- getLclEnv
259 ; let { id_env' = addListToUFM (if_id_env env) pairs
260 ; pairs = [(occNameFS (getOccName id), id) | id <- ids] }
261 ; setLclEnv (env { if_id_env = id_env' }) thing_inside }
264 tcIfaceTyVar :: FastString -> IfL TyVar
266 = do { lcl <- getLclEnv
267 ; case (lookupUFM (if_tv_env lcl) occ) of
268 Just ty_var -> return ty_var
269 Nothing -> failIfM (text "Iface type variable out of scope: " <+> ppr occ)
272 extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a
273 extendIfaceTyVarEnv tyvars thing_inside
274 = do { env <- getLclEnv
275 ; let { tv_env' = addListToUFM (if_tv_env env) pairs
276 ; pairs = [(occNameFS (getOccName tv), tv) | tv <- tyvars] }
277 ; setLclEnv (env { if_tv_env = tv_env' }) thing_inside }
281 %************************************************************************
283 Getting from RdrNames to Names
285 %************************************************************************
288 lookupIfaceTop :: OccName -> IfL Name
289 -- Look up a top-level name from the current Iface module
291 = do { env <- getLclEnv; lookupOrig (if_mod env) occ }
293 newIfaceName :: OccName -> IfL Name
295 = do { uniq <- newUnique
296 ; return $! mkInternalName uniq occ noSrcSpan }
298 newIfaceNames :: [OccName] -> IfL [Name]
300 = do { uniqs <- newUniqueSupply
301 ; return [ mkInternalName uniq occ noSrcSpan
302 | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
305 %************************************************************************
307 (Re)creating tick boxes
309 %************************************************************************
312 tcIfaceTick :: Module -> Int -> IfL Id
313 tcIfaceTick modName tickNo
314 = do { uniq <- newUnique
315 ; return $ mkTickBoxOpId uniq modName tickNo