/compiler/specialise/SpecConstr.hs
Haskell | 2122 lines | 925 code | 258 blank | 939 comment | 33 complexity | d7bb5f9e4c490d2b4f3a783d957d24ef MD5 | raw file
Possible License(s): MIT, BSD-3-Clause, GPL-3.0
Large files files are truncated, but you can click here to view the full file
- {-
- ToDo [Oct 2013]
- ~~~~~~~~~~~~~~~
- 1. Nuke ForceSpecConstr for good (it is subsumed by GHC.Types.SPEC in ghc-prim)
- 2. Nuke NoSpecConstr
- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
- \section[SpecConstr]{Specialise over constructors}
- -}
- {-# LANGUAGE CPP #-}
- module SpecConstr(
- specConstrProgram
- #ifdef GHCI
- , SpecConstrAnnotation(..)
- #endif
- ) where
- #include "HsVersions.h"
- import CoreSyn
- import CoreSubst
- import CoreUtils
- import CoreUnfold ( couldBeSmallEnoughToInline )
- import CoreFVs ( exprsFreeVarsList )
- import CoreMonad
- import Literal ( litIsLifted )
- import HscTypes ( ModGuts(..) )
- import WwLib ( mkWorkerArgs )
- import DataCon
- import Coercion hiding( substCo )
- import Rules
- import Type hiding ( substTy )
- import TyCon ( tyConName )
- import Id
- import PprCore ( pprParendExpr )
- import MkCore ( mkImpossibleExpr )
- import Var
- import VarEnv
- import VarSet
- import Name
- import BasicTypes
- import DynFlags ( DynFlags(..) )
- import StaticFlags ( opt_PprStyle_Debug )
- import Maybes ( orElse, catMaybes, isJust, isNothing )
- import Demand
- import GHC.Serialized ( deserializeWithData )
- import Util
- import Pair
- import UniqSupply
- import Outputable
- import FastString
- import UniqFM
- import MonadUtils
- import Control.Monad ( zipWithM )
- import Data.List
- import PrelNames ( specTyConName )
- import Module
- -- See Note [Forcing specialisation]
- #ifndef GHCI
- type SpecConstrAnnotation = ()
- #else
- import TyCon ( TyCon )
- import GHC.Exts( SpecConstrAnnotation(..) )
- #endif
- {-
- -----------------------------------------------------
- Game plan
- -----------------------------------------------------
- Consider
- drop n [] = []
- drop 0 xs = []
- drop n (x:xs) = drop (n-1) xs
- After the first time round, we could pass n unboxed. This happens in
- numerical code too. Here's what it looks like in Core:
- drop n xs = case xs of
- [] -> []
- (y:ys) -> case n of
- I# n# -> case n# of
- 0 -> []
- _ -> drop (I# (n# -# 1#)) xs
- Notice that the recursive call has an explicit constructor as argument.
- Noticing this, we can make a specialised version of drop
- RULE: drop (I# n#) xs ==> drop' n# xs
- drop' n# xs = let n = I# n# in ...orig RHS...
- Now the simplifier will apply the specialisation in the rhs of drop', giving
- drop' n# xs = case xs of
- [] -> []
- (y:ys) -> case n# of
- 0 -> []
- _ -> drop' (n# -# 1#) xs
- Much better!
- We'd also like to catch cases where a parameter is carried along unchanged,
- but evaluated each time round the loop:
- f i n = if i>0 || i>n then i else f (i*2) n
- Here f isn't strict in n, but we'd like to avoid evaluating it each iteration.
- In Core, by the time we've w/wd (f is strict in i) we get
- f i# n = case i# ># 0 of
- False -> I# i#
- True -> case n of { I# n# ->
- case i# ># n# of
- False -> I# i#
- True -> f (i# *# 2#) n
- At the call to f, we see that the argument, n is known to be (I# n#),
- and n is evaluated elsewhere in the body of f, so we can play the same
- trick as above.
- Note [Reboxing]
- ~~~~~~~~~~~~~~~
- We must be careful not to allocate the same constructor twice. Consider
- f p = (...(case p of (a,b) -> e)...p...,
- ...let t = (r,s) in ...t...(f t)...)
- At the recursive call to f, we can see that t is a pair. But we do NOT want
- to make a specialised copy:
- f' a b = let p = (a,b) in (..., ...)
- because now t is allocated by the caller, then r and s are passed to the
- recursive call, which allocates the (r,s) pair again.
- This happens if
- (a) the argument p is used in other than a case-scrutinisation way.
- (b) the argument to the call is not a 'fresh' tuple; you have to
- look into its unfolding to see that it's a tuple
- Hence the "OR" part of Note [Good arguments] below.
- ALTERNATIVE 2: pass both boxed and unboxed versions. This no longer saves
- allocation, but does perhaps save evals. In the RULE we'd have
- something like
- f (I# x#) = f' (I# x#) x#
- If at the call site the (I# x) was an unfolding, then we'd have to
- rely on CSE to eliminate the duplicate allocation.... This alternative
- doesn't look attractive enough to pursue.
- ALTERNATIVE 3: ignore the reboxing problem. The trouble is that
- the conservative reboxing story prevents many useful functions from being
- specialised. Example:
- foo :: Maybe Int -> Int -> Int
- foo (Just m) 0 = 0
- foo x@(Just m) n = foo x (n-m)
- Here the use of 'x' will clearly not require boxing in the specialised function.
- The strictness analyser has the same problem, in fact. Example:
- f p@(a,b) = ...
- If we pass just 'a' and 'b' to the worker, it might need to rebox the
- pair to create (a,b). A more sophisticated analysis might figure out
- precisely the cases in which this could happen, but the strictness
- analyser does no such analysis; it just passes 'a' and 'b', and hopes
- for the best.
- So my current choice is to make SpecConstr similarly aggressive, and
- ignore the bad potential of reboxing.
- Note [Good arguments]
- ~~~~~~~~~~~~~~~~~~~~~
- So we look for
- * A self-recursive function. Ignore mutual recursion for now,
- because it's less common, and the code is simpler for self-recursion.
- * EITHER
- a) At a recursive call, one or more parameters is an explicit
- constructor application
- AND
- That same parameter is scrutinised by a case somewhere in
- the RHS of the function
- OR
- b) At a recursive call, one or more parameters has an unfolding
- that is an explicit constructor application
- AND
- That same parameter is scrutinised by a case somewhere in
- the RHS of the function
- AND
- Those are the only uses of the parameter (see Note [Reboxing])
- What to abstract over
- ~~~~~~~~~~~~~~~~~~~~~
- There's a bit of a complication with type arguments. If the call
- site looks like
- f p = ...f ((:) [a] x xs)...
- then our specialised function look like
- f_spec x xs = let p = (:) [a] x xs in ....as before....
- This only makes sense if either
- a) the type variable 'a' is in scope at the top of f, or
- b) the type variable 'a' is an argument to f (and hence fs)
- Actually, (a) may hold for value arguments too, in which case
- we may not want to pass them. Supose 'x' is in scope at f's
- defn, but xs is not. Then we'd like
- f_spec xs = let p = (:) [a] x xs in ....as before....
- Similarly (b) may hold too. If x is already an argument at the
- call, no need to pass it again.
- Finally, if 'a' is not in scope at the call site, we could abstract
- it as we do the term variables:
- f_spec a x xs = let p = (:) [a] x xs in ...as before...
- So the grand plan is:
- * abstract the call site to a constructor-only pattern
- e.g. C x (D (f p) (g q)) ==> C s1 (D s2 s3)
- * Find the free variables of the abstracted pattern
- * Pass these variables, less any that are in scope at
- the fn defn. But see Note [Shadowing] below.
- NOTICE that we only abstract over variables that are not in scope,
- so we're in no danger of shadowing variables used in "higher up"
- in f_spec's RHS.
- Note [Shadowing]
- ~~~~~~~~~~~~~~~~
- In this pass we gather up usage information that may mention variables
- that are bound between the usage site and the definition site; or (more
- seriously) may be bound to something different at the definition site.
- For example:
- f x = letrec g y v = let x = ...
- in ...(g (a,b) x)...
- Since 'x' is in scope at the call site, we may make a rewrite rule that
- looks like
- RULE forall a,b. g (a,b) x = ...
- But this rule will never match, because it's really a different 'x' at
- the call site -- and that difference will be manifest by the time the
- simplifier gets to it. [A worry: the simplifier doesn't *guarantee*
- no-shadowing, so perhaps it may not be distinct?]
- Anyway, the rule isn't actually wrong, it's just not useful. One possibility
- is to run deShadowBinds before running SpecConstr, but instead we run the
- simplifier. That gives the simplest possible program for SpecConstr to
- chew on; and it virtually guarantees no shadowing.
- Note [Specialising for constant parameters]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- This one is about specialising on a *constant* (but not necessarily
- constructor) argument
- foo :: Int -> (Int -> Int) -> Int
- foo 0 f = 0
- foo m f = foo (f m) (+1)
- It produces
- lvl_rmV :: GHC.Base.Int -> GHC.Base.Int
- lvl_rmV =
- \ (ds_dlk :: GHC.Base.Int) ->
- case ds_dlk of wild_alH { GHC.Base.I# x_alG ->
- GHC.Base.I# (GHC.Prim.+# x_alG 1)
- T.$wfoo :: GHC.Prim.Int# -> (GHC.Base.Int -> GHC.Base.Int) ->
- GHC.Prim.Int#
- T.$wfoo =
- \ (ww_sme :: GHC.Prim.Int#) (w_smg :: GHC.Base.Int -> GHC.Base.Int) ->
- case ww_sme of ds_Xlw {
- __DEFAULT ->
- case w_smg (GHC.Base.I# ds_Xlw) of w1_Xmo { GHC.Base.I# ww1_Xmz ->
- T.$wfoo ww1_Xmz lvl_rmV
- };
- 0 -> 0
- }
- The recursive call has lvl_rmV as its argument, so we could create a specialised copy
- with that argument baked in; that is, not passed at all. Now it can perhaps be inlined.
- When is this worth it? Call the constant 'lvl'
- - If 'lvl' has an unfolding that is a constructor, see if the corresponding
- parameter is scrutinised anywhere in the body.
- - If 'lvl' has an unfolding that is a inlinable function, see if the corresponding
- parameter is applied (...to enough arguments...?)
- Also do this is if the function has RULES?
- Also
- Note [Specialising for lambda parameters]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- foo :: Int -> (Int -> Int) -> Int
- foo 0 f = 0
- foo m f = foo (f m) (\n -> n-m)
- This is subtly different from the previous one in that we get an
- explicit lambda as the argument:
- T.$wfoo :: GHC.Prim.Int# -> (GHC.Base.Int -> GHC.Base.Int) ->
- GHC.Prim.Int#
- T.$wfoo =
- \ (ww_sm8 :: GHC.Prim.Int#) (w_sma :: GHC.Base.Int -> GHC.Base.Int) ->
- case ww_sm8 of ds_Xlr {
- __DEFAULT ->
- case w_sma (GHC.Base.I# ds_Xlr) of w1_Xmf { GHC.Base.I# ww1_Xmq ->
- T.$wfoo
- ww1_Xmq
- (\ (n_ad3 :: GHC.Base.Int) ->
- case n_ad3 of wild_alB { GHC.Base.I# x_alA ->
- GHC.Base.I# (GHC.Prim.-# x_alA ds_Xlr)
- })
- };
- 0 -> 0
- }
- I wonder if SpecConstr couldn't be extended to handle this? After all,
- lambda is a sort of constructor for functions and perhaps it already
- has most of the necessary machinery?
- Furthermore, there's an immediate win, because you don't need to allocate the lambda
- at the call site; and if perchance it's called in the recursive call, then you
- may avoid allocating it altogether. Just like for constructors.
- Looks cool, but probably rare...but it might be easy to implement.
- Note [SpecConstr for casts]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
- Consider
- data family T a :: *
- data instance T Int = T Int
- foo n = ...
- where
- go (T 0) = 0
- go (T n) = go (T (n-1))
- The recursive call ends up looking like
- go (T (I# ...) `cast` g)
- So we want to spot the constructor application inside the cast.
- That's why we have the Cast case in argToPat
- Note [Local recursive groups]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- For a *local* recursive group, we can see all the calls to the
- function, so we seed the specialisation loop from the calls in the
- body, not from the calls in the RHS. Consider:
- bar m n = foo n (n,n) (n,n) (n,n) (n,n)
- where
- foo n p q r s
- | n == 0 = m
- | n > 3000 = case p of { (p1,p2) -> foo (n-1) (p2,p1) q r s }
- | n > 2000 = case q of { (q1,q2) -> foo (n-1) p (q2,q1) r s }
- | n > 1000 = case r of { (r1,r2) -> foo (n-1) p q (r2,r1) s }
- | otherwise = case s of { (s1,s2) -> foo (n-1) p q r (s2,s1) }
- If we start with the RHSs of 'foo', we get lots and lots of specialisations,
- most of which are not needed. But if we start with the (single) call
- in the rhs of 'bar' we get exactly one fully-specialised copy, and all
- the recursive calls go to this fully-specialised copy. Indeed, the original
- function is later collected as dead code. This is very important in
- specialising the loops arising from stream fusion, for example in NDP where
- we were getting literally hundreds of (mostly unused) specialisations of
- a local function.
- In a case like the above we end up never calling the original un-specialised
- function. (Although we still leave its code around just in case.)
- However, if we find any boring calls in the body, including *unsaturated*
- ones, such as
- letrec foo x y = ....foo...
- in map foo xs
- then we will end up calling the un-specialised function, so then we *should*
- use the calls in the un-specialised RHS as seeds. We call these
- "boring call patterns", and callsToPats reports if it finds any of these.
- Note [Seeding top-level recursive groups]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- This seeding is done in the binding for seed_calls in specRec.
- 1. If all the bindings in a top-level recursive group are local (not
- exported), then all the calls are in the rest of the top-level
- bindings. This means we can specialise with those call patterns
- ONLY, and NOT with the RHSs of the recursive group (exactly like
- Note [Local recursive groups])
- 2. But if any of the bindings are exported, the function may be called
- with any old arguments, so (for lack of anything better) we specialise
- based on
- (a) the call patterns in the RHS
- (b) the call patterns in the rest of the top-level bindings
- NB: before Apr 15 we used (a) only, but Dimitrios had an example
- where (b) was crucial, so I added that.
- Adding (b) also improved nofib allocation results:
- multiplier: 4% better
- minimax: 2.8% better
- Actually in case (2), instead of using the calls from the RHS, it
- would be better to specialise in the importing module. We'd need to
- add an INLINEABLE pragma to the function, and then it can be
- specialised in the importing scope, just as is done for type classes
- in Specialise.specImports. This remains to be done (#10346).
- Note [Top-level recursive groups]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- To get the call usage information from "the rest of the top level
- bindings" (c.f. Note [Seeding top-level recursive groups]), we work
- backwards through the top-level bindings so we see the usage before we
- get to the binding of the function. Before we can collect the usage
- though, we go through all the bindings and add them to the
- environment. This is necessary because usage is only tracked for
- functions in the environment. These two passes are called
- 'go' and 'goEnv'
- in specConstrProgram. (Looks a bit revolting to me.)
- Note [Do not specialise diverging functions]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- Specialising a function that just diverges is a waste of code.
- Furthermore, it broke GHC (simpl014) thus:
- {-# STR Sb #-}
- f = \x. case x of (a,b) -> f x
- If we specialise f we get
- f = \x. case x of (a,b) -> fspec a b
- But fspec doesn't have decent strictness info. As it happened,
- (f x) :: IO t, so the state hack applied and we eta expanded fspec,
- and hence f. But now f's strictness is less than its arity, which
- breaks an invariant.
- Note [Forcing specialisation]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- With stream fusion and in other similar cases, we want to fully
- specialise some (but not necessarily all!) loops regardless of their
- size and the number of specialisations.
- We allow a library to do this, in one of two ways (one which is
- deprecated):
- 1) Add a parameter of type GHC.Types.SPEC (from ghc-prim) to the loop body.
- 2) (Deprecated) Annotate a type with ForceSpecConstr from GHC.Exts,
- and then add *that* type as a parameter to the loop body
- The reason #2 is deprecated is because it requires GHCi, which isn't
- available for things like a cross compiler using stage1.
- Here's a (simplified) example from the `vector` package. You may bring
- the special 'force specialization' type into scope by saying:
- import GHC.Types (SPEC(..))
- or by defining your own type (again, deprecated):
- data SPEC = SPEC | SPEC2
- {-# ANN type SPEC ForceSpecConstr #-}
- (Note this is the exact same definition of GHC.Types.SPEC, just
- without the annotation.)
- After that, you say:
- foldl :: (a -> b -> a) -> a -> Stream b -> a
- {-# INLINE foldl #-}
- foldl f z (Stream step s _) = foldl_loop SPEC z s
- where
- foldl_loop !sPEC z s = case step s of
- Yield x s' -> foldl_loop sPEC (f z x) s'
- Skip -> foldl_loop sPEC z s'
- Done -> z
- SpecConstr will spot the SPEC parameter and always fully specialise
- foldl_loop. Note that
- * We have to prevent the SPEC argument from being removed by
- w/w which is why (a) SPEC is a sum type, and (b) we have to seq on
- the SPEC argument.
- * And lastly, the SPEC argument is ultimately eliminated by
- SpecConstr itself so there is no runtime overhead.
- This is all quite ugly; we ought to come up with a better design.
- ForceSpecConstr arguments are spotted in scExpr' and scTopBinds which then set
- sc_force to True when calling specLoop. This flag does four things:
- * Ignore specConstrThreshold, to specialise functions of arbitrary size
- (see scTopBind)
- * Ignore specConstrCount, to make arbitrary numbers of specialisations
- (see specialise)
- * Specialise even for arguments that are not scrutinised in the loop
- (see argToPat; Trac #4488)
- * Only specialise on recursive types a finite number of times
- (see is_too_recursive; Trac #5550; Note [Limit recursive specialisation])
- This flag is inherited for nested non-recursive bindings (which are likely to
- be join points and hence should be fully specialised) but reset for nested
- recursive bindings.
- What alternatives did I consider? Annotating the loop itself doesn't
- work because (a) it is local and (b) it will be w/w'ed and having
- w/w propagating annotations somehow doesn't seem like a good idea. The
- types of the loop arguments really seem to be the most persistent
- thing.
- Annotating the types that make up the loop state doesn't work,
- either, because (a) it would prevent us from using types like Either
- or tuples here, (b) we don't want to restrict the set of types that
- can be used in Stream states and (c) some types are fixed by the user
- (e.g., the accumulator here) but we still want to specialise as much
- as possible.
- Alternatives to ForceSpecConstr
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- Instead of giving the loop an extra argument of type SPEC, we
- also considered *wrapping* arguments in SPEC, thus
- data SPEC a = SPEC a | SPEC2
- loop = \arg -> case arg of
- SPEC state ->
- case state of (x,y) -> ... loop (SPEC (x',y')) ...
- S2 -> error ...
- The idea is that a SPEC argument says "specialise this argument
- regardless of whether the function case-analyses it". But this
- doesn't work well:
- * SPEC must still be a sum type, else the strictness analyser
- eliminates it
- * But that means that 'loop' won't be strict in its real payload
- This loss of strictness in turn screws up specialisation, because
- we may end up with calls like
- loop (SPEC (case z of (p,q) -> (q,p)))
- Without the SPEC, if 'loop' were strict, the case would move out
- and we'd see loop applied to a pair. But if 'loop' isn't strict
- this doesn't look like a specialisable call.
- Note [Limit recursive specialisation]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- It is possible for ForceSpecConstr to cause an infinite loop of specialisation.
- Because there is no limit on the number of specialisations, a recursive call with
- a recursive constructor as an argument (for example, list cons) will generate
- a specialisation for that constructor. If the resulting specialisation also
- contains a recursive call with the constructor, this could proceed indefinitely.
- For example, if ForceSpecConstr is on:
- loop :: [Int] -> [Int] -> [Int]
- loop z [] = z
- loop z (x:xs) = loop (x:z) xs
- this example will create a specialisation for the pattern
- loop (a:b) c = loop' a b c
- loop' a b [] = (a:b)
- loop' a b (x:xs) = loop (x:(a:b)) xs
- and a new pattern is found:
- loop (a:(b:c)) d = loop'' a b c d
- which can continue indefinitely.
- Roman's suggestion to fix this was to stop after a couple of times on recursive types,
- but still specialising on non-recursive types as much as possible.
- To implement this, we count the number of recursive constructors in each
- function argument. If the maximum is greater than the specConstrRecursive limit,
- do not specialise on that pattern.
- This is only necessary when ForceSpecConstr is on: otherwise the specConstrCount
- will force termination anyway.
- See Trac #5550.
- Note [NoSpecConstr]
- ~~~~~~~~~~~~~~~~~~~
- The ignoreDataCon stuff allows you to say
- {-# ANN type T NoSpecConstr #-}
- to mean "don't specialise on arguments of this type". It was added
- before we had ForceSpecConstr. Lacking ForceSpecConstr we specialised
- regardless of size; and then we needed a way to turn that *off*. Now
- that we have ForceSpecConstr, this NoSpecConstr is probably redundant.
- (Used only for PArray.)
- -----------------------------------------------------
- Stuff not yet handled
- -----------------------------------------------------
- Here are notes arising from Roman's work that I don't want to lose.
- Example 1
- ~~~~~~~~~
- data T a = T !a
- foo :: Int -> T Int -> Int
- foo 0 t = 0
- foo x t | even x = case t of { T n -> foo (x-n) t }
- | otherwise = foo (x-1) t
- SpecConstr does no specialisation, because the second recursive call
- looks like a boxed use of the argument. A pity.
- $wfoo_sFw :: GHC.Prim.Int# -> T.T GHC.Base.Int -> GHC.Prim.Int#
- $wfoo_sFw =
- \ (ww_sFo [Just L] :: GHC.Prim.Int#) (w_sFq [Just L] :: T.T GHC.Base.Int) ->
- case ww_sFo of ds_Xw6 [Just L] {
- __DEFAULT ->
- case GHC.Prim.remInt# ds_Xw6 2 of wild1_aEF [Dead Just A] {
- __DEFAULT -> $wfoo_sFw (GHC.Prim.-# ds_Xw6 1) w_sFq;
- 0 ->
- case w_sFq of wild_Xy [Just L] { T.T n_ad5 [Just U(L)] ->
- case n_ad5 of wild1_aET [Just A] { GHC.Base.I# y_aES [Just L] ->
- $wfoo_sFw (GHC.Prim.-# ds_Xw6 y_aES) wild_Xy
- } } };
- 0 -> 0
- Example 2
- ~~~~~~~~~
- data a :*: b = !a :*: !b
- data T a = T !a
- foo :: (Int :*: T Int) -> Int
- foo (0 :*: t) = 0
- foo (x :*: t) | even x = case t of { T n -> foo ((x-n) :*: t) }
- | otherwise = foo ((x-1) :*: t)
- Very similar to the previous one, except that the parameters are now in
- a strict tuple. Before SpecConstr, we have
- $wfoo_sG3 :: GHC.Prim.Int# -> T.T GHC.Base.Int -> GHC.Prim.Int#
- $wfoo_sG3 =
- \ (ww_sFU [Just L] :: GHC.Prim.Int#) (ww_sFW [Just L] :: T.T
- GHC.Base.Int) ->
- case ww_sFU of ds_Xws [Just L] {
- __DEFAULT ->
- case GHC.Prim.remInt# ds_Xws 2 of wild1_aEZ [Dead Just A] {
- __DEFAULT ->
- case ww_sFW of tpl_B2 [Just L] { T.T a_sFo [Just A] ->
- $wfoo_sG3 (GHC.Prim.-# ds_Xws 1) tpl_B2 -- $wfoo1
- };
- 0 ->
- case ww_sFW of wild_XB [Just A] { T.T n_ad7 [Just S(L)] ->
- case n_ad7 of wild1_aFd [Just L] { GHC.Base.I# y_aFc [Just L] ->
- $wfoo_sG3 (GHC.Prim.-# ds_Xws y_aFc) wild_XB -- $wfoo2
- } } };
- 0 -> 0 }
- We get two specialisations:
- "SC:$wfoo1" [0] __forall {a_sFB :: GHC.Base.Int sc_sGC :: GHC.Prim.Int#}
- Foo.$wfoo sc_sGC (Foo.T @ GHC.Base.Int a_sFB)
- = Foo.$s$wfoo1 a_sFB sc_sGC ;
- "SC:$wfoo2" [0] __forall {y_aFp :: GHC.Prim.Int# sc_sGC :: GHC.Prim.Int#}
- Foo.$wfoo sc_sGC (Foo.T @ GHC.Base.Int (GHC.Base.I# y_aFp))
- = Foo.$s$wfoo y_aFp sc_sGC ;
- But perhaps the first one isn't good. After all, we know that tpl_B2 is
- a T (I# x) really, because T is strict and Int has one constructor. (We can't
- unbox the strict fields, because T is polymorphic!)
- ************************************************************************
- * *
- \subsection{Top level wrapper stuff}
- * *
- ************************************************************************
- -}
- specConstrProgram :: ModGuts -> CoreM ModGuts
- specConstrProgram guts
- = do
- dflags <- getDynFlags
- us <- getUniqueSupplyM
- annos <- getFirstAnnotations deserializeWithData guts
- this_mod <- getModule
- let binds' = reverse $ fst $ initUs us $ do
- -- Note [Top-level recursive groups]
- (env, binds) <- goEnv (initScEnv dflags this_mod annos)
- (mg_binds guts)
- -- binds is identical to (mg_binds guts), except that the
- -- binders on the LHS have been replaced by extendBndr
- -- (SPJ this seems like overkill; I don't think the binders
- -- will change at all; and we don't substitute in the RHSs anyway!!)
- go env nullUsage (reverse binds)
- return (guts { mg_binds = binds' })
- where
- -- See Note [Top-level recursive groups]
- goEnv env [] = return (env, [])
- goEnv env (bind:binds) = do (env', bind') <- scTopBindEnv env bind
- (env'', binds') <- goEnv env' binds
- return (env'', bind' : binds')
- -- Arg list of bindings is in reverse order
- go _ _ [] = return []
- go env usg (bind:binds) = do (usg', bind') <- scTopBind env usg bind
- binds' <- go env usg' binds
- return (bind' : binds')
- {-
- ************************************************************************
- * *
- \subsection{Environment: goes downwards}
- * *
- ************************************************************************
- Note [Work-free values only in environment]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- The sc_vals field keeps track of in-scope value bindings, so
- that if we come across (case x of Just y ->...) we can reduce the
- case from knowing that x is bound to a pair.
- But only *work-free* values are ok here. For example if the envt had
- x -> Just (expensive v)
- then we do NOT want to expand to
- let y = expensive v in ...
- because the x-binding still exists and we've now duplicated (expensive v).
- This seldom happens because let-bound constructor applications are
- ANF-ised, but it can happen as a result of on-the-fly transformations in
- SpecConstr itself. Here is Trac #7865:
- let {
- a'_shr =
- case xs_af8 of _ {
- [] -> acc_af6;
- : ds_dgt [Dmd=<L,A>] ds_dgu [Dmd=<L,A>] ->
- (expensive x_af7, x_af7
- } } in
- let {
- ds_sht =
- case a'_shr of _ { (p'_afd, q'_afe) ->
- TSpecConstr_DoubleInline.recursive
- (GHC.Types.: @ GHC.Types.Int x_af7 wild_X6) (q'_afe, p'_afd)
- } } in
- When processed knowing that xs_af8 was bound to a cons, we simplify to
- a'_shr = (expensive x_af7, x_af7)
- and we do NOT want to inline that at the occurrence of a'_shr in ds_sht.
- (There are other occurrences of a'_shr.) No no no.
- It would be possible to do some on-the-fly ANF-ising, so that a'_shr turned
- into a work-free value again, thus
- a1 = expensive x_af7
- a'_shr = (a1, x_af7)
- but that's more work, so until its shown to be important I'm going to
- leave it for now.
- -}
- data ScEnv = SCE { sc_dflags :: DynFlags,
- sc_module :: !Module,
- sc_size :: Maybe Int, -- Size threshold
- sc_count :: Maybe Int, -- Max # of specialisations for any one fn
- -- See Note [Avoiding exponential blowup]
- sc_recursive :: Int, -- Max # of specialisations over recursive type.
- -- Stops ForceSpecConstr from diverging.
- sc_force :: Bool, -- Force specialisation?
- -- See Note [Forcing specialisation]
- sc_subst :: Subst, -- Current substitution
- -- Maps InIds to OutExprs
- sc_how_bound :: HowBoundEnv,
- -- Binds interesting non-top-level variables
- -- Domain is OutVars (*after* applying the substitution)
- sc_vals :: ValueEnv,
- -- Domain is OutIds (*after* applying the substitution)
- -- Used even for top-level bindings (but not imported ones)
- -- The range of the ValueEnv is *work-free* values
- -- such as (\x. blah), or (Just v)
- -- but NOT (Just (expensive v))
- -- See Note [Work-free values only in environment]
- sc_annotations :: UniqFM SpecConstrAnnotation
- }
- ---------------------
- -- As we go, we apply a substitution (sc_subst) to the current term
- type InExpr = CoreExpr -- _Before_ applying the subst
- type InVar = Var
- type OutExpr = CoreExpr -- _After_ applying the subst
- type OutId = Id
- type OutVar = Var
- ---------------------
- type HowBoundEnv = VarEnv HowBound -- Domain is OutVars
- ---------------------
- type ValueEnv = IdEnv Value -- Domain is OutIds
- data Value = ConVal AltCon [CoreArg] -- _Saturated_ constructors
- -- The AltCon is never DEFAULT
- | LambdaVal -- Inlinable lambdas or PAPs
- instance Outputable Value where
- ppr (ConVal con args) = ppr con <+> interpp'SP args
- ppr LambdaVal = text "<Lambda>"
- ---------------------
- initScEnv :: DynFlags -> Module -> UniqFM SpecConstrAnnotation -> ScEnv
- initScEnv dflags this_mod anns
- = SCE { sc_dflags = dflags,
- sc_module = this_mod,
- sc_size = specConstrThreshold dflags,
- sc_count = specConstrCount dflags,
- sc_recursive = specConstrRecursive dflags,
- sc_force = False,
- sc_subst = emptySubst,
- sc_how_bound = emptyVarEnv,
- sc_vals = emptyVarEnv,
- sc_annotations = anns }
- data HowBound = RecFun -- These are the recursive functions for which
- -- we seek interesting call patterns
- | RecArg -- These are those functions' arguments, or their sub-components;
- -- we gather occurrence information for these
- instance Outputable HowBound where
- ppr RecFun = text "RecFun"
- ppr RecArg = text "RecArg"
- scForce :: ScEnv -> Bool -> ScEnv
- scForce env b = env { sc_force = b }
- lookupHowBound :: ScEnv -> Id -> Maybe HowBound
- lookupHowBound env id = lookupVarEnv (sc_how_bound env) id
- scSubstId :: ScEnv -> Id -> CoreExpr
- scSubstId env v = lookupIdSubst (text "scSubstId") (sc_subst env) v
- scSubstTy :: ScEnv -> Type -> Type
- scSubstTy env ty = substTy (sc_subst env) ty
- scSubstCo :: ScEnv -> Coercion -> Coercion
- scSubstCo env co = substCo (sc_subst env) co
- zapScSubst :: ScEnv -> ScEnv
- zapScSubst env = env { sc_subst = zapSubstEnv (sc_subst env) }
- extendScInScope :: ScEnv -> [Var] -> ScEnv
- -- Bring the quantified variables into scope
- extendScInScope env qvars = env { sc_subst = extendInScopeList (sc_subst env) qvars }
- -- Extend the substitution
- extendScSubst :: ScEnv -> Var -> OutExpr -> ScEnv
- extendScSubst env var expr = env { sc_subst = extendSubst (sc_subst env) var expr }
- extendScSubstList :: ScEnv -> [(Var,OutExpr)] -> ScEnv
- extendScSubstList env prs = env { sc_subst = extendSubstList (sc_subst env) prs }
- extendHowBound :: ScEnv -> [Var] -> HowBound -> ScEnv
- extendHowBound env bndrs how_bound
- = env { sc_how_bound = extendVarEnvList (sc_how_bound env)
- [(bndr,how_bound) | bndr <- bndrs] }
- extendBndrsWith :: HowBound -> ScEnv -> [Var] -> (ScEnv, [Var])
- extendBndrsWith how_bound env bndrs
- = (env { sc_subst = subst', sc_how_bound = hb_env' }, bndrs')
- where
- (subst', bndrs') = substBndrs (sc_subst env) bndrs
- hb_env' = sc_how_bound env `extendVarEnvList`
- [(bndr,how_bound) | bndr <- bndrs']
- extendBndrWith :: HowBound -> ScEnv -> Var -> (ScEnv, Var)
- extendBndrWith how_bound env bndr
- = (env { sc_subst = subst', sc_how_bound = hb_env' }, bndr')
- where
- (subst', bndr') = substBndr (sc_subst env) bndr
- hb_env' = extendVarEnv (sc_how_bound env) bndr' how_bound
- extendRecBndrs :: ScEnv -> [Var] -> (ScEnv, [Var])
- extendRecBndrs env bndrs = (env { sc_subst = subst' }, bndrs')
- where
- (subst', bndrs') = substRecBndrs (sc_subst env) bndrs
- extendBndr :: ScEnv -> Var -> (ScEnv, Var)
- extendBndr env bndr = (env { sc_subst = subst' }, bndr')
- where
- (subst', bndr') = substBndr (sc_subst env) bndr
- extendValEnv :: ScEnv -> Id -> Maybe Value -> ScEnv
- extendValEnv env _ Nothing = env
- extendValEnv env id (Just cv)
- | valueIsWorkFree cv -- Don't duplicate work!! Trac #7865
- = env { sc_vals = extendVarEnv (sc_vals env) id cv }
- extendValEnv env _ _ = env
- extendCaseBndrs :: ScEnv -> OutExpr -> OutId -> AltCon -> [Var] -> (ScEnv, [Var])
- -- When we encounter
- -- case scrut of b
- -- C x y -> ...
- -- we want to bind b, to (C x y)
- -- NB1: Extends only the sc_vals part of the envt
- -- NB2: Kill the dead-ness info on the pattern binders x,y, since
- -- they are potentially made alive by the [b -> C x y] binding
- extendCaseBndrs env scrut case_bndr con alt_bndrs
- = (env2, alt_bndrs')
- where
- live_case_bndr = not (isDeadBinder case_bndr)
- env1 | Var v <- stripTicksTopE (const True) scrut
- = extendValEnv env v cval
- | otherwise = env -- See Note [Add scrutinee to ValueEnv too]
- env2 | live_case_bndr = extendValEnv env1 case_bndr cval
- | otherwise = env1
- alt_bndrs' | case scrut of { Var {} -> True; _ -> live_case_bndr }
- = map zap alt_bndrs
- | otherwise
- = alt_bndrs
- cval = case con of
- DEFAULT -> Nothing
- LitAlt {} -> Just (ConVal con [])
- DataAlt {} -> Just (ConVal con vanilla_args)
- where
- vanilla_args = map Type (tyConAppArgs (idType case_bndr)) ++
- varsToCoreExprs alt_bndrs
- zap v | isTyVar v = v -- See NB2 above
- | otherwise = zapIdOccInfo v
- decreaseSpecCount :: ScEnv -> Int -> ScEnv
- -- See Note [Avoiding exponential blowup]
- decreaseSpecCount env n_specs
- = env { sc_count = case sc_count env of
- Nothing -> Nothing
- Just n -> Just (n `div` (n_specs + 1)) }
- -- The "+1" takes account of the original function;
- -- See Note [Avoiding exponential blowup]
- ---------------------------------------------------
- -- See Note [Forcing specialisation]
- ignoreType :: ScEnv -> Type -> Bool
- ignoreDataCon :: ScEnv -> DataCon -> Bool
- forceSpecBndr :: ScEnv -> Var -> Bool
- #ifndef GHCI
- ignoreType _ _ = False
- ignoreDataCon _ _ = False
- #else /* GHCI */
- ignoreDataCon env dc = ignoreTyCon env (dataConTyCon dc)
- ignoreType env ty
- = case tyConAppTyCon_maybe ty of
- Just tycon -> ignoreTyCon env tycon
- _ -> False
- ignoreTyCon :: ScEnv -> TyCon -> Bool
- ignoreTyCon env tycon
- = lookupUFM (sc_annotations env) tycon == Just NoSpecConstr
- #endif /* GHCI */
- forceSpecBndr env var = forceSpecFunTy env . snd . splitForAllTys . varType $ var
- forceSpecFunTy :: ScEnv -> Type -> Bool
- forceSpecFunTy env = any (forceSpecArgTy env) . fst . splitFunTys
- forceSpecArgTy :: ScEnv -> Type -> Bool
- forceSpecArgTy env ty
- | Just ty' <- coreView ty = forceSpecArgTy env ty'
- forceSpecArgTy env ty
- | Just (tycon, tys) <- splitTyConApp_maybe ty
- , tycon /= funTyCon
- = tyConName tycon == specTyConName
- #ifdef GHCI
- || lookupUFM (sc_annotations env) tycon == Just ForceSpecConstr
- #endif
- || any (forceSpecArgTy env) tys
- forceSpecArgTy _ _ = False
- {-
- Note [Add scrutinee to ValueEnv too]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- Consider this:
- case x of y
- (a,b) -> case b of c
- I# v -> ...(f y)...
- By the time we get to the call (f y), the ValueEnv
- will have a binding for y, and for c
- y -> (a,b)
- c -> I# v
- BUT that's not enough! Looking at the call (f y) we
- see that y is pair (a,b), but we also need to know what 'b' is.
- So in extendCaseBndrs we must *also* add the binding
- b -> I# v
- else we lose a useful specialisation for f. This is necessary even
- though the simplifier has systematically replaced uses of 'x' with 'y'
- and 'b' with 'c' in the code. The use of 'b' in the ValueEnv came
- from outside the case. See Trac #4908 for the live example.
- Note [Avoiding exponential blowup]
- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- The sc_count field of the ScEnv says how many times we are prepared to
- duplicate a single function. But we must take care with recursive
- specialisations. Consider
- let $j1 = let $j2 = let $j3 = ...
- in
- ...$j3...
- in
- ...$j2...
- in
- ...$j1...
- If we specialise $j1 then in each specialisation (as well as the original)
- we can specialise $j2, and similarly $j3. Even if we make just *one*
- specialisation of each, because we also have the original we'll get 2^n
- copies of $j3, which is not good.
- So when recursively specialising we divide the sc_count by the number of
- copies we are making at this level, including the original.
- ************************************************************************
- * *
- \subsection{Usage information: flows upwards}
- * *
- ************************************************************************
- -}
- data ScUsage
- = SCU {
- scu_calls :: CallEnv, -- Calls
- -- The functions are a subset of the
- -- RecFuns in the ScEnv
- scu_occs :: !(IdEnv ArgOcc) -- Information on argument occurrences
- } -- The domain is OutIds
- type CallEnv = IdEnv [Call]
- data Call = Call Id [CoreArg] ValueEnv
- -- The arguments of the call, together with the
- -- env giving the constructor bindings at the call site
- -- We keep the function mainly for debug output
- instance Outputable ScUsage where
- ppr (SCU { scu_calls = calls, scu_occs = occs })
- = text "SCU" <+> braces (sep [ ptext (sLit "calls =") <+> ppr calls
- , text "occs =" <+> ppr occs ])
- instance Outputable Call where
- ppr (Call fn args _) = ppr fn <+> fsep (map pprParendExpr args)
- nullUsage :: ScUsage
- nullUsage = SCU { scu_calls = emptyVarEnv, scu_occs = emptyVarEnv }
- combineCalls :: CallEnv -> CallEnv -> CallEnv
- combineCalls = plusVarEnv_C (++)
- where
- -- plus cs ds | length res > 1
- -- = pprTrace "combineCalls" (vcat [ text "cs:" <+> ppr cs
- -- , text "ds:" <+> ppr ds])
- -- res
- -- | otherwise = res
- -- where
- -- res = cs ++ ds
- combineUsage :: ScUsage -> ScUsage -> ScUsage
- combineUsage u1 u2 = SCU { scu_calls = combineCalls (scu_calls u1) (scu_calls u2),
- scu_occs = plusVarEnv_C combineOcc (scu_occs u1) (scu_occs u2) }
- combineUsages :: [ScUsage] -> ScUsage
- combineUsages [] = nullUsage
- combineUsages us = foldr1 combineUsage us
- lookupOccs :: ScUsage -> [OutVar] -> (ScUsage, [ArgOcc])
- lookupOccs (SCU { scu_calls = sc_calls, scu_occs = sc_occs }) bndrs
- = (SCU {scu_calls = sc_calls, scu_occs = delVarEnvList sc_occs bndrs},
- [lookupVarEnv sc_occs b `orElse` NoOcc | b <- bndrs])
- data ArgOcc = NoOcc -- Doesn't occur at all; or a type argument
- | UnkOcc -- Used in some unknown way
- | ScrutOcc -- See Note [ScrutOcc]
- (DataConEnv [ArgOcc]) -- How the sub-components are used
- type DataConEnv a = UniqFM a -- Keyed by DataCon
- {- Note [ScrutOcc]
- ~~~~~~~~~~~~~~~~~~~
- An occurrence of ScrutOcc indicates that the thing, or a `cast` version of the thing,
- is *only* taken apart or applied.
- Functions, literal: ScrutOcc emptyUFM
- Data constructors: ScrutOcc subs,
- where (subs :: UniqFM [ArgOcc]) gives usage of the *pattern-bound* components,
- The domain of the UniqFM is the Unique of the data constructor
- The [ArgOcc] is the occurrences of the *pattern-bound* components
- of the data structure. E.g.
- data T a = forall b. MkT a b (b->a)
- A pattern binds b, x::a, y::b, z::b->a, but not 'a'!
- -}
- instance Outputable ArgOcc where
- ppr (ScrutOcc xs) = text "scrut-occ" <> ppr xs
- ppr UnkOcc = text "unk-occ"
- ppr NoOcc = text "no-occ"
- evalScrutOcc :: ArgOcc
- evalScrutOcc = ScrutOcc emptyUFM
- -- Experimentally, this vesion of combineOcc makes ScrutOcc "win", so
- -- that if the thing is scrutinised anywhere then we get to see that
- -- in the overall result, even if it's also used in a boxed way
- -- This might be too aggressive; see Note [Reboxing] Alternative 3
- combineOcc :: ArgOcc -> ArgOcc -> ArgOcc
- combineOcc NoOcc occ = occ
- combineOcc occ NoOcc = occ
- combineOcc (ScrutOcc xs) (ScrutOcc ys) = ScrutOcc (plusUFM_C combineOccs xs ys)
- combineOcc UnkOcc (ScrutOcc ys) = ScrutOcc ys
- combineOcc (ScrutOcc xs) UnkOcc = ScrutOcc xs
- combineOcc UnkOcc UnkOcc = UnkOcc
- combineOccs :: [ArgOcc] -> [ArgOcc] -> [ArgOcc]
- combineOccs xs ys = zipWithEqual "combineOccs" combineOcc xs ys
- setScrutOcc :: ScEnv -> ScUsage -> OutExpr -> ArgOcc -> ScUsage
- -- _Overwrite_ the occurrence info for the scrutinee, if the scrutinee
- -- is a variable, and an interesting variable
- setScrutOcc env usg (Cast e _) occ = setScrutOcc env usg e occ
- setScrutOcc env usg (Tick _ e) occ = setScrutOcc env usg e occ
- setScrutOcc env usg (Var v) occ
- | Just RecArg <- lookupHowBound env v = usg { scu_occs = extendVarEnv (scu_occs usg) v occ }
- | otherwise = usg
- setScrutOcc _env usg _other _occ -- Catch-all
- = usg
- {-
- ************************************************************************
- * *
- \subsection{The main recursive function}
- * *
- ************************************************************************
- The main recursive function gathers up usage information, and
- creates specialised versions of functions.
- -}
- scExpr, scExpr' :: ScEnv -> CoreExpr -> UniqSM (ScUsage, CoreExpr)
- -- The unique supply is needed when we invent
- -- a new name for the specialised function and its args
- scExpr env e = scExpr' env e
- scExpr' env (Var v) = case scSubstId env v of
- Var v' -> return (mkVarUsage env v' [], Var v')
- e' -> scExpr (zapScSubst env) e'
- scExpr' env (Type t) = return (nullUsage, Type (scSubstTy env t))
- scExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c))
- scExpr' _ e@(Lit {}) = return (nullUsage, e)
- scExpr' env (Tick t e) = do (usg, e') <- scExpr env e
- return (usg, Tick t e')
- scExpr' env (Cast e co) = do (usg, e') <- scExpr env e
- return (usg, mkCast e' (scSubstCo env co))
- -- Important to use mkCast here
- -- See Note [SpecConstr call patterns]
- scExpr' env e@(App _ _) = scApp env (collectArgs e)
- scExpr' env (Lam b e) = do let (env', b') = extendBndr env b
- (usg, e') <- scExpr env' e
- return (usg, Lam b' e')
- scExpr' env (Case scrut b ty alts)
- = do { (scrut_usg, scrut') <- scExpr env scrut
- ; case isValue (sc_vals env) scrut' of
- Just (ConVal con args) -> sc_con_app con args scrut'
- _other -> sc_vanilla scrut_usg scrut'
- }
- where
- sc_con_app con args scrut' -- Known constructor; simplify
- = do { let (_, bs, rhs) = findAlt con alts
- `orElse` (DEFAULT, [], mkImpossibleExpr ty)
- alt_env' = extendScSubstList env ((b,scrut') : bs `zip` trimConArgs con args)
- ; scExpr alt_env' rhs }
- sc_vanilla scrut_usg scrut' -- Normal case
- = do { let (alt_env,b') = extendBndrWith RecArg env b
- -- Record RecArg for the components
- ; (alt_usgs, alt_occs, alts')
- <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts
- ; let scrut_occ = foldr combineOcc NoOcc alt_occs
- scrut_usg' = setScrutOcc env scrut_usg scrut' scrut_occ
- -- The combined usage of the scrutinee is given
- -- by scrut_occ, which is passed to scScrut, which
- -- in turn treats a bare-variable scrutinee specially
- ; return (foldr combineUsage scrut_usg' alt_usgs,
- Case scrut' b' (scSubstTy env ty) alts') }
- sc_alt env scrut' b' (con,bs,rhs)
- = do { let (env1, bs1) = extendBndrsWith RecArg env bs
- (env2, bs2) = extendCaseBndrs env1 scrut' b' con bs1
- ; (usg, rhs') <- scExpr env2 rhs
- ; let (usg', b_occ:arg_occs) = lookupOccs usg (b':bs2)
- scrut_occ = case con of
- DataAlt dc -> ScrutOcc (unitUFM dc arg_occs)
- _ -> ScrutOcc emptyUFM
- ; return (usg', b_occ `combineOcc` scrut_occ, (con, bs2, rhs')) }
- scExpr' env (Let (NonRec bndr rhs) body)
- | isTyVar bndr -- Type-lets may be created by doBeta
- = scExpr' (extendScSubst env bndr rhs) body
- | otherwise
- = do { let (body_env, bndr') = extendBndr env bndr
- ; rhs_info <- scRecRhs env (bndr',rhs)
- ; let body_env2 = extendHowBound body_env [bndr'] RecFun
- -- Note [Local let bindings]
- rhs' = ri_new_rhs rhs_info
- body_env3 = extendValEnv body_env2 bndr' (isValue (sc_vals env) rhs')
- ; (body_usg, body') <- scExpr body_env3 body
- -- NB: For non-recursive bindings we inherit sc_force flag from
- -- the parent function (see Note [Forcing specialisation])
- ; (spec_usg, specs) <- specNonRec env body_usg rhs_info
- ; return (body_usg { scu_calls = scu_calls body_usg `delVarEnv` bndr' }
- `combineUsage` spec_usg, -- Note [spec_usg includes rhs_usg]
- mkLets [NonRec b r | (b,r) <- ruleInfoBinds rhs_info specs] body')
- }
- -- A *local* recursive group: see Note [Local recursive groups]
- scExpr' env (Let (Rec prs) body)
- = do { let (bndrs,rhss) = unzip prs
- (rhs_env1,bndrs') = extendRecBndrs env bndrs
- rhs_env2 = extendHowBound rhs_env1 bndrs' RecFun
- force_spec = any (forceSpecBndr env) bndrs'
- -- Note [Forcing specialisation]
- ; rhs_infos <- mapM (scRecRhs rhs_env2) (bndrs' `zip` rhss)
- ; (body_usg, body') <- scExpr rhs_env2 body
- -- NB: start specLoop from body_usg
- ; (spec_usg, specs) <- specRec NotTopLevel (scForce rhs_env2 force_spec)
- body_usg rhs_infos
- -- Do not unconditionally generate specialisations from rhs_usgs
- -- Instead use them only if we find an unspecialised call
- -- See Note [Local recursive groups]
- ; let all_usg = spec_usg `combineUsage` body_usg -- Note [spec_usg includes rhs_usg]
- bind' = Rec (concat (zipWith ruleInfoBinds rhs_infos specs))
- ; return (all_usg { scu_calls = scu_calls all_usg `delVarEnvList` bndrs' },
- Let bind' body') }
- {-
- Note [Local let bindings]
- ~~~~~~~~~~~~~~~~~~~~~~~~~
- It is not uncommon to find this
- let $j = \x. <blah> in ...$j True...$j True...
- Here $j is an arbitrary let-bound function, but it often comes up for
- join points. We might like to specialise $j for its call patterns.
- Notice the difference from a letrec, where we look for call patterns
- in the *RHS* of the function. Here we look for call patterns in the
- *body* of the let.
- At one point I predicated this on the RHS mentioning the outer
- recursive function, but that's not essential and might even be
- harmful. I'm not sure.
- -}
- scApp :: ScEnv -> (InExpr, [InExpr]) -> UniqSM (ScUsage…
Large files files are truncated, but you can click here to view the full file