2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section{Tidying up Core}
12 #include "HsVersions.h"
14 import CmdLineOpts ( DynFlags, DynFlag(..), opt_OmitInterfacePragmas )
16 import CoreUnfold ( noUnfolding, mkTopUnfolding, okToUnfoldInHiFile )
17 import CoreUtils ( exprArity )
18 import CoreFVs ( ruleSomeFreeVars, exprSomeFreeVars )
19 import CoreLint ( showPass, endPass )
22 import Var ( Id, Var )
23 import Id ( idType, idInfo, idName, isExportedId,
24 idCafInfo, mkId, isLocalId, isImplicitId,
25 idFlavour, modifyIdInfo, idArity
27 import IdInfo {- loads of stuff -}
28 import Name ( getOccName, nameOccName, globaliseName, setNameOcc,
29 localiseName, mkLocalName, isGlobalName, isDllName
31 import OccName ( TidyOccEnv, initTidyOccEnv, tidyOccName )
32 import Type ( tidyTopType, tidyType, tidyTyVar )
33 import Module ( Module, moduleName )
34 import PrimOp ( PrimOp(..), setCCallUnique )
35 import HscTypes ( PersistentCompilerState( pcs_PRS ),
36 PersistentRenamerState( prsOrig ),
37 NameSupply( nsNames ), OrigNameCache
40 import DataCon ( dataConName )
41 import Literal ( isLitLitLit )
42 import FiniteMap ( lookupFM, addToFM )
43 import Maybes ( maybeToBool, orElse )
44 import ErrUtils ( showPass )
45 import SrcLoc ( noSrcLoc )
46 import UniqFM ( mapUFM )
49 import List ( partition )
50 import Util ( mapAccumL )
55 %************************************************************************
57 \subsection{What goes on}
59 %************************************************************************
65 Step 1: Figure out external Ids
66 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
67 First we figure out which Ids are "external" Ids. An
68 "external" Id is one that is visible from outside the compilation
70 a) the user exported ones
71 b) ones mentioned in the unfoldings, workers,
72 or rules of externally-visible ones
73 This exercise takes a sweep of the bindings bottom to top. Actually,
74 in Step 2 we're also going to need to know which Ids should be
75 exported with their unfoldings, so we produce not an IdSet but an
79 Step 2: Tidy the program
80 ~~~~~~~~~~~~~~~~~~~~~~~~
81 Next we traverse the bindings top to bottom. For each top-level
84 - Make all external Ids have Global names and vice versa
85 This is used by the code generator to decide whether
86 to make the label externally visible
88 - Give external ids a "tidy" occurrence name. This means
89 we can print them in interface files without confusing
90 "x" (unique 5) with "x" (unique 10).
92 - Give external Ids the same Unique as they had before
93 if the name is in the renamer's name cache
95 - Clone all local Ids. This means that Tidy Core has the property
96 that all Ids are unique, rather than the weaker guarantee of
97 no clashes which the simplifier provides.
99 - Give each dynamic CCall occurrence a fresh unique; this is
100 rather like the cloning step above.
102 - Give the Id its UTTERLY FINAL IdInfo; in ptic,
103 * Its flavour becomes ConstantId, reflecting the fact that
104 from now on we regard it as a constant, not local, Id
106 * its unfolding, if it should have one
108 * its arity, computed from the number of visible lambdas
110 * its CAF info, computed from what is free in its RHS
113 Finally, substitute these new top-level binders consistently
114 throughout, including in unfoldings. We also tidy binders in
115 RHSs, so that they print nicely in interfaces.
118 tidyCorePgm :: DynFlags -> Module
119 -> PersistentCompilerState
120 -> [CoreBind] -> [IdCoreRule]
121 -> IO (PersistentCompilerState, [CoreBind], [IdCoreRule])
122 tidyCorePgm dflags mod pcs binds_in orphans_in
123 = do { showPass dflags "Tidy Core"
125 ; let ext_ids = findExternalSet binds_in orphans_in
127 ; us <- mkSplitUniqSupply 't' -- for "tidy"
129 ; let ((us1, orig_env', occ_env, subst_env), binds_out)
130 = mapAccumL (tidyTopBind mod ext_ids)
131 (init_tidy_env us) binds_in
133 ; let (orphans_out, _)
134 = initUs us1 (tidyIdRules (occ_env,subst_env) orphans_in)
136 ; let prs' = prs { prsOrig = orig { nsNames = orig_env' } }
137 pcs' = pcs { pcs_PRS = prs' }
139 ; endPass dflags "Tidy Core" Opt_D_dump_simpl binds_out
141 ; return (pcs', binds_out, orphans_out)
144 -- We also make sure to avoid any exported binders. Consider
145 -- f{-u1-} = 1 -- Local decl
147 -- f{-u2-} = 2 -- Exported decl
149 -- The second exported decl must 'get' the name 'f', so we
150 -- have to put 'f' in the avoids list before we get to the first
151 -- decl. tidyTopId then does a no-op on exported binders.
154 orig_env = nsNames orig
156 init_tidy_env us = (us, orig_env, initTidyOccEnv avoids, emptyVarEnv)
157 avoids = [getOccName bndr | bndr <- bindersOfBinds binds_in,
158 isGlobalName (idName bndr)]
162 %************************************************************************
164 \subsection{Step 1: finding externals}
166 %************************************************************************
169 findExternalSet :: [CoreBind] -> [IdCoreRule]
170 -> IdEnv Bool -- True <=> show unfolding
171 -- Step 1 from the notes above
172 findExternalSet binds orphan_rules
173 = foldr find init_needed binds
175 orphan_rule_ids :: IdSet
176 orphan_rule_ids = unionVarSets [ ruleSomeFreeVars isIdAndLocal rule
177 | (_, rule) <- orphan_rules]
178 init_needed :: IdEnv Bool
179 init_needed = mapUFM (\_ -> False) orphan_rule_ids
180 -- The mapUFM is a bit cheesy. It is a cheap way
181 -- to turn the set of orphan_rule_ids, which we use to initialise
182 -- the sweep, into a mapping saying 'don't expose unfolding'
183 -- (When we come to the binding site we may change our mind, of course.)
185 find (NonRec id rhs) needed
186 | need_id needed id = addExternal (id,rhs) needed
188 find (Rec prs) needed = find_prs prs needed
190 -- For a recursive group we have to look for a fixed point
192 | null needed_prs = needed
193 | otherwise = find_prs other_prs new_needed
195 (needed_prs, other_prs) = partition (need_pr needed) prs
196 new_needed = foldr addExternal needed needed_prs
198 -- The 'needed' set contains the Ids that are needed by earlier
199 -- interface file emissions. If the Id isn't in this set, and isn't
200 -- exported, there's no need to emit anything
201 need_id needed_set id = id `elemVarEnv` needed_set || isExportedId id
202 need_pr needed_set (id,rhs) = need_id needed_set id
204 isIdAndLocal id = isId id && isLocalId id
206 addExternal :: (Id,CoreExpr) -> IdEnv Bool -> IdEnv Bool
207 -- The Id is needed; extend the needed set
208 -- with it and its dependents (free vars etc)
209 addExternal (id,rhs) needed
210 = extendVarEnv (foldVarSet add_occ needed new_needed_ids)
213 add_occ id needed = extendVarEnv needed id False
214 -- "False" because we don't know we need the Id's unfolding
215 -- We'll override it later when we find the binding site
217 new_needed_ids | opt_OmitInterfacePragmas = emptyVarSet
218 | otherwise = worker_ids `unionVarSet`
219 unfold_ids `unionVarSet`
223 dont_inline = isNeverInlinePrag (inlinePragInfo idinfo)
224 loop_breaker = isLoopBreaker (occInfo idinfo)
225 bottoming_fn = isBottomingStrictness (strictnessInfo idinfo)
226 spec_ids = rulesRhsFreeVars (specInfo idinfo)
227 worker_info = workerInfo idinfo
229 -- Stuff to do with the Id's unfolding
230 -- The simplifier has put an up-to-date unfolding
231 -- in the IdInfo, but the RHS will do just as well
232 unfolding = unfoldingInfo idinfo
233 rhs_is_small = not (neverUnfold unfolding)
235 -- We leave the unfolding there even if there is a worker
236 -- In GHCI the unfolding is used by importers
237 -- When writing an interface file, we omit the unfolding
238 -- if there is a worker
239 show_unfold = not bottoming_fn && -- Not necessary
242 rhs_is_small && -- Small enough
243 okToUnfoldInHiFile rhs -- No casms etc
245 unfold_ids | show_unfold = exprSomeFreeVars isIdAndLocal rhs
246 | otherwise = emptyVarSet
248 worker_ids = case worker_info of
249 HasWorker work_id _ -> unitVarSet work_id
250 otherwise -> emptyVarSet
254 %************************************************************************
256 \subsection{Step 2: top-level tidying}
258 %************************************************************************
262 type TopTidyEnv = (UniqSupply, OrigNameCache, TidyOccEnv, VarEnv Var)
264 -- TopTidyEnv: when tidying we need to know
265 -- * orig_env: Any pre-ordained Names. These may have arisen because the
266 -- renamer read in an interface file mentioning M.$wf, say,
267 -- and assigned it unique r77. If, on this compilation, we've
268 -- invented an Id whose name is $wf (but with a different unique)
269 -- we want to rename it to have unique r77, so that we can do easy
270 -- comparisons with stuff from the interface file
272 -- * occ_env: The TidyOccEnv, which tells us which local occurrences
275 -- * subst_env: A Var->Var mapping that substitutes the new Var for the old
277 -- * uniqsuppy: so we can clone any Ids with non-preordained names.
283 tidyTopBind :: Module
284 -> IdEnv Bool -- Domain = Ids that should be external
285 -- True <=> their unfolding is external too
286 -> TopTidyEnv -> CoreBind
287 -> (TopTidyEnv, CoreBind)
289 tidyTopBind mod ext_ids env (NonRec bndr rhs)
290 = ((us2,orig,occ,subst) , NonRec bndr' rhs')
292 ((us1,orig,occ,subst), bndr')
293 = tidyTopBinder mod ext_ids tidy_env rhs' caf_info env bndr
294 tidy_env = (occ,subst)
295 caf_info = hasCafRefs (const True) rhs'
296 (rhs',us2) = initUs us1 (tidyExpr tidy_env rhs)
298 tidyTopBind mod ext_ids env (Rec prs)
299 = (final_env, Rec prs')
301 (final_env@(_,_,occ,subst), prs') = mapAccumL do_one env prs
302 final_tidy_env = (occ,subst)
304 do_one env (bndr,rhs)
305 = ((us',orig,occ,subst), (bndr',rhs'))
307 ((us,orig,occ,subst), bndr')
308 = tidyTopBinder mod ext_ids final_tidy_env rhs' caf_info env bndr
309 (rhs', us') = initUs us (tidyExpr final_tidy_env rhs)
311 -- the CafInfo for a recursive group says whether *any* rhs in
312 -- the group may refer indirectly to a CAF (because then, they all do).
313 (bndrs, rhss) = unzip prs'
314 caf_info = hasCafRefss pred rhss
315 pred v = v `notElem` bndrs
318 tidyTopBinder :: Module -> IdEnv Bool
319 -> TidyEnv -> CoreExpr -> CafInfo
320 -- The TidyEnv is used to tidy the IdInfo
321 -- The expr is the already-tided RHS
322 -- Both are knot-tied: don't look at them!
323 -> TopTidyEnv -> Id -> (TopTidyEnv, Id)
325 tidyTopBinder mod ext_ids tidy_env rhs caf_info
326 env@(us, orig_env2, occ_env2, subst_env2) id
328 | isImplicitId id -- Don't mess with constructors,
329 = (env, id) -- record selectors, and the like
332 -- This function is the heart of Step 2
333 -- The second env is the one to use for the IdInfo
334 -- It's necessary because when we are dealing with a recursive
335 -- group, a variable late in the group might be mentioned
336 -- in the IdInfo of one early in the group
338 -- The rhs is already tidied
340 = ((us_r, orig_env', occ_env', subst_env'), id')
342 (us_l, us_r) = splitUniqSupply us
344 (orig_env', occ_env', name') = tidyTopName mod orig_env2 occ_env2
347 ty' = tidyTopType (idType id)
348 idinfo' = tidyIdInfo us_l tidy_env
349 is_external unfold_info arity_info caf_info id
351 id' = mkId name' ty' idinfo'
352 subst_env' = extendVarEnv subst_env2 id id'
354 maybe_external = lookupVarEnv ext_ids id
355 is_external = maybeToBool maybe_external
357 -- Expose an unfolding if ext_ids tells us to
358 show_unfold = maybe_external `orElse` False
359 unfold_info | show_unfold = mkTopUnfolding rhs
360 | otherwise = noUnfolding
362 arity_info = exprArity rhs
365 tidyIdInfo us tidy_env is_external unfold_info arity_info caf_info id
366 | opt_OmitInterfacePragmas || not is_external
367 -- No IdInfo if the Id isn't external, or if we don't have -O
368 = mkIdInfo new_flavour caf_info
369 `setStrictnessInfo` strictnessInfo core_idinfo
370 `setArityInfo` ArityExactly arity_info
371 -- Keep strictness, arity and CAF info; it's used by the code generator
374 = let (rules', _) = initUs us (tidyRules tidy_env (specInfo core_idinfo))
376 mkIdInfo new_flavour caf_info
377 `setCprInfo` cprInfo core_idinfo
378 `setStrictnessInfo` strictnessInfo core_idinfo
379 `setInlinePragInfo` inlinePragInfo core_idinfo
380 `setUnfoldingInfo` unfold_info
381 `setWorkerInfo` tidyWorker tidy_env arity_info (workerInfo core_idinfo)
383 `setArityInfo` ArityExactly arity_info
384 -- this is the final IdInfo, it must agree with the
385 -- code finally generated (i.e. NO more transformations
388 core_idinfo = idInfo id
390 -- A DFunId must stay a DFunId, so that we can gather the
391 -- DFunIds up later. Other local things become ConstantIds.
392 new_flavour = case flavourInfo core_idinfo of
393 VanillaId -> ConstantId
394 ExportedId -> ConstantId
395 ConstantId -> ConstantId -- e.g. Default methods
396 DictFunId -> DictFunId
397 flavour -> pprTrace "tidyIdInfo" (ppr id <+> ppFlavourInfo flavour)
401 -- This is where we set names to local/global based on whether they really are
402 -- externally visible (see comment at the top of this module). If the name
403 -- was previously local, we have to give it a unique occurrence name if
404 -- we intend to globalise it.
405 tidyTopName mod orig_env occ_env external name
406 | global && internal = (orig_env, occ_env, localiseName name)
408 | local && internal = (orig_env, occ_env', setNameOcc name occ')
409 -- Even local, internal names must get a unique occurrence, because
410 -- if we do -split-objs we globalise the name later, n the code generator
412 | global && external = (orig_env, occ_env, name)
413 -- Global names are assumed to have been allocated by the renamer,
414 -- so they already have the "right" unique
416 | local && external = case lookupFM orig_env key of
417 Just orig -> (orig_env, occ_env', orig)
418 Nothing -> (addToFM orig_env key global_name, occ_env', global_name)
419 -- If we want to globalise a currently-local name, check
420 -- whether we have already assigned a unique for it.
421 -- If so, use it; if not, extend the table
424 (occ_env', occ') = tidyOccName occ_env (nameOccName name)
425 key = (moduleName mod, occ')
426 global_name = globaliseName (setNameOcc name occ') mod
427 global = isGlobalName name
429 internal = not external
431 ------------ Worker --------------
432 -- We only treat a function as having a worker if
433 -- the exported arity (which is now the number of visible lambdas)
434 -- is the same as the arity at the moment of the w/w split
435 -- If so, we can safely omit the unfolding inside the wrapper, and
436 -- instead re-generate it from the type/arity/strictness info
437 -- But if the arity has changed, we just take the simple path and
438 -- put the unfolding into the interface file, forgetting the fact
439 -- that it's a wrapper.
441 -- How can this happen? Sometimes we get
442 -- f = coerce t (\x y -> $wf x y)
443 -- at the moment of w/w split; but the eta reducer turns it into
445 -- which is perfectly fine except that the exposed arity so far as
446 -- the code generator is concerned (zero) differs from the arity
447 -- when we did the split (2).
449 -- All this arises because we use 'arity' to mean "exactly how many
450 -- top level lambdas are there" in interface files; but during the
451 -- compilation of this module it means "how many things can I apply
453 tidyWorker tidy_env real_arity (HasWorker work_id wrap_arity)
454 | real_arity == wrap_arity
455 = HasWorker (tidyVarOcc tidy_env work_id) wrap_arity
456 tidyWorker tidy_env real_arity other
459 ------------ Rules --------------
460 tidyIdRules :: TidyEnv -> [IdCoreRule] -> UniqSM [IdCoreRule]
461 tidyIdRules env [] = returnUs []
462 tidyIdRules env ((fn,rule) : rules)
463 = tidyRule env rule `thenUs` \ rule ->
464 tidyIdRules env rules `thenUs` \ rules ->
465 returnUs ((tidyVarOcc env fn, rule) : rules)
467 tidyRules :: TidyEnv -> CoreRules -> UniqSM CoreRules
468 tidyRules env (Rules rules fvs)
469 = mapUs (tidyRule env) rules `thenUs` \ rules ->
470 returnUs (Rules rules (foldVarSet tidy_set_elem emptyVarSet fvs))
472 tidy_set_elem var new_set = extendVarSet new_set (tidyVarOcc env var)
474 tidyRule :: TidyEnv -> CoreRule -> UniqSM CoreRule
475 tidyRule env rule@(BuiltinRule _) = returnUs rule
476 tidyRule env (Rule name vars tpl_args rhs)
477 = tidyBndrs env vars `thenUs` \ (env', vars) ->
478 mapUs (tidyExpr env') tpl_args `thenUs` \ tpl_args ->
479 tidyExpr env' rhs `thenUs` \ rhs ->
480 returnUs (Rule name vars tpl_args rhs)
483 %************************************************************************
485 \subsection{Step 2: inner tidying
487 %************************************************************************
492 -> UniqSM (TidyEnv, CoreBind)
493 tidyBind env (NonRec bndr rhs)
494 = tidyBndrWithRhs env (bndr,rhs) `thenUs` \ (env', bndr') ->
495 tidyExpr env' rhs `thenUs` \ rhs' ->
496 returnUs (env', NonRec bndr' rhs')
498 tidyBind env (Rec prs)
499 = mapAccumLUs tidyBndrWithRhs env prs `thenUs` \ (env', bndrs') ->
500 mapUs (tidyExpr env') (map snd prs) `thenUs` \ rhss' ->
501 returnUs (env', Rec (zip bndrs' rhss'))
504 = fiddleCCall v `thenUs` \ v ->
505 returnUs (Var (tidyVarOcc env v))
507 tidyExpr env (Type ty) = returnUs (Type (tidyType env ty))
508 tidyExpr env (Lit lit) = returnUs (Lit lit)
510 tidyExpr env (App f a)
511 = tidyExpr env f `thenUs` \ f ->
512 tidyExpr env a `thenUs` \ a ->
515 tidyExpr env (Note n e)
516 = tidyExpr env e `thenUs` \ e ->
517 returnUs (Note (tidyNote env n) e)
519 tidyExpr env (Let b e)
520 = tidyBind env b `thenUs` \ (env', b') ->
521 tidyExpr env' e `thenUs` \ e ->
524 tidyExpr env (Case e b alts)
525 = tidyExpr env e `thenUs` \ e ->
526 tidyBndr env b `thenUs` \ (env', b) ->
527 mapUs (tidyAlt env') alts `thenUs` \ alts ->
528 returnUs (Case e b alts)
530 tidyExpr env (Lam b e)
531 = tidyBndr env b `thenUs` \ (env', b) ->
532 tidyExpr env' e `thenUs` \ e ->
536 tidyAlt env (con, vs, rhs)
537 = tidyBndrs env vs `thenUs` \ (env', vs) ->
538 tidyExpr env' rhs `thenUs` \ rhs ->
539 returnUs (con, vs, rhs)
541 tidyNote env (Coerce t1 t2) = Coerce (tidyType env t1) (tidyType env t2)
542 tidyNote env note = note
546 %************************************************************************
548 \subsection{Tidying up non-top-level binders}
550 %************************************************************************
553 tidyVarOcc (_, var_env) v = case lookupVarEnv var_env v of
557 -- tidyBndr is used for lambda and case binders
558 tidyBndr :: TidyEnv -> Var -> UniqSM (TidyEnv, Var)
560 | isTyVar var = returnUs (tidyTyVar env var)
561 | otherwise = tidyId env var vanillaIdInfo
563 tidyBndrs :: TidyEnv -> [Var] -> UniqSM (TidyEnv, [Var])
564 tidyBndrs env vars = mapAccumLUs tidyBndr env vars
566 -- tidyBndrWithRhs is used for let binders
567 tidyBndrWithRhs :: TidyEnv -> (Var, CoreExpr) -> UniqSM (TidyEnv, Var)
568 tidyBndrWithRhs env (id,rhs)
569 = tidyId env id idinfo
571 idinfo = vanillaIdInfo `setArityInfo` ArityExactly (exprArity rhs)
572 -- NB: This throws away the IdInfo of the Id, which we
573 -- no longer need. That means we don't need to
574 -- run over it with env, nor renumber it.
576 tidyId :: TidyEnv -> Id -> IdInfo -> UniqSM (TidyEnv, Id)
577 tidyId env@(tidy_env, var_env) id idinfo
578 = -- Non-top-level variables
579 getUniqueUs `thenUs` \ uniq ->
581 -- Give the Id a fresh print-name, *and* rename its type
582 -- The SrcLoc isn't important now,
583 -- though we could extract it from the Id
584 name' = mkLocalName uniq occ' noSrcLoc
585 (tidy_env', occ') = tidyOccName tidy_env (getOccName id)
586 ty' = tidyType (tidy_env,var_env) (idType id)
587 id' = mkId name' ty' idinfo
588 var_env' = extendVarEnv var_env id id'
590 returnUs ((tidy_env', var_env'), id')
594 = case idFlavour id of
595 PrimOpId (CCallOp ccall) ->
596 -- Make a guaranteed unique name for a dynamic ccall.
597 getUniqueUs `thenUs` \ uniq ->
598 returnUs (modifyIdInfo (`setFlavourInfo`
599 PrimOpId (CCallOp (setCCallUnique ccall uniq))) id)
604 %************************************************************************
606 \subsection{Figuring out CafInfo for an expression}
608 %************************************************************************
611 hasCafRefs :: (Id -> Bool) -> CoreExpr -> CafInfo
612 hasCafRefss :: (Id -> Bool) -> [CoreExpr] -> CafInfo
613 -- predicate returns True for a given Id if we look at this Id when
614 -- calculating the result. Used to *avoid* looking at the CafInfo
615 -- field for an Id that is part of the current recursive group.
617 hasCafRefs p expr = if isCAF expr || isFastTrue (cafRefs p expr)
621 -- used for recursive groups. The whole group is set to
622 -- "MayHaveCafRefs" if at least one of the group is a CAF or
623 -- refers to any CAFs.
624 hasCafRefss p exprs = if any isCAF exprs || isFastTrue (cafRefss p exprs)
630 = case idCafInfo id of
631 NoCafRefs -> fastBool False
632 MayHaveCafRefs -> fastBool True
636 cafRefs p (Lit l) = fastBool False
637 cafRefs p (App f a) = cafRefs p f `fastOr` cafRefs p a
638 cafRefs p (Lam x e) = cafRefs p e
639 cafRefs p (Let b e) = cafRefss p (rhssOfBind b) `fastOr` cafRefs p e
640 cafRefs p (Case e bndr alts) = cafRefs p e `fastOr` cafRefss p (rhssOfAlts alts)
641 cafRefs p (Note n e) = cafRefs p e
642 cafRefs p (Type t) = fastBool False
644 cafRefss p [] = fastBool False
645 cafRefss p (e:es) = cafRefs p e `fastOr` cafRefss p es
647 -- Decide whether a closure looks like a CAF or not. In an effort to
648 -- keep the number of CAFs (and hence the size of the SRTs) down, we
649 -- would also like to look at the expression and decide whether it
650 -- requires a small bounded amount of heap, so we can ignore it as a
651 -- CAF. In these cases however, we would need to use an additional
652 -- CAF list to keep track of non-collectable CAFs.
654 -- We mark real CAFs as `MayHaveCafRefs' because this information is
655 -- used to decide whether a particular closure needs to be referenced
658 isCAF :: CoreExpr -> Bool
659 isCAF e = not (rhsIsNonUpd e)
660 {- ToDo: check type for onceness, i.e. non-updatable thunks? -}
662 rhsIsNonUpd :: CoreExpr -> Bool -- True => Value-lambda, constructor, PAP
663 rhsIsNonUpd (Lam b e) = isId b || rhsIsNonUpd e
664 rhsIsNonUpd (Note (SCC _) e) = False
665 rhsIsNonUpd (Note _ e) = rhsIsNonUpd e
666 rhsIsNonUpd other_expr
669 go (Var f) n_args args = idAppIsNonUpd f n_args args
671 go (App f a) n_args args
672 | isTypeArg a = go f n_args args
673 | otherwise = go f (n_args + 1) (a:args)
675 go (Note (SCC _) f) n_args args = False
676 go (Note _ f) n_args args = go f n_args args
678 go other n_args args = False
680 idAppIsNonUpd :: Id -> Int -> [CoreExpr] -> Bool
681 idAppIsNonUpd id n_val_args args
682 = case idFlavour id of
683 DataConId con | not (isDynConApp con args) -> True
684 other -> n_val_args < idArity id
686 isDynConApp con args = isDllName (dataConName con) || any isDynArg args
688 -- Does this argument refer to something in a different DLL,
689 -- or is a LitLit? Constructor arguments which are in another
690 -- DLL or are LitLits aren't compiled into static constructors
691 -- (see CoreToStg), so we have to take that into account here.
692 isDynArg :: CoreExpr -> Bool
693 isDynArg (Var v) = isDllName (idName v)
694 isDynArg (Note _ e) = isDynArg e
695 isDynArg (Lit lit) = isLitLitLit lit
696 isDynArg (App e _) = isDynArg e -- must be a type app
697 isDynArg (Lam _ e) = isDynArg e -- must be a type lam
699 -- We consider partial applications to be non-updatable. NOTE: this
700 -- must match how CoreToStg marks the closure.