2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[SimplCore]{Driver for simplifying @Core@ programs}
7 module SimplCore ( core2core, simplifyExpr ) where
9 #include "HsVersions.h"
11 import CmdLineOpts ( CoreToDo(..), SimplifierSwitch(..),
12 SimplifierMode(..), DynFlags, DynFlag(..), dopt,
13 dopt_CoreToDo, buildCoreToDo
16 import TcIface ( loadImportedRules )
17 import HscTypes ( HscEnv(..), ModGuts(..), ExternalPackageState(..),
18 Dependencies( dep_mods ),
20 import CSE ( cseProgram )
21 import Rules ( RuleBase, ruleBaseIds, emptyRuleBase,
22 extendRuleBaseList, pprRuleBase, ruleCheckProgram )
23 import PprCore ( pprCoreBindings, pprCoreExpr, pprIdRules )
24 import OccurAnal ( occurAnalysePgm, occurAnalyseGlobalExpr )
25 import IdInfo ( setNewStrictnessInfo, newStrictnessInfo,
26 setWorkerInfo, workerInfo,
27 setSpecInfo, specInfo )
28 import CoreUtils ( coreBindsSize )
29 import Simplify ( simplTopBinds, simplExpr )
30 import SimplEnv ( SimplEnv, simplBinders, mkSimplEnv, setInScopeSet )
32 import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass )
33 import CoreLint ( endPass )
34 import VarEnv ( mkInScopeSet )
35 import FloatIn ( floatInwards )
36 import FloatOut ( floatOutwards )
37 import Id ( Id, modifyIdInfo, idInfo, idIsFrom, isExportedId, isLocalId,
38 idSpecialisation, setIdSpecialisation )
39 import Rules ( addRules )
42 import LiberateCase ( liberateCase )
43 import SAT ( doStaticArgs )
44 import Specialise ( specProgram)
45 import SpecConstr ( specConstrProgram)
46 import DmdAnal ( dmdAnalPgm )
47 import WorkWrap ( wwTopBinds )
49 import StrictAnal ( saBinds )
50 import CprAnalyse ( cprAnalyse )
53 import UniqSupply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply )
54 import IO ( hPutStr, stderr )
56 import List ( partition )
57 import Maybes ( orElse )
60 %************************************************************************
62 \subsection{The driver for the simplifier}
64 %************************************************************************
71 core2core hsc_env guts
73 let dflags = hsc_dflags hsc_env
75 | Just todo <- dopt_CoreToDo dflags = todo
76 | otherwise = buildCoreToDo dflags
78 us <- mkSplitUniqSupply 's'
79 let (cp_us, ru_us) = splitUniqSupply us
81 -- COMPUTE THE RULE BASE TO USE
82 (imp_rule_base, guts') <- prepareRules hsc_env guts ru_us
85 (stats, guts'') <- doCorePasses hsc_env cp_us
86 (zeroSimplCount dflags)
87 imp_rule_base guts' core_todos
89 dumpIfSet_dyn dflags Opt_D_dump_simpl_stats
90 "Grand total simplifier statistics"
96 simplifyExpr :: DynFlags -- includes spec of what core-to-core passes to do
99 -- simplifyExpr is called by the driver to simplify an
100 -- expression typed in at the interactive prompt
101 simplifyExpr dflags expr
103 ; showPass dflags "Simplify"
105 ; us <- mkSplitUniqSupply 's'
107 ; let (expr', _counts) = initSmpl dflags us $
108 simplExprGently gentleSimplEnv expr
110 ; dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
116 gentleSimplEnv :: SimplEnv
117 gentleSimplEnv = mkSimplEnv SimplGently
121 doCorePasses :: HscEnv
122 -> UniqSupply -- uniques
123 -> SimplCount -- simplifier stats
124 -> RuleBase -- the main rule base
125 -> ModGuts -- local binds in (with rules attached)
126 -> [CoreToDo] -- which passes to do
127 -> IO (SimplCount, ModGuts)
129 doCorePasses hsc_env us stats rb guts []
130 = return (stats, guts)
132 doCorePasses hsc_env us stats rb guts (to_do : to_dos)
134 let (us1, us2) = splitUniqSupply us
135 (stats1, rb1, guts1) <- doCorePass to_do hsc_env us1 rb guts
136 doCorePasses hsc_env us2 (stats `plusSimplCount` stats1) rb1 guts1 to_dos
138 doCorePass (CoreDoSimplify mode sws) = _scc_ "Simplify" simplifyPgm mode sws
139 doCorePass CoreCSE = _scc_ "CommonSubExpr" trBinds cseProgram
140 doCorePass CoreLiberateCase = _scc_ "LiberateCase" trBinds liberateCase
141 doCorePass CoreDoFloatInwards = _scc_ "FloatInwards" trBinds floatInwards
142 doCorePass (CoreDoFloatOutwards f) = _scc_ "FloatOutwards" trBindsU (floatOutwards f)
143 doCorePass CoreDoStaticArgs = _scc_ "StaticArgs" trBinds doStaticArgs
144 doCorePass CoreDoStrictness = _scc_ "Stranal" trBinds dmdAnalPgm
145 doCorePass CoreDoWorkerWrapper = _scc_ "WorkWrap" trBindsU wwTopBinds
146 doCorePass CoreDoSpecialising = _scc_ "Specialise" trBindsU specProgram
147 doCorePass CoreDoSpecConstr = _scc_ "SpecConstr" trBindsU specConstrProgram
148 doCorePass CoreDoGlomBinds = trBinds glomBinds
149 doCorePass CoreDoPrintCore = observe printCore
150 doCorePass (CoreDoRuleCheck phase pat) = observe (ruleCheck phase pat)
151 doCorePass CoreDoNothing = observe (\ _ _ -> return ())
152 #ifdef OLD_STRICTNESS
153 doCorePass CoreDoOldStrictness = _scc_ "OldStrictness" trBinds doOldStrictness
156 #ifdef OLD_STRICTNESS
157 doOldStrictness dfs binds
158 = do binds1 <- saBinds dfs binds
159 binds2 <- cprAnalyse dfs binds1
163 printCore _ binds = dumpIfSet True "Print Core" (pprCoreBindings binds)
165 ruleCheck phase pat dflags binds = do showPass dflags "RuleCheck"
166 printDump (ruleCheckProgram phase pat binds)
168 -- Most passes return no stats and don't change rules
169 trBinds :: (DynFlags -> [CoreBind] -> IO [CoreBind])
170 -> HscEnv -> UniqSupply -> RuleBase -> ModGuts
171 -> IO (SimplCount, RuleBase, ModGuts)
172 trBinds do_pass hsc_env us rb guts
173 = do { binds' <- do_pass dflags (mg_binds guts)
174 ; return (zeroSimplCount dflags, rb, guts { mg_binds = binds' }) }
176 dflags = hsc_dflags hsc_env
178 trBindsU :: (DynFlags -> UniqSupply -> [CoreBind] -> IO [CoreBind])
179 -> HscEnv -> UniqSupply -> RuleBase -> ModGuts
180 -> IO (SimplCount, RuleBase, ModGuts)
181 trBindsU do_pass hsc_env us rb guts
182 = do { binds' <- do_pass dflags us (mg_binds guts)
183 ; return (zeroSimplCount dflags, rb, guts { mg_binds = binds' }) }
185 dflags = hsc_dflags hsc_env
187 -- Observer passes just peek; don't modify the bindings at all
188 observe :: (DynFlags -> [CoreBind] -> IO a)
189 -> HscEnv -> UniqSupply -> RuleBase -> ModGuts
190 -> IO (SimplCount, RuleBase, ModGuts)
191 observe do_pass hsc_env us rb guts
192 = do { binds <- do_pass dflags (mg_binds guts)
193 ; return (zeroSimplCount dflags, rb, guts) }
195 dflags = hsc_dflags hsc_env
200 %************************************************************************
202 \subsection{Dealing with rules}
204 %************************************************************************
206 -- prepareLocalRuleBase takes the CoreBinds and rules defined in this module.
207 -- It attaches those rules that are for local Ids to their binders, and
208 -- returns the remainder attached to Ids in an IdSet.
211 prepareRules :: HscEnv
214 -> IO (RuleBase, -- Rule base for imported things, incl
215 -- (a) rules defined in this module (orphans)
216 -- (b) rules from other packages
217 -- (c) rules from other modules in home package
218 ModGuts) -- Modified fields are
219 -- (a) Bindings have rules attached,
220 -- (b) Rules are now just orphan rules
222 prepareRules hsc_env@(HscEnv { hsc_dflags = dflags, hsc_HPT = hpt })
223 guts@(ModGuts { mg_binds = binds, mg_deps = deps, mg_rules = local_rules })
225 = do { eps <- hscEPS hsc_env
227 ; let -- Simplify the local rules; boringly, we need to make an in-scope set
228 -- from the local binders, to avoid warnings from Simplify.simplVar
229 local_ids = mkInScopeSet (mkVarSet (bindersOfBinds binds))
230 env = setInScopeSet gentleSimplEnv local_ids
231 (better_rules,_) = initSmpl dflags us (mapSmpl (simplRule env) local_rules)
232 home_pkg_rules = hptRules hsc_env (dep_mods deps)
234 (orphan_rules, rules_for_locals) = partition isOrphanRule better_rules
235 -- Get the rules for locally-defined Ids out of the RuleBase
236 -- If we miss any rules for Ids defined here, then we end up
237 -- giving the local decl a new Unique (because the in-scope-set is (hackily) the
238 -- same as the non-local-rule-id set, so the Id looks as if it's in scope
239 -- and hence should be cloned), and now the binding for the class method
240 -- doesn't have the same Unique as the one in the Class and the tc-env
241 -- Example: class Foo a where
243 -- {-# RULES "op" op x = x #-}
245 -- NB: we assume that the imported rules dont include
246 -- rules for Ids in this module; if there is, the above bad things may happen
248 pkg_rule_base = eps_rule_base eps
249 hpt_rule_base = extendRuleBaseList pkg_rule_base home_pkg_rules
250 imp_rule_base = extendRuleBaseList hpt_rule_base orphan_rules
252 -- Update the binders in the local bindings with the lcoal rules
253 -- Update the binders of top-level bindings by
254 -- attaching the rules for each locally-defined Id to that Id.
257 -- - It makes the rules easier to look up
258 -- - It means that transformation rules and specialisations for
259 -- locally defined Ids are handled uniformly
260 -- - It keeps alive things that are referred to only from a rule
261 -- (the occurrence analyser knows about rules attached to Ids)
262 -- - It makes sure that, when we apply a rule, the free vars
263 -- of the RHS are more likely to be in scope
264 -- - The imported rules are carried in the in-scope set
265 -- which is extended on each iteration by the new wave of
266 -- local binders; any rules which aren't on the binding will
267 -- thereby get dropped
268 local_rule_base = extendRuleBaseList emptyRuleBase rules_for_locals
269 binds_w_rules = updateBinders local_rule_base binds
271 ; dumpIfSet_dyn dflags Opt_D_dump_rules "Transformation rules"
272 (vcat [text "Local rules", pprIdRules better_rules,
274 text "Imported rules", pprRuleBase imp_rule_base])
277 ; let bad_rules = filter (idIsFrom (mg_module guts))
278 (varSetElems (ruleBaseIds imp_rule_base))
279 ; WARN( not (null bad_rules), ppr bad_rules ) return ()
281 ; return (imp_rule_base, guts { mg_binds = binds_w_rules, mg_rules = orphan_rules })
284 updateBinders :: RuleBase -> [CoreBind] -> [CoreBind]
285 updateBinders rule_base binds
286 = map update_bndrs binds
288 rule_ids = ruleBaseIds rule_base
290 update_bndrs (NonRec b r) = NonRec (update_bndr b) r
291 update_bndrs (Rec prs) = Rec [(update_bndr b, r) | (b,r) <- prs]
293 update_bndr bndr = case lookupVarSet rule_ids bndr of
295 Just id -> bndr `setIdSpecialisation` idSpecialisation id
299 We must do some gentle simplification on the template (but not the RHS)
300 of each rule. The case that forced me to add this was the fold/build rule,
301 which without simplification looked like:
302 fold k z (build (/\a. g a)) ==> ...
303 This doesn't match unless you do eta reduction on the build argument.
306 simplRule env rule@(IdCoreRule id _ (BuiltinRule _ _))
308 simplRule env (IdCoreRule id is_orph (Rule act name bndrs args rhs))
309 = simplBinders env bndrs `thenSmpl` \ (env, bndrs') ->
310 mapSmpl (simplExprGently env) args `thenSmpl` \ args' ->
311 simplExprGently env rhs `thenSmpl` \ rhs' ->
312 returnSmpl (IdCoreRule id is_orph (Rule act name bndrs' args' rhs'))
314 -- It's important that simplExprGently does eta reduction.
315 -- For example, in a rule like:
316 -- augment g (build h)
317 -- we do not want to get
318 -- augment (\a. g a) (build h)
319 -- otherwise we don't match when given an argument like
322 -- The simplifier does indeed do eta reduction (it's in
323 -- Simplify.completeLam) but only if -O is on.
327 simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr
328 -- Simplifies an expression
329 -- does occurrence analysis, then simplification
330 -- and repeats (twice currently) because one pass
331 -- alone leaves tons of crud.
332 -- Used (a) for user expressions typed in at the interactive prompt
333 -- (b) the LHS and RHS of a RULE
335 -- The name 'Gently' suggests that the SimplifierMode is SimplGently,
336 -- and in fact that is so.... but the 'Gently' in simplExprGently doesn't
337 -- enforce that; it just simplifies the expression twice
339 simplExprGently env expr
340 = simplExpr env (occurAnalyseGlobalExpr expr) `thenSmpl` \ expr1 ->
341 simplExpr env (occurAnalyseGlobalExpr expr1)
345 %************************************************************************
347 \subsection{Glomming}
349 %************************************************************************
352 glomBinds :: DynFlags -> [CoreBind] -> IO [CoreBind]
353 -- Glom all binds together in one Rec, in case any
354 -- transformations have introduced any new dependencies
356 -- NB: the global invariant is this:
357 -- *** the top level bindings are never cloned, and are always unique ***
359 -- We sort them into dependency order, but applying transformation rules may
360 -- make something at the top refer to something at the bottom:
364 -- RULE: p (q x) = h x
366 -- Applying this rule makes f refer to h,
367 -- although it doesn't appear to in the source program.
368 -- This pass lets us control where it happens.
370 -- NOTICE that this cannot happen for rules whose head is a locally-defined
371 -- function. It only happens for rules whose head is an imported function
372 -- (p in the example above). So, for example, the rule had been
373 -- RULE: f (p x) = h x
374 -- then the rule for f would be attached to f itself (in its IdInfo)
375 -- by prepareLocalRuleBase and h would be regarded by the occurrency
376 -- analyser as free in f.
378 glomBinds dflags binds
379 = do { showPass dflags "GlomBinds" ;
380 let { recd_binds = [Rec (flattenBinds binds)] } ;
382 -- Not much point in printing the result...
383 -- just consumes output bandwidth
387 %************************************************************************
389 \subsection{The driver for the simplifier}
391 %************************************************************************
394 simplifyPgm :: SimplifierMode
395 -> [SimplifierSwitch]
400 -> IO (SimplCount, RuleBase, ModGuts) -- New bindings
402 simplifyPgm mode switches hsc_env us rule_base guts
404 showPass dflags "Simplify";
406 (termination_msg, it_count, counts_out, rule_base', binds')
407 <- do_iteration us rule_base 1 (zeroSimplCount dflags) (mg_binds guts) ;
409 dumpIfSet (dopt Opt_D_verbose_core2core dflags
410 && dopt Opt_D_dump_simpl_stats dflags)
411 "Simplifier statistics"
412 (vcat [text termination_msg <+> text "after" <+> ppr it_count <+> text "iterations",
414 pprSimplCount counts_out]);
416 endPass dflags "Simplify" Opt_D_verbose_core2core binds';
418 return (counts_out, rule_base', guts { mg_binds = binds' })
421 dflags = hsc_dflags hsc_env
422 phase_info = case mode of
423 SimplGently -> "gentle"
424 SimplPhase n -> show n
426 sw_chkr = isAmongSimpl switches
427 max_iterations = intSwitchSet sw_chkr MaxSimplifierIterations `orElse` 2
429 do_iteration us rule_base iteration_no counts binds
430 -- iteration_no is the number of the iteration we are
431 -- about to begin, with '1' for the first
432 | iteration_no > max_iterations -- Stop if we've run out of iterations
435 if max_iterations > 2 then
436 hPutStr stderr ("NOTE: Simplifier still going after " ++
437 show max_iterations ++
438 " iterations; bailing out.\n")
442 -- Subtract 1 from iteration_no to get the
443 -- number of iterations we actually completed
444 return ("Simplifier baled out", iteration_no - 1, counts, rule_base, binds)
447 -- Try and force thunks off the binds; significantly reduces
448 -- space usage, especially with -O. JRS, 000620.
449 | let sz = coreBindsSize binds in sz == sz
451 -- Occurrence analysis
452 let { tagged_binds = _scc_ "OccAnal" occurAnalysePgm binds } ;
453 dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
454 (pprCoreBindings tagged_binds);
456 -- Get any new rules, and extend the rule base
457 -- (on the side this extends the package rule base in the
458 -- ExternalPackageTable, ready for the next complation
460 -- We need to do this regularly, because simplification can
461 -- poke on IdInfo thunks, which in turn brings in new rules
462 -- behind the scenes. Otherwise there's a danger we'll simply
463 -- miss the rules for Ids hidden inside imported inlinings
464 new_rules <- loadImportedRules hsc_env guts ;
465 let { rule_base' = extendRuleBaseList rule_base new_rules
466 ; simpl_env = mkSimplEnv mode sw_chkr rule_base' } ;
467 -- The new rule base Ids are used to initialise
468 -- the in-scope set. That way, the simplifier will change any
469 -- occurrences of the imported id to the one in the imported_rule_ids
470 -- set, which are decorated with their rules.
472 -- Simplify the program
473 -- We do this with a *case* not a *let* because lazy pattern
474 -- matching bit us with bad space leak!
475 -- With a let, we ended up with
480 -- case t of {(_,counts') -> if counts'=0 then ... }
481 -- So the conditional didn't force counts', because the
482 -- selection got duplicated. Sigh!
483 case initSmpl dflags us1 (_scc_ "SimplTopBinds" simplTopBinds simpl_env tagged_binds) of {
484 (binds', counts') -> do {
486 let { all_counts = counts `plusSimplCount` counts'
487 ; herald = "Simplifier phase " ++ phase_info ++
488 ", iteration " ++ show iteration_no ++
489 " out of " ++ show max_iterations
492 -- Stop if nothing happened; don't dump output
493 if isZeroSimplCount counts' then
494 return ("Simplifier reached fixed point", iteration_no,
495 all_counts, rule_base', binds')
497 -- Short out indirections
498 -- We do this *after* at least one run of the simplifier
499 -- because indirection-shorting uses the export flag on *occurrences*
500 -- and that isn't guaranteed to be ok until after the first run propagates
501 -- stuff from the binding site to its occurrences
502 let { binds'' = _scc_ "ZapInd" shortOutIndirections binds' } ;
504 -- Dump the result of this iteration
505 dumpIfSet_dyn dflags Opt_D_dump_simpl_iterations herald
506 (pprSimplCount counts') ;
507 endPass dflags herald Opt_D_dump_simpl_iterations binds'' ;
510 do_iteration us2 rule_base' (iteration_no + 1) all_counts binds''
513 (us1, us2) = splitUniqSupply us
517 %************************************************************************
519 Shorting out indirections
521 %************************************************************************
525 x_local = <expression>
529 where x_exported is exported, and x_local is not, then we replace it with this:
531 x_exported = <expression>
535 Without this we never get rid of the x_exported = x_local thing. This
536 save a gratuitous jump (from \tr{x_exported} to \tr{x_local}), and
537 makes strictness information propagate better. This used to happen in
538 the final phase, but it's tidier to do it here.
540 STRICTNESS: if we have done strictness analysis, we want the strictness info on
541 x_local to transfer to x_exported. Hence the copyIdInfo call.
543 RULES: we want to *add* any RULES for x_local to x_exported.
545 Note [Rules and indirection-zapping]
546 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
547 Problem: what if x_exported has a RULE that mentions something in ...bindings...?
548 Then the things mentioned can be out of scope! Solution
549 a) Make sure that in this pass the usage-info from x_exported is
550 available for ...bindings...
551 b) If there are any such RULES, rec-ify the entire top-level.
552 It'll get sorted out next time round
556 The example that went bad on me at one stage was this one:
558 iterate :: (a -> a) -> a -> [a]
560 iterate = iterateList
562 iterateFB c f x = x `c` iterateFB c f (f x)
563 iterateList f x = x : iterateList f (f x)
567 "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x)
568 "iterateFB" iterateFB (:) = iterateList
571 This got shorted out to:
573 iterateList :: (a -> a) -> a -> [a]
574 iterateList = iterate
576 iterateFB c f x = x `c` iterateFB c f (f x)
577 iterate f x = x : iterate f (f x)
580 "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x)
581 "iterateFB" iterateFB (:) = iterate
584 And now we get an infinite loop in the rule system
585 iterate f x -> build (\cn -> iterateFB c f x)
589 Tiresome old solution:
590 don't do shorting out if f has rewrite rules (see shortableIdInfo)
592 New solution (I think):
593 use rule switching-off pragmas to get rid
594 of iterateList in the first place
599 If more than one exported thing is equal to a local thing (i.e., the
600 local thing really is shared), then we do one only:
603 x_exported1 = x_local
604 x_exported2 = x_local
608 x_exported2 = x_exported1
611 We rely on prior eta reduction to simplify things like
613 x_exported = /\ tyvars -> x_local tyvars
617 Hence,there's a possibility of leaving unchanged something like this:
620 x_exported1 = x_local Int
622 By the time we've thrown away the types in STG land this
623 could be eliminated. But I don't think it's very common
624 and it's dangerous to do this fiddling in STG land
625 because we might elminate a binding that's mentioned in the
626 unfolding for something.
629 type IndEnv = IdEnv Id -- Maps local_id -> exported_id
631 shortOutIndirections :: [CoreBind] -> [CoreBind]
632 shortOutIndirections binds
633 | isEmptyVarEnv ind_env = binds
634 | no_need_to_flatten = binds'
635 | otherwise = [Rec (flattenBinds binds')] -- See Note [Rules and indirect-zapping]
637 ind_env = makeIndEnv binds
638 exp_ids = varSetElems ind_env
639 exp_id_set = mkVarSet exp_ids
640 no_need_to_flatten = all (null . rulesRules . idSpecialisation) exp_ids
641 binds' = concatMap zap binds
643 zap (NonRec bndr rhs) = [NonRec b r | (b,r) <- zapPair (bndr,rhs)]
644 zap (Rec pairs) = [Rec (concatMap zapPair pairs)]
647 | bndr `elemVarSet` exp_id_set = []
648 | Just exp_id <- lookupVarEnv ind_env bndr = [(transferIdInfo exp_id bndr, rhs),
650 | otherwise = [(bndr,rhs)]
652 makeIndEnv :: [CoreBind] -> IndEnv
654 = foldr add_bind emptyVarEnv binds
656 add_bind :: CoreBind -> IndEnv -> IndEnv
657 add_bind (NonRec exported_id rhs) env = add_pair (exported_id, rhs) env
658 add_bind (Rec pairs) env = foldr add_pair env pairs
660 add_pair :: (Id,CoreExpr) -> IndEnv -> IndEnv
661 add_pair (exported_id, Var local_id) env
662 | shortMeOut env exported_id local_id = extendVarEnv env local_id exported_id
663 add_pair (exported_id, rhs) env
666 shortMeOut ind_env exported_id local_id
667 -- The if-then-else stuff is just so I can get a pprTrace to see
668 -- how often I don't get shorting out becuase of IdInfo stuff
669 = if isExportedId exported_id && -- Only if this is exported
671 isLocalId local_id && -- Only if this one is defined in this
672 -- module, so that we *can* change its
673 -- binding to be the exported thing!
675 not (isExportedId local_id) && -- Only if this one is not itself exported,
676 -- since the transformation will nuke it
678 not (local_id `elemVarEnv` ind_env) -- Only if not already substituted for
683 if isEmptyCoreRules (specInfo (idInfo exported_id)) -- Only if no rules
684 then True -- See note on "Messing up rules"
687 pprTrace "shortMeOut:" (ppr exported_id)
696 transferIdInfo :: Id -> Id -> Id
697 transferIdInfo exported_id local_id
698 = modifyIdInfo transfer exported_id
700 local_info = idInfo local_id
701 transfer exp_info = exp_info `setNewStrictnessInfo` newStrictnessInfo local_info
702 `setWorkerInfo` workerInfo local_info
703 `setSpecInfo` addRules exported_id (specInfo exp_info)
704 (rulesRules (specInfo local_info))