Commit 4c9154fa authored by Simon Marlow's avatar Simon Marlow
Browse files

Fix #4346 (INLINABLE pragma not behaving consistently)

Debugged thanks to lots of help from Simon PJ: we weren't updating the
UnfoldingGuidance when the unfolding changed.
Also, a bit of refactoring and additinoal comments.
parent 26b6eac2
......@@ -483,7 +483,20 @@ data UnfoldingSource
-- Replace uf_tmpl each time around
| InlineStable -- From an INLINE or INLINABLE pragma
-- Do not replace uf_tmpl; instead, keep it unchanged
-- INLINE if guidance is UnfWhen
-- INLINABLE if guidance is UnfIfGoodArgs
-- (well, technically an INLINABLE might be made
-- UnfWhen if it was small enough, and then
-- it will behave like INLINE outside the current
-- module, but that is the way automatic unfoldings
-- work so it is consistent with the intended
-- meaning of INLINABLE).
--
-- uf_tmpl may change, but only as a result of
-- gentle simplification, it doesn't get updated
-- to the current RHS during compilation as with
-- InlineRhs.
--
-- See Note [InlineRules]
| InlineCompulsory -- Something that *has* no binding, so you *must* inline it
......
......@@ -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
......@@ -212,10 +212,12 @@ data IfaceInfoItem
data IfaceUnfolding
= IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
-- Possibly could eliminate the Bool here, the information
-- is also in the InlinePragma.
| IfCompulsory IfaceExpr -- Only used for default methods, in fact
| IfInlineRule Arity
| IfInlineRule Arity -- INLINE pragmas
Bool -- OK to inline even if *un*-saturated
Bool -- OK to inline even if context is boring
IfaceExpr
......
......@@ -1034,7 +1034,7 @@ tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
= do { mb_expr <- tcPragExpr name if_expr
; return (case mb_expr of
Nothing -> NoUnfolding
Just expr -> mkCoreUnfolding True InlineStable expr arity
Just expr -> mkCoreUnfolding InlineStable True expr arity
(UnfWhen unsat_ok boring_ok))
}
......
......@@ -718,8 +718,17 @@ simplUnfolding env top_lvl id _ _
| isStableSource src
= do { expr' <- simplExpr rule_env expr
; let src' = CoreSubst.substUnfoldingSource (mkCoreSubst (text "inline-unf") env) src
; return (mkCoreUnfolding (isTopLevel top_lvl) src' expr' arity guide) }
is_top_lvl = isTopLevel top_lvl
; case guide of
UnfIfGoodArgs{} ->
return (mkUnfolding src' is_top_lvl (isBottomingId id) expr')
-- If the guidance is UnfIfGoodArgs, this is an INLINABLE
-- unfolding, and we need to make sure the guidance is kept up
-- to date with respect to any changes in the unfolding.
_other ->
return (mkCoreUnfolding src' is_top_lvl expr' arity guide)
-- See Note [Top-level flag on inline rules] in CoreUnfold
}
where
act = idInlineActivation id
rule_env = updMode (updModeForInlineRules act) env
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment