never executed always true always false
1 -- (c) The University of Glasgow 2002-2006
2
3 {-# LANGUAGE RankNTypes #-}
4
5 module GHC.Iface.Env (
6 newGlobalBinder, newInteractiveBinder,
7 externaliseName,
8 lookupIfaceTop,
9 lookupOrig, lookupOrigIO, lookupOrigNameCache,
10 newIfaceName, newIfaceNames,
11 extendIfaceIdEnv, extendIfaceTyVarEnv,
12 tcIfaceLclId, tcIfaceTyVar, lookupIfaceVar,
13 lookupIfaceTyVar, extendIfaceEnvs,
14 setNameModule,
15
16 ifaceExportNames,
17
18 trace_if, trace_hi_diffs,
19
20 -- Name-cache stuff
21 allocateGlobalBinder,
22 ) where
23
24 import GHC.Prelude
25
26 import GHC.Driver.Env
27 import GHC.Driver.Session
28
29 import GHC.Tc.Utils.Monad
30 import GHC.Core.Type
31 import GHC.Iface.Type
32 import GHC.Runtime.Context
33
34 import GHC.Unit.Module
35 import GHC.Unit.Module.ModIface
36
37 import GHC.Data.FastString
38 import GHC.Data.FastString.Env
39
40 import GHC.Types.Var
41 import GHC.Types.Name
42 import GHC.Types.Avail
43 import GHC.Types.Name.Cache
44 import GHC.Types.Unique.Supply
45 import GHC.Types.SrcLoc
46
47 import GHC.Utils.Outputable
48 import GHC.Utils.Error
49 import GHC.Utils.Logger
50
51 import Data.List ( partition )
52 import Control.Monad
53
54 {-
55 *********************************************************
56 * *
57 Allocating new Names in the Name Cache
58 * *
59 *********************************************************
60
61 See Also: Note [The Name Cache] in GHC.Types.Name.Cache
62 -}
63
64 newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
65 -- Used for source code and interface files, to make the
66 -- Name for a thing, given its Module and OccName
67 -- See Note [The Name Cache] in GHC.Types.Name.Cache
68 --
69 -- The cache may already have a binding for this thing,
70 -- because we may have seen an occurrence before, but now is the
71 -- moment when we know its Module and SrcLoc in their full glory
72
73 newGlobalBinder mod occ loc
74 = do { hsc_env <- getTopEnv
75 ; name <- liftIO $ allocateGlobalBinder (hsc_NC hsc_env) mod occ loc
76 ; traceIf (text "newGlobalBinder" <+>
77 (vcat [ ppr mod <+> ppr occ <+> ppr loc, ppr name]))
78 ; return name }
79
80 newInteractiveBinder :: HscEnv -> OccName -> SrcSpan -> IO Name
81 -- Works in the IO monad, and gets the Module
82 -- from the interactive context
83 newInteractiveBinder hsc_env occ loc = do
84 let mod = icInteractiveModule (hsc_IC hsc_env)
85 allocateGlobalBinder (hsc_NC hsc_env) mod occ loc
86
87 allocateGlobalBinder
88 :: NameCache
89 -> Module -> OccName -> SrcSpan
90 -> IO Name
91 -- See Note [The Name Cache] in GHC.Types.Name.Cache
92 allocateGlobalBinder nc mod occ loc
93 = updateNameCache nc mod occ $ \cache0 -> do
94 case lookupOrigNameCache cache0 mod occ of
95 -- A hit in the cache! We are at the binding site of the name.
96 -- This is the moment when we know the SrcLoc
97 -- of the Name, so we set this field in the Name we return.
98 --
99 -- Then (bogus) multiple bindings of the same Name
100 -- get different SrcLocs can be reported as such.
101 --
102 -- Possible other reason: it might be in the cache because we
103 -- encountered an occurrence before the binding site for an
104 -- implicitly-imported Name. Perhaps the current SrcLoc is
105 -- better... but not really: it'll still just say 'imported'
106 --
107 -- IMPORTANT: Don't mess with wired-in names.
108 -- Their wired-in-ness is in their NameSort
109 -- and their Module is correct.
110
111 Just name | isWiredInName name
112 -> pure (cache0, name)
113 | otherwise
114 -> pure (new_cache, name')
115 where
116 uniq = nameUnique name
117 name' = mkExternalName uniq mod occ loc
118 -- name' is like name, but with the right SrcSpan
119 new_cache = extendOrigNameCache cache0 mod occ name'
120
121 -- Miss in the cache!
122 -- Build a completely new Name, and put it in the cache
123 _ -> do
124 uniq <- takeUniqFromNameCache nc
125 let name = mkExternalName uniq mod occ loc
126 let new_cache = extendOrigNameCache cache0 mod occ name
127 pure (new_cache, name)
128
129 ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo]
130 ifaceExportNames exports = return exports
131
132 {-
133 ************************************************************************
134 * *
135 Name cache access
136 * *
137 ************************************************************************
138 -}
139
140 -- | Look up the 'Name' for a given 'Module' and 'OccName'.
141 -- Consider alternatively using 'lookupIfaceTop' if you're in the 'IfL' monad
142 -- and 'Module' is simply that of the 'ModIface' you are typechecking.
143 lookupOrig :: Module -> OccName -> TcRnIf a b Name
144 lookupOrig mod occ = do
145 hsc_env <- getTopEnv
146 traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ)
147 liftIO $ lookupNameCache (hsc_NC hsc_env) mod occ
148
149 lookupOrigIO :: HscEnv -> Module -> OccName -> IO Name
150 lookupOrigIO hsc_env mod occ
151 = lookupNameCache (hsc_NC hsc_env) mod occ
152
153 lookupNameCache :: NameCache -> Module -> OccName -> IO Name
154 -- Lookup up the (Module,OccName) in the NameCache
155 -- If you find it, return it; if not, allocate a fresh original name and extend
156 -- the NameCache.
157 -- Reason: this may the first occurrence of (say) Foo.bar we have encountered.
158 -- If we need to explore its value we will load Foo.hi; but meanwhile all we
159 -- need is a Name for it.
160 lookupNameCache nc mod occ = updateNameCache nc mod occ $ \cache0 ->
161 case lookupOrigNameCache cache0 mod occ of
162 Just name -> pure (cache0, name)
163 Nothing -> do
164 uniq <- takeUniqFromNameCache nc
165 let name = mkExternalName uniq mod occ noSrcSpan
166 let new_cache = extendOrigNameCache cache0 mod occ name
167 pure (new_cache, name)
168
169 externaliseName :: Module -> Name -> TcRnIf m n Name
170 -- Take an Internal Name and make it an External one,
171 -- with the same unique
172 externaliseName mod name
173 = do { let occ = nameOccName name
174 loc = nameSrcSpan name
175 uniq = nameUnique name
176 ; occ `seq` return () -- c.f. seq in newGlobalBinder
177 ; hsc_env <- getTopEnv
178 ; liftIO $ updateNameCache (hsc_NC hsc_env) mod occ $ \cache -> do
179 let name' = mkExternalName uniq mod occ loc
180 cache' = extendOrigNameCache cache mod occ name'
181 pure (cache', name') }
182
183 -- | Set the 'Module' of a 'Name'.
184 setNameModule :: Maybe Module -> Name -> TcRnIf m n Name
185 setNameModule Nothing n = return n
186 setNameModule (Just m) n =
187 newGlobalBinder m (nameOccName n) (nameSrcSpan n)
188
189 {-
190 ************************************************************************
191 * *
192 Type variables and local Ids
193 * *
194 ************************************************************************
195 -}
196
197 tcIfaceLclId :: FastString -> IfL Id
198 tcIfaceLclId occ
199 = do { lcl <- getLclEnv
200 ; case (lookupFsEnv (if_id_env lcl) occ) of
201 Just ty_var -> return ty_var
202 Nothing -> failIfM (text "Iface id out of scope: " <+> ppr occ)
203 }
204
205 extendIfaceIdEnv :: [Id] -> IfL a -> IfL a
206 extendIfaceIdEnv ids thing_inside
207 = do { env <- getLclEnv
208 ; let { id_env' = extendFsEnvList (if_id_env env) pairs
209 ; pairs = [(occNameFS (getOccName id), id) | id <- ids] }
210 ; setLclEnv (env { if_id_env = id_env' }) thing_inside }
211
212
213 tcIfaceTyVar :: FastString -> IfL TyVar
214 tcIfaceTyVar occ
215 = do { lcl <- getLclEnv
216 ; case (lookupFsEnv (if_tv_env lcl) occ) of
217 Just ty_var -> return ty_var
218 Nothing -> failIfM (text "Iface type variable out of scope: " <+> ppr occ)
219 }
220
221 lookupIfaceTyVar :: IfaceTvBndr -> IfL (Maybe TyVar)
222 lookupIfaceTyVar (occ, _)
223 = do { lcl <- getLclEnv
224 ; return (lookupFsEnv (if_tv_env lcl) occ) }
225
226 lookupIfaceVar :: IfaceBndr -> IfL (Maybe TyCoVar)
227 lookupIfaceVar (IfaceIdBndr (_, occ, _))
228 = do { lcl <- getLclEnv
229 ; return (lookupFsEnv (if_id_env lcl) occ) }
230 lookupIfaceVar (IfaceTvBndr (occ, _))
231 = do { lcl <- getLclEnv
232 ; return (lookupFsEnv (if_tv_env lcl) occ) }
233
234 extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a
235 extendIfaceTyVarEnv tyvars thing_inside
236 = do { env <- getLclEnv
237 ; let { tv_env' = extendFsEnvList (if_tv_env env) pairs
238 ; pairs = [(occNameFS (getOccName tv), tv) | tv <- tyvars] }
239 ; setLclEnv (env { if_tv_env = tv_env' }) thing_inside }
240
241 extendIfaceEnvs :: [TyCoVar] -> IfL a -> IfL a
242 extendIfaceEnvs tcvs thing_inside
243 = extendIfaceTyVarEnv tvs $
244 extendIfaceIdEnv cvs $
245 thing_inside
246 where
247 (tvs, cvs) = partition isTyVar tcvs
248
249 {-
250 ************************************************************************
251 * *
252 Getting from RdrNames to Names
253 * *
254 ************************************************************************
255 -}
256
257 -- | Look up a top-level name from the current Iface module
258 lookupIfaceTop :: OccName -> IfL Name
259 lookupIfaceTop occ
260 = do { env <- getLclEnv; lookupOrig (if_mod env) occ }
261
262 newIfaceName :: OccName -> IfL Name
263 newIfaceName occ
264 = do { uniq <- newUnique
265 ; return $! mkInternalName uniq occ noSrcSpan }
266
267 newIfaceNames :: [OccName] -> IfL [Name]
268 newIfaceNames occs
269 = do { uniqs <- newUniqueSupply
270 ; return [ mkInternalName uniq occ noSrcSpan
271 | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
272
273 trace_if :: Logger -> SDoc -> IO ()
274 {-# INLINE trace_if #-}
275 trace_if logger doc = when (logHasDumpFlag logger Opt_D_dump_if_trace) $ putMsg logger doc
276
277 trace_hi_diffs :: Logger -> SDoc -> IO ()
278 {-# INLINE trace_hi_diffs #-}
279 trace_hi_diffs logger doc = when (logHasDumpFlag logger Opt_D_dump_hi_diffs) $ putMsg logger doc