2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[SimplCore]{Driver for simplifying @Core@ programs}
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and fix
10 -- any warnings in the module. See
11 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
14 module SimplCore ( core2core, simplifyExpr ) where
16 #include "HsVersions.h"
18 import DynFlags ( CoreToDo(..), SimplifierSwitch(..),
19 SimplifierMode(..), DynFlags, DynFlag(..), dopt,
22 import HscTypes ( HscEnv(..), ModGuts(..), ExternalPackageState(..),
23 Dependencies( dep_mods ),
25 import CSE ( cseProgram )
26 import Rules ( RuleBase, emptyRuleBase, mkRuleBase, unionRuleBase,
27 extendRuleBaseList, pprRuleBase, ruleCheckProgram,
28 addSpecInfo, addIdSpecialisations )
29 import PprCore ( pprCoreBindings, pprCoreExpr, pprRules )
30 import OccurAnal ( occurAnalysePgm, occurAnalyseExpr )
31 import IdInfo ( setNewStrictnessInfo, newStrictnessInfo,
32 setWorkerInfo, workerInfo, setSpecInfoHead,
33 setInlinePragInfo, inlinePragInfo,
34 setSpecInfo, specInfo, specInfoRules )
35 import CoreUtils ( coreBindsSize )
36 import Simplify ( simplTopBinds, simplExpr )
37 import SimplEnv ( SimplEnv, simplBinders, mkSimplEnv, setInScopeSet )
39 import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass )
40 import CoreLint ( endPass, endIteration )
41 import FloatIn ( floatInwards )
42 import FloatOut ( floatOutwards )
44 import Id ( Id, modifyIdInfo, idInfo, isExportedId, isLocalId,
45 idSpecialisation, idName )
48 import NameEnv ( lookupNameEnv )
49 import LiberateCase ( liberateCase )
50 import SAT ( doStaticArgs )
51 import Specialise ( specProgram)
52 import SpecConstr ( specConstrProgram)
53 import DmdAnal ( dmdAnalPgm )
54 import WorkWrap ( wwTopBinds )
56 import StrictAnal ( saBinds )
57 import CprAnalyse ( cprAnalyse )
59 import Vectorise ( vectorise )
61 import UniqSupply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply )
62 import IO ( hPutStr, stderr )
64 import List ( partition )
65 import Maybes ( orElse )
68 %************************************************************************
70 \subsection{The driver for the simplifier}
72 %************************************************************************
79 core2core hsc_env guts
81 let dflags = hsc_dflags hsc_env
82 core_todos = getCoreToDo dflags
84 us <- mkSplitUniqSupply 's'
85 let (cp_us, ru_us) = splitUniqSupply us
87 -- COMPUTE THE RULE BASE TO USE
88 (imp_rule_base, guts') <- prepareRules hsc_env guts ru_us
91 (stats, guts'') <- doCorePasses hsc_env imp_rule_base cp_us
92 (zeroSimplCount dflags)
95 dumpIfSet_dyn dflags Opt_D_dump_simpl_stats
96 "Grand total simplifier statistics"
102 simplifyExpr :: DynFlags -- includes spec of what core-to-core passes to do
105 -- simplifyExpr is called by the driver to simplify an
106 -- expression typed in at the interactive prompt
107 simplifyExpr dflags expr
109 ; showPass dflags "Simplify"
111 ; us <- mkSplitUniqSupply 's'
113 ; let (expr', _counts) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
114 simplExprGently gentleSimplEnv expr
116 ; dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
122 gentleSimplEnv :: SimplEnv
123 gentleSimplEnv = mkSimplEnv SimplGently (isAmongSimpl [])
125 doCorePasses :: HscEnv
126 -> RuleBase -- the imported main rule base
127 -> UniqSupply -- uniques
128 -> SimplCount -- simplifier stats
129 -> ModGuts -- local binds in (with rules attached)
130 -> [CoreToDo] -- which passes to do
131 -> IO (SimplCount, ModGuts)
133 doCorePasses hsc_env rb us stats guts []
134 = return (stats, guts)
136 doCorePasses hsc_env rb us stats guts (CoreDoPasses to_dos1 : to_dos2)
137 = doCorePasses hsc_env rb us stats guts (to_dos1 ++ to_dos2)
139 doCorePasses hsc_env rb us stats guts (to_do : to_dos)
141 let (us1, us2) = splitUniqSupply us
142 (stats1, guts1) <- doCorePass to_do hsc_env us1 rb guts
143 doCorePasses hsc_env rb us2 (stats `plusSimplCount` stats1) guts1 to_dos
145 doCorePass :: CoreToDo -> HscEnv -> UniqSupply -> RuleBase
146 -> ModGuts -> IO (SimplCount, ModGuts)
147 doCorePass (CoreDoSimplify mode sws) = {-# SCC "Simplify" #-} simplifyPgm mode sws
148 doCorePass CoreCSE = {-# SCC "CommonSubExpr" #-} trBinds cseProgram
149 doCorePass CoreLiberateCase = {-# SCC "LiberateCase" #-} liberateCase
150 doCorePass CoreDoFloatInwards = {-# SCC "FloatInwards" #-} trBinds floatInwards
151 doCorePass (CoreDoFloatOutwards f) = {-# SCC "FloatOutwards" #-} trBindsU (floatOutwards f)
152 doCorePass CoreDoStaticArgs = {-# SCC "StaticArgs" #-} trBinds doStaticArgs
153 doCorePass CoreDoStrictness = {-# SCC "Stranal" #-} trBinds dmdAnalPgm
154 doCorePass CoreDoWorkerWrapper = {-# SCC "WorkWrap" #-} trBindsU wwTopBinds
155 doCorePass CoreDoSpecialising = {-# SCC "Specialise" #-} trBindsU specProgram
156 doCorePass CoreDoSpecConstr = {-# SCC "SpecConstr" #-} trBindsU specConstrProgram
157 doCorePass CoreDoGlomBinds = trBinds glomBinds
158 doCorePass CoreDoVectorisation = {-# SCC "Vectorise" #-} vectorise
159 doCorePass CoreDoPrintCore = observe printCore
160 doCorePass (CoreDoRuleCheck phase pat) = ruleCheck phase pat
161 doCorePass CoreDoNothing = observe (\ _ _ -> return ())
162 #ifdef OLD_STRICTNESS
163 doCorePass CoreDoOldStrictness = {-# SCC "OldStrictness" #-} trBinds doOldStrictness
165 doCorePass CoreDoOldStrictness = panic "CoreDoOldStrictness"
167 doCorePass (CoreDoPasses _) = panic "CoreDoPasses"
169 #ifdef OLD_STRICTNESS
170 doOldStrictness dfs binds
171 = do binds1 <- saBinds dfs binds
172 binds2 <- cprAnalyse dfs binds1
176 printCore _ binds = dumpIfSet True "Print Core" (pprCoreBindings binds)
178 ruleCheck phase pat hsc_env us rb guts
179 = do let dflags = hsc_dflags hsc_env
180 showPass dflags "RuleCheck"
181 printDump (ruleCheckProgram phase pat rb (mg_binds guts))
182 return (zeroSimplCount dflags, guts)
184 -- Most passes return no stats and don't change rules
185 trBinds :: (DynFlags -> [CoreBind] -> IO [CoreBind])
186 -> HscEnv -> UniqSupply -> RuleBase -> ModGuts
187 -> IO (SimplCount, ModGuts)
188 trBinds do_pass hsc_env us rb guts
189 = do { binds' <- do_pass dflags (mg_binds guts)
190 ; return (zeroSimplCount dflags, guts { mg_binds = binds' }) }
192 dflags = hsc_dflags hsc_env
194 trBindsU :: (DynFlags -> UniqSupply -> [CoreBind] -> IO [CoreBind])
195 -> HscEnv -> UniqSupply -> RuleBase -> ModGuts
196 -> IO (SimplCount, ModGuts)
197 trBindsU do_pass hsc_env us rb guts
198 = do { binds' <- do_pass dflags us (mg_binds guts)
199 ; return (zeroSimplCount dflags, guts { mg_binds = binds' }) }
201 dflags = hsc_dflags hsc_env
203 -- Observer passes just peek; don't modify the bindings at all
204 observe :: (DynFlags -> [CoreBind] -> IO a)
205 -> HscEnv -> UniqSupply -> RuleBase -> ModGuts
206 -> IO (SimplCount, ModGuts)
207 observe do_pass hsc_env us rb guts
208 = do { binds <- do_pass dflags (mg_binds guts)
209 ; return (zeroSimplCount dflags, guts) }
211 dflags = hsc_dflags hsc_env
216 %************************************************************************
218 \subsection{Dealing with rules}
220 %************************************************************************
222 -- prepareLocalRuleBase takes the CoreBinds and rules defined in this module.
223 -- It attaches those rules that are for local Ids to their binders, and
224 -- returns the remainder attached to Ids in an IdSet.
227 prepareRules :: HscEnv
230 -> IO (RuleBase, -- Rule base for imported things, incl
231 -- (a) rules defined in this module (orphans)
232 -- (b) rules from other modules in home package
233 -- but not things from other packages
235 ModGuts) -- Modified fields are
236 -- (a) Bindings have rules attached,
237 -- (b) Rules are now just orphan rules
239 prepareRules hsc_env@(HscEnv { hsc_dflags = dflags, hsc_HPT = hpt })
240 guts@(ModGuts { mg_binds = binds, mg_deps = deps, mg_rules = local_rules })
242 = do { let -- Simplify the local rules; boringly, we need to make an in-scope set
243 -- from the local binders, to avoid warnings from Simplify.simplVar
244 local_ids = mkInScopeSet (mkVarSet (bindersOfBinds binds))
245 env = setInScopeSet gentleSimplEnv local_ids
246 (better_rules,_) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
247 (mapM (simplRule env) local_rules)
248 home_pkg_rules = hptRules hsc_env (dep_mods deps)
250 -- Find the rules for locally-defined Ids; then we can attach them
251 -- to the binders in the top-level bindings
254 -- - It makes the rules easier to look up
255 -- - It means that transformation rules and specialisations for
256 -- locally defined Ids are handled uniformly
257 -- - It keeps alive things that are referred to only from a rule
258 -- (the occurrence analyser knows about rules attached to Ids)
259 -- - It makes sure that, when we apply a rule, the free vars
260 -- of the RHS are more likely to be in scope
261 -- - The imported rules are carried in the in-scope set
262 -- which is extended on each iteration by the new wave of
263 -- local binders; any rules which aren't on the binding will
264 -- thereby get dropped
265 (rules_for_locals, rules_for_imps) = partition isLocalRule better_rules
266 local_rule_base = extendRuleBaseList emptyRuleBase rules_for_locals
267 binds_w_rules = updateBinders local_rule_base binds
269 hpt_rule_base = mkRuleBase home_pkg_rules
270 imp_rule_base = extendRuleBaseList hpt_rule_base rules_for_imps
272 ; dumpIfSet_dyn dflags Opt_D_dump_rules "Transformation rules"
273 (vcat [text "Local rules", pprRules better_rules,
275 text "Imported rules", pprRuleBase imp_rule_base])
277 ; return (imp_rule_base, guts { mg_binds = binds_w_rules,
278 mg_rules = rules_for_imps })
281 updateBinders :: RuleBase -> [CoreBind] -> [CoreBind]
282 updateBinders local_rules binds
283 = map update_bndrs binds
285 update_bndrs (NonRec b r) = NonRec (update_bndr b) r
286 update_bndrs (Rec prs) = Rec [(update_bndr b, r) | (b,r) <- prs]
288 update_bndr bndr = case lookupNameEnv local_rules (idName bndr) of
290 Just rules -> bndr `addIdSpecialisations` rules
291 -- The binder might have some existing rules,
292 -- arising from specialisation pragmas
296 We must do some gentle simplification on the template (but not the RHS)
297 of each rule. The case that forced me to add this was the fold/build rule,
298 which without simplification looked like:
299 fold k z (build (/\a. g a)) ==> ...
300 This doesn't match unless you do eta reduction on the build argument.
303 simplRule env rule@(BuiltinRule {})
305 simplRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs })
306 = do (env, bndrs') <- simplBinders env bndrs
307 args' <- mapM (simplExprGently env) args
308 rhs' <- simplExprGently env rhs
309 return (rule { ru_bndrs = bndrs', ru_args = args', ru_rhs = rhs' })
311 -- It's important that simplExprGently does eta reduction.
312 -- For example, in a rule like:
313 -- augment g (build h)
314 -- we do not want to get
315 -- augment (\a. g a) (build h)
316 -- otherwise we don't match when given an argument like
319 -- The simplifier does indeed do eta reduction (it's in
320 -- Simplify.completeLam) but only if -O is on.
324 simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr
325 -- Simplifies an expression
326 -- does occurrence analysis, then simplification
327 -- and repeats (twice currently) because one pass
328 -- alone leaves tons of crud.
329 -- Used (a) for user expressions typed in at the interactive prompt
330 -- (b) the LHS and RHS of a RULE
332 -- The name 'Gently' suggests that the SimplifierMode is SimplGently,
333 -- and in fact that is so.... but the 'Gently' in simplExprGently doesn't
334 -- enforce that; it just simplifies the expression twice
336 simplExprGently env expr = do
337 expr1 <- simplExpr env (occurAnalyseExpr expr)
338 simplExpr env (occurAnalyseExpr expr1)
342 %************************************************************************
344 \subsection{Glomming}
346 %************************************************************************
349 glomBinds :: DynFlags -> [CoreBind] -> IO [CoreBind]
350 -- Glom all binds together in one Rec, in case any
351 -- transformations have introduced any new dependencies
353 -- NB: the global invariant is this:
354 -- *** the top level bindings are never cloned, and are always unique ***
356 -- We sort them into dependency order, but applying transformation rules may
357 -- make something at the top refer to something at the bottom:
361 -- RULE: p (q x) = h x
363 -- Applying this rule makes f refer to h,
364 -- although it doesn't appear to in the source program.
365 -- This pass lets us control where it happens.
367 -- NOTICE that this cannot happen for rules whose head is a locally-defined
368 -- function. It only happens for rules whose head is an imported function
369 -- (p in the example above). So, for example, the rule had been
370 -- RULE: f (p x) = h x
371 -- then the rule for f would be attached to f itself (in its IdInfo)
372 -- by prepareLocalRuleBase and h would be regarded by the occurrency
373 -- analyser as free in f.
375 glomBinds dflags binds
376 = do { showPass dflags "GlomBinds" ;
377 let { recd_binds = [Rec (flattenBinds binds)] } ;
379 -- Not much point in printing the result...
380 -- just consumes output bandwidth
384 %************************************************************************
386 \subsection{The driver for the simplifier}
388 %************************************************************************
391 simplifyPgm :: SimplifierMode
392 -> [SimplifierSwitch]
397 -> IO (SimplCount, ModGuts) -- New bindings
399 simplifyPgm mode switches hsc_env us imp_rule_base guts
401 showPass dflags "Simplify";
403 (termination_msg, it_count, counts_out, binds')
404 <- do_iteration us 1 (zeroSimplCount dflags) (mg_binds guts) ;
406 dumpIfSet (dopt Opt_D_verbose_core2core dflags
407 && dopt Opt_D_dump_simpl_stats dflags)
408 "Simplifier statistics"
409 (vcat [text termination_msg <+> text "after" <+> ppr it_count <+> text "iterations",
411 pprSimplCount counts_out]);
413 endPass dflags ("Simplify phase " ++ phase_info ++ " done") Opt_D_dump_simpl_phases binds';
415 return (counts_out, guts { mg_binds = binds' })
418 dflags = hsc_dflags hsc_env
419 phase_info = case mode of
420 SimplGently -> "gentle"
421 SimplPhase n -> show n
423 sw_chkr = isAmongSimpl switches
424 max_iterations = intSwitchSet sw_chkr MaxSimplifierIterations `orElse` 2
426 do_iteration us iteration_no counts binds
427 -- iteration_no is the number of the iteration we are
428 -- about to begin, with '1' for the first
429 | iteration_no > max_iterations -- Stop if we've run out of iterations
432 if max_iterations > 2 then
433 hPutStr stderr ("NOTE: Simplifier still going after " ++
434 show max_iterations ++
435 " iterations; bailing out. Size = " ++ show (coreBindsSize binds) ++ "\n" )
439 -- Subtract 1 from iteration_no to get the
440 -- number of iterations we actually completed
441 return ("Simplifier baled out", iteration_no - 1, counts, binds)
444 -- Try and force thunks off the binds; significantly reduces
445 -- space usage, especially with -O. JRS, 000620.
446 | let sz = coreBindsSize binds in sz == sz
448 -- Occurrence analysis
449 let { tagged_binds = {-# SCC "OccAnal" #-} occurAnalysePgm binds } ;
450 dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
451 (pprCoreBindings tagged_binds);
453 -- Get any new rules, and extend the rule base
454 -- We need to do this regularly, because simplification can
455 -- poke on IdInfo thunks, which in turn brings in new rules
456 -- behind the scenes. Otherwise there's a danger we'll simply
457 -- miss the rules for Ids hidden inside imported inlinings
458 eps <- hscEPS hsc_env ;
459 let { rule_base' = unionRuleBase imp_rule_base (eps_rule_base eps)
460 ; simpl_env = mkSimplEnv mode sw_chkr
461 ; simpl_binds = {-# SCC "SimplTopBinds" #-}
462 simplTopBinds simpl_env tagged_binds
463 ; fam_envs = (eps_fam_inst_env eps, mg_fam_inst_env guts) } ;
465 -- Simplify the program
466 -- We do this with a *case* not a *let* because lazy pattern
467 -- matching bit us with bad space leak!
468 -- With a let, we ended up with
473 -- case t of {(_,counts') -> if counts'=0 then ... }
474 -- So the conditional didn't force counts', because the
475 -- selection got duplicated. Sigh!
476 case initSmpl dflags rule_base' fam_envs us1 simpl_binds of {
477 (binds', counts') -> do {
479 let { all_counts = counts `plusSimplCount` counts'
480 ; herald = "Simplifier phase " ++ phase_info ++
481 ", iteration " ++ show iteration_no ++
482 " out of " ++ show max_iterations
485 -- Stop if nothing happened; don't dump output
486 if isZeroSimplCount counts' then
487 return ("Simplifier reached fixed point", iteration_no,
490 -- Short out indirections
491 -- We do this *after* at least one run of the simplifier
492 -- because indirection-shorting uses the export flag on *occurrences*
493 -- and that isn't guaranteed to be ok until after the first run propagates
494 -- stuff from the binding site to its occurrences
496 -- ToDo: alas, this means that indirection-shorting does not happen at all
497 -- if the simplifier does nothing (not common, I know, but unsavoury)
498 let { binds'' = {-# SCC "ZapInd" #-} shortOutIndirections binds' } ;
500 -- Dump the result of this iteration
501 dumpIfSet_dyn dflags Opt_D_dump_simpl_iterations herald
502 (pprSimplCount counts') ;
503 endIteration dflags herald Opt_D_dump_simpl_iterations binds'' ;
506 do_iteration us2 (iteration_no + 1) all_counts binds''
509 (us1, us2) = splitUniqSupply us
513 %************************************************************************
515 Shorting out indirections
517 %************************************************************************
521 x_local = <expression>
525 where x_exported is exported, and x_local is not, then we replace it with this:
527 x_exported = <expression>
531 Without this we never get rid of the x_exported = x_local thing. This
532 save a gratuitous jump (from \tr{x_exported} to \tr{x_local}), and
533 makes strictness information propagate better. This used to happen in
534 the final phase, but it's tidier to do it here.
536 STRICTNESS: if we have done strictness analysis, we want the strictness info on
537 x_local to transfer to x_exported. Hence the copyIdInfo call.
539 RULES: we want to *add* any RULES for x_local to x_exported.
541 Note [Rules and indirection-zapping]
542 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
543 Problem: what if x_exported has a RULE that mentions something in ...bindings...?
544 Then the things mentioned can be out of scope! Solution
545 a) Make sure that in this pass the usage-info from x_exported is
546 available for ...bindings...
547 b) If there are any such RULES, rec-ify the entire top-level.
548 It'll get sorted out next time round
552 The example that went bad on me at one stage was this one:
554 iterate :: (a -> a) -> a -> [a]
556 iterate = iterateList
558 iterateFB c f x = x `c` iterateFB c f (f x)
559 iterateList f x = x : iterateList f (f x)
563 "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x)
564 "iterateFB" iterateFB (:) = iterateList
567 This got shorted out to:
569 iterateList :: (a -> a) -> a -> [a]
570 iterateList = iterate
572 iterateFB c f x = x `c` iterateFB c f (f x)
573 iterate f x = x : iterate f (f x)
576 "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x)
577 "iterateFB" iterateFB (:) = iterate
580 And now we get an infinite loop in the rule system
581 iterate f x -> build (\cn -> iterateFB c f x)
585 Tiresome old solution:
586 don't do shorting out if f has rewrite rules (see shortableIdInfo)
588 New solution (I think):
589 use rule switching-off pragmas to get rid
590 of iterateList in the first place
595 If more than one exported thing is equal to a local thing (i.e., the
596 local thing really is shared), then we do one only:
599 x_exported1 = x_local
600 x_exported2 = x_local
604 x_exported2 = x_exported1
607 We rely on prior eta reduction to simplify things like
609 x_exported = /\ tyvars -> x_local tyvars
613 Hence,there's a possibility of leaving unchanged something like this:
616 x_exported1 = x_local Int
618 By the time we've thrown away the types in STG land this
619 could be eliminated. But I don't think it's very common
620 and it's dangerous to do this fiddling in STG land
621 because we might elminate a binding that's mentioned in the
622 unfolding for something.
625 type IndEnv = IdEnv Id -- Maps local_id -> exported_id
627 shortOutIndirections :: [CoreBind] -> [CoreBind]
628 shortOutIndirections binds
629 | isEmptyVarEnv ind_env = binds
630 | no_need_to_flatten = binds' -- See Note [Rules and indirect-zapping]
631 | otherwise = [Rec (flattenBinds binds')] -- for this no_need_to_flatten stuff
633 ind_env = makeIndEnv binds
634 exp_ids = varSetElems ind_env -- These exported Ids are the subjects
635 exp_id_set = mkVarSet exp_ids -- of the indirection-elimination
636 no_need_to_flatten = all (null . specInfoRules . idSpecialisation) exp_ids
637 binds' = concatMap zap binds
639 zap (NonRec bndr rhs) = [NonRec b r | (b,r) <- zapPair (bndr,rhs)]
640 zap (Rec pairs) = [Rec (concatMap zapPair pairs)]
643 | bndr `elemVarSet` exp_id_set = []
644 | Just exp_id <- lookupVarEnv ind_env bndr = [(transferIdInfo exp_id bndr, rhs),
646 | otherwise = [(bndr,rhs)]
648 makeIndEnv :: [CoreBind] -> IndEnv
650 = foldr add_bind emptyVarEnv binds
652 add_bind :: CoreBind -> IndEnv -> IndEnv
653 add_bind (NonRec exported_id rhs) env = add_pair (exported_id, rhs) env
654 add_bind (Rec pairs) env = foldr add_pair env pairs
656 add_pair :: (Id,CoreExpr) -> IndEnv -> IndEnv
657 add_pair (exported_id, Var local_id) env
658 | shortMeOut env exported_id local_id = extendVarEnv env local_id exported_id
659 add_pair (exported_id, rhs) env
662 shortMeOut ind_env exported_id local_id
663 -- The if-then-else stuff is just so I can get a pprTrace to see
664 -- how often I don't get shorting out becuase of IdInfo stuff
665 = if isExportedId exported_id && -- Only if this is exported
667 isLocalId local_id && -- Only if this one is defined in this
668 -- module, so that we *can* change its
669 -- binding to be the exported thing!
671 not (isExportedId local_id) && -- Only if this one is not itself exported,
672 -- since the transformation will nuke it
674 not (local_id `elemVarEnv` ind_env) -- Only if not already substituted for
679 if isEmptySpecInfo (specInfo (idInfo exported_id)) -- Only if no rules
680 then True -- See note on "Messing up rules"
683 pprTrace "shortMeOut:" (ppr exported_id)
692 transferIdInfo :: Id -> Id -> Id
694 -- lcl_id = e; exp_id = lcl_id
695 -- and lcl_id has useful IdInfo, we don't want to discard it by going
696 -- gbl_id = e; lcl_id = gbl_id
697 -- Instead, transfer IdInfo from lcl_id to exp_id
698 -- Overwriting, rather than merging, seems to work ok.
699 transferIdInfo exported_id local_id
700 = modifyIdInfo transfer exported_id
702 local_info = idInfo local_id
703 transfer exp_info = exp_info `setNewStrictnessInfo` newStrictnessInfo local_info
704 `setWorkerInfo` workerInfo local_info
705 `setInlinePragInfo` inlinePragInfo local_info
706 `setSpecInfo` addSpecInfo (specInfo exp_info) new_info
707 new_info = setSpecInfoHead (idName exported_id)
708 (specInfo local_info)
709 -- Remember to set the function-name field of the
710 -- rules as we transfer them from one function to another