-toIfUnfolding :: Unfolding -> Maybe IfaceInfoItem
-toIfUnfolding (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity, uf_guidance = guidance })
- = case guidance of
- InlineRule { ir_info = InlWrapper w } -> Just (HsUnfold (IfWrapper arity (idName w)))
- InlineRule { ir_sat = InlSat } -> Just (HsUnfold (IfInlineRule arity True (toIfaceExpr rhs)))
- InlineRule { ir_sat = InlUnSat } -> Just (HsUnfold (IfInlineRule arity False (toIfaceExpr rhs)))
- UnfoldNever -> Nothing
- UnfoldIfGoodArgs {} -> Just (HsUnfold (IfCoreUnfold (toIfaceExpr rhs)))
-
-toIfUnfolding (DFunUnfolding _con ops)
- = Just (HsUnfold (IfDFunUnfold (map toIfaceExpr ops)))
+toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
+toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
+ , uf_src = src, uf_guidance = guidance })
+ = Just $ HsUnfold lb $
+ case src of
+ InlineStable
+ -> case guidance of
+ UnfWhen unsat_ok boring_ok -> IfInlineRule arity unsat_ok boring_ok if_rhs
+ _other -> IfCoreUnfold True if_rhs
+ InlineWrapper w | isExternalName n -> IfExtWrapper arity n
+ | otherwise -> IfLclWrapper arity (getFS n)
+ where
+ n = idName w
+ InlineCompulsory -> IfCompulsory if_rhs
+ InlineRhs -> IfCoreUnfold False if_rhs
+ -- Yes, even if guidance is UnfNever, expose the unfolding
+ -- If we didn't want to expose the unfolding, TidyPgm would
+ -- have stuck in NoUnfolding. For supercompilation we want
+ -- to see that unfolding!
+ where
+ if_rhs = toIfaceExpr rhs
+
+toIfUnfolding lb (DFunUnfolding _ar _con ops)
+ = Just (HsUnfold lb (IfDFunUnfold (map (fmap toIfaceExpr) ops)))