-
--}
--- NEW VERSION:
-occAnalTop :: OccEnv -- What's in scope
- -> [CoreBinding]
- -> (IdEnv BinderInfo, -- Occurrence info
- [[SimplifiableCoreBinding]]
- )
-occAnalTop env binds = occAnalTop' env ind_env binds
- where
- ind_env = go nullIdEnv binds
-
- go ind_env [] = ind_env
- go ind_env (NonRec exported_id (Var local_id) : binds)
- | isExported 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 (isExported local_id) && -- Only if this one is not itself exported,
- -- since the transformation will nuke it
-
- not (omitIfaceSigForId local_id)
- = go ind_env' binds
- where
- -- the last addition for 'local_id' wins.
- ind_env' = addOneToIdEnv ind_env local_id exported_id
-
- go ind_env (_:xs) = go ind_env xs
-
-occAnalTop' :: OccEnv -- What's in scope
- -> IdEnv Id -- Indirection elimination info
- -> [CoreBinding]
- -> (IdEnv BinderInfo, -- Occurrence info
- [[SimplifiableCoreBinding]]
- )
-occAnalTop' env ind_env [] = (emptyDetails, [])
-
--- 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
-
-occAnalTop' env ind_env (NonRec exported_id (Var local_id) : binds)
- | maybeToBool (lookupIdEnv ind_env local_id)
- = occAnalTop' env ind_env' binds
- where
- ind_env' = delOneFromIdEnv ind_env local_id
-
--- The normal case
-occAnalTop' env ind_env (bind : binds)
- = (final_usage, (new_binds : binds'))
- where
- new_env = env `addNewCands` (bindersOf bind)
- (scope_usage, binds') = occAnalTop' new_env ind_env binds
- (final_usage, new_binds) = occAnalBind env (zap_bind bind) scope_usage
-
- -- Deal with any indirections
- zap_bind (NonRec bndr rhs)
- | bndr `elemIdEnv` ind_env = Rec (zap (bndr,rhs))
- -- The Rec isn't strictly necessary, but it's convenient
- zap_bind (Rec pairs)
- | or [id `elemIdEnv` ind_env | (id,_) <- pairs] = Rec (concat (map zap pairs))
-
- zap_bind bind = bind
-
- zap pair@(bndr,rhs) = case lookupIdEnv ind_env bndr of
- Nothing -> [pair]
- Just exported_id -> [(bndr, Var exported_id),
- (exported_id, rhs)]
-