+ -- We also make sure to avoid any exported binders. Consider
+ -- f{-u1-} = 1 -- Local decl
+ -- ...
+ -- f{-u2-} = 2 -- Exported decl
+ --
+ -- The second exported decl must 'get' the name 'f', so we
+ -- have to put 'f' in the avoids list before we get to the first
+ -- decl. tidyTopId then does a no-op on exported binders.
+ init_occ_env = initTidyOccEnv avoids
+
+
+ search :: [(Id,Id)] -- The work-list: (external id, referrring id)
+ -- Make a tidy, external Name for the external id,
+ -- add it to the UnfoldEnv, and do the same for the
+ -- transitive closure of Ids it refers to
+ -- The referring id is used to generate a tidy
+ --- name for the external id
+ -> UnfoldEnv -- id -> (new Name, show_unfold)
+ -> TidyOccEnv -- occ env for choosing new Names
+ -> IO (UnfoldEnv, TidyOccEnv)
+
+ search [] unfold_env occ_env = return (unfold_env, occ_env)
+
+ search ((idocc,referrer) : rest) unfold_env occ_env
+ | idocc `elemVarEnv` unfold_env = search rest unfold_env occ_env
+ | otherwise = do
+ (occ_env', name') <- tidyTopName mod nc_var (Just referrer) occ_env idocc
+ let
+ (new_ids, show_unfold)
+ | omit_prags = ([], False)
+ | otherwise = addExternal expose_all refined_id
+
+ -- 'idocc' is an *occurrence*, but we need to see the
+ -- unfolding in the *definition*; so look up in binder_set
+ refined_id = case lookupVarSet binder_set idocc of
+ Just id -> id
+ Nothing -> WARN( True, ppr idocc ) idocc
+
+ unfold_env' = extendVarEnv unfold_env idocc (name',show_unfold)
+ referrer' | isExportedId refined_id = refined_id
+ | otherwise = referrer
+ --
+ search (zip new_ids (repeat referrer') ++ rest) unfold_env' occ_env'
+
+ tidy_internal :: [Id] -> UnfoldEnv -> TidyOccEnv
+ -> IO (UnfoldEnv, TidyOccEnv)
+ tidy_internal [] unfold_env occ_env = return (unfold_env,occ_env)
+ tidy_internal (id:ids) unfold_env occ_env = do
+ (occ_env', name') <- tidyTopName mod nc_var Nothing occ_env id
+ let unfold_env' = extendVarEnv unfold_env id (name',False)
+ tidy_internal ids unfold_env' occ_env'
+
+addExternal :: Bool -> Id -> ([Id],Bool)
+addExternal expose_all id = (new_needed_ids, show_unfold)
+ where
+ new_needed_ids = unfold_ids ++
+ filter (\id -> isLocalId id &&
+ not (id `elemVarSet` unfold_set))
+ (varSetElems spec_ids) -- XXX non-det ordering