- do_one top_tidy_env (bndr,rhs)
- = ((orig,occ,subst), (bndr',rhs'))
- where
- ((orig,occ,subst), bndr')
- = tidyTopBinder mod ext_ids cg_info_env
- rec_tidy_env rhs rhs' top_tidy_env bndr
-
- rhs' = tidyExpr rec_tidy_env rhs
-
-tidyTopBinder :: Module -> IdEnv Bool -> CgInfoEnv
- -> TidyEnv -- The TidyEnv is used to tidy the IdInfo
- -> CoreExpr -- RHS *before* tidying
- -> CoreExpr -- RHS *after* tidying
- -- The TidyEnv and the after-tidying RHS are
- -- both are knot-tied: don't look at them!
- -> TopTidyEnv -> Id -> (TopTidyEnv, Id)
- -- NB: tidyTopBinder doesn't affect the unique supply
-
-tidyTopBinder mod ext_ids cg_info_env rec_tidy_env rhs tidy_rhs
- env@(ns2, occ_env2, subst_env2) id
+ -- the CafInfo for a recursive group says whether *any* rhs in
+ -- the group may refer indirectly to a CAF (because then, they all do).
+ caf_info
+ | or [ mayHaveCafRefs (hasCafRefs subst1 (idArity bndr) rhs)
+ | (bndr,rhs) <- prs ] = MayHaveCafRefs
+ | otherwise = NoCafRefs
+
+--------------------------------------------------------------------
+-- tidyTopName
+-- This is where we set names to local/global based on whether they really are
+-- externally visible (see comment at the top of this module). If the name
+-- was previously local, we have to give it a unique occurrence name if
+-- we intend to externalise it.
+tidyTopNames mod nc_var ext_ids occ_env [] = return (occ_env, [])
+tidyTopNames mod nc_var ext_ids occ_env (id:ids)
+ = do { (occ_env1, name) <- tidyTopName mod nc_var ext_ids occ_env id
+ ; (occ_env2, names) <- tidyTopNames mod nc_var ext_ids occ_env1 ids
+ ; return (occ_env2, name:names) }
+
+tidyTopName :: Module -> IORef NameCache -> VarEnv Bool -> TidyOccEnv
+ -> Id -> IO (TidyOccEnv, Name)
+tidyTopName mod nc_var ext_ids occ_env id
+ | global && internal = return (occ_env, localiseName name)
+
+ | global && external = return (occ_env, name)
+ -- Global names are assumed to have been allocated by the renamer,
+ -- so they already have the "right" unique
+ -- And it's a system-wide unique too
+
+ -- Now we get to the real reason that all this is in the IO Monad:
+ -- we have to update the name cache in a nice atomic fashion
+
+ | local && internal = do { nc <- readIORef nc_var
+ ; let (nc', new_local_name) = mk_new_local nc
+ ; writeIORef nc_var nc'
+ ; return (occ_env', new_local_name) }
+ -- Even local, internal names must get a unique occurrence, because
+ -- if we do -split-objs we externalise the name later, in the code generator
+ --
+ -- Similarly, we must make sure it has a system-wide Unique, because
+ -- the byte-code generator builds a system-wide Name->BCO symbol table
+
+ | local && external = do { nc <- readIORef nc_var
+ ; let (nc', new_external_name) = mk_new_external nc
+ ; writeIORef nc_var nc'
+ ; return (occ_env', new_external_name) }
+ where
+ name = idName id
+ external = id `elemVarEnv` ext_ids
+ global = isExternalName name
+ local = not global
+ internal = not external
+ mb_parent = nameParent_maybe name
+ loc = nameSrcLoc name
+
+ (occ_env', occ') = tidyOccName occ_env (nameOccName name)
+
+ mk_new_local nc = (nc { nsUniqs = us2 }, mkInternalName uniq occ' loc)
+ where
+ (us1, us2) = splitUniqSupply (nsUniqs nc)
+ uniq = uniqFromSupply us1
+
+ mk_new_external nc = allocateGlobalBinder nc mod occ' mb_parent loc
+ -- If we want to externalise a currently-local name, check
+ -- whether we have already assigned a unique for it.
+ -- If so, use it; if not, extend the table.
+ -- All this is done by allcoateGlobalBinder.
+ -- This is needed when *re*-compiling a module in GHCi; we want to
+ -- use the same name for externally-visible things as we did before.
+
+
+-----------------------------------------------------------
+tidyTopPair :: VarEnv Bool
+ -> TidyEnv -- The TidyEnv is used to tidy the IdInfo
+ -- It is knot-tied: don't look at it!
+ -> CafInfo
+ -> Name -- New name
+ -> (Id, CoreExpr) -- Binder and RHS before tidying
+ -> (Id, CoreExpr)
projects / ghc-hetmet.git / blobdiff