Commit ca380cd1 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Recover proper sharing for Integer literals

Trac #5549 showed a loss of performance for GHC 7.4.
What was happening was that an integer literal was being
allocated each time around a loop, rather than being
floated to top level and shared.

Two fixes
 * Make the float-out pass float literals that are non-trivial
 * Make the inliner *not* treat Integer literals as size-zero
parent 2ad79aaa
......@@ -23,6 +23,7 @@ module Literal
, literalType
, hashLiteral
, absentLiteralOf
, pprLiteral
-- ** Predicates on Literals and their contents
, litIsDupable, litIsTrivial
......@@ -199,7 +200,7 @@ instance Binary Literal where
\begin{code}
instance Outputable Literal where
ppr lit = pprLit lit
ppr lit = pprLiteral (\d -> d) lit
instance Show Literal where
showsPrec p lit = showsPrecSDoc p (ppr lit)
......@@ -437,21 +438,24 @@ litTag (LitInteger {}) = _ILIT(11)
exceptions: MachFloat gets an initial keyword prefix.
\begin{code}
pprLit :: Literal -> SDoc
pprLit (MachChar ch) = pprHsChar ch
pprLit (MachStr s) = pprHsString s
pprLit (MachInt i) = pprIntVal i
pprLit (MachInt64 i) = ptext (sLit "__int64") <+> integer i
pprLit (MachWord w) = ptext (sLit "__word") <+> integer w
pprLit (MachWord64 w) = ptext (sLit "__word64") <+> integer w
pprLit (MachFloat f) = ptext (sLit "__float") <+> float (fromRat f)
pprLit (MachDouble d) = double (fromRat d)
pprLit (MachNullAddr) = ptext (sLit "__NULL")
pprLit (MachLabel l mb fod) = ptext (sLit "__label") <+> b <+> ppr fod
pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
-- The function is used on non-atomic literals
-- to wrap parens around literals that occur in
-- a context requiring an atomic thing
pprLiteral _ (MachChar ch) = pprHsChar ch
pprLiteral _ (MachStr s) = pprHsString s
pprLiteral _ (MachInt i) = pprIntVal i
pprLiteral _ (MachDouble d) = double (fromRat d)
pprLiteral _ (MachNullAddr) = ptext (sLit "__NULL")
pprLiteral add_par (LitInteger i _) = add_par (ptext (sLit "__integer") <+> integer i)
pprLiteral add_par (MachInt64 i) = add_par (ptext (sLit "__int64") <+> integer i)
pprLiteral add_par (MachWord w) = add_par (ptext (sLit "__word") <+> integer w)
pprLiteral add_par (MachWord64 w) = add_par (ptext (sLit "__word64") <+> integer w)
pprLiteral add_par (MachFloat f) = add_par (ptext (sLit "__float") <+> float (fromRat f))
pprLiteral add_par (MachLabel l mb fod) = add_par (ptext (sLit "__label") <+> b <+> ppr fod)
where b = case mb of
Nothing -> pprHsString l
Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
pprLit (LitInteger i _) = ptext (sLit "__integer") <+> integer i
pprIntVal :: Integer -> SDoc
-- ^ Print negative integers with parens to be sure it's unambiguous
......
......@@ -491,7 +491,8 @@ sizeExpr bOMB_OUT_SIZE top_args expr
-- | Finds a nominal size of a string literal.
litSize :: Literal -> Int
-- Used by CoreUnfold.sizeExpr
litSize (MachStr str) = 10 + 10 * ((lengthFS str + 3) `div` 4)
litSize (LitInteger {}) = 100 -- Note [Size of literal integers]
litSize (MachStr str) = 10 + 10 * ((lengthFS str + 3) `div` 4)
-- If size could be 0 then @f "x"@ might be too small
-- [Sept03: make literal strings a bit bigger to avoid fruitless
-- duplication of little strings]
......@@ -556,6 +557,17 @@ conSize dc n_val_args
-- [SDM, 25/5/11]
\end{code}
Note [Literal integer size]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Literal integers *can* be big (mkInteger [...coefficients...]), but
need not be (S# n). We just use an aribitrary big-ish constant here
so that, in particular, we don't inline top-level defns like
n = S# 5
There's no point in doing so -- any optimsations will see the S#
through n's unfolding. Nor will a big size inhibit unfoldings functions
that mention a literal Integer, because the float-out pass will float
all those constants to top level.
Note [Constructor size]
~~~~~~~~~~~~~~~~~~~~~~~
Treat a constructors application as size 1, regardless of how many
......
......@@ -14,6 +14,7 @@ module PprCore (
import CoreSyn
import CostCentre
import Literal( pprLiteral )
import Var
import Id
import IdInfo
......@@ -94,8 +95,8 @@ ppr_binding (val_bdr, expr)
\end{code}
\begin{code}
pprParendExpr expr = ppr_expr parens expr
pprCoreExpr expr = ppr_expr noParens expr
pprParendExpr expr = ppr_expr parens expr
pprCoreExpr expr = ppr_expr noParens expr
noParens :: SDoc -> SDoc
noParens pp = pp
......@@ -106,12 +107,10 @@ ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
-- The function adds parens in context that need
-- an atomic value (e.g. function args)
ppr_expr add_par (Type ty) = add_par (ptext (sLit "TYPE") <+> ppr ty) -- Wierd
ppr_expr _ (Var name) = ppr name
ppr_expr add_par (Type ty) = add_par (ptext (sLit "TYPE") <+> ppr ty) -- Wierd
ppr_expr add_par (Coercion co) = add_par (ptext (sLit "CO") <+> ppr co)
ppr_expr _ (Var name) = ppr name
ppr_expr _ (Lit lit) = ppr lit
ppr_expr add_par (Lit lit) = pprLiteral add_par lit
ppr_expr add_par (Cast expr co)
= add_par $
......
......@@ -67,6 +67,7 @@ import IdInfo
import Var
import VarSet
import VarEnv
import Literal ( litIsTrivial )
import Demand ( StrictSig, increaseStrictSigArity )
import Name ( getOccName, mkSystemVarName )
import OccName ( occNameString )
......@@ -569,7 +570,8 @@ notWorthFloating e abs_vars
= go e (count isId abs_vars)
where
go (_, AnnVar {}) n = n >= 0
go (_, AnnLit {}) n = n >= 0
go (_, AnnLit lit) n = ASSERT( n==0 )
litIsTrivial lit -- Note [Floating literals]
go (_, AnnCast e _) n = go e n
go (_, AnnApp e arg) n
| (_, AnnType {}) <- arg = go e n
......@@ -587,6 +589,16 @@ notWorthFloating e abs_vars
is_triv _ = False
\end{code}
Note [Floating literals]
~~~~~~~~~~~~~~~~~~~~~~~~
It's important to float Integer literals, so that they get shared,
rather than being allocated every time round the loop.
Hence the litIsTrivial.
We'd *like* to share MachStr literal strings too, mainly so we could
CSE them, but alas can't do so directly because they are unlifted.
Note [Escaping a value lambda]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We want to float even cheap expressions out of value lambdas,
......
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