Commit f5c94708 authored by apt's avatar apt
Browse files

[project @ 2001-07-19 15:32:05 by apt]

reinstate inlinings that are completely within an INLINE
parent 8fd92abe
...@@ -49,7 +49,8 @@ module SimplMonad ( ...@@ -49,7 +49,8 @@ module SimplMonad (
#include "HsVersions.h" #include "HsVersions.h"
import Id ( Id, mkSysLocal, idType, idUnfolding, isDataConWrapId ) import Id ( Id, mkSysLocal, idType, idUnfolding, isDataConWrapId,
isGlobalId )
import CoreSyn import CoreSyn
import CoreUnfold ( isCompulsoryUnfolding ) import CoreUnfold ( isCompulsoryUnfolding )
import CoreUtils ( exprOkForSpeculation ) import CoreUtils ( exprOkForSpeculation )
...@@ -61,7 +62,8 @@ import VarSet ...@@ -61,7 +62,8 @@ import VarSet
import OrdList import OrdList
import qualified Subst import qualified Subst
import Subst ( Subst, mkSubst, substEnv, import Subst ( Subst, mkSubst, substEnv,
InScopeSet, mkInScopeSet, substInScope InScopeSet, mkInScopeSet, substInScope,
isInScope
) )
import Type ( Type, isUnLiftedType ) import Type ( Type, isUnLiftedType )
import UniqSupply ( uniqsFromSupply, uniqFromSupply, splitUniqSupply, import UniqSupply ( uniqsFromSupply, uniqFromSupply, splitUniqSupply,
...@@ -629,18 +631,21 @@ setBlackList black_list m dflags env us sc ...@@ -629,18 +631,21 @@ setBlackList black_list m dflags env us sc
getBlackList :: SimplM BlackList getBlackList :: SimplM BlackList
getBlackList dflags env us sc = (seBlackList env, us, sc) getBlackList dflags env us sc = (seBlackList env, us, sc)
noInlineBlackList :: BlackList noInlineBlackList :: SimplM BlackList
-- Inside inlinings, black list anything that is in scope or imported. -- Inside inlinings, black list anything that is in scope or imported.
-- except for things that must be unfolded (Compulsory) -- except for things that must be unfolded (Compulsory)
-- and data con wrappers. The latter is a hack, like the one in -- and data con wrappers. The latter is a hack, like the one in
-- SimplCore.simplRules, to make wrappers inline in rule LHSs. -- SimplCore.simplRules, to make wrappers inline in rule LHSs.
-- We may as well do the same here. -- We may as well do the same here.
noInlineBlackList v = not (isCompulsoryUnfolding (idUnfolding v)) && noInlineBlackList dflags env us sc = (blacklisted,us,sc)
not (isDataConWrapId v) where blacklisted v =
-- NB: this implementation means that even inlinings *completely within* not (isCompulsoryUnfolding (idUnfolding v)) &&
-- an INLINE won't happen, which is perhaps overkill. not (isDataConWrapId v) &&
-- An earlier verion had: (v `isInScope` subst) || not (isLocallyDefined v) (v `isInScope` (seSubst env) || isGlobalId v)
-- but it's more expensive, and it probably doesn't matter. -- NB: An earlier version omitted the last clause; this meant
-- that even inlinings *completely within* an INLINE didn't happen.
-- This was cheaper, and probably adequate, but produced awful code
-- for some dictionary constructions.
\end{code} \end{code}
......
...@@ -429,7 +429,8 @@ simplNote InlineCall e cont ...@@ -429,7 +429,8 @@ simplNote InlineCall e cont
simplNote InlineMe e cont simplNote InlineMe e cont
| keep_inline cont -- Totally boring continuation | keep_inline cont -- Totally boring continuation
= -- Don't inline inside an INLINE expression = -- Don't inline inside an INLINE expression
setBlackList noInlineBlackList (simplExpr e) `thenSmpl` \ e' -> noInlineBlackList `thenSmpl` \ bl ->
setBlackList bl (simplExpr e) `thenSmpl` \ e' ->
rebuild (mkInlineMe e') cont rebuild (mkInlineMe e') cont
| otherwise -- Dissolve the InlineMe note if there's | otherwise -- Dissolve the InlineMe note if there's
...@@ -947,7 +948,8 @@ simplifyArgs is_data_con args cont_ty thing_inside ...@@ -947,7 +948,8 @@ simplifyArgs is_data_con args cont_ty thing_inside
-- Even though x get's an occurrence of 'many', its RHS looks cheap, -- Even though x get's an occurrence of 'many', its RHS looks cheap,
-- and there's a good chance it'll get inlined back into C's RHS. Urgh! -- and there's a good chance it'll get inlined back into C's RHS. Urgh!
= getBlackList `thenSmpl` \ old_bl -> = getBlackList `thenSmpl` \ old_bl ->
setBlackList noInlineBlackList $ noInlineBlackList `thenSmpl` \ ni_bl ->
setBlackList ni_bl $
go args $ \ args' -> go args $ \ args' ->
setBlackList old_bl $ setBlackList old_bl $
thing_inside args' thing_inside args'
......
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