-------------------------
-tidyTopBind :: PackageId
- -> Module
- -> IORef NameCache -- For allocating new unique names
- -> ExtIdEnv
- -> TidyEnv -> CoreBind
- -> IO (TidyEnv, CoreBind)
-
-tidyTopBind this_pkg mod nc_var ext_ids (occ_env1,subst1) (NonRec bndr rhs)
- = do { (occ_env2, name') <- tidyTopName mod nc_var ext_ids occ_env1 bndr
- ; let { (bndr', rhs') = tidyTopPair ext_ids tidy_env2 caf_info name' (bndr, rhs)
- ; subst2 = extendVarEnv subst1 bndr bndr'
- ; tidy_env2 = (occ_env2, subst2) }
- ; return (tidy_env2, NonRec bndr' rhs') }
- where
- caf_info = hasCafRefs this_pkg subst1 (idArity bndr) rhs
-
-tidyTopBind this_pkg mod nc_var ext_ids (occ_env1,subst1) (Rec prs)
- = do { (occ_env2, names') <- tidyTopNames mod nc_var ext_ids occ_env1 bndrs
- ; let { prs' = zipWith (tidyTopPair ext_ids tidy_env2 caf_info)
- names' prs
- ; subst2 = extendVarEnvList subst1 (bndrs `zip` map fst prs')
- ; tidy_env2 = (occ_env2, subst2) }
- ; return (tidy_env2, Rec prs') }
+ mb_unfold_ids :: Maybe (IdSet, [Id]) -- Nothing => don't unfold
+ mb_unfold_ids = case unfoldingInfo idinfo of
+ CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src, uf_guidance = guide }
+ | show_unfolding src guide
+ -> Just (unf_ext_ids src unf_rhs)
+ DFunUnfolding _ _ ops -> Just (exprsFvsInOrder ops)
+ _ -> Nothing
+ where
+ unf_ext_ids (InlineWrapper v) _ = (unitVarSet v, [v])
+ unf_ext_ids _ unf_rhs = exprFvsInOrder unf_rhs
+ -- For a wrapper, externalise the wrapper id rather than the
+ -- fvs of the rhs. The two usually come down to the same thing
+ -- but I've seen cases where we had a wrapper id $w but a
+ -- rhs where $w had been inlined; see Trac #3922
+
+ show_unfolding unf_source unf_guidance
+ = expose_all -- 'expose_all' says to expose all
+ -- unfoldings willy-nilly
+
+ || isInlineRuleSource unf_source -- Always expose things whose
+ -- source is an inline rule
+
+ || not (bottoming_fn -- No need to inline bottom functions
+ || never_active -- Or ones that say not to
+ || loop_breaker -- Or that are loop breakers
+ || neverUnfoldGuidance unf_guidance)
+
+-- We want a deterministic free-variable list. exprFreeVars gives us
+-- a VarSet, which is in a non-deterministic order when converted to a
+-- list. Hence, here we define a free-variable finder that returns
+-- the free variables in the order that they are encountered.
+--
+-- Note [choosing external names]
+
+exprFvsInOrder :: CoreExpr -> (VarSet, [Id])
+exprFvsInOrder e = run (dffvExpr e)
+
+exprsFvsInOrder :: [CoreExpr] -> (VarSet, [Id])
+exprsFvsInOrder es = run (mapM_ dffvExpr es)
+
+run :: DFFV () -> (VarSet, [Id])
+run (DFFV m) = case m emptyVarSet [] of
+ (set,ids,_) -> (set,ids)
+
+newtype DFFV a = DFFV (VarSet -> [Var] -> (VarSet,[Var],a))
+
+instance Monad DFFV where
+ return a = DFFV $ \set ids -> (set, ids, a)
+ (DFFV m) >>= k = DFFV $ \set ids ->
+ case m set ids of
+ (set',ids',a) -> case k a of
+ DFFV f -> f set' ids'
+
+insert :: Var -> DFFV ()
+insert v = DFFV $ \ set ids -> case () of
+ _ | v `elemVarSet` set -> (set,ids,())
+ | otherwise -> (extendVarSet set v, v:ids, ())
+
+dffvExpr :: CoreExpr -> DFFV ()
+dffvExpr e = go emptyVarSet e