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 DynFlags ( CoreToDo(..), SimplifierSwitch(..),
12 SimplifierMode(..), DynFlags, DynFlag(..), dopt,
15 import HscTypes ( HscEnv(..), ModGuts(..), ExternalPackageState(..),
16 Dependencies( dep_mods ),
18 import CSE ( cseProgram )
19 import Rules ( RuleBase, emptyRuleBase, mkRuleBase, unionRuleBase,
20 extendRuleBaseList, pprRuleBase, ruleCheckProgram,
21 addSpecInfo, addIdSpecialisations )
22 import PprCore ( pprCoreBindings, pprCoreExpr, pprRules )
23 import OccurAnal ( occurAnalysePgm, occurAnalyseExpr )
24 import IdInfo ( setNewStrictnessInfo, newStrictnessInfo,
25 setWorkerInfo, workerInfo,
26 setInlinePragInfo, inlinePragInfo,
27 setSpecInfo, specInfo, specInfoRules )
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 FloatIn ( floatInwards )
35 import FloatOut ( floatOutwards )
37 import Id ( Id, modifyIdInfo, idInfo, isExportedId, isLocalId,
38 idSpecialisation, idName )
41 import NameEnv ( lookupNameEnv )
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 )
52 import Vectorise ( vectorise )
54 import UniqSupply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply )
55 import IO ( hPutStr, stderr )
57 import List ( partition )
58 import Maybes ( orElse )
61 %************************************************************************
63 \subsection{The driver for the simplifier}
65 %************************************************************************
72 core2core hsc_env guts
74 let dflags = hsc_dflags hsc_env
75 core_todos = getCoreToDo dflags
77 us <- mkSplitUniqSupply 's'
78 let (cp_us, ru_us) = splitUniqSupply us
80 -- COMPUTE THE RULE BASE TO USE
81 (imp_rule_base, guts') <- prepareRules hsc_env guts ru_us
84 (stats, guts'') <- doCorePasses hsc_env imp_rule_base cp_us
85 (zeroSimplCount dflags)
88 dumpIfSet_dyn dflags Opt_D_dump_simpl_stats
89 "Grand total simplifier statistics"
95 simplifyExpr :: DynFlags -- includes spec of what core-to-core passes to do
98 -- simplifyExpr is called by the driver to simplify an
99 -- expression typed in at the interactive prompt
100 simplifyExpr dflags expr
102 ; showPass dflags "Simplify"
104 ; us <- mkSplitUniqSupply 's'
106 ; let (expr', _counts) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
107 simplExprGently gentleSimplEnv expr
109 ; dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
115 gentleSimplEnv :: SimplEnv
116 gentleSimplEnv = mkSimplEnv SimplGently (isAmongSimpl [])
118 doCorePasses :: HscEnv
119 -> RuleBase -- the imported main rule base
120 -> UniqSupply -- uniques
121 -> SimplCount -- simplifier stats
122 -> ModGuts -- local binds in (with rules attached)
123 -> [CoreToDo] -- which passes to do
124 -> IO (SimplCount, ModGuts)
126 doCorePasses hsc_env rb us stats guts []
127 = return (stats, guts)
129 doCorePasses hsc_env rb us stats guts (CoreDoPasses to_dos1 : to_dos2)
130 = doCorePasses hsc_env rb us stats guts (to_dos1 ++ to_dos2)
132 doCorePasses hsc_env rb us stats guts (to_do : to_dos)
134 let (us1, us2) = splitUniqSupply us
135 (stats1, guts1) <- doCorePass to_do hsc_env us1 rb guts
136 doCorePasses hsc_env rb us2 (stats `plusSimplCount` stats1) guts1 to_dos
138 doCorePass :: CoreToDo -> HscEnv -> UniqSupply -> RuleBase
139 -> ModGuts -> IO (SimplCount, ModGuts)
140 doCorePass (CoreDoSimplify mode sws) = _scc_ "Simplify" simplifyPgm mode sws
141 doCorePass CoreCSE = _scc_ "CommonSubExpr" trBinds cseProgram
142 doCorePass CoreLiberateCase = _scc_ "LiberateCase" liberateCase
143 doCorePass CoreDoFloatInwards = _scc_ "FloatInwards" trBinds floatInwards
144 doCorePass (CoreDoFloatOutwards f) = _scc_ "FloatOutwards" trBindsU (floatOutwards f)
145 doCorePass CoreDoStaticArgs = _scc_ "StaticArgs" trBinds doStaticArgs
146 doCorePass CoreDoStrictness = _scc_ "Stranal" trBinds dmdAnalPgm
147 doCorePass CoreDoWorkerWrapper = _scc_ "WorkWrap" trBindsU wwTopBinds
148 doCorePass CoreDoSpecialising = _scc_ "Specialise" trBindsU specProgram
149 doCorePass CoreDoSpecConstr = _scc_ "SpecConstr" trBindsU specConstrProgram
150 doCorePass CoreDoGlomBinds = trBinds glomBinds
151 doCorePass CoreDoVectorisation = _scc_ "Vectorise" vectorise
152 doCorePass CoreDoPrintCore = observe printCore
153 doCorePass (CoreDoRuleCheck phase pat) = observe (ruleCheck phase pat)
154 doCorePass CoreDoNothing = observe (\ _ _ -> return ())
155 #ifdef OLD_STRICTNESS
156 doCorePass CoreDoOldStrictness = _scc_ "OldStrictness" trBinds doOldStrictness
158 doCorePass CoreDoOldStrictness = panic "CoreDoOldStrictness"
160 doCorePass (CoreDoPasses _) = panic "CoreDoPasses"
162 #ifdef OLD_STRICTNESS
163 doOldStrictness dfs binds
164 = do binds1 <- saBinds dfs binds
165 binds2 <- cprAnalyse dfs binds1
169 printCore _ binds = dumpIfSet True "Print Core" (pprCoreBindings binds)
171 ruleCheck phase pat dflags binds = do showPass dflags "RuleCheck"
172 printDump (ruleCheckProgram phase pat binds)
174 -- Most passes return no stats and don't change rules
175 trBinds :: (DynFlags -> [CoreBind] -> IO [CoreBind])
176 -> HscEnv -> UniqSupply -> RuleBase -> ModGuts
177 -> IO (SimplCount, ModGuts)
178 trBinds do_pass hsc_env us rb guts
179 = do { binds' <- do_pass dflags (mg_binds guts)
180 ; return (zeroSimplCount dflags, guts { mg_binds = binds' }) }
182 dflags = hsc_dflags hsc_env
184 trBindsU :: (DynFlags -> UniqSupply -> [CoreBind] -> IO [CoreBind])
185 -> HscEnv -> UniqSupply -> RuleBase -> ModGuts
186 -> IO (SimplCount, ModGuts)
187 trBindsU do_pass hsc_env us rb guts
188 = do { binds' <- do_pass dflags us (mg_binds guts)
189 ; return (zeroSimplCount dflags, guts { mg_binds = binds' }) }
191 dflags = hsc_dflags hsc_env
193 -- Observer passes just peek; don't modify the bindings at all
194 observe :: (DynFlags -> [CoreBind] -> IO a)
195 -> HscEnv -> UniqSupply -> RuleBase -> ModGuts
196 -> IO (SimplCount, ModGuts)
197 observe do_pass hsc_env us rb guts
198 = do { binds <- do_pass dflags (mg_binds guts)
199 ; return (zeroSimplCount dflags, guts) }
201 dflags = hsc_dflags hsc_env
206 %************************************************************************
208 \subsection{Dealing with rules}
210 %************************************************************************
212 -- prepareLocalRuleBase takes the CoreBinds and rules defined in this module.
213 -- It attaches those rules that are for local Ids to their binders, and
214 -- returns the remainder attached to Ids in an IdSet.
217 prepareRules :: HscEnv
220 -> IO (RuleBase, -- Rule base for imported things, incl
221 -- (a) rules defined in this module (orphans)
222 -- (b) rules from other modules in home package
223 -- but not things from other packages
225 ModGuts) -- Modified fields are
226 -- (a) Bindings have rules attached,
227 -- (b) Rules are now just orphan rules
229 prepareRules hsc_env@(HscEnv { hsc_dflags = dflags, hsc_HPT = hpt })
230 guts@(ModGuts { mg_binds = binds, mg_deps = deps, mg_rules = local_rules })
232 = do { let -- Simplify the local rules; boringly, we need to make an in-scope set
233 -- from the local binders, to avoid warnings from Simplify.simplVar
234 local_ids = mkInScopeSet (mkVarSet (bindersOfBinds binds))
235 env = setInScopeSet gentleSimplEnv local_ids
236 (better_rules,_) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
237 (mapSmpl (simplRule env) local_rules)
238 home_pkg_rules = hptRules hsc_env (dep_mods deps)
240 -- Find the rules for locally-defined Ids; then we can attach them
241 -- to the binders in the top-level bindings
244 -- - It makes the rules easier to look up
245 -- - It means that transformation rules and specialisations for
246 -- locally defined Ids are handled uniformly
247 -- - It keeps alive things that are referred to only from a rule
248 -- (the occurrence analyser knows about rules attached to Ids)
249 -- - It makes sure that, when we apply a rule, the free vars
250 -- of the RHS are more likely to be in scope
251 -- - The imported rules are carried in the in-scope set
252 -- which is extended on each iteration by the new wave of
253 -- local binders; any rules which aren't on the binding will
254 -- thereby get dropped
255 (rules_for_locals, rules_for_imps) = partition isLocalRule better_rules
256 local_rule_base = extendRuleBaseList emptyRuleBase rules_for_locals
257 binds_w_rules = updateBinders local_rule_base binds
259 hpt_rule_base = mkRuleBase home_pkg_rules
260 imp_rule_base = extendRuleBaseList hpt_rule_base rules_for_imps
262 ; dumpIfSet_dyn dflags Opt_D_dump_rules "Transformation rules"
263 (vcat [text "Local rules", pprRules better_rules,
265 text "Imported rules", pprRuleBase imp_rule_base])
267 ; return (imp_rule_base, guts { mg_binds = binds_w_rules,
268 mg_rules = rules_for_imps })
271 updateBinders :: RuleBase -> [CoreBind] -> [CoreBind]
272 updateBinders local_rules binds
273 = map update_bndrs binds
275 update_bndrs (NonRec b r) = NonRec (update_bndr b) r
276 update_bndrs (Rec prs) = Rec [(update_bndr b, r) | (b,r) <- prs]
278 update_bndr bndr = case lookupNameEnv local_rules (idName bndr) of
280 Just rules -> bndr `addIdSpecialisations` rules
281 -- The binder might have some existing rules,
282 -- arising from specialisation pragmas
286 We must do some gentle simplification on the template (but not the RHS)
287 of each rule. The case that forced me to add this was the fold/build rule,
288 which without simplification looked like:
289 fold k z (build (/\a. g a)) ==> ...
290 This doesn't match unless you do eta reduction on the build argument.
293 simplRule env rule@(BuiltinRule {})
295 simplRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs })
296 = simplBinders env bndrs `thenSmpl` \ (env, bndrs') ->
297 mapSmpl (simplExprGently env) args `thenSmpl` \ args' ->
298 simplExprGently env rhs `thenSmpl` \ rhs' ->
299 returnSmpl (rule { ru_bndrs = bndrs', ru_args = args', ru_rhs = rhs' })
301 -- It's important that simplExprGently does eta reduction.
302 -- For example, in a rule like:
303 -- augment g (build h)
304 -- we do not want to get
305 -- augment (\a. g a) (build h)
306 -- otherwise we don't match when given an argument like
309 -- The simplifier does indeed do eta reduction (it's in
310 -- Simplify.completeLam) but only if -O is on.
314 simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr
315 -- Simplifies an expression
316 -- does occurrence analysis, then simplification
317 -- and repeats (twice currently) because one pass
318 -- alone leaves tons of crud.
319 -- Used (a) for user expressions typed in at the interactive prompt
320 -- (b) the LHS and RHS of a RULE
322 -- The name 'Gently' suggests that the SimplifierMode is SimplGently,
323 -- and in fact that is so.... but the 'Gently' in simplExprGently doesn't
324 -- enforce that; it just simplifies the expression twice
326 simplExprGently env expr
327 = simplExpr env (occurAnalyseExpr expr) `thenSmpl` \ expr1 ->
328 simplExpr env (occurAnalyseExpr expr1)
332 %************************************************************************
334 \subsection{Glomming}
336 %************************************************************************
339 glomBinds :: DynFlags -> [CoreBind] -> IO [CoreBind]
340 -- Glom all binds together in one Rec, in case any
341 -- transformations have introduced any new dependencies
343 -- NB: the global invariant is this:
344 -- *** the top level bindings are never cloned, and are always unique ***
346 -- We sort them into dependency order, but applying transformation rules may
347 -- make something at the top refer to something at the bottom:
351 -- RULE: p (q x) = h x
353 -- Applying this rule makes f refer to h,
354 -- although it doesn't appear to in the source program.
355 -- This pass lets us control where it happens.
357 -- NOTICE that this cannot happen for rules whose head is a locally-defined
358 -- function. It only happens for rules whose head is an imported function
359 -- (p in the example above). So, for example, the rule had been
360 -- RULE: f (p x) = h x
361 -- then the rule for f would be attached to f itself (in its IdInfo)
362 -- by prepareLocalRuleBase and h would be regarded by the occurrency
363 -- analyser as free in f.
365 glomBinds dflags binds
366 = do { showPass dflags "GlomBinds" ;
367 let { recd_binds = [Rec (flattenBinds binds)] } ;
369 -- Not much point in printing the result...
370 -- just consumes output bandwidth
374 %************************************************************************
376 \subsection{The driver for the simplifier}
378 %************************************************************************
381 simplifyPgm :: SimplifierMode
382 -> [SimplifierSwitch]
387 -> IO (SimplCount, ModGuts) -- New bindings
389 simplifyPgm mode switches hsc_env us imp_rule_base guts
391 showPass dflags "Simplify";
393 (termination_msg, it_count, counts_out, binds')
394 <- do_iteration us 1 (zeroSimplCount dflags) (mg_binds guts) ;
396 dumpIfSet (dopt Opt_D_verbose_core2core dflags
397 && dopt Opt_D_dump_simpl_stats dflags)
398 "Simplifier statistics"
399 (vcat [text termination_msg <+> text "after" <+> ppr it_count <+> text "iterations",
401 pprSimplCount counts_out]);
403 endPass dflags ("Simplify phase " ++ phase_info ++ " done") Opt_D_verbose_core2core binds';
405 return (counts_out, guts { mg_binds = binds' })
408 dflags = hsc_dflags hsc_env
409 phase_info = case mode of
410 SimplGently -> "gentle"
411 SimplPhase n -> show n
413 sw_chkr = isAmongSimpl switches
414 max_iterations = intSwitchSet sw_chkr MaxSimplifierIterations `orElse` 2
416 do_iteration us iteration_no counts binds
417 -- iteration_no is the number of the iteration we are
418 -- about to begin, with '1' for the first
419 | iteration_no > max_iterations -- Stop if we've run out of iterations
422 if max_iterations > 2 then
423 hPutStr stderr ("NOTE: Simplifier still going after " ++
424 show max_iterations ++
425 " iterations; bailing out.\n")
429 -- Subtract 1 from iteration_no to get the
430 -- number of iterations we actually completed
431 return ("Simplifier baled out", iteration_no - 1, counts, binds)
434 -- Try and force thunks off the binds; significantly reduces
435 -- space usage, especially with -O. JRS, 000620.
436 | let sz = coreBindsSize binds in sz == sz
438 -- Occurrence analysis
439 let { tagged_binds = _scc_ "OccAnal" occurAnalysePgm binds } ;
440 dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
441 (pprCoreBindings tagged_binds);
443 -- Get any new rules, and extend the rule base
444 -- We need to do this regularly, because simplification can
445 -- poke on IdInfo thunks, which in turn brings in new rules
446 -- behind the scenes. Otherwise there's a danger we'll simply
447 -- miss the rules for Ids hidden inside imported inlinings
448 eps <- hscEPS hsc_env ;
449 let { rule_base' = unionRuleBase imp_rule_base (eps_rule_base eps)
450 ; simpl_env = mkSimplEnv mode sw_chkr
451 ; simpl_binds = _scc_ "SimplTopBinds"
452 simplTopBinds simpl_env tagged_binds
453 ; fam_envs = (eps_fam_inst_env eps, mg_fam_inst_env guts) } ;
455 -- Simplify the program
456 -- We do this with a *case* not a *let* because lazy pattern
457 -- matching bit us with bad space leak!
458 -- With a let, we ended up with
463 -- case t of {(_,counts') -> if counts'=0 then ... }
464 -- So the conditional didn't force counts', because the
465 -- selection got duplicated. Sigh!
466 case initSmpl dflags rule_base' fam_envs us1 simpl_binds of {
467 (binds', counts') -> do {
469 let { all_counts = counts `plusSimplCount` counts'
470 ; herald = "Simplifier phase " ++ phase_info ++
471 ", iteration " ++ show iteration_no ++
472 " out of " ++ show max_iterations
475 -- Stop if nothing happened; don't dump output
476 if isZeroSimplCount counts' then
477 return ("Simplifier reached fixed point", iteration_no,
480 -- Short out indirections
481 -- We do this *after* at least one run of the simplifier
482 -- because indirection-shorting uses the export flag on *occurrences*
483 -- and that isn't guaranteed to be ok until after the first run propagates
484 -- stuff from the binding site to its occurrences
486 -- ToDo: alas, this means that indirection-shorting does not happen at all
487 -- if the simplifier does nothing (not common, I know, but unsavoury)
488 let { binds'' = _scc_ "ZapInd" shortOutIndirections binds' } ;
490 -- Dump the result of this iteration
491 dumpIfSet_dyn dflags Opt_D_dump_simpl_iterations herald
492 (pprSimplCount counts') ;
493 endPass dflags herald Opt_D_dump_simpl_iterations binds'' ;
496 do_iteration us2 (iteration_no + 1) all_counts binds''
499 (us1, us2) = splitUniqSupply us
503 %************************************************************************
505 Shorting out indirections
507 %************************************************************************
511 x_local = <expression>
515 where x_exported is exported, and x_local is not, then we replace it with this:
517 x_exported = <expression>
521 Without this we never get rid of the x_exported = x_local thing. This
522 save a gratuitous jump (from \tr{x_exported} to \tr{x_local}), and
523 makes strictness information propagate better. This used to happen in
524 the final phase, but it's tidier to do it here.
526 STRICTNESS: if we have done strictness analysis, we want the strictness info on
527 x_local to transfer to x_exported. Hence the copyIdInfo call.
529 RULES: we want to *add* any RULES for x_local to x_exported.
531 Note [Rules and indirection-zapping]
532 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
533 Problem: what if x_exported has a RULE that mentions something in ...bindings...?
534 Then the things mentioned can be out of scope! Solution
535 a) Make sure that in this pass the usage-info from x_exported is
536 available for ...bindings...
537 b) If there are any such RULES, rec-ify the entire top-level.
538 It'll get sorted out next time round
542 The example that went bad on me at one stage was this one:
544 iterate :: (a -> a) -> a -> [a]
546 iterate = iterateList
548 iterateFB c f x = x `c` iterateFB c f (f x)
549 iterateList f x = x : iterateList f (f x)
553 "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x)
554 "iterateFB" iterateFB (:) = iterateList
557 This got shorted out to:
559 iterateList :: (a -> a) -> a -> [a]
560 iterateList = iterate
562 iterateFB c f x = x `c` iterateFB c f (f x)
563 iterate f x = x : iterate f (f x)
566 "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x)
567 "iterateFB" iterateFB (:) = iterate
570 And now we get an infinite loop in the rule system
571 iterate f x -> build (\cn -> iterateFB c f x)
575 Tiresome old solution:
576 don't do shorting out if f has rewrite rules (see shortableIdInfo)
578 New solution (I think):
579 use rule switching-off pragmas to get rid
580 of iterateList in the first place
585 If more than one exported thing is equal to a local thing (i.e., the
586 local thing really is shared), then we do one only:
589 x_exported1 = x_local
590 x_exported2 = x_local
594 x_exported2 = x_exported1
597 We rely on prior eta reduction to simplify things like
599 x_exported = /\ tyvars -> x_local tyvars
603 Hence,there's a possibility of leaving unchanged something like this:
606 x_exported1 = x_local Int
608 By the time we've thrown away the types in STG land this
609 could be eliminated. But I don't think it's very common
610 and it's dangerous to do this fiddling in STG land
611 because we might elminate a binding that's mentioned in the
612 unfolding for something.
615 type IndEnv = IdEnv Id -- Maps local_id -> exported_id
617 shortOutIndirections :: [CoreBind] -> [CoreBind]
618 shortOutIndirections binds
619 | isEmptyVarEnv ind_env = binds
620 | no_need_to_flatten = binds' -- See Note [Rules and indirect-zapping]
621 | otherwise = [Rec (flattenBinds binds')] -- for this no_need_to_flatten stuff
623 ind_env = makeIndEnv binds
624 exp_ids = varSetElems ind_env -- These exported Ids are the subjects
625 exp_id_set = mkVarSet exp_ids -- of the indirection-elimination
626 no_need_to_flatten = all (null . specInfoRules . idSpecialisation) exp_ids
627 binds' = concatMap zap binds
629 zap (NonRec bndr rhs) = [NonRec b r | (b,r) <- zapPair (bndr,rhs)]
630 zap (Rec pairs) = [Rec (concatMap zapPair pairs)]
633 | bndr `elemVarSet` exp_id_set = []
634 | Just exp_id <- lookupVarEnv ind_env bndr = [(transferIdInfo exp_id bndr, rhs),
636 | otherwise = [(bndr,rhs)]
638 makeIndEnv :: [CoreBind] -> IndEnv
640 = foldr add_bind emptyVarEnv binds
642 add_bind :: CoreBind -> IndEnv -> IndEnv
643 add_bind (NonRec exported_id rhs) env = add_pair (exported_id, rhs) env
644 add_bind (Rec pairs) env = foldr add_pair env pairs
646 add_pair :: (Id,CoreExpr) -> IndEnv -> IndEnv
647 add_pair (exported_id, Var local_id) env
648 | shortMeOut env exported_id local_id = extendVarEnv env local_id exported_id
649 add_pair (exported_id, rhs) env
652 shortMeOut ind_env exported_id local_id
653 -- The if-then-else stuff is just so I can get a pprTrace to see
654 -- how often I don't get shorting out becuase of IdInfo stuff
655 = if isExportedId exported_id && -- Only if this is exported
657 isLocalId local_id && -- Only if this one is defined in this
658 -- module, so that we *can* change its
659 -- binding to be the exported thing!
661 not (isExportedId local_id) && -- Only if this one is not itself exported,
662 -- since the transformation will nuke it
664 not (local_id `elemVarEnv` ind_env) -- Only if not already substituted for
669 if isEmptySpecInfo (specInfo (idInfo exported_id)) -- Only if no rules
670 then True -- See note on "Messing up rules"
673 pprTrace "shortMeOut:" (ppr exported_id)
682 transferIdInfo :: Id -> Id -> Id
684 -- lcl_id = e; exp_id = lcl_id
685 -- and lcl_id has useful IdInfo, we don't want to discard it by going
686 -- gbl_id = e; lcl_id = gbl_id
687 -- Instead, transfer IdInfo from lcl_id to exp_id
688 -- Overwriting, rather than merging, seems to work ok.
689 transferIdInfo exported_id local_id
690 = modifyIdInfo transfer exported_id
692 local_info = idInfo local_id
693 transfer exp_info = exp_info `setNewStrictnessInfo` newStrictnessInfo local_info
694 `setWorkerInfo` workerInfo local_info
695 `setInlinePragInfo` inlinePragInfo local_info
696 `setSpecInfo` addSpecInfo (specInfo exp_info)
697 (specInfo local_info)