+ show_unfold = isJust mb_unfold_ids
+ (unfold_set, unfold_ids) = mb_unfold_ids `orElse` (emptyVarSet, [])
+
+ 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 (dfunArgExprs 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
+
+ || isStableSource 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
+ where
+ go scope e = case e of
+ Var v | isLocalId v && not (v `elemVarSet` scope) -> insert v
+ App e1 e2 -> do go scope e1; go scope e2
+ Lam v e -> go (extendVarSet scope v) e
+ Note _ e -> go scope e
+ Cast e _ -> go scope e
+ Let (NonRec x r) e -> do go scope r; go (extendVarSet scope x) e
+ Let (Rec prs) e -> do let scope' = extendVarSetList scope (map fst prs)
+ mapM_ (go scope') (map snd prs)
+ go scope' e
+ Case e b _ as -> do go scope e
+ mapM_ (go_alt (extendVarSet scope b)) as
+ _other -> return ()
+
+ go_alt scope (_,xs,r) = go (extendVarSetList scope xs) r