Commit 72462499 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

The Big INLINE Patch: totally reorganise way that INLINE pragmas work

This patch has been a long time in gestation and has, as a
result, accumulated some extra bits and bobs that are only
loosely related.  I separated the bits that are easy to split
off, but the rest comes as one big patch, I'm afraid.

Note that:
 * It comes together with a patch to the 'base' library
 * Interface file formats change slightly, so you need to
   recompile all libraries

The patch is mainly giant tidy-up, driven in part by the
particular stresses of the Data Parallel Haskell project. I don't
expect a big performance win for random programs.  Still, here are the
nofib results, relative to the state of affairs without the patch

        Program           Size    Allocs   Runtime   Elapsed
--------------------------------------------------------------------------------
            Min         -12.7%    -14.5%    -17.5%    -17.8%
            Max          +4.7%    +10.9%     +9.1%     +8.4%
 Geometric Mean          +0.9%     -0.1%     -5.6%     -7.3%

The +10.9% allocation outlier is rewrite, which happens to have a
very delicate optimisation opportunity involving an interaction
of CSE and inlining (see nofib/Simon-nofib-notes). The fact that
the 'before' case found the optimisation is somewhat accidental.
Runtimes seem to go down, but I never kno wwhether to really trust
this number.  Binary sizes wobble a bit, but nothing drastic.


The Main Ideas are as follows.

InlineRules
~~~~~~~~~~~
When you say 
      {-# INLINE f #-}
      f x = <rhs>
you intend that calls (f e) are replaced by <rhs>[e/x] So we
should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
with it.  Meanwhile, we can optimise <rhs> to our heart's content,
leaving the original unfolding intact in Unfolding of 'f'.

So the representation of an Unfolding has changed quite a bit
(see CoreSyn).  An INLINE pragma gives rise to an InlineRule 
unfolding.  

Moreover, it's only used when 'f' is applied to the
specified number of arguments; that is, the number of argument on 
the LHS of the '=' sign in the original source definition. 
For example, (.) is now defined in the libraries like this
   {-# INLINE (.) #-}
   (.) f g = \x -> f (g x)
so that it'll inline when applied to two arguments. If 'x' appeared
on the left, thus
   (.) f g x = f (g x)
it'd only inline when applied to three arguments.  This slightly-experimental
change was requested by Roman, but it seems to make sense.

Other associated changes

* Moving the deck chairs in DsBinds, which processes the INLINE pragmas

* In the old system an INLINE pragma made the RHS look like
   (Note InlineMe <rhs>)
  The Note switched off optimisation in <rhs>.  But it was quite
  fragile in corner cases. The new system is more robust, I believe.
  In any case, the InlineMe note has disappeared 

* The workerInfo of an Id has also been combined into its Unfolding,
  so it's no longer a separate field of the IdInfo.

* Many changes in CoreUnfold, esp in callSiteInline, which is the critical
  function that decides which function to inline.  Lots of comments added!

* exprIsConApp_maybe has moved to CoreUnfold, since it's so strongly
  associated with "does this expression unfold to a constructor application".
  It can now do some limited beta reduction too, which Roman found 
  was an important.

Instance declarations
~~~~~~~~~~~~~~~~~~~~~
It's always been tricky to get the dfuns generated from instance
declarations to work out well.  This is particularly important in 
the Data Parallel Haskell project, and I'm now on my fourth attempt,
more or less.

There is a detailed description in TcInstDcls, particularly in
Note [How instance declarations are translated].   Roughly speaking
we now generate a top-level helper function for every method definition
in an instance declaration, so that the dfun takes a particularly
stylised form:
  dfun a d1 d2 = MkD (op1 a d1 d2) (op2 a d1 d2) ...etc...

In fact, it's *so* stylised that we never need to unfold a dfun.
Instead ClassOps have a special rewrite rule that allows us to
short-cut dictionary selection.  Suppose dfun :: Ord a -> Ord [a]
                                            d :: Ord a
Then   
    compare (dfun a d)  -->   compare_list a d 
in one rewrite, without first inlining the 'compare' selector
and the body of the dfun.

To support this
a) ClassOps have a BuiltInRule (see MkId.dictSelRule)
b) DFuns have a special form of unfolding (CoreSyn.DFunUnfolding)
   which is exploited in CoreUnfold.exprIsConApp_maybe

Implmenting all this required a root-and-branch rework of TcInstDcls
and bits of TcClassDcl.


Default methods
~~~~~~~~~~~~~~~
If you give an INLINE pragma to a default method, it should be just
as if you'd written out that code in each instance declaration, including
the INLINE pragma.  I think that it now *is* so.  As a result, library
code can be simpler; less duplication.


The CONLIKE pragma
~~~~~~~~~~~~~~~~~~
In the DPH project, Roman found cases where he had

   p n k = let x = replicate n k
           in ...(f x)...(g x)....

   {-# RULE f (replicate x) = f_rep x #-}

Normally the RULE would not fire, because doing so involves 
(in effect) duplicating the redex (replicate n k).  A new
experimental modifier to the INLINE pragma, {-# INLINE CONLIKE
replicate #-}, allows you to tell GHC to be prepared to duplicate
a call of this function if it allows a RULE to fire.

See Note [CONLIKE pragma] in BasicTypes


Join points
~~~~~~~~~~~
See Note [Case binders and join points] in Simplify


Other refactoring
~~~~~~~~~~~~~~~~~
* I moved endPass from CoreLint to CoreMonad, with associated jigglings

* Better pretty-printing of Core

* The top-level RULES (ones that are not rules for locally-defined things)
  are now substituted on every simplifier iteration.  I'm not sure how
  we got away without doing this before.  This entails a bit more plumbing
  in SimplCore.

* The necessary stuff to serialise and deserialise the new
  info across interface files.

* Something about bottoming floats in SetLevels
      Note [Bottoming floats]

* substUnfolding has moved from SimplEnv to CoreSubs, where it belongs


--------------------------------------------------------------------------------
        Program           Size    Allocs   Runtime   Elapsed
--------------------------------------------------------------------------------
           anna          +2.4%     -0.5%      0.16      0.17
           ansi          +2.6%     -0.1%      0.00      0.00
           atom          -3.8%     -0.0%     -1.0%     -2.5%
         awards          +3.0%     +0.7%      0.00      0.00
         banner          +3.3%     -0.0%      0.00      0.00
     bernouilli          +2.7%     +0.0%     -4.6%     -6.9%
          boyer          +2.6%     +0.0%      0.06      0.07
         boyer2          +4.4%     +0.2%      0.01      0.01
           bspt          +3.2%     +9.6%      0.02      0.02
      cacheprof          +1.4%     -1.0%    -12.2%    -13.6%
       calendar          +2.7%     -1.7%      0.00      0.00
       cichelli          +3.7%     -0.0%      0.13      0.14
        circsim          +3.3%     +0.0%     -2.3%     -9.9%
       clausify          +2.7%     +0.0%      0.05      0.06
  comp_lab_zift          +2.6%     -0.3%     -7.2%     -7.9%
       compress          +3.3%     +0.0%     -8.5%     -9.6%
      compress2          +3.6%     +0.0%    -15.1%    -17.8%
    constraints          +2.7%     -0.6%    -10.0%    -10.7%
   cryptarithm1          +4.5%     +0.0%     -4.7%     -5.7%
   cryptarithm2          +4.3%    -14.5%      0.02      0.02
            cse          +4.4%     -0.0%      0.00      0.00
          eliza          +2.8%     -0.1%      0.00      0.00
          event          +2.6%     -0.0%     -4.9%     -4.4%
         exp3_8          +2.8%     +0.0%     -4.5%     -9.5%
         expert          +2.7%     +0.3%      0.00      0.00
            fem          -2.0%     +0.6%      0.04      0.04
            fft          -6.0%     +1.8%      0.05      0.06
           fft2          -4.8%     +2.7%      0.13      0.14
       fibheaps          +2.6%     -0.6%      0.05      0.05
           fish          +4.1%     +0.0%      0.03      0.04
          fluid          -2.1%     -0.2%      0.01      0.01
         fulsom          -4.8%     +9.2%     +9.1%     +8.4%
         gamteb          -7.1%     -1.3%      0.10      0.11
            gcd          +2.7%     +0.0%      0.05      0.05
    gen_regexps          +3.9%     -0.0%      0.00      0.00
         genfft          +2.7%     -0.1%      0.05      0.06
             gg          -2.7%     -0.1%      0.02      0.02
           grep          +3.2%     -0.0%      0.00      0.00
         hidden          -0.5%     +0.0%    -11.9%    -13.3%
            hpg          -3.0%     -1.8%     +0.0%     -2.4%
            ida          +2.6%     -1.2%      0.17     -9.0%
          infer          +1.7%     -0.8%      0.08      0.09
        integer          +2.5%     -0.0%     -2.6%     -2.2%
      integrate          -5.0%     +0.0%     -1.3%     -2.9%
        knights          +4.3%     -1.5%      0.01      0.01
           lcss          +2.5%     -0.1%     -7.5%     -9.4%
           life          +4.2%     +0.0%     -3.1%     -3.3%
           lift          +2.4%     -3.2%      0.00      0.00
      listcompr          +4.0%     -1.6%      0.16      0.17
       listcopy          +4.0%     -1.4%      0.17      0.18
       maillist          +4.1%     +0.1%      0.09      0.14
         mandel          +2.9%     +0.0%      0.11      0.12
        mandel2          +4.7%     +0.0%      0.01      0.01
        minimax          +3.8%     -0.0%      0.00      0.00
        mkhprog          +3.2%     -4.2%      0.00      0.00
     multiplier          +2.5%     -0.4%     +0.7%     -1.3%
       nucleic2          -9.3%     +0.0%      0.10      0.10
           para          +2.9%     +0.1%     -0.7%     -1.2%
      paraffins         -10.4%     +0.0%      0.20     -1.9%
         parser          +3.1%     -0.0%      0.05      0.05
        parstof          +1.9%     -0.0%      0.00      0.01
            pic          -2.8%     -0.8%      0.01      0.02
          power          +2.1%     +0.1%     -8.5%     -9.0%
         pretty         -12.7%     +0.1%      0.00      0.00
         primes          +2.8%     +0.0%      0.11      0.11
      primetest          +2.5%     -0.0%     -2.1%     -3.1%
         prolog          +3.2%     -7.2%      0.00      0.00
         puzzle          +4.1%     +0.0%     -3.5%     -8.0%
         queens          +2.8%     +0.0%      0.03      0.03
        reptile          +2.2%     -2.2%      0.02      0.02
        rewrite          +3.1%    +10.9%      0.03      0.03
           rfib          -5.2%     +0.2%      0.03      0.03
            rsa          +2.6%     +0.0%      0.05      0.06
            scc          +4.6%     +0.4%      0.00      0.00
          sched          +2.7%     +0.1%      0.03      0.03
            scs          -2.6%     -0.9%     -9.6%    -11.6%
         simple          -4.0%     +0.4%    -14.6%    -14.9%
          solid          -5.6%     -0.6%     -9.3%    -14.3%
        sorting          +3.8%     +0.0%      0.00      0.00
         sphere          -3.6%     +8.5%      0.15      0.16
         symalg          -1.3%     +0.2%      0.03      0.03
            tak          +2.7%     +0.0%      0.02      0.02
      transform          +2.0%     -2.9%     -8.0%     -8.8%
       treejoin          +3.1%     +0.0%    -17.5%    -17.8%
      typecheck          +2.9%     -0.3%     -4.6%     -6.6%
        veritas          +3.9%     -0.3%      0.00      0.00
           wang          -6.2%     +0.0%      0.18     -9.8%
      wave4main         -10.3%     +2.6%     -2.1%     -2.3%
   wheel-sieve1          +2.7%     -0.0%     +0.3%     -0.6%
   wheel-sieve2          +2.7%     +0.0%     -3.7%     -7.5%
           x2n1          -4.1%     +0.1%      0.03      0.04
--------------------------------------------------------------------------------
            Min         -12.7%    -14.5%    -17.5%    -17.8%
            Max          +4.7%    +10.9%     +9.1%     +8.4%
 Geometric Mean          +0.9%     -0.1%     -5.6%     -7.3%
parent ad23a496
......@@ -54,12 +54,12 @@ module BasicTypes(
StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
CompilerPhase,
Activation(..), isActive, isNeverActive, isAlwaysActive,
RuleMatchInfo(..), isConLike, isFunLike,
InlinePragma(..), defaultInlinePragma, isDefaultInlinePragma,
Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
RuleMatchInfo(..), isConLike, isFunLike,
InlinePragma(..), defaultInlinePragma, neverInlinePragma, dfunInlinePragma,
isDefaultInlinePragma, isInlinePragma,
inlinePragmaActivation, inlinePragmaRuleMatchInfo,
setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
SuccessFlag(..), succeeded, failed, successIf
) where
......@@ -585,10 +585,69 @@ data Activation = NeverActive
| ActiveAfter CompilerPhase -- Active in this phase and later
deriving( Eq ) -- Eq used in comparing rules in HsDecls
data RuleMatchInfo = ConLike
data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
| FunLike
deriving( Eq )
data InlinePragma -- Note [InlinePragma]
= InlinePragma
{ inl_inline :: Bool -- True <=> INLINE,
-- False <=> no pragma at all, or NOINLINE
, inl_act :: Activation -- Says during which phases inlining is allowed
, inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
} deriving( Eq )
\end{code}
Note [InlinePragma]
~~~~~~~~~~~~~~~~~~~
This data type mirrors what you can write in an INLINE or NOINLINE pragma in
the source program.
If you write nothing at all, you get defaultInlinePragma:
inl_inline = False
inl_act = AlwaysActive
inl_rule = FunLike
It's not possible to get that combination by *writing* something, so
if an Id has defaultInlinePragma it means the user didn't specify anything.
Note [CONLIKE pragma]
~~~~~~~~~~~~~~~~~~~~~
The ConLike constructor of a RuleMatchInfo is aimed at the following.
Consider first
{-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
g b bs = let x = b:bs in ..x...x...(r x)...
Now, the rule applies to the (r x) term, because GHC "looks through"
the definition of 'x' to see that it is (b:bs).
Now consider
{-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
g v = let x = f v in ..x...x...(r x)...
Normally the (r x) would *not* match the rule, because GHC would be
scared about duplicating the redex (f v), so it does not "look
through" the bindings.
However the CONLIKE modifier says to treat 'f' like a constructor in
this situation, and "look through" the unfolding for x. So (r x)
fires, yielding (f (v+1)).
This is all controlled with a user-visible pragma:
{-# NOINLINE CONLIKE [1] f #-}
The main effects of CONLIKE are:
- The occurrence analyser (OccAnal) and simplifier (Simplify) treat
CONLIKE thing like constructors, by ANF-ing them
- New function coreUtils.exprIsExpandable is like exprIsCheap, but
additionally spots applications of CONLIKE functions
- A CoreUnfolding has a field that caches exprIsExpandable
- The rule matcher consults this field. See
Note [Expanding variables] in Rules.lhs.
\begin{code}
isConLike :: RuleMatchInfo -> Bool
isConLike ConLike = True
isConLike _ = False
......@@ -597,55 +656,39 @@ isFunLike :: RuleMatchInfo -> Bool
isFunLike FunLike = True
isFunLike _ = False
data InlinePragma
= InlinePragma
Activation -- Says during which phases inlining is allowed
RuleMatchInfo -- Should the function be treated like a constructor?
deriving( Eq )
defaultInlinePragma :: InlinePragma
defaultInlinePragma = InlinePragma AlwaysActive FunLike
defaultInlinePragma, neverInlinePragma, dfunInlinePragma :: InlinePragma
defaultInlinePragma
= InlinePragma { inl_act = AlwaysActive, inl_rule = FunLike, inl_inline = False }
neverInlinePragma
= InlinePragma { inl_act = NeverActive, inl_rule = FunLike, inl_inline = False }
dfunInlinePragma
= InlinePragma { inl_act = AlwaysActive, inl_rule = ConLike, inl_inline = False }
isDefaultInlinePragma :: InlinePragma -> Bool
isDefaultInlinePragma (InlinePragma activation match_info)
= isAlwaysActive activation && isFunLike match_info
isDefaultInlinePragma (InlinePragma { inl_act = activation
, inl_rule = match_info
, inl_inline = inline })
= not inline && isAlwaysActive activation && isFunLike match_info
isInlinePragma :: InlinePragma -> Bool
isInlinePragma prag = inl_inline prag
inlinePragmaActivation :: InlinePragma -> Activation
inlinePragmaActivation (InlinePragma activation _) = activation
inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
inlinePragmaRuleMatchInfo (InlinePragma _ info) = info
inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
setInlinePragmaActivation (InlinePragma _ info) activation
= InlinePragma activation info
setInlinePragmaActivation prag activation = prag { inl_act = activation }
setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
setInlinePragmaRuleMatchInfo (InlinePragma activation _) info
= InlinePragma activation info
data InlineSpec
= Inline
InlinePragma
Bool -- True <=> INLINE
-- False <=> NOINLINE
deriving( Eq )
defaultInlineSpec :: InlineSpec
alwaysInlineSpec, neverInlineSpec :: RuleMatchInfo -> InlineSpec
defaultInlineSpec = Inline defaultInlinePragma False
-- Inlining is OK, but not forced
alwaysInlineSpec match_info
= Inline (InlinePragma AlwaysActive match_info) True
-- INLINE always
neverInlineSpec match_info
= Inline (InlinePragma NeverActive match_info) False
-- NOINLINE
setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
instance Outputable Activation where
ppr NeverActive = ptext (sLit "NEVER")
ppr AlwaysActive = ptext (sLit "ALWAYS")
ppr NeverActive = ptext (sLit "NEVER")
ppr (ActiveBefore n) = brackets (char '~' <> int n)
ppr (ActiveAfter n) = brackets (int n)
......@@ -654,25 +697,17 @@ instance Outputable RuleMatchInfo where
ppr FunLike = ptext (sLit "FUNLIKE")
instance Outputable InlinePragma where
ppr (InlinePragma activation FunLike)
= ppr activation
ppr (InlinePragma activation match_info)
= ppr match_info <+> ppr activation
instance Outputable InlineSpec where
ppr (Inline (InlinePragma act match_info) is_inline)
| is_inline = ptext (sLit "INLINE")
<+> ppr_match_info
<+> case act of
AlwaysActive -> empty
_ -> ppr act
| otherwise = ptext (sLit "NOINLINE")
<+> ppr_match_info
<+> case act of
NeverActive -> empty
_ -> ppr act
where
ppr_match_info = if isFunLike match_info then empty else ppr match_info
ppr (InlinePragma { inl_inline = inline, inl_act = activation, inl_rule = info })
= pp_inline <+> pp_info <+> pp_activation
where
pp_inline | inline = ptext (sLit "INLINE")
| otherwise = ptext (sLit "NOINLINE")
pp_info | isFunLike info = empty
| otherwise = ppr info
pp_activation
| inline && isAlwaysActive activation = empty
| not inline && isNeverActive activation = empty
| otherwise = ppr activation
isActive :: CompilerPhase -> Activation -> Bool
isActive _ NeverActive = False
......@@ -680,11 +715,15 @@ isActive _ AlwaysActive = True
isActive p (ActiveAfter n) = p <= n
isActive p (ActiveBefore n) = p > n
isNeverActive, isAlwaysActive :: Activation -> Bool
isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
isNeverActive NeverActive = True
isNeverActive _ = False
isAlwaysActive AlwaysActive = True
isAlwaysActive _ = False
isEarlyActive AlwaysActive = True
isEarlyActive (ActiveBefore {}) = True
isEarlyActive _ = False
\end{code}
......@@ -69,7 +69,6 @@ module Id (
idArity,
idNewDemandInfo, idNewDemandInfo_maybe,
idNewStrictness, idNewStrictness_maybe,
idWorkerInfo,
idUnfolding,
idSpecialisation, idCoreRules, idHasRules,
idCafInfo,
......@@ -87,7 +86,6 @@ module Id (
setIdArity,
setIdNewDemandInfo,
setIdNewStrictness, zapIdNewStrictness,
setIdWorkerInfo,
setIdSpecialisation,
setIdCafInfo,
setIdOccInfo, zapIdOccInfo,
......@@ -140,7 +138,6 @@ infixl 1 `setIdUnfolding`,
`setIdArity`,
`setIdNewDemandInfo`,
`setIdNewStrictness`,
`setIdWorkerInfo`,
`setIdSpecialisation`,
`setInlinePragma`,
`idCafInfo`
......@@ -289,9 +286,7 @@ instantiated before use.
-- | Workers get local names. "CoreTidy" will externalise these if necessary
mkWorkerId :: Unique -> Id -> Type -> Id
mkWorkerId uniq unwrkr ty
= mkLocalId wkr_name ty
where
wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcSpan unwrkr)
= mkLocalId (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty
-- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings
mkTemplateLocal :: Int -> Type -> Id
......@@ -350,8 +345,8 @@ isPrimOpId id = case Var.idDetails id of
_ -> False
isDFunId id = case Var.idDetails id of
DFunId -> True
_ -> False
DFunId _ -> True
_ -> False
isPrimOpId_maybe id = case Var.idDetails id of
PrimOpId op -> Just op
......@@ -409,11 +404,11 @@ isImplicitId :: Id -> Bool
-- file, even if it's mentioned in some other interface unfolding.
isImplicitId id
= case Var.idDetails id of
FCallId _ -> True
ClassOpId _ -> True
PrimOpId _ -> True
DataConWorkId _ -> True
DataConWrapId _ -> True
FCallId {} -> True
ClassOpId {} -> True
PrimOpId {} -> True
DataConWorkId {} -> True
DataConWrapId {} -> True
-- These are are implied by their type or class decl;
-- remember that all type and class decls appear in the interface file.
-- The dfun id is not an implicit Id; it must *not* be omitted, because
......@@ -512,14 +507,6 @@ isStrictId id
(isStrictDmd (idNewDemandInfo id)) ||
(isStrictType (idType id))
---------------------------------
-- WORKER ID
idWorkerInfo :: Id -> WorkerInfo
idWorkerInfo id = workerInfo (idInfo id)
setIdWorkerInfo :: Id -> WorkerInfo -> Id
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
---------------------------------
-- UNFOLDING
idUnfolding :: Id -> Unfolding
......@@ -549,6 +536,9 @@ setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
---------------------------------
-- SPECIALISATION
-- See Note [Specialisations and RULES in IdInfo] in IdInfo.lhs
idSpecialisation :: Id -> SpecInfo
idSpecialisation id = specInfo (idInfo id)
......@@ -617,7 +607,7 @@ idInlineActivation :: Id -> Activation
idInlineActivation id = inlinePragmaActivation (idInlinePragma id)
setInlineActivation :: Id -> Activation -> Id
setInlineActivation id act = modifyInlinePragma id (\(InlinePragma _ match_info) -> InlinePragma act match_info)
setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act)
idRuleMatchInfo :: Id -> RuleMatchInfo
idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)
......
......@@ -49,11 +49,6 @@ module IdInfo (
cprInfoFromNewStrictness,
#endif
-- ** The WorkerInfo type
WorkerInfo(..),
workerExists, wrapperArity, workerId,
workerInfo, setWorkerInfo, ppWorkerInfo,
-- ** Unfolding Info
unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
......@@ -94,7 +89,6 @@ import CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding )
import Class
import PrimOp
import Name
import Var
import VarSet
import BasicTypes
import DataCon
......@@ -119,7 +113,6 @@ infixl 1 `setSpecInfo`,
`setArityInfo`,
`setInlinePragInfo`,
`setUnfoldingInfo`,
`setWorkerInfo`,
`setLBVarInfo`,
`setOccInfo`,
`setCafInfo`,
......@@ -165,8 +158,8 @@ seqNewStrictnessInfo Nothing = ()
seqNewStrictnessInfo (Just ty) = seqStrictSig ty
pprNewStrictness :: Maybe StrictSig -> SDoc
pprNewStrictness Nothing = empty
pprNewStrictness (Just sig) = ftext (fsLit "Str:") <+> ppr sig
pprNewStrictness Nothing = empty
pprNewStrictness (Just sig) = ppr sig
#ifdef OLD_STRICTNESS
oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
......@@ -260,35 +253,38 @@ data IdDetails
-- b) when desugaring a RecordCon we can get
-- from the Id back to the data con]
| ClassOpId Class -- ^ The 'Id' is an operation of a class
| ClassOpId Class -- ^ The 'Id' is an superclass selector or class operation of a class
| PrimOpId PrimOp -- ^ The 'Id' is for a primitive operator
| FCallId ForeignCall -- ^ The 'Id' is for a foreign call
| TickBoxOpId TickBoxOp -- ^ The 'Id' is for a HPC tick box (both traditional and binary)
| DFunId -- ^ A dictionary function. We don't use this in an essential way,
-- currently, but it's kind of nice that we can keep track of
-- which Ids are DFuns, across module boundaries too
| DFunId Bool -- ^ A dictionary function.
-- True <=> the class has only one method, so may be
-- implemented with a newtype, so it might be bad
-- to be strict on this dictionary
instance Outputable IdDetails where
ppr = pprIdDetails
pprIdDetails :: IdDetails -> SDoc
pprIdDetails VanillaId = empty
pprIdDetails (DataConWorkId _) = ptext (sLit "[DataCon]")
pprIdDetails (DataConWrapId _) = ptext (sLit "[DataConWrapper]")
pprIdDetails (ClassOpId _) = ptext (sLit "[ClassOp]")
pprIdDetails (PrimOpId _) = ptext (sLit "[PrimOp]")
pprIdDetails (FCallId _) = ptext (sLit "[ForeignCall]")
pprIdDetails (TickBoxOpId _) = ptext (sLit "[TickBoxOp]")
pprIdDetails DFunId = ptext (sLit "[DFunId]")
pprIdDetails (RecSelId { sel_naughty = is_naughty })
= brackets $ ptext (sLit "RecSel") <> pp_naughty
where
pp_naughty | is_naughty = ptext (sLit "(naughty)")
| otherwise = empty
pprIdDetails VanillaId = empty
pprIdDetails other = brackets (pp other)
where
pp VanillaId = panic "pprIdDetails"
pp (DataConWorkId _) = ptext (sLit "DataCon")
pp (DataConWrapId _) = ptext (sLit "DataConWrapper")
pp (ClassOpId {}) = ptext (sLit "ClassOp")
pp (PrimOpId _) = ptext (sLit "PrimOp")
pp (FCallId _) = ptext (sLit "ForeignCall")
pp (TickBoxOpId _) = ptext (sLit "TickBoxOp")
pp (DFunId b) = ptext (sLit "DFunId") <>
ppWhen b (ptext (sLit "(newtype)"))
pp (RecSelId { sel_naughty = is_naughty })
= brackets $ ptext (sLit "RecSel")
<> ppWhen is_naughty (ptext (sLit "(naughty)"))
\end{code}
......@@ -314,20 +310,12 @@ data IdInfo
= IdInfo {
arityInfo :: !ArityInfo, -- ^ 'Id' arity
specInfo :: SpecInfo, -- ^ Specialisations of the 'Id's function which exist
-- See Note [Specialisations and RULES in IdInfo]
#ifdef OLD_STRICTNESS
cprInfo :: CprInfo, -- ^ If the 'Id's function always constructs a product result
demandInfo :: Demand.Demand, -- ^ Whether or not the 'Id' is definitely demanded
strictnessInfo :: StrictnessInfo, -- ^ 'Id' strictness properties
#endif
workerInfo :: WorkerInfo, -- ^ Pointer to worker function.
-- Within one module this is irrelevant; the
-- inlining of a worker is handled via the 'Unfolding'.
-- However, when the module is imported by others, the
-- 'WorkerInfo' is used /only/ to indicate the form of
-- the RHS, so that interface files don't actually
-- need to contain the RHS; it can be derived from
-- the strictness info
unfoldingInfo :: Unfolding, -- ^ The 'Id's unfolding
cafInfo :: CafInfo, -- ^ 'Id' CAF info
lbvarInfo :: LBVarInfo, -- ^ Info about a lambda-bound variable, if the 'Id' is one
......@@ -353,7 +341,6 @@ seqIdInfo (IdInfo {}) = ()
megaSeqIdInfo :: IdInfo -> ()
megaSeqIdInfo info
= seqSpecInfo (specInfo info) `seq`
seqWorker (workerInfo info) `seq`
-- Omitting this improves runtimes a little, presumably because
-- some unfoldings are not calculated at all
......@@ -376,8 +363,6 @@ megaSeqIdInfo info
Setters
\begin{code}
setWorkerInfo :: IdInfo -> WorkerInfo -> IdInfo
setWorkerInfo info wk = wk `seq` info { workerInfo = wk }
setSpecInfo :: IdInfo -> SpecInfo -> IdInfo
setSpecInfo info sp = sp `seq` info { specInfo = sp }
setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
......@@ -433,7 +418,6 @@ vanillaIdInfo
strictnessInfo = NoStrictnessInfo,
#endif
specInfo = emptySpecInfo,
workerInfo = NoWorker,
unfoldingInfo = noUnfolding,
lbvarInfo = NoLBVarInfo,
inlinePragInfo = defaultInlinePragma,
......@@ -505,6 +489,25 @@ type InlinePragInfo = InlinePragma
%* *
%************************************************************************
Note [Specialisations and RULES in IdInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Generally speaking, a GlobalIdshas an *empty* SpecInfo. All their
RULES are contained in the globally-built rule-base. In principle,
one could attach the to M.f the RULES for M.f that are defined in M.
But we don't do that for instance declarations and so we just treat
them all uniformly.
The EXCEPTION is PrimOpIds, which do have rules in their IdInfo. That is
jsut for convenience really.
However, LocalIds may have non-empty SpecInfo. We treat them
differently because:
a) they might be nested, in which case a global table won't work
b) the RULE might mention free variables, which we use to keep things alive
In TidyPgm, when the LocalId becomes a GlobalId, its RULES are stripped off
and put in the global list.
\begin{code}
-- | Records the specializations of this 'Id' that we know about
-- in the form of rewrite 'CoreRule's that target them
......@@ -540,67 +543,6 @@ seqSpecInfo :: SpecInfo -> ()
seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
\end{code}
%************************************************************************
%* *
\subsection[worker-IdInfo]{Worker info about an @Id@}
%* *
%************************************************************************
There might not be a worker, even for a strict function, because:
(a) the function might be small enough to inline, so no need
for w/w split
(b) the strictness info might be "SSS" or something, so no w/w split.
Sometimes the arity of a wrapper changes from the original arity from
which it was generated, so we always emit the "original" arity into
the interface file, as part of the worker info.
How can this happen? Sometimes we get
f = coerce t (\x y -> $wf x y)
at the moment of w/w split; but the eta reducer turns it into
f = coerce t $wf
which is perfectly fine except that the exposed arity so far as
the code generator is concerned (zero) differs from the arity
when we did the split (2).
All this arises because we use 'arity' to mean "exactly how many
top level lambdas are there" in interface files; but during the
compilation of this module it means "how many things can I apply
this to".
\begin{code}
-- | If this Id has a worker then we store a reference to it. Worker
-- functions are generated by the worker\/wrapper pass, using information
-- information from strictness analysis.
data WorkerInfo = NoWorker -- ^ No known worker function
| HasWorker Id Arity -- ^ The 'Arity' is the arity of the /wrapper/ at the moment of the
-- worker\/wrapper split, which may be different from the current 'Id' 'Aritiy'
seqWorker :: WorkerInfo -> ()
seqWorker (HasWorker id a) = id `seq` a `seq` ()
seqWorker NoWorker = ()
ppWorkerInfo :: WorkerInfo -> SDoc
ppWorkerInfo NoWorker = empty
ppWorkerInfo (HasWorker wk_id _) = ptext (sLit "Worker") <+> ppr wk_id
workerExists :: WorkerInfo -> Bool
workerExists NoWorker = False
workerExists (HasWorker _ _) = True
-- | The 'Id' of the worker function if it exists, or a panic otherwise
workerId :: WorkerInfo -> Id
workerId (HasWorker id _) = id
workerId NoWorker = panic "workerId: NoWorker"
-- | The 'Arity' of the worker function at the time of the split if it exists, or a panic otherwise
wrapperArity :: WorkerInfo -> Arity
wrapperArity (HasWorker _ a) = a
wrapperArity NoWorker = panic "wrapperArity: NoWorker"
\end{code}
%************************************************************************
%* *
\subsection[CG-IdInfo]{Code generator-related information}
......@@ -634,6 +576,9 @@ mayHaveCafRefs _ = False
seqCaf :: CafInfo -> ()
seqCaf c = c `seq` ()
instance Outputable CafInfo where
ppr = ppCafInfo
ppCafInfo :: CafInfo -> SDoc
ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs")
ppCafInfo MayHaveCafRefs = empty
......@@ -777,7 +722,6 @@ zapFragileInfo :: IdInfo -> Maybe IdInfo
-- ^ Zap info that depends on free variables
zapFragileInfo info
= Just (info `setSpecInfo` emptySpecInfo
`setWorkerInfo` NoWorker
`setUnfoldingInfo` noUnfolding
`setOccInfo` if isFragileOcc occ then NoOccInfo else occ)
where
......
......@@ -345,8 +345,8 @@ mkDataConIds wrap_name wkr_name data_con
-- ...(let w = C x in ...(w p q)...)...
-- we want to see that w is strict in its two arguments
wrap_unf = mkImplicitUnfolding $ Note InlineMe $
mkLams wrap_tvs $
wrap_unf = mkInlineRule InlSat wrap_rhs (length dict_args + length id_args)
wrap_rhs = mkLams wrap_tvs $
mkLams eq_args $
mkLams dict_args $ mkLams id_args $
foldr mk_case con_app
......@@ -460,12 +460,25 @@ mkDictSelId no_unf name clas
info = noCafIdInfo
`setArityInfo` 1
`setAllStrictnessInfo` Just strict_sig
`setUnfoldingInfo` (if no_unf then noUnfolding
else mkImplicitUnfolding rhs)
`setSpecInfo` mkSpecInfo [rule]
`setInlinePragInfo` neverInlinePragma
`setUnfoldingInfo` (if no_unf then noUnfolding
else mkImplicitUnfolding rhs)
-- Experimental: NOINLINE, so that their rule matches
-- We no longer use 'must-inline' on record selectors. They'll
-- inline like crazy if they scrutinise a constructor
n_ty_args = length tyvars
-- This is the built-in rule that goes
-- op (dfT d1 d2) ---> opT d1 d2
rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS`
occNameFS (getOccName name)
, ru_fn = name
, ru_nargs = n_ty_args + 1
, ru_try = dictSelRule index n_ty_args }
-- The strictness signature is of the form U(AAAVAAAA) -> T
-- where the V depends on which item we are selecting
-- It's worth giving one, so that absence info etc is generated
......@@ -480,7 +493,8 @@ mkDictSelId no_unf name clas
tyvars = dataConUnivTyVars data_con
arg_tys = {- ASSERT( isVanillaDataCon data_con ) -} dataConRepArgTys data_con
eq_theta = dataConEqTheta data_con
the_arg_id = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` arg_ids) name
index = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` [0..]) name
the_arg_id = arg_ids !! index
pred = mkClassPred clas (mkTyVarTys tyvars)
dict_id = mkTemplateLocal 1 $ mkPredTy pred
......@@ -496,6 +510,20 @@ mkDictSelId no_unf name clas
rhs_body | isNewTyCon tycon = unwrapNewTypeBody tycon (map mkTyVarTy tyvars) (Var dict_id)
| otherwise = Case (Var dict_id) dict_id (idType the_arg_id)
[(DataAlt data_con, eq_ids ++ arg_ids, Var the_arg_id)]
dictSelRule :: Int -> Arity -> [CoreExpr] -> Maybe CoreExpr
-- Oh, very clever
-- op_i t1..tk (df s1..sn d1..dm) = op_i_helper s1..sn d1..dm
-- op_i t1..tk (D t1..tk op1 ... opm) = opi
--
-- NB: the data constructor has the same number of type args as the class op
dictSelRule index n_ty_args args
| (dict_arg : _) <- drop n_ty_args args
, Just (_, _, val_args) <- exprIsConApp_maybe dict_arg
= Just (val_args !! index)
| otherwise
= Nothing
\end{code}
......@@ -825,8 +853,9 @@ mkDictFunId :: Name -- Name to use for the dict fun;
-> Id
mkDictFunId dfun_name inst_tyvars dfun_theta clas inst_tys
= mkExportedLocalVar DFunId dfun_name dfun_ty vanillaIdInfo
= mkExportedLocalVar (DFunId is_nt) dfun_name dfun_ty vanillaIdInfo
where
is_nt = isNewTyCon (classTyCon clas)
dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
\end{code}
......@@ -934,7 +963,7 @@ c) It has quite a bit of desugaring magic.
d) There is some special rule handing: Note [RULES for seq]
Note [Rules for seq]
Note [RULES for seq]
~~~~~~~~~~~~~~~~~~~~
Roman found situations where he had
case (f n) of _ -> e
......
......@@ -37,7 +37,7 @@ module Name (
BuiltInSyntax(..),
-- ** Creating 'Name's
mkInternalName, mkSystemName,
mkInternalName, mkSystemName, mkDerivedInternalName,
mkSystemVarName, mkSysTvName,
mkFCallName, mkIPName,
mkTickBoxOpName,
......@@ -249,6 +249,11 @@ mkInternalName uniq occ loc = Name { n_uniq = getKeyFastInt uniq, n_sort = Inter
-- * for interface files we tidyCore first, which puts the uniques
-- into the print name (see setNameVisibility below)
mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name
mkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc })
= Name { n_uniq = getKeyFastInt uniq, n_sort = Internal
, n_occ = derive_occ occ, n_loc = loc }
-- | Create a name which definitely originates in the given module
mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName uniq mod occ loc
......
......@@ -49,7 +49,7 @@ module OccName (
-- ** Derived 'OccName's
isDerivedOccName,
mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc,
mkDerivedTyConOcc, mkNewTyCoOcc,
mkDerivedTyConOcc, mkNewTyCoOcc, mkClassOpAuxOcc,
mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc,
mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
......@@ -58,7 +58,7 @@ module OccName (
mkInstTyCoOcc, mkEqPredCoOcc,
mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
mkPDataTyConOcc, mkPDataDataConOcc,
mkPReprTyConOcc,
mkPReprTyConOcc,
mkPADFunOcc,
-- ** Deconstruction
......@@ -526,7 +526,7 @@ mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc,
mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
mkInstTyCoOcc, mkEqPredCoOcc,
mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
mkPDataTyConOcc, mkPDataDataConOcc, mkPReprTyConOcc, mkPADFunOcc
......@@ -536,6 +536,7 @@ mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
mkDataConWrapperOcc = mk_simple_deriv varName "$W"
mkWorkerOcc = mk_simple_deriv varName "$w"
mkDefaultMethodOcc = mk_simple_deriv varName "$dm"
mkClassOpAuxOcc = mk_simple_deriv varName "$c"
mkDerivedTyConOcc = mk_simple_deriv tcName ":" -- The : prefix makes sure it classifies
mkClassTyConOcc = mk_simple_deriv tcName "T:" -- as a tycon/datacon
mkClassDataConOcc = mk_simple_deriv dataName "D:" -- We go straight to the "real" data con
......@@ -544,9 +545,9 @@ mkDictOcc = mk_simple_deriv varName "$d"
mkIPOcc = mk_simple_deriv varName "$i"
mkSpecOcc = mk_simple_deriv varName "$s"
mkForeignExportOcc = mk_simple_deriv varName "$f"
mkNewTyCoOcc = mk_simple_deriv tcName "NTCo:" -- Coercion for newtypes
mkInstTyCoOcc = mk_simple_deriv tcName "TFCo:" -- Coercion for type functions
mkEqPredCoOcc = mk_simple_deriv tcName "$co"
mkNewTyCoOcc = mk_simple_deriv tcName "NTCo:" -- Coercion for newtypes
mkInstTyCoOcc = mk_simple_deriv tcName "TFCo:" -- Coercion for type functions
mkEqPredCoOcc = mk_simple_deriv tcName "$co"
-- used in derived instances
mkCon2TagOcc = mk_simple_deriv varName "$con2tag_"
......
......@@ -8,7 +8,7 @@
\begin{code}
-- | Arit and eta expansion
module CoreArity (
manifestArity, exprArity,
manifestArity, exprArity, exprBotStrictness_maybe,
exprEtaExpandArity, etaExpand