+\begin{code}
+coreToStg :: DynFlags -> Module -> [CoreBind] -> IO [StgBinding]
+coreToStg dflags this_mod pgm
+ = return (fst (initLne (coreTopBindsToStg pgm)))
+
+coreExprToStg :: CoreExpr -> StgExpr
+coreExprToStg expr
+ = new_expr where (new_expr,_,_) = initLne (coreToStgExpr expr)
+
+-- For top-level guys, we basically aren't worried about this
+-- live-variable stuff; we do need to keep adding to the environment
+-- as we step through the bindings (using @extendVarEnv@).
+
+coreTopBindsToStg :: [CoreBind] -> LneM ([StgBinding], FreeVarsInfo)
+
+coreTopBindsToStg [] = returnLne ([], emptyFVInfo)
+coreTopBindsToStg (bind:binds)
+ = let
+ binders = bindersOf bind
+ env_extension = binders `zip` repeat how_bound
+ how_bound = LetrecBound True {- top level -}
+ emptyVarSet
+ in
+
+ extendVarEnvLne env_extension (
+ coreTopBindsToStg binds `thenLne` \ (binds', fv_binds) ->
+ coreTopBindToStg binders fv_binds bind `thenLne` \ (bind', fv_bind) ->
+ returnLne (
+ (bind' : binds'),
+ (fv_binds `unionFVInfo` fv_bind) `minusFVBinders` binders
+ )
+ )
+
+
+coreTopBindToStg
+ :: [Id] -- New binders (with correct arity)
+ -> FreeVarsInfo -- Info about the body
+ -> CoreBind
+ -> LneM (StgBinding, FreeVarsInfo)
+
+coreTopBindToStg [binder] body_fvs (NonRec _ rhs)
+ = coreToStgRhs body_fvs TopLevel (binder,rhs) `thenLne` \ (rhs2, fvs, _) ->
+ returnLne (StgNonRec binder rhs2, fvs)
+
+coreTopBindToStg binders body_fvs (Rec pairs)
+ = fixLne (\ ~(_, rec_rhs_fvs) ->
+ let scope_fvs = unionFVInfo body_fvs rec_rhs_fvs
+ in
+ mapAndUnzip3Lne (coreToStgRhs scope_fvs TopLevel) pairs
+ `thenLne` \ (rhss2, fvss, _) ->
+ let fvs = unionFVInfos fvss
+ in
+ returnLne (StgRec (binders `zip` rhss2), fvs)
+ )
+\end{code}