2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section{Tidying up Core}
7 module TidyPgm( simpleTidyPgm, optTidyPgm ) where
9 #include "HsVersions.h"
11 import DynFlags ( DynFlags, DynFlag(..) )
13 import CoreUnfold ( noUnfolding, mkTopUnfolding )
14 import CoreFVs ( ruleLhsFreeIds, exprSomeFreeVars )
15 import CoreTidy ( tidyExpr, tidyVarOcc, tidyRules )
16 import PprCore ( pprRules )
17 import CoreLint ( showPass, endPass )
18 import CoreUtils ( exprArity, rhsIsStatic )
21 import Var ( Id, Var )
22 import Id ( idType, idInfo, idName, idCoreRules, isGlobalId,
23 isExportedId, mkVanillaGlobal, isLocalId,
24 idArity, idCafInfo, idUnfolding
26 import IdInfo {- loads of stuff -}
27 import InstEnv ( Instance, DFunId, instanceDFunId, setInstanceDFunId )
28 import NewDemand ( isBottomingSig, topSig )
29 import BasicTypes ( Arity, isNeverActive )
30 import Name ( Name, getOccName, nameOccName, mkInternalName,
31 localiseName, isExternalName, nameSrcLoc, nameParent_maybe,
32 isWiredInName, getName
34 import NameSet ( NameSet, elemNameSet )
35 import IfaceEnv ( allocateGlobalBinder )
36 import NameEnv ( filterNameEnv )
37 import OccName ( TidyOccEnv, initTidyOccEnv, tidyOccName )
38 import Type ( tidyTopType )
39 import TcType ( isFFITy )
40 import DataCon ( dataConName, dataConFieldLabels, dataConWrapId_maybe )
41 import TyCon ( TyCon, makeTyConAbstract, tyConDataCons, isNewTyCon,
42 newTyConRep, isDataTyCon, tyConSelIds, isAlgTyCon )
43 import Class ( classSelIds )
44 import Module ( Module )
45 import HscTypes ( HscEnv(..), NameCache( nsUniqs ), CgGuts(..),
46 TypeEnv, typeEnvIds, typeEnvElts, typeEnvTyCons,
47 extendTypeEnvWithIds, mkTypeEnv,
48 ModGuts(..), TyThing(..), ModDetails(..), Dependencies(..)
50 import Maybes ( orElse, mapCatMaybes )
51 import ErrUtils ( showPass, dumpIfSet_core )
52 import UniqSupply ( splitUniqSupply, uniqFromSupply )
53 import List ( partition )
54 import Maybe ( isJust )
56 import DATA_IOREF ( IORef, readIORef, writeIORef )
57 import FastTypes hiding ( fastOr )
61 Constructing the TypeEnv, Instances, Rules from which the ModIface is
62 constructed, and which goes on to subsequent modules in --make mode.
64 Most of the interface file is obtained simply by serialising the
65 TypeEnv. One important consequence is that if the *interface file*
66 has pragma info if and only if the final TypeEnv does. This is not so
67 important for *this* module, but it's essential for ghc --make:
68 subsequent compilations must not see (e.g.) the arity if the interface
69 file does not contain arity If they do, they'll exploit the arity;
70 then the arity might change, but the iface file doesn't change =>
71 recompilation does not happen => disaster.
73 For data types, the final TypeEnv will have a TyThing for the TyCon,
74 plus one for each DataCon; the interface file will contain just one
75 data type declaration, but it is de-serialised back into a collection
78 %************************************************************************
82 %************************************************************************
85 Plan A: simpleTidyPgm: omit pragmas, make interfaces small
86 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
89 * Drop all WiredIn things from the TypeEnv
90 (we never want them in interface files)
91 (why are they there? I think mainly as a memo
92 to avoid repeatedly checking that we've loaded their
93 home interface; but I'm not certain)
95 * Retain all TyCons and Classes in the TypeEnv, to avoid
96 having to find which ones are mentioned in the
99 * Trim off the constructors of non-exported TyCons, both
100 from the TyCon and from the TypeEnv
102 * Drop non-exported Ids from the TypeEnv
104 * Tidy the types of the DFunIds of Instances,
105 make them into GlobalIds, (they already have External Names)
106 and add them to the TypeEnv
108 * Tidy the types of the (exported) Ids in the TypeEnv,
109 make them into GlobalIds (they already have External Names)
111 * Drop rules altogether
113 * Tidy the bindings, to ensure that the Caf and Arity
114 information is correct for each top-level binder; the
115 code generator needs it. And to ensure that local names have
116 distinct OccNames in case of object-file splitting
119 simpleTidyPgm :: HscEnv -> ModGuts
120 -> IO (CgGuts, ModDetails)
121 -- This is Plan A: make a small type env when typechecking only,
122 -- or when compiling a hs-boot file, or simply when not using -O
124 simpleTidyPgm hsc_env mod_impl@(ModGuts { mg_module = mod,
125 mg_exports = exports,
129 = do { let dflags = hsc_dflags hsc_env
130 ; showPass dflags "Tidy Type Env"
132 ; let { ispecs' = tidyInstances tidyExternalId ispecs
134 ; things' = mapCatMaybes (tidyThing exports)
135 (typeEnvElts type_env)
137 ; type_env' = extendTypeEnvWithIds (mkTypeEnv things')
138 (map instanceDFunId ispecs')
139 ; ext_ids = mkVarEnv [ (id, False) | id <- typeEnvIds type_env']
142 ; (_, cg_guts) <- tidyCgStuff hsc_env ext_ids mod_impl
144 ; return (cg_guts, ModDetails { md_types = type_env'
147 , md_exports = exports })
150 tidyInstances :: (DFunId -> DFunId) -> [Instance] -> [Instance]
151 tidyInstances tidy_dfun ispecs
154 tidy ispec = setInstanceDFunId ispec (tidy_dfun (instanceDFunId ispec))
156 tidyThing :: NameSet -- Exports
157 -> TyThing -> Maybe TyThing -- Nothing => drop it
158 tidyThing exports thing
159 | isWiredInName (getName thing)
163 AClass cl -> Just thing
166 | mustExposeTyCon exports tc -> Just thing
167 | otherwise -> Just (ATyCon (makeTyConAbstract tc))
170 | getName dc `elemNameSet` exports -> Just thing
171 | otherwise -> Nothing
174 | not (getName id `elemNameSet` exports) -> Nothing
175 | not (isLocalId id) -> Just thing -- Implicit Ids such as class ops,
176 -- data-con wrappers etc
177 | otherwise -> Just (AnId (tidyExternalId id))
179 tidyExternalId :: Id -> Id
180 -- Takes an LocalId with an External Name,
181 -- makes it into a GlobalId with VanillaIdInfo, and tidies its type
182 -- (NB: vanillaIdInfo makes a conservative assumption about Caf-hood.)
184 = ASSERT2( isLocalId id && isExternalName (idName id), ppr id )
185 mkVanillaGlobal (idName id) (tidyTopType (idType id)) vanillaIdInfo
187 mustExposeTyCon :: NameSet -- Exports
188 -> TyCon -- The tycon
189 -> Bool -- Can its rep be hidden?
190 -- We are compiling without -O, and thus trying to write as little as
191 -- possible into the interface file. But we must expose the details of
192 -- any data types whose constructors or fields are exported
193 mustExposeTyCon exports tc
194 | not (isAlgTyCon tc) -- Synonyms
196 | otherwise -- Newtype, datatype
197 = any exported_con (tyConDataCons tc)
198 -- Expose rep if any datacon or field is exported
200 || (isNewTyCon tc && isFFITy (snd (newTyConRep tc)))
201 -- Expose the rep for newtypes if the rep is an FFI type.
202 -- For a very annoying reason. 'Foreign import' is meant to
203 -- be able to look through newtypes transparently, but it
204 -- can only do that if it can "see" the newtype representation
206 exported_con con = any (`elemNameSet` exports)
207 (dataConName con : dataConFieldLabels con)
211 %************************************************************************
213 Plan B: tidy bindings, make TypeEnv full of IdInfo
215 %************************************************************************
217 Plan B: include pragmas, make interfaces
218 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
219 * Figure out which Ids are externally visible
221 * Tidy the bindings, externalising appropriate Ids
223 * Drop all Ids from the TypeEnv, and add all the External Ids from
224 the bindings. (This adds their IdInfo to the TypeEnv; and adds
225 floated-out Ids that weren't even in the TypeEnv before.)
227 Step 1: Figure out external Ids
228 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
229 First we figure out which Ids are "external" Ids. An
230 "external" Id is one that is visible from outside the compilation
232 a) the user exported ones
233 b) ones mentioned in the unfoldings, workers,
234 or rules of externally-visible ones
235 This exercise takes a sweep of the bindings bottom to top. Actually,
236 in Step 2 we're also going to need to know which Ids should be
237 exported with their unfoldings, so we produce not an IdSet but an
241 Step 2: Tidy the program
242 ~~~~~~~~~~~~~~~~~~~~~~~~
243 Next we traverse the bindings top to bottom. For each *top-level*
246 1. Make it into a GlobalId; its IdDetails becomes VanillaGlobal,
247 reflecting the fact that from now on we regard it as a global,
250 2. Give it a system-wide Unique.
251 [Even non-exported things need system-wide Uniques because the
252 byte-code generator builds a single Name->BCO symbol table.]
254 We use the NameCache kept in the HscEnv as the
255 source of such system-wide uniques.
257 For external Ids, use the original-name cache in the NameCache
258 to ensure that the unique assigned is the same as the Id had
259 in any previous compilation run.
261 3. If it's an external Id, make it have a External Name, otherwise
262 make it have an Internal Name.
263 This is used by the code generator to decide whether
264 to make the label externally visible
266 4. Give external Ids a "tidy" OccName. This means
267 we can print them in interface files without confusing
268 "x" (unique 5) with "x" (unique 10).
270 5. Give it its UTTERLY FINAL IdInfo; in ptic,
271 * its unfolding, if it should have one
273 * its arity, computed from the number of visible lambdas
275 * its CAF info, computed from what is free in its RHS
278 Finally, substitute these new top-level binders consistently
279 throughout, including in unfoldings. We also tidy binders in
280 RHSs, so that they print nicely in interfaces.
283 optTidyPgm :: HscEnv -> ModGuts
284 -> IO (CgGuts, ModDetails)
287 mod_impl@(ModGuts { mg_module = mod, mg_exports = exports,
288 mg_types = env_tc, mg_insts = insts_tc,
290 mg_rules = imp_rules })
291 = do { let dflags = hsc_dflags hsc_env
292 ; showPass dflags "Tidy Core"
294 ; let ext_ids = findExternalIds binds_in
295 ; let ext_rules = findExternalRules binds_in imp_rules ext_ids
296 -- findExternalRules filters imp_rules to avoid binders that
297 -- aren't externally visible; but the externally-visible binders
298 -- are computed (by findExternalIds) assuming that all orphan
299 -- rules are exported (they get their Exported flag set in the desugarer)
300 -- So in fact we may export more than we need.
301 -- (It's a sort of mutual recursion.)
303 ; (final_env, cg_guts) <- tidyCgStuff hsc_env ext_ids mod_impl
305 ; let { tidy_rules = tidyRules final_env ext_rules
306 ; tidy_type_env = tidyTypeEnv env_tc (cg_binds cg_guts)
307 ; tidy_ispecs = tidyInstances (tidyVarOcc final_env) insts_tc
308 -- A DFunId will have a binding in tidy_binds, and so
309 -- will now be in final_env, replete with IdInfo
310 -- Its name will be unchanged since it was born, but
311 -- we want Global, IdInfo-rich DFunId in the tidy_ispecs
314 ; endPass dflags "Tidy Core" Opt_D_dump_simpl (cg_binds cg_guts)
315 ; dumpIfSet_core dflags Opt_D_dump_simpl
317 (pprRules tidy_rules)
319 ; return (cg_guts, ModDetails { md_types = tidy_type_env
320 , md_rules = tidy_rules
321 , md_insts = tidy_ispecs
322 , md_exports = exports })
326 tidyTypeEnv :: TypeEnv -- From typechecker
327 -> [CoreBind] -- Final Ids
330 -- The competed type environment is gotten from
331 -- Dropping any wired-in things, and then
332 -- a) keeping the types and classes
333 -- b) removing all Ids,
334 -- c) adding Ids with correct IdInfo, including unfoldings,
335 -- gotten from the bindings
336 -- From (c) we keep only those Ids with External names;
337 -- the CoreTidy pass makes sure these are all and only
338 -- the externally-accessible ones
339 -- This truncates the type environment to include only the
340 -- exported Ids and things needed from them, which saves space
342 tidyTypeEnv type_env tidy_binds
343 = extendTypeEnvWithIds (filterNameEnv keep_it type_env) final_ids
346 | bind <- tidy_binds,
347 id <- bindersOf bind,
348 isExternalName (idName id)]
350 -- We keep GlobalIds, because they won't appear
351 -- in the bindings from which final_ids are derived!
352 -- (The bindings bind LocalIds.)
353 keep_it thing | isWiredInName (getName thing) = False
354 keep_it (AnId id) = isGlobalId id -- Keep GlobalIds (e.g. class ops)
355 keep_it other = True -- Keep all TyCons, DataCons, and Classes
358 %************************************************************************
360 \subsection{Step 1: finding externals}
362 %************************************************************************
365 findExternalIds :: [CoreBind]
366 -> IdEnv Bool -- In domain => external
367 -- Range = True <=> show unfolding
368 -- Step 1 from the notes above
369 findExternalIds binds
370 = foldr find emptyVarEnv binds
372 find (NonRec id rhs) needed
373 | need_id needed id = addExternal (id,rhs) needed
375 find (Rec prs) needed = find_prs prs needed
377 -- For a recursive group we have to look for a fixed point
379 | null needed_prs = needed
380 | otherwise = find_prs other_prs new_needed
382 (needed_prs, other_prs) = partition (need_pr needed) prs
383 new_needed = foldr addExternal needed needed_prs
385 -- The 'needed' set contains the Ids that are needed by earlier
386 -- interface file emissions. If the Id isn't in this set, and isn't
387 -- exported, there's no need to emit anything
388 need_id needed_set id = id `elemVarEnv` needed_set || isExportedId id
389 need_pr needed_set (id,rhs) = need_id needed_set id
391 addExternal :: (Id,CoreExpr) -> IdEnv Bool -> IdEnv Bool
392 -- The Id is needed; extend the needed set
393 -- with it and its dependents (free vars etc)
394 addExternal (id,rhs) needed
395 = extendVarEnv (foldVarSet add_occ needed new_needed_ids)
398 add_occ id needed = extendVarEnv needed id False
399 -- "False" because we don't know we need the Id's unfolding
400 -- We'll override it later when we find the binding site
402 new_needed_ids = worker_ids `unionVarSet`
403 unfold_ids `unionVarSet`
407 dont_inline = isNeverActive (inlinePragInfo idinfo)
408 loop_breaker = isLoopBreaker (occInfo idinfo)
409 bottoming_fn = isBottomingSig (newStrictnessInfo idinfo `orElse` topSig)
410 spec_ids = specInfoFreeVars (specInfo idinfo)
411 worker_info = workerInfo idinfo
413 -- Stuff to do with the Id's unfolding
414 -- The simplifier has put an up-to-date unfolding
415 -- in the IdInfo, but the RHS will do just as well
416 unfolding = unfoldingInfo idinfo
417 rhs_is_small = not (neverUnfold unfolding)
419 -- We leave the unfolding there even if there is a worker
420 -- In GHCI the unfolding is used by importers
421 -- When writing an interface file, we omit the unfolding
422 -- if there is a worker
423 show_unfold = not bottoming_fn && -- Not necessary
426 rhs_is_small -- Small enough
428 unfold_ids | show_unfold = exprSomeFreeVars isLocalId rhs
429 | otherwise = emptyVarSet
431 worker_ids = case worker_info of
432 HasWorker work_id _ -> unitVarSet work_id
433 otherwise -> emptyVarSet
438 findExternalRules :: [CoreBind]
439 -> [CoreRule] -- Non-local rules (i.e. ones for imported fns)
440 -> IdEnv a -- Ids that are exported, so we need their rules
442 -- The complete rules are gotten by combining
443 -- a) the non-local rules
444 -- b) rules embedded in the top-level Ids
445 findExternalRules binds non_local_rules ext_ids
446 = filter (not . internal_rule) (non_local_rules ++ local_rules)
449 | id <- bindersOfBinds binds,
450 id `elemVarEnv` ext_ids,
451 rule <- idCoreRules id
455 = any internal_id (varSetElems (ruleLhsFreeIds rule))
456 -- Don't export a rule whose LHS mentions a locally-defined
457 -- Id that is completely internal (i.e. not visible to an
460 internal_id id = not (id `elemVarEnv` ext_ids)
465 %************************************************************************
467 \subsection{Step 2: top-level tidying}
469 %************************************************************************
473 -- TopTidyEnv: when tidying we need to know
474 -- * nc_var: The NameCache, containing a unique supply and any pre-ordained Names.
475 -- These may have arisen because the
476 -- renamer read in an interface file mentioning M.$wf, say,
477 -- and assigned it unique r77. If, on this compilation, we've
478 -- invented an Id whose name is $wf (but with a different unique)
479 -- we want to rename it to have unique r77, so that we can do easy
480 -- comparisons with stuff from the interface file
482 -- * occ_env: The TidyOccEnv, which tells us which local occurrences
485 -- * subst_env: A Var->Var mapping that substitutes the new Var for the old
487 tidyCgStuff :: HscEnv
488 -> IdEnv Bool -- Domain = Ids that should be external
489 -- True <=> their unfolding is external too
491 -> IO (TidyEnv, CgGuts)
493 -- * Tidy the bindings
494 -- * Add bindings for the "implicit" Ids
496 tidyCgStuff hsc_env ext_ids
497 (ModGuts { mg_module = mod, mg_binds = binds, mg_types = type_env,
498 mg_dir_imps = dir_imps, mg_deps = deps,
499 mg_foreign = foreign_stubs })
500 = do { (env, binds') <- tidy init_env (map get_defn implicit_ids ++ binds)
501 ; return (env, CgGuts { cg_module = mod,
502 cg_tycons = filter isAlgTyCon tycons,
504 cg_dir_imps = dir_imps,
505 cg_foreign = foreign_stubs,
506 cg_dep_pkgs = dep_pkgs deps })
509 dflags = hsc_dflags hsc_env
510 nc_var = hsc_NC hsc_env
512 -- We also make sure to avoid any exported binders. Consider
513 -- f{-u1-} = 1 -- Local decl
515 -- f{-u2-} = 2 -- Exported decl
517 -- The second exported decl must 'get' the name 'f', so we
518 -- have to put 'f' in the avoids list before we get to the first
519 -- decl. tidyTopId then does a no-op on exported binders.
520 init_env = (initTidyOccEnv avoids, emptyVarEnv)
521 avoids = [getOccName name | bndr <- typeEnvIds type_env,
522 let name = idName bndr,
524 -- In computing our "avoids" list, we must include
526 -- all things with global names (assigned once and for
527 -- all by the renamer)
528 -- since their names are "taken".
529 -- The type environment is a convenient source of such things.
531 tidy env [] = return (env, [])
532 tidy env (b:bs) = do { (env1, b') <- tidyTopBind dflags mod nc_var ext_ids env b
533 ; (env2, bs') <- tidy env1 bs
534 ; return (env2, b':bs') }
536 tycons = typeEnvTyCons type_env
539 implicit_ids = concatMap implicit_con_ids tycons
540 ++ concatMap other_implicit_ids (typeEnvElts type_env)
541 --Put the constructor wrappers first, because
542 -- other implicit bindings (notably the fromT functions arising
543 -- from generics) use the constructor wrappers.
545 implicit_con_ids tc = mapCatMaybes dataConWrapId_maybe (tyConDataCons tc)
547 other_implicit_ids (ATyCon tc) = tyConSelIds tc
548 other_implicit_ids (AClass cl) = classSelIds cl
549 other_implicit_ids other = []
551 get_defn :: Id -> CoreBind
552 get_defn id = NonRec id (unfoldingTemplate (idUnfolding id))
554 ------------------------
555 tidyTopBind :: DynFlags
557 -> IORef NameCache -- For allocating new unique names
558 -> IdEnv Bool -- Domain = Ids that should be external
559 -- True <=> their unfolding is external too
560 -> TidyEnv -> CoreBind
561 -> IO (TidyEnv, CoreBind)
563 tidyTopBind dflags mod nc_var ext_ids tidy_env1@(occ_env1,subst1) (NonRec bndr rhs)
564 = do { (occ_env2, name') <- tidyTopName mod nc_var ext_ids occ_env1 bndr
565 ; let { (bndr', rhs') = tidyTopPair ext_ids tidy_env2 caf_info name' (bndr, rhs)
566 ; subst2 = extendVarEnv subst1 bndr bndr'
567 ; tidy_env2 = (occ_env2, subst2) }
568 ; return (tidy_env2, NonRec bndr' rhs') }
570 caf_info = hasCafRefs dflags subst1 (idArity bndr) rhs
572 tidyTopBind dflags mod nc_var ext_ids tidy_env1@(occ_env1,subst1) (Rec prs)
573 = do { (occ_env2, names') <- tidyTopNames mod nc_var ext_ids occ_env1 bndrs
574 ; let { prs' = zipWith (tidyTopPair ext_ids tidy_env2 caf_info)
576 ; subst2 = extendVarEnvList subst1 (bndrs `zip` map fst prs')
577 ; tidy_env2 = (occ_env2, subst2) }
578 ; return (tidy_env2, Rec prs') }
582 -- the CafInfo for a recursive group says whether *any* rhs in
583 -- the group may refer indirectly to a CAF (because then, they all do).
585 | or [ mayHaveCafRefs (hasCafRefs dflags subst1 (idArity bndr) rhs)
586 | (bndr,rhs) <- prs ] = MayHaveCafRefs
587 | otherwise = NoCafRefs
589 --------------------------------------------------------------------
591 -- This is where we set names to local/global based on whether they really are
592 -- externally visible (see comment at the top of this module). If the name
593 -- was previously local, we have to give it a unique occurrence name if
594 -- we intend to externalise it.
595 tidyTopNames mod nc_var ext_ids occ_env [] = return (occ_env, [])
596 tidyTopNames mod nc_var ext_ids occ_env (id:ids)
597 = do { (occ_env1, name) <- tidyTopName mod nc_var ext_ids occ_env id
598 ; (occ_env2, names) <- tidyTopNames mod nc_var ext_ids occ_env1 ids
599 ; return (occ_env2, name:names) }
601 tidyTopName :: Module -> IORef NameCache -> VarEnv Bool -> TidyOccEnv
602 -> Id -> IO (TidyOccEnv, Name)
603 tidyTopName mod nc_var ext_ids occ_env id
604 | global && internal = return (occ_env, localiseName name)
606 | global && external = return (occ_env, name)
607 -- Global names are assumed to have been allocated by the renamer,
608 -- so they already have the "right" unique
609 -- And it's a system-wide unique too
611 -- Now we get to the real reason that all this is in the IO Monad:
612 -- we have to update the name cache in a nice atomic fashion
614 | local && internal = do { nc <- readIORef nc_var
615 ; let (nc', new_local_name) = mk_new_local nc
616 ; writeIORef nc_var nc'
617 ; return (occ_env', new_local_name) }
618 -- Even local, internal names must get a unique occurrence, because
619 -- if we do -split-objs we externalise the name later, in the code generator
621 -- Similarly, we must make sure it has a system-wide Unique, because
622 -- the byte-code generator builds a system-wide Name->BCO symbol table
624 | local && external = do { nc <- readIORef nc_var
625 ; let (nc', new_external_name) = mk_new_external nc
626 ; writeIORef nc_var nc'
627 ; return (occ_env', new_external_name) }
630 external = id `elemVarEnv` ext_ids
631 global = isExternalName name
633 internal = not external
634 mb_parent = nameParent_maybe name
635 loc = nameSrcLoc name
637 (occ_env', occ') = tidyOccName occ_env (nameOccName name)
639 mk_new_local nc = (nc { nsUniqs = us2 }, mkInternalName uniq occ' loc)
641 (us1, us2) = splitUniqSupply (nsUniqs nc)
642 uniq = uniqFromSupply us1
644 mk_new_external nc = allocateGlobalBinder nc mod occ' mb_parent loc
645 -- If we want to externalise a currently-local name, check
646 -- whether we have already assigned a unique for it.
647 -- If so, use it; if not, extend the table.
648 -- All this is done by allcoateGlobalBinder.
649 -- This is needed when *re*-compiling a module in GHCi; we must
650 -- use the same name for externally-visible things as we did before.
653 -----------------------------------------------------------
654 tidyTopPair :: VarEnv Bool
655 -> TidyEnv -- The TidyEnv is used to tidy the IdInfo
656 -- It is knot-tied: don't look at it!
659 -> (Id, CoreExpr) -- Binder and RHS before tidying
661 -- This function is the heart of Step 2
662 -- The rec_tidy_env is the one to use for the IdInfo
663 -- It's necessary because when we are dealing with a recursive
664 -- group, a variable late in the group might be mentioned
665 -- in the IdInfo of one early in the group
667 tidyTopPair ext_ids rhs_tidy_env caf_info name' (bndr, rhs)
668 | isGlobalId bndr -- Injected binding for record selector, etc
669 = (bndr, tidyExpr rhs_tidy_env rhs)
673 bndr' = mkVanillaGlobal name' ty' idinfo'
674 ty' = tidyTopType (idType bndr)
675 rhs' = tidyExpr rhs_tidy_env rhs
676 idinfo' = tidyTopIdInfo rhs_tidy_env (isJust maybe_external)
677 (idInfo bndr) unfold_info arity
680 -- Expose an unfolding if ext_ids tells us to
681 -- Remember that ext_ids maps an Id to a Bool:
682 -- True to show the unfolding, False to hide it
683 maybe_external = lookupVarEnv ext_ids bndr
684 show_unfold = maybe_external `orElse` False
685 unfold_info | show_unfold = mkTopUnfolding rhs'
686 | otherwise = noUnfolding
688 -- Usually the Id will have an accurate arity on it, because
689 -- the simplifier has just run, but not always.
690 -- One case I found was when the last thing the simplifier
691 -- did was to let-bind a non-atomic argument and then float
692 -- it to the top level. So it seems more robust just to
694 arity = exprArity rhs
697 -- tidyTopIdInfo creates the final IdInfo for top-level
698 -- binders. There are two delicate pieces:
700 -- * Arity. After CoreTidy, this arity must not change any more.
701 -- Indeed, CorePrep must eta expand where necessary to make
702 -- the manifest arity equal to the claimed arity.
704 -- * CAF info. This must also remain valid through to code generation.
705 -- We add the info here so that it propagates to all
706 -- occurrences of the binders in RHSs, and hence to occurrences in
707 -- unfoldings, which are inside Ids imported by GHCi. Ditto RULES.
708 -- CoreToStg makes use of this when constructing SRTs.
710 tidyTopIdInfo tidy_env is_external idinfo unfold_info arity caf_info
711 | not is_external -- For internal Ids (not externally visible)
712 = vanillaIdInfo -- we only need enough info for code generation
713 -- Arity and strictness info are enough;
714 -- c.f. CoreTidy.tidyLetBndr
715 `setCafInfo` caf_info
717 `setAllStrictnessInfo` newStrictnessInfo idinfo
719 | otherwise -- Externally-visible Ids get the whole lot
721 `setCafInfo` caf_info
723 `setAllStrictnessInfo` newStrictnessInfo idinfo
724 `setInlinePragInfo` inlinePragInfo idinfo
725 `setUnfoldingInfo` unfold_info
726 `setWorkerInfo` tidyWorker tidy_env (workerInfo idinfo)
727 -- NB: we throw away the Rules
728 -- They have already been extracted by findExternalRules
732 ------------ Worker --------------
733 tidyWorker tidy_env (HasWorker work_id wrap_arity)
734 = HasWorker (tidyVarOcc tidy_env work_id) wrap_arity
735 tidyWorker tidy_env other
739 %************************************************************************
741 \subsection{Figuring out CafInfo for an expression}
743 %************************************************************************
745 hasCafRefs decides whether a top-level closure can point into the dynamic heap.
746 We mark such things as `MayHaveCafRefs' because this information is
747 used to decide whether a particular closure needs to be referenced
750 There are two reasons for setting MayHaveCafRefs:
751 a) The RHS is a CAF: a top-level updatable thunk.
752 b) The RHS refers to something that MayHaveCafRefs
754 Possible improvement: In an effort to keep the number of CAFs (and
755 hence the size of the SRTs) down, we could also look at the expression and
756 decide whether it requires a small bounded amount of heap, so we can ignore
757 it as a CAF. In these cases however, we would need to use an additional
758 CAF list to keep track of non-collectable CAFs.
761 hasCafRefs :: DynFlags -> VarEnv Var -> Arity -> CoreExpr -> CafInfo
762 hasCafRefs dflags p arity expr
763 | is_caf || mentions_cafs = MayHaveCafRefs
764 | otherwise = NoCafRefs
766 mentions_cafs = isFastTrue (cafRefs p expr)
767 is_caf = not (arity > 0 || rhsIsStatic dflags expr)
768 -- NB. we pass in the arity of the expression, which is expected
769 -- to be calculated by exprArity. This is because exprArity
770 -- knows how much eta expansion is going to be done by
771 -- CorePrep later on, and we don't want to duplicate that
772 -- knowledge in rhsIsStatic below.
775 -- imported Ids first:
776 | not (isLocalId id) = fastBool (mayHaveCafRefs (idCafInfo id))
777 -- now Ids local to this module:
779 case lookupVarEnv p id of
780 Just id' -> fastBool (mayHaveCafRefs (idCafInfo id'))
781 Nothing -> fastBool False
783 cafRefs p (Lit l) = fastBool False
784 cafRefs p (App f a) = fastOr (cafRefs p f) (cafRefs p) a
785 cafRefs p (Lam x e) = cafRefs p e
786 cafRefs p (Let b e) = fastOr (cafRefss p (rhssOfBind b)) (cafRefs p) e
787 cafRefs p (Case e bndr _ alts) = fastOr (cafRefs p e) (cafRefss p) (rhssOfAlts alts)
788 cafRefs p (Note n e) = cafRefs p e
789 cafRefs p (Type t) = fastBool False
791 cafRefss p [] = fastBool False
792 cafRefss p (e:es) = fastOr (cafRefs p e) (cafRefss p) es
794 -- hack for lazy-or over FastBool.
795 fastOr a f x = fastBool (isFastTrue a || isFastTrue (f x))