+
+ -- The rhs is already tidied
+
+ = ((us_r, orig_env', occ_env', subst_env'), id')
+ where
+ (us_l, us_r) = splitUniqSupply us
+
+ (orig_env', occ_env', name') = tidyTopName mod orig_env2 occ_env2
+ is_external
+ (idName id)
+ ty' = tidyTopType (idType id)
+ idinfo' = tidyIdInfo us_l tidy_env
+ is_external unfold_info arity_info caf_info id
+
+ id' = mkId name' ty' idinfo'
+ subst_env' = extendVarEnv subst_env2 id id'
+
+ maybe_external = lookupVarEnv ext_ids id
+ is_external = maybeToBool maybe_external
+
+ -- Expose an unfolding if ext_ids tells us to
+ show_unfold = maybe_external `orElse` False
+ unfold_info | show_unfold = mkTopUnfolding rhs
+ | otherwise = noUnfolding
+
+ arity_info = exprArity rhs
+
+
+tidyIdInfo us tidy_env is_external unfold_info arity_info caf_info id
+ | opt_OmitInterfacePragmas || not is_external
+ -- No IdInfo if the Id isn't external, or if we don't have -O
+ = mkIdInfo new_flavour caf_info
+ `setStrictnessInfo` strictnessInfo core_idinfo
+ `setArityInfo` ArityExactly arity_info
+ -- Keep strictness, arity and CAF info; it's used by the code generator
+
+ | otherwise
+ = let (rules', _) = initUs us (tidyRules tidy_env (specInfo core_idinfo))
+ in
+ mkIdInfo new_flavour caf_info
+ `setCprInfo` cprInfo core_idinfo
+ `setStrictnessInfo` strictnessInfo core_idinfo
+ `setInlinePragInfo` inlinePragInfo core_idinfo
+ `setUnfoldingInfo` unfold_info
+ `setWorkerInfo` tidyWorker tidy_env arity_info (workerInfo core_idinfo)
+ `setSpecInfo` rules'
+ `setArityInfo` ArityExactly arity_info
+ -- this is the final IdInfo, it must agree with the
+ -- code finally generated (i.e. NO more transformations
+ -- after this!).
+ where
+ core_idinfo = idInfo id
+
+ -- A DFunId must stay a DFunId, so that we can gather the
+ -- DFunIds up later. Other local things become ConstantIds.
+ new_flavour = case flavourInfo core_idinfo of
+ VanillaId -> ConstantId
+ ExportedId -> ConstantId
+ ConstantId -> ConstantId -- e.g. Default methods
+ DictFunId -> DictFunId
+ flavour -> pprTrace "tidyIdInfo" (ppr id <+> ppFlavourInfo flavour)
+ flavour
+
+
+-- 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 globalise it.
+tidyTopName mod orig_env occ_env external name
+ | global && internal = (orig_env, occ_env, localiseName name)
+
+ | local && internal = (orig_env, occ_env', setNameOcc name occ')
+ -- Even local, internal names must get a unique occurrence, because
+ -- if we do -split-objs we globalise the name later, n the code generator
+
+ | global && external = (orig_env, occ_env, name)
+ -- Global names are assumed to have been allocated by the renamer,
+ -- so they already have the "right" unique
+
+ | local && external = case lookupFM orig_env key of
+ Just orig -> (orig_env, occ_env', orig)
+ Nothing -> (addToFM orig_env key global_name, occ_env', global_name)
+ -- If we want to globalise a currently-local name, check
+ -- whether we have already assigned a unique for it.
+ -- If so, use it; if not, extend the table
+
+ where
+ (occ_env', occ') = tidyOccName occ_env (nameOccName name)
+ key = (moduleName mod, occ')
+ global_name = globaliseName (setNameOcc name occ') mod
+ global = isGlobalName name
+ local = not global
+ internal = not external
+
+------------ Worker --------------
+-- We only treat a function as having a worker if
+-- the exported arity (which is now the number of visible lambdas)
+-- is the same as the arity at the moment of the w/w split
+-- If so, we can safely omit the unfolding inside the wrapper, and
+-- instead re-generate it from the type/arity/strictness info
+-- But if the arity has changed, we just take the simple path and
+-- put the unfolding into the interface file, forgetting the fact
+-- that it's a wrapper.
+--
+-- How can this happen? Sometimes we get
+-- f = coerce t (\x y -> $wf x y)
+-- at the moment of w/w split; but the eta reducer turns it into
+-- f = coerce t $wf
+-- which is perfectly fine except that the exposed arity so far as
+-- the code generator is concerned (zero) differs from the arity
+-- when we did the split (2).
+--
+-- All this arises because we use 'arity' to mean "exactly how many
+-- top level lambdas are there" in interface files; but during the
+-- compilation of this module it means "how many things can I apply
+-- this to".
+tidyWorker tidy_env real_arity (HasWorker work_id wrap_arity)
+ | real_arity == wrap_arity
+ = HasWorker (tidyVarOcc tidy_env work_id) wrap_arity
+tidyWorker tidy_env real_arity other
+ = NoWorker
+
+------------ Rules --------------
+tidyIdRules :: TidyEnv -> [IdCoreRule] -> UniqSM [IdCoreRule]
+tidyIdRules env [] = returnUs []
+tidyIdRules env ((fn,rule) : rules)
+ = tidyRule env rule `thenUs` \ rule ->
+ tidyIdRules env rules `thenUs` \ rules ->
+ returnUs ((tidyVarOcc env fn, rule) : rules)
+
+tidyRules :: TidyEnv -> CoreRules -> UniqSM CoreRules
+tidyRules env (Rules rules fvs)
+ = mapUs (tidyRule env) rules `thenUs` \ rules ->
+ returnUs (Rules rules (foldVarSet tidy_set_elem emptyVarSet fvs))
+ where
+ tidy_set_elem var new_set = extendVarSet new_set (tidyVarOcc env var)
+
+tidyRule :: TidyEnv -> CoreRule -> UniqSM CoreRule
+tidyRule env rule@(BuiltinRule _) = returnUs rule
+tidyRule env (Rule name vars tpl_args rhs)
+ = tidyBndrs env vars `thenUs` \ (env', vars) ->
+ mapUs (tidyExpr env') tpl_args `thenUs` \ tpl_args ->
+ tidyExpr env' rhs `thenUs` \ rhs ->
+ returnUs (Rule name vars tpl_args rhs)