+--------------------------------------------------------------------
+-- 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.
+
+\begin{code}
+tidyTopName :: Module -> IORef NameCache -> Maybe Id -> TidyOccEnv
+ -> Id -> IO (TidyOccEnv, Name)
+tidyTopName mod nc_var maybe_ref 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) }
+
+ | otherwise = panic "tidyTopName"
+ where
+ name = idName id
+ external = isJust maybe_ref
+ global = isExternalName name
+ local = not global
+ internal = not external
+ loc = nameSrcSpan name
+
+ old_occ = nameOccName name
+ new_occ
+ | Just ref <- maybe_ref, ref /= id =
+ mkOccName (occNameSpace old_occ) $
+ let
+ ref_str = occNameString (getOccName ref)
+ occ_str = occNameString old_occ
+ in
+ case occ_str of
+ '$':'w':_ -> occ_str
+ -- workers: the worker for a function already
+ -- includes the occname for its parent, so there's
+ -- no need to prepend the referrer.
+ _other | isSystemName name -> ref_str
+ | otherwise -> ref_str ++ '_' : occ_str
+ -- If this name was system-generated, then don't bother
+ -- to retain its OccName, just use the referrer. These
+ -- system-generated names will become "f1", "f2", etc. for
+ -- a referrer "f".
+ | otherwise = old_occ
+
+ (occ_env', occ') = tidyOccName occ_env new_occ
+
+ 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' 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 must
+ -- use the same name for externally-visible things as we did before.
+\end{code}
+