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