X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUnfold.lhs;fp=compiler%2FcoreSyn%2FCoreUnfold.lhs;h=7ab0e230e39da56e700a277bde0f581108b6e4e2;hp=18a04455fb376099c25a8f39fd7904cb11133ee0;hb=4c9154facefe185dcbb99e2bb1cfe118f02f8bd3;hpb=26b6eac2c4d9409e625c1c4fd325a76076d5cd26 diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index 18a0445..7ab0e23 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -104,20 +104,20 @@ mkDFunUnfolding dfun_ty ops mkWwInlineRule :: Id -> CoreExpr -> Arity -> Unfolding mkWwInlineRule id expr arity - = mkCoreUnfolding True (InlineWrapper id) + = mkCoreUnfolding (InlineWrapper id) True (simpleOptExpr expr) arity (UnfWhen unSaturatedOk boringCxtNotOk) mkCompulsoryUnfolding :: CoreExpr -> Unfolding mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded - = mkCoreUnfolding True InlineCompulsory + = mkCoreUnfolding InlineCompulsory True expr 0 -- Arity of unfolding doesn't matter (UnfWhen unSaturatedOk boringCxtOk) mkInlineUnfolding :: Maybe Arity -> CoreExpr -> Unfolding mkInlineUnfolding mb_arity expr - = mkCoreUnfolding True -- Note [Top-level flag on inline rules] - InlineStable + = mkCoreUnfolding InlineStable + True -- Note [Top-level flag on inline rules] expr' arity (UnfWhen unsat_ok boring_ok) where @@ -135,18 +135,19 @@ mkInlineUnfolding mb_arity expr mkInlinableUnfolding :: CoreExpr -> Unfolding mkInlinableUnfolding expr - = mkUnfolding InlineStable True is_bot expr + = mkUnfolding InlineStable True is_bot expr' where - is_bot = isJust (exprBotStrictness_maybe expr) + expr' = simpleOptExpr expr + is_bot = isJust (exprBotStrictness_maybe expr') \end{code} Internal functions \begin{code} -mkCoreUnfolding :: Bool -> UnfoldingSource -> CoreExpr +mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr -> Arity -> UnfoldingGuidance -> Unfolding -- Occurrence-analyses the expression before capturing it -mkCoreUnfolding top_lvl src expr arity guidance +mkCoreUnfolding src top_lvl expr arity guidance = CoreUnfolding { uf_tmpl = occurAnalyseExpr expr, uf_src = src, uf_arity = arity, @@ -1307,4 +1308,4 @@ Note [DFun arity check] ~~~~~~~~~~~~~~~~~~~~~~~ Here we check that the total number of supplied arguments (inclding type args) matches what the dfun is expecting. This may be *less* -than the ordinary arity of the dfun: see Note [DFun unfoldings] in CoreSyn \ No newline at end of file +than the ordinary arity of the dfun: see Note [DFun unfoldings] in CoreSyn