+ (_, _, binds') = go initialTopEnv binds
+
+ go :: OccEnv -> [CoreBind]
+ -> (UsageDetails, -- Occurrence info
+ IdEnv Id, -- Indirection elimination info
+ -- Maps local-id -> exported-id, but it embodies
+ -- bindings of the form exported-id = local-id in
+ -- the argument to go
+ [CoreBind]) -- Occ-analysed bindings, less the exported-id=local-id ones
+
+ 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 isLocalId -- 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@(local_id,rhs)
+ = case lookupVarEnv ind_env local_id of
+ Nothing -> [pair]
+ Just exported_id -> [(local_id, Var exported_id),
+ (exported_id', rhs)]
+ where
+ exported_id' = modifyIdInfo (copyIdInfo (idInfo local_id)) exported_id
+
+shortMeOut ind_env exported_id local_id
+-- The if-then-else stuff is just so I can get a pprTrace to see
+-- how often I don't get shorting out becuase of IdInfo stuff
+ = if isExportedId exported_id && -- Only if this is exported
+
+ isLocalId 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
+ then
+ if shortableIdInfo (idInfo exported_id) -- Only if its IdInfo is 'shortable'
+ -- (see the defn of IdInfo.shortableIdInfo
+ then True
+ else pprTrace "shortMeOut:" (ppr exported_id) False
+ else
+ False