+
+%************************************************************************
+%* *
+\subsection{Top level stuff}
+%* *
+%************************************************************************
+
+In @occAnalTop@ we do indirection-shorting. That is, if we have this:
+
+ loc = <expression>
+ ...
+ exp = loc
+
+where exp is exported, and loc is not, then we replace it with this:
+
+ loc = exp
+ exp = <expression>
+ ...
+
+Without this we never get rid of the exp = loc thing.
+This save a gratuitous jump
+(from \tr{x_exported} to \tr{x_local}), and makes strictness
+information propagate better.
+This used to happen in the final phase, but its tidier to do it here.
+
+
+If more than one exported thing is equal to a local thing (i.e., the
+local thing really is shared), then we do one only:
+\begin{verbatim}
+ x_local = ....
+ x_exported1 = x_local
+ x_exported2 = x_local
+==>
+ x_exported1 = ....
+
+ x_exported2 = x_exported1
+\end{verbatim}
+
+We rely on prior eta reduction to simplify things like
+\begin{verbatim}
+ x_exported = /\ tyvars -> x_local tyvars
+==>
+ x_exported = x_local
+\end{verbatim}
+Hence,there's a possibility of leaving unchanged something like this:
+\begin{verbatim}
+ x_local = ....
+ x_exported1 = x_local Int
+\end{verbatim}
+By the time we've thrown away the types in STG land this
+could be eliminated. But I don't think it's very common
+and it's dangerous to do this fiddling in STG land
+because we might elminate a binding that's mentioned in the
+unfolding for something.
+
+
+\begin{code}
+occAnalTop :: OccEnv -- What's in scope
+ -> [CoreBinding]
+ -> (IdEnv BinderInfo, -- Occurrence info
+ IdEnv Id, -- Indirection elimination info
+ [SimplifiableCoreBinding]
+ )
+
+occAnalTop env [] = (emptyDetails, nullIdEnv, [])
+
+-- Special case for eliminating indirections
+occAnalTop 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) && -- Don't do the transformation if rhs_id is
+ -- something like a constructor, whose
+ -- definition is implicitly exported and
+ -- which must not vanish.
+ -- To illustrate the preceding check consider
+ -- data T = MkT Int
+ -- mkT = MkT
+ -- f x = MkT (x+1)
+ -- Here, we'll make a local, non-exported, defn for MkT, and without the
+ -- above condition we'll transform it to:
+ -- mkT = \x. MkT [x]
+ -- f = \y. mkT (y+1)
+ -- This is bad because mkT will get the IdDetails of MkT, and won't
+ -- be exported. Also the code generator won't make a definition for
+ -- the MkT constructor.
+ -- Slightly gruesome, this.
+
+
+ not (maybeToBool (lookupIdEnv ind_env local_id))
+ -- Only if not already substituted for
+
+ = -- Aha! An indirection; let's eliminate it!
+ (scope_usage, ind_env', binds')
+ where
+ (scope_usage, ind_env, binds') = occAnalTop env binds
+ ind_env' = addOneToIdEnv ind_env local_id exported_id
+
+-- The normal case
+occAnalTop env (bind : binds)
+ = (final_usage, ind_env, new_binds ++ binds')
+ where
+ new_env = env `addNewCands` (bindersOf bind)
+ (scope_usage, ind_env, binds') = occAnalTop new_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)]
+\end{code}
+
+