-occurAnalyseBinds binds
- = binds'
- where
- (_, _, binds') = go initialTopEnv binds
-
- go :: OccEnv -> [CoreBind]
- -> (UsageDetails, -- Occurrence info
- IdEnv Id, -- Indirection elimination info
- [CoreBind])
-
- go env [] = (emptyDetails, emptyVarEnv, [])
-
- go env (bind : binds)
- = let
- new_env = env `addNewCands` (bindersOf bind)
- (scope_usage, ind_env, binds') = go new_env binds
- (final_usage, new_binds) = occAnalBind env (zapBind ind_env bind) scope_usage
- -- NB: I zap before occur-analysing, so
- -- I don't need to worry about getting the
- -- occ info on the new bindings right.
- in
- case bind of
- NonRec exported_id (Var local_id)
- | shortMeOut ind_env exported_id local_id
- -- Special case for eliminating indirections
- -- Note: it's a shortcoming that this only works for
- -- non-recursive bindings. Elminating indirections
- -- makes perfect sense for recursive bindings too, but
- -- it's more complicated to implement, so I haven't done so
- -> (scope_usage, ind_env', binds')
- where
- ind_env' = extendVarEnv ind_env local_id exported_id
-
- other -> -- Ho ho! The normal case
- (final_usage, ind_env, new_binds ++ binds')
-
-initialTopEnv = OccEnv isLocallyDefined -- Anything local is interesting
- emptyVarSet
- []
-
-
--- Deal with any indirections
-zapBind ind_env (NonRec bndr rhs)
- | bndr `elemVarEnv` ind_env = Rec (zap ind_env (bndr,rhs))
- -- The Rec isn't strictly necessary, but it's convenient
-zapBind ind_env (Rec pairs)
- | or [id `elemVarEnv` ind_env | (id,_) <- pairs] = Rec (concat (map (zap ind_env) pairs))
-
-zapBind ind_env bind = bind
-
-zap ind_env pair@(bndr,rhs)
- = case lookupVarEnv ind_env bndr of
- Nothing -> [pair]
- Just exported_id -> [(bndr, Var exported_id),
- (exported_id_w_info, rhs)]
- where
- exported_id_w_info = modifyIdInfo (copyIdInfo (idInfo bndr)) exported_id
- -- See notes with copyIdInfo about propagating IdInfo from
- -- one to t'other
-
-shortMeOut ind_env exported_id local_id
- = isExportedId exported_id && -- Only if this is exported
-
- isLocallyDefined local_id && -- Only if this one is defined in this
- -- module, so that we *can* change its
- -- binding to be the exported thing!
-
- not (isExportedId local_id) && -- Only if this one is not itself exported,
- -- since the transformation will nuke it
-
- not (local_id `elemVarEnv` ind_env) -- Only if not already substituted for