From a7dff32d3a8c10c9bd2081f441285ed31a01d2c1 Mon Sep 17 00:00:00 2001 From: simonpj Date: Mon, 19 Mar 2001 16:22:51 +0000 Subject: [PATCH] [project @ 2001-03-19 16:22:51 by simonpj] ------------------------------------------------------- Be more careful about floating out from INLINE pragmas ------------------------------------------------------- Given this: x = __inline__ (f (g y)) we were floating the (g y) out as a MFE, thus: lvl = g y x = __inline__ (f lvl) This is bad. The (g y) redex gets outside the __inline__ envelope, and may never get inlined. The solution involved a bit of fiddling in SetLevels. --- ghc/compiler/simplCore/SetLevels.lhs | 53 +++++++++++++++++++++++++++------- 1 file changed, 43 insertions(+), 10 deletions(-) diff --git a/ghc/compiler/simplCore/SetLevels.lhs b/ghc/compiler/simplCore/SetLevels.lhs index 0d2ece8..e128eea 100644 --- a/ghc/compiler/simplCore/SetLevels.lhs +++ b/ghc/compiler/simplCore/SetLevels.lhs @@ -80,7 +80,9 @@ import Outputable %************************************************************************ \begin{code} -data Level = Level Int -- Level number of enclosing lambdas +data Level = InlineCtxt -- A level that's used only for + -- the context parameter ctxt_lvl + | Level Int -- Level number of enclosing lambdas Int -- Number of big-lambda and/or case expressions between -- here and the nearest enclosing lambda \end{code} @@ -105,45 +107,69 @@ The main function @lvlExpr@ carries a ``context level'' (@ctxt_lvl@). That's meant to be the level number of the enclosing binder in the final (floated) program. If the level number of a sub-expression is less than that of the context, then it might be worth let-binding the -sub-expression so that it will indeed float. This context level starts -at @Level 0 0@. +sub-expression so that it will indeed float. + +If you can float to level @Level 0 0@ worth doing so because then your +allocation becomes static instead of dynamic. We always start with +context @Level 0 0@. @InlineCtxt@ very similar to @Level 0 0@, but is +used for one purpose: to say "don't float anything out of here". +That's exactly what we want for the body of an INLINE, where we don't +want to float anything out at all. See notes with lvlMFE below. + \begin{code} type LevelledExpr = TaggedExpr Level type LevelledBind = TaggedBind Level -tOP_LEVEL = Level 0 0 +tOP_LEVEL = Level 0 0 +iNLINE_CTXT = InlineCtxt incMajorLvl :: Level -> Level +incMajorLvl InlineCtxt = Level 1 0 incMajorLvl (Level major minor) = Level (major+1) 0 incMinorLvl :: Level -> Level +incMinorLvl InlineCtxt = Level 0 1 incMinorLvl (Level major minor) = Level major (minor+1) maxLvl :: Level -> Level -> Level +maxLvl InlineCtxt l2 = l2 +maxLvl l1 InlineCtxt = l1 maxLvl l1@(Level maj1 min1) l2@(Level maj2 min2) | (maj1 > maj2) || (maj1 == maj2 && min1 > min2) = l1 | otherwise = l2 ltLvl :: Level -> Level -> Bool +ltLvl any_lvl InlineCtxt = False +ltLvl InlineCtxt (Level _ _) = True ltLvl (Level maj1 min1) (Level maj2 min2) = (maj1 < maj2) || (maj1 == maj2 && min1 < min2) ltMajLvl :: Level -> Level -> Bool -- Tells if one level belongs to a difft *lambda* level to another +ltMajLvl any_lvl InlineCtxt = False +ltMajLvl InlineCtxt (Level maj2 _) = 0 < maj2 ltMajLvl (Level maj1 _) (Level maj2 _) = maj1 < maj2 isTopLvl :: Level -> Bool isTopLvl (Level 0 0) = True -isTopLvl other = False +isTopLvl other = False + +isInlineCtxt :: Level -> Bool +isInlineCtxt InlineCtxt = True +isInlineCtxt other = False instance Outputable Level where + ppr InlineCtxt = text "" ppr (Level maj min) = hcat [ char '<', int maj, char ',', int min, char '>' ] instance Eq Level where + InlineCtxt == InlineCtxt = True (Level maj1 min1) == (Level maj2 min2) = maj1==maj2 && min1==min2 + l1 == l2 = False \end{code} + %************************************************************************ %* * \subsection{Main level-setting code} @@ -224,8 +250,8 @@ lvlExpr ctxt_lvl env (_, AnnApp fun arg) -- but we do if the function is big and hairy, like a case lvlExpr ctxt_lvl env (_, AnnNote InlineMe expr) --- Don't float anything out of an InlineMe; hence the tOP_LEVEL - = lvlExpr tOP_LEVEL env expr `thenLvl` \ expr' -> +-- Don't float anything out of an InlineMe; hence the iNLINE_CTXT + = lvlExpr iNLINE_CTXT env expr `thenLvl` \ expr' -> returnLvl (Note InlineMe expr') lvlExpr ctxt_lvl env (_, AnnNote note expr) @@ -319,11 +345,18 @@ lvlMFE strict_ctxt ctxt_lvl env ann_expr@(fvs, _) dest_lvl = destLevel env fvs (isFunction ann_expr) abs_vars = abstractVars dest_lvl env fvs - good_destination = dest_lvl `ltMajLvl` ctxt_lvl -- Escapes a value lambda - || (isTopLvl dest_lvl && not strict_ctxt) -- Goes to the top + good_destination = dest_lvl `ltMajLvl` ctxt_lvl -- Escapes a value lambda + || (isTopLvl dest_lvl -- Goes to the top + && not (isInlineCtxt ctxt_lvl) -- Don't float out of an __inline__ context + && not strict_ctxt) -- or from a strict context -- A decision to float entails let-binding this thing, and we only do -- that if we'll escape a value lambda, or will go to the top level. - -- But beware + -- But beware (a): + -- x = __inline__ (f (g y)) + -- Here we don't want to float the (g y); otherwise it'll get outside the + -- __inline__ envelope, and may never get inlined + -- + -- Also beware (b): -- concat = /\ a -> foldr ..a.. (++) [] -- was getting turned into -- concat = /\ a -> lvl a -- 1.7.10.4