2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section{Tidying up Core}
8 tidyCorePgm, tidyExpr, tidyCoreExpr, tidyIdRules,
12 #include "HsVersions.h"
14 import CmdLineOpts ( DynFlags, DynFlag(..), opt_OmitInterfacePragmas )
16 import CoreUnfold ( noUnfolding, mkTopUnfolding, okToUnfoldInHiFile )
17 import CoreFVs ( ruleLhsFreeIds, ruleRhsFreeVars, exprSomeFreeVars )
18 import PprCore ( pprIdRules )
19 import CoreLint ( showPass, endPass )
20 import CoreUtils ( exprArity )
23 import Var ( Id, Var )
24 import Id ( idType, idInfo, idName, idCoreRules,
25 isExportedId, idUnique, mkVanillaGlobal, isLocalId,
26 isImplicitId, mkUserLocal, setIdInfo
28 import IdInfo {- loads of stuff -}
29 import NewDemand ( isBottomingSig, topSig )
30 import BasicTypes ( isNeverActive )
31 import Name ( getOccName, nameOccName, mkInternalName, mkExternalName,
32 localiseName, isExternalName, nameSrcLoc
34 import NameEnv ( filterNameEnv )
35 import OccName ( TidyOccEnv, initTidyOccEnv, tidyOccName )
36 import Type ( tidyTopType, tidyType, tidyTyVarBndr )
37 import Module ( Module, moduleName )
38 import HscTypes ( PersistentCompilerState( pcs_PRS ),
39 PersistentRenamerState( prsOrig ),
40 NameSupply( nsNames, nsUniqs ),
41 TypeEnv, extendTypeEnvList, typeEnvIds,
42 ModDetails(..), TyThing(..)
44 import FiniteMap ( lookupFM, addToFM )
45 import Maybes ( orElse )
46 import ErrUtils ( showPass, dumpIfSet_core )
47 import SrcLoc ( noSrcLoc )
48 import UniqFM ( mapUFM )
49 import UniqSupply ( splitUniqSupply, uniqFromSupply )
50 import List ( partition )
51 import Util ( mapAccumL )
52 import Maybe ( isJust )
58 %************************************************************************
60 \subsection{What goes on}
62 %************************************************************************
68 Step 1: Figure out external Ids
69 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
70 First we figure out which Ids are "external" Ids. An
71 "external" Id is one that is visible from outside the compilation
73 a) the user exported ones
74 b) ones mentioned in the unfoldings, workers,
75 or rules of externally-visible ones
76 This exercise takes a sweep of the bindings bottom to top. Actually,
77 in Step 2 we're also going to need to know which Ids should be
78 exported with their unfoldings, so we produce not an IdSet but an
82 Step 2: Tidy the program
83 ~~~~~~~~~~~~~~~~~~~~~~~~
84 Next we traverse the bindings top to bottom. For each *top-level*
87 1. Make it into a GlobalId
89 2. Give it a system-wide Unique.
90 [Even non-exported things need system-wide Uniques because the
91 byte-code generator builds a single Name->BCO symbol table.]
93 We use the NameSupply kept in the PersistentRenamerState as the
94 source of such system-wide uniques.
96 For external Ids, use the original-name cache in the NameSupply
97 to ensure that the unique assigned is the same as the Id had
98 in any previous compilation run.
100 3. If it's an external Id, make it have a global Name, otherwise
101 make it have a local Name.
102 This is used by the code generator to decide whether
103 to make the label externally visible
105 4. Give external Ids a "tidy" occurrence name. This means
106 we can print them in interface files without confusing
107 "x" (unique 5) with "x" (unique 10).
109 5. Give it its UTTERLY FINAL IdInfo; in ptic,
110 * Its IdDetails becomes VanillaGlobal, reflecting the fact that
111 from now on we regard it as a global, not local, Id
113 * its unfolding, if it should have one
115 * its arity, computed from the number of visible lambdas
117 * its CAF info, computed from what is free in its RHS
120 Finally, substitute these new top-level binders consistently
121 throughout, including in unfoldings. We also tidy binders in
122 RHSs, so that they print nicely in interfaces.
125 tidyCorePgm :: DynFlags -> Module
126 -> PersistentCompilerState
127 -> CgInfoEnv -- Information from the back end,
128 -- to be splatted into the IdInfo
130 -> IO (PersistentCompilerState, ModDetails)
132 tidyCorePgm dflags mod pcs cg_info_env
133 (ModDetails { md_types = env_tc, md_insts = insts_tc,
134 md_binds = binds_in, md_rules = orphans_in })
135 = do { showPass dflags "Tidy Core"
137 ; let ext_ids = findExternalSet binds_in orphans_in
138 ; let ext_rules = findExternalRules binds_in orphans_in ext_ids
139 -- findExternalRules filters ext_rules to avoid binders that
140 -- aren't externally visible; but the externally-visible binders
141 -- are computed (by findExternalSet) assuming that all orphan
142 -- rules are exported. So in fact we may export more than we
143 -- need. (It's a sort of mutual recursion.)
145 -- We also make sure to avoid any exported binders. Consider
146 -- f{-u1-} = 1 -- Local decl
148 -- f{-u2-} = 2 -- Exported decl
150 -- The second exported decl must 'get' the name 'f', so we
151 -- have to put 'f' in the avoids list before we get to the first
152 -- decl. tidyTopId then does a no-op on exported binders.
153 ; let prs = pcs_PRS pcs
154 orig_ns = prsOrig prs
156 init_tidy_env = (orig_ns, initTidyOccEnv avoids, emptyVarEnv)
157 avoids = [getOccName name | bndr <- typeEnvIds env_tc,
158 let name = idName bndr,
160 -- In computing our "avoids" list, we must include
162 -- all things with global names (assigned once and for
163 -- all by the renamer)
164 -- since their names are "taken".
165 -- The type environment is a convenient source of such things.
167 ; let ((orig_ns', occ_env, subst_env), tidy_binds)
168 = mapAccumL (tidyTopBind mod ext_ids cg_info_env)
169 init_tidy_env binds_in
171 ; let tidy_rules = tidyIdCoreRules (occ_env,subst_env) ext_rules
173 ; let prs' = prs { prsOrig = orig_ns' }
174 pcs' = pcs { pcs_PRS = prs' }
176 ; let final_ids = [ id
178 , id <- bindersOf bind
179 , isExternalName (idName id)]
181 -- Dfuns are local Ids that might have
182 -- changed their unique during tidying
183 ; let lookup_dfun_id id = lookupVarEnv subst_env id `orElse`
184 pprPanic "lookup_dfun_id" (ppr id)
187 ; let tidy_type_env = mkFinalTypeEnv env_tc final_ids
188 tidy_dfun_ids = map lookup_dfun_id insts_tc
190 ; let tidy_details = ModDetails { md_types = tidy_type_env,
191 md_rules = tidy_rules,
192 md_insts = tidy_dfun_ids,
193 md_binds = tidy_binds }
195 ; endPass dflags "Tidy Core" Opt_D_dump_simpl tidy_binds
196 ; dumpIfSet_core dflags Opt_D_dump_simpl
198 (pprIdRules tidy_rules)
200 ; return (pcs', tidy_details)
203 tidyCoreExpr :: CoreExpr -> IO CoreExpr
204 tidyCoreExpr expr = return (tidyExpr emptyTidyEnv expr)
208 %************************************************************************
210 \subsection{Write a new interface file}
212 %************************************************************************
215 mkFinalTypeEnv :: TypeEnv -- From typechecker
219 mkFinalTypeEnv type_env final_ids
220 = extendTypeEnvList (filterNameEnv keep_it type_env)
223 -- The competed type environment is gotten from
224 -- a) keeping the types and classes
225 -- b) removing all Ids,
226 -- c) adding Ids with correct IdInfo, including unfoldings,
227 -- gotten from the bindings
228 -- From (c) we keep only those Ids with Global names;
229 -- the CoreTidy pass makes sure these are all and only
230 -- the externally-accessible ones
231 -- This truncates the type environment to include only the
232 -- exported Ids and things needed from them, which saves space
234 -- However, we do keep things like constructors, which should not appear
235 -- in interface files, because they are needed by importing modules when
236 -- using the compilation manager
238 -- We keep implicit Ids, because they won't appear
239 -- in the bindings from which final_ids are derived!
240 keep_it (AnId id) = isImplicitId id -- Remove all Ids except implicit ones
241 keep_it other = True -- Keep all TyCons and Classes
245 findExternalRules :: [CoreBind]
246 -> [IdCoreRule] -- Orphan rules
247 -> IdEnv a -- Ids that are exported, so we need their rules
249 -- The complete rules are gotten by combining
250 -- a) the orphan rules
251 -- b) rules embedded in the top-level Ids
252 findExternalRules binds orphan_rules ext_ids
253 | opt_OmitInterfacePragmas = []
255 = filter needed_rule (orphan_rules ++ local_rules)
258 | id <- bindersOfBinds binds,
259 id `elemVarEnv` ext_ids,
260 rule <- idCoreRules id
262 needed_rule (id, rule)
263 = not (isBuiltinRule rule)
264 -- We can't print builtin rules in interface files
265 -- Since they are built in, an importing module
266 -- will have access to them anyway
268 && not (any internal_id (varSetElems (ruleLhsFreeIds rule)))
269 -- Don't export a rule whose LHS mentions an Id that
270 -- is completely internal (i.e. not visible to an
273 internal_id id = isLocalId id && not (id `elemVarEnv` ext_ids)
276 %************************************************************************
278 \subsection{Step 1: finding externals}
280 %************************************************************************
283 findExternalSet :: [CoreBind] -> [IdCoreRule]
284 -> IdEnv Bool -- In domain => external
285 -- Range = True <=> show unfolding
286 -- Step 1 from the notes above
287 findExternalSet binds orphan_rules
288 = foldr find init_needed binds
290 orphan_rule_ids :: IdSet
291 orphan_rule_ids = unionVarSets [ ruleRhsFreeVars rule
292 | (_, rule) <- orphan_rules]
293 init_needed :: IdEnv Bool
294 init_needed = mapUFM (\_ -> False) orphan_rule_ids
295 -- The mapUFM is a bit cheesy. It is a cheap way
296 -- to turn the set of orphan_rule_ids, which we use to initialise
297 -- the sweep, into a mapping saying 'don't expose unfolding'
298 -- (When we come to the binding site we may change our mind, of course.)
300 find (NonRec id rhs) needed
301 | need_id needed id = addExternal (id,rhs) needed
303 find (Rec prs) needed = find_prs prs needed
305 -- For a recursive group we have to look for a fixed point
307 | null needed_prs = needed
308 | otherwise = find_prs other_prs new_needed
310 (needed_prs, other_prs) = partition (need_pr needed) prs
311 new_needed = foldr addExternal needed needed_prs
313 -- The 'needed' set contains the Ids that are needed by earlier
314 -- interface file emissions. If the Id isn't in this set, and isn't
315 -- exported, there's no need to emit anything
316 need_id needed_set id = id `elemVarEnv` needed_set || isExportedId id
317 need_pr needed_set (id,rhs) = need_id needed_set id
319 addExternal :: (Id,CoreExpr) -> IdEnv Bool -> IdEnv Bool
320 -- The Id is needed; extend the needed set
321 -- with it and its dependents (free vars etc)
322 addExternal (id,rhs) needed
323 = extendVarEnv (foldVarSet add_occ needed new_needed_ids)
326 add_occ id needed = extendVarEnv needed id False
327 -- "False" because we don't know we need the Id's unfolding
328 -- We'll override it later when we find the binding site
330 new_needed_ids | opt_OmitInterfacePragmas = emptyVarSet
331 | otherwise = worker_ids `unionVarSet`
332 unfold_ids `unionVarSet`
336 dont_inline = isNeverActive (inlinePragInfo idinfo)
337 loop_breaker = isLoopBreaker (occInfo idinfo)
338 bottoming_fn = isBottomingSig (newStrictnessInfo idinfo `orElse` topSig)
339 spec_ids = rulesRhsFreeVars (specInfo idinfo)
340 worker_info = workerInfo idinfo
342 -- Stuff to do with the Id's unfolding
343 -- The simplifier has put an up-to-date unfolding
344 -- in the IdInfo, but the RHS will do just as well
345 unfolding = unfoldingInfo idinfo
346 rhs_is_small = not (neverUnfold unfolding)
348 -- We leave the unfolding there even if there is a worker
349 -- In GHCI the unfolding is used by importers
350 -- When writing an interface file, we omit the unfolding
351 -- if there is a worker
352 show_unfold = not bottoming_fn && -- Not necessary
355 rhs_is_small && -- Small enough
356 okToUnfoldInHiFile rhs -- No casms etc
358 unfold_ids | show_unfold = exprSomeFreeVars isLocalId rhs
359 | otherwise = emptyVarSet
361 worker_ids = case worker_info of
362 HasWorker work_id _ -> unitVarSet work_id
363 otherwise -> emptyVarSet
367 %************************************************************************
369 \subsection{Step 2: top-level tidying}
371 %************************************************************************
375 type TopTidyEnv = (NameSupply, TidyOccEnv, VarEnv Var)
377 -- TopTidyEnv: when tidying we need to know
378 -- * ns: The NameSupply, containing a unique supply and any pre-ordained Names.
379 -- These may have arisen because the
380 -- renamer read in an interface file mentioning M.$wf, say,
381 -- and assigned it unique r77. If, on this compilation, we've
382 -- invented an Id whose name is $wf (but with a different unique)
383 -- we want to rename it to have unique r77, so that we can do easy
384 -- comparisons with stuff from the interface file
386 -- * occ_env: The TidyOccEnv, which tells us which local occurrences
389 -- * subst_env: A Var->Var mapping that substitutes the new Var for the old
394 tidyTopBind :: Module
395 -> IdEnv Bool -- Domain = Ids that should be external
396 -- True <=> their unfolding is external too
398 -> TopTidyEnv -> CoreBind
399 -> (TopTidyEnv, CoreBind)
401 tidyTopBind mod ext_ids cg_info_env top_tidy_env (NonRec bndr rhs)
402 = ((orig,occ,subst) , NonRec bndr' rhs')
404 ((orig,occ,subst), bndr')
405 = tidyTopBinder mod ext_ids cg_info_env
406 rec_tidy_env rhs rhs' top_tidy_env bndr
407 rec_tidy_env = (occ,subst)
408 rhs' = tidyExpr rec_tidy_env rhs
410 tidyTopBind mod ext_ids cg_info_env top_tidy_env (Rec prs)
411 = (final_env, Rec prs')
413 (final_env@(_,occ,subst), prs') = mapAccumL do_one top_tidy_env prs
414 rec_tidy_env = (occ,subst)
416 do_one top_tidy_env (bndr,rhs)
417 = ((orig,occ,subst), (bndr',rhs'))
419 ((orig,occ,subst), bndr')
420 = tidyTopBinder mod ext_ids cg_info_env
421 rec_tidy_env rhs rhs' top_tidy_env bndr
423 rhs' = tidyExpr rec_tidy_env rhs
425 tidyTopBinder :: Module -> IdEnv Bool -> CgInfoEnv
426 -> TidyEnv -- The TidyEnv is used to tidy the IdInfo
427 -> CoreExpr -- RHS *before* tidying
428 -> CoreExpr -- RHS *after* tidying
429 -- The TidyEnv and the after-tidying RHS are
430 -- both are knot-tied: don't look at them!
431 -> TopTidyEnv -> Id -> (TopTidyEnv, Id)
432 -- NB: tidyTopBinder doesn't affect the unique supply
434 tidyTopBinder mod ext_ids cg_info_env rec_tidy_env rhs tidy_rhs
435 env@(ns2, occ_env2, subst_env2) id
436 -- This function is the heart of Step 2
437 -- The rec_tidy_env is the one to use for the IdInfo
438 -- It's necessary because when we are dealing with a recursive
439 -- group, a variable late in the group might be mentioned
440 -- in the IdInfo of one early in the group
442 -- The rhs is already tidied
444 = ((orig_env', occ_env', subst_env'), id')
446 (orig_env', occ_env', name') = tidyTopName mod ns2 occ_env2
449 ty' = tidyTopType (idType id)
450 idinfo = tidyTopIdInfo rec_tidy_env is_external
451 (idInfo id) unfold_info arity
452 (lookupCgInfo cg_info_env name')
454 id' = mkVanillaGlobal name' ty' idinfo
456 subst_env' = extendVarEnv subst_env2 id id'
458 maybe_external = lookupVarEnv ext_ids id
459 is_external = isJust maybe_external
461 -- Expose an unfolding if ext_ids tells us to
462 -- Remember that ext_ids maps an Id to a Bool:
463 -- True to show the unfolding, False to hide it
464 show_unfold = maybe_external `orElse` False
465 unfold_info | show_unfold = mkTopUnfolding tidy_rhs
466 | otherwise = noUnfolding
468 -- Usually the Id will have an accurate arity on it, because
469 -- the simplifier has just run, but not always.
470 -- One case I found was when the last thing the simplifier
471 -- did was to let-bind a non-atomic argument and then float
472 -- it to the top level. So it seems more robust just to
474 arity = exprArity rhs
478 -- tidyTopIdInfo creates the final IdInfo for top-level
479 -- binders. There are two delicate pieces:
481 -- * Arity. After CoreTidy, this arity must not change any more.
482 -- Indeed, CorePrep must eta expand where necessary to make
483 -- the manifest arity equal to the claimed arity.
485 -- * CAF info, which comes from the CoreToStg pass via a knot.
486 -- The CAF info will not be looked at by the downstream stuff:
487 -- it *generates* it, and knot-ties it back. It will only be
488 -- looked at by (a) MkIface when generating an interface file
489 -- (b) In GHCi, importing modules
490 -- Nevertheless, we add the info here so that it propagates to all
491 -- occurrences of the binders in RHSs, and hence to occurrences in
492 -- unfoldings, which are inside Ids imported by GHCi. Ditto RULES.
494 -- An alterative would be to do a second pass over the unfoldings
495 -- of Ids, and rules, right at the top, but that would be a pain.
497 tidyTopIdInfo tidy_env is_external idinfo unfold_info arity cg_info
498 | opt_OmitInterfacePragmas || not is_external
499 -- Only basic info if the Id isn't external, or if we don't have -O
502 | otherwise -- Add extra optimisation info
504 `setInlinePragInfo` inlinePragInfo idinfo
505 `setUnfoldingInfo` unfold_info
506 `setWorkerInfo` tidyWorker tidy_env (workerInfo idinfo)
507 -- NB: we throw away the Rules
508 -- They have already been extracted by findExternalRules
511 -- baasic_info is attached to every top-level binder
512 basic_info = vanillaIdInfo
515 `setAllStrictnessInfo` newStrictnessInfo idinfo
517 -- This is where we set names to local/global based on whether they really are
518 -- externally visible (see comment at the top of this module). If the name
519 -- was previously local, we have to give it a unique occurrence name if
520 -- we intend to externalise it.
521 tidyTopName mod ns occ_env external name
522 | global && internal = (ns, occ_env, localiseName name)
524 | global && external = (ns, occ_env, name)
525 -- Global names are assumed to have been allocated by the renamer,
526 -- so they already have the "right" unique
527 -- And it's a system-wide unique too
529 | local && internal = (ns_w_local, occ_env', new_local_name)
530 -- Even local, internal names must get a unique occurrence, because
531 -- if we do -split-objs we externalise the name later, in the code generator
533 -- Similarly, we must make sure it has a system-wide Unique, because
534 -- the byte-code generator builds a system-wide Name->BCO symbol table
536 | local && external = case lookupFM ns_names key of
537 Just orig -> (ns, occ_env', orig)
538 Nothing -> (ns_w_global, occ_env', new_external_name)
539 -- If we want to externalise a currently-local name, check
540 -- whether we have already assigned a unique for it.
541 -- If so, use it; if not, extend the table (ns_w_global).
542 -- This is needed when *re*-compiling a module in GHCi; we want to
543 -- use the same name for externally-visible things as we did before.
546 global = isExternalName name
548 internal = not external
550 (occ_env', occ') = tidyOccName occ_env (nameOccName name)
551 key = (moduleName mod, occ')
552 ns_names = nsNames ns
553 ns_uniqs = nsUniqs ns
554 (us1, us2) = splitUniqSupply ns_uniqs
555 uniq = uniqFromSupply us1
556 loc = nameSrcLoc name
558 new_local_name = mkInternalName uniq occ' loc
559 new_external_name = mkExternalName uniq mod occ' loc
561 ns_w_local = ns { nsUniqs = us2 }
562 ns_w_global = ns { nsUniqs = us2, nsNames = addToFM ns_names key new_external_name }
565 ------------ Worker --------------
566 tidyWorker tidy_env (HasWorker work_id wrap_arity)
567 = HasWorker (tidyVarOcc tidy_env work_id) wrap_arity
568 tidyWorker tidy_env other
571 ------------ Rules --------------
572 tidyIdRules :: Id -> [IdCoreRule]
573 tidyIdRules id = tidyIdCoreRules emptyTidyEnv (idCoreRules id)
575 tidyIdCoreRules :: TidyEnv -> [IdCoreRule] -> [IdCoreRule]
576 tidyIdCoreRules env [] = []
577 tidyIdCoreRules env ((fn,rule) : rules)
578 = tidyRule env rule =: \ rule ->
579 tidyIdCoreRules env rules =: \ rules ->
580 ((tidyVarOcc env fn, rule) : rules)
582 tidyRule :: TidyEnv -> CoreRule -> CoreRule
583 tidyRule env rule@(BuiltinRule _ _) = rule
584 tidyRule env (Rule name act vars tpl_args rhs)
585 = tidyBndrs env vars =: \ (env', vars) ->
586 map (tidyExpr env') tpl_args =: \ tpl_args ->
587 (Rule name act vars tpl_args (tidyExpr env' rhs))
590 %************************************************************************
592 \subsection{Step 2: inner tidying
594 %************************************************************************
599 -> (TidyEnv, CoreBind)
601 tidyBind env (NonRec bndr rhs)
602 = tidyLetBndr env (bndr,rhs) =: \ (env', bndr') ->
603 (env', NonRec bndr' (tidyExpr env' rhs))
605 tidyBind env (Rec prs)
606 = mapAccumL tidyLetBndr env prs =: \ (env', bndrs') ->
607 map (tidyExpr env') (map snd prs) =: \ rhss' ->
608 (env', Rec (zip bndrs' rhss'))
611 tidyExpr env (Var v) = Var (tidyVarOcc env v)
612 tidyExpr env (Type ty) = Type (tidyType env ty)
613 tidyExpr env (Lit lit) = Lit lit
614 tidyExpr env (App f a) = App (tidyExpr env f) (tidyExpr env a)
615 tidyExpr env (Note n e) = Note (tidyNote env n) (tidyExpr env e)
617 tidyExpr env (Let b e)
618 = tidyBind env b =: \ (env', b') ->
619 Let b' (tidyExpr env' e)
621 tidyExpr env (Case e b alts)
622 = tidyBndr env b =: \ (env', b) ->
623 Case (tidyExpr env e) b (map (tidyAlt env') alts)
625 tidyExpr env (Lam b e)
626 = tidyBndr env b =: \ (env', b) ->
627 Lam b (tidyExpr env' e)
630 tidyAlt env (con, vs, rhs)
631 = tidyBndrs env vs =: \ (env', vs) ->
632 (con, vs, tidyExpr env' rhs)
634 tidyNote env (Coerce t1 t2) = Coerce (tidyType env t1) (tidyType env t2)
635 tidyNote env note = note
639 %************************************************************************
641 \subsection{Tidying up non-top-level binders}
643 %************************************************************************
646 tidyVarOcc (_, var_env) v = case lookupVarEnv var_env v of
650 -- tidyBndr is used for lambda and case binders
651 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
653 | isTyVar var = tidyTyVarBndr env var
654 | otherwise = tidyIdBndr env var
656 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
657 tidyBndrs env vars = mapAccumL tidyBndr env vars
659 tidyLetBndr :: TidyEnv -> (Id, CoreExpr) -> (TidyEnv, Var)
660 -- Used for local (non-top-level) let(rec)s
661 tidyLetBndr env (id,rhs)
662 = ((tidy_env,new_var_env), final_id)
664 ((tidy_env,var_env), new_id) = tidyIdBndr env id
666 -- We need to keep around any interesting strictness and demand info
667 -- because later on we may need to use it when converting to A-normal form.
669 -- f (g x), where f is strict in its argument, will be converted
670 -- into case (g x) of z -> f z by CorePrep, but only if f still
671 -- has its strictness info.
673 -- Similarly for the demand info - on a let binder, this tells
674 -- CorePrep to turn the let into a case.
676 -- Similarly arity info for eta expansion in CorePrep
677 final_id = new_id `setIdInfo` new_info
679 new_info = vanillaIdInfo
680 `setArityInfo` exprArity rhs
681 `setAllStrictnessInfo` newStrictnessInfo idinfo
682 `setNewDemandInfo` newDemandInfo idinfo
684 -- Override the env we get back from tidyId with the new IdInfo
685 -- so it gets propagated to the usage sites.
686 new_var_env = extendVarEnv var_env id final_id
688 -- Non-top-level variables
689 tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
690 tidyIdBndr env@(tidy_env, var_env) id
691 = -- do this pattern match strictly, otherwise we end up holding on to
692 -- stuff in the OccName.
693 case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
695 -- Give the Id a fresh print-name, *and* rename its type
696 -- The SrcLoc isn't important now,
697 -- though we could extract it from the Id
699 -- All nested Ids now have the same IdInfo, namely none,
700 -- which should save some space.
701 ty' = tidyType env (idType id)
702 id' = mkUserLocal occ' (idUnique id) ty' noSrcLoc
703 var_env' = extendVarEnv var_env id id'
705 ((tidy_env', var_env'), id')