<commit_before>%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
\section[CoreToStg]{Converts Core to STG Syntax}

And, as we have the info in hand, we may convert some lets to
let-no-escapes.

\begin{code}
module CoreToStg ( coreToStg, coreExprToStg ) where

#include "HsVersions.h"

import CoreSyn
import CoreUtils	( rhsIsStatic, manifestArity, exprType, findDefault )
import StgSyn

import Type
import TyCon		( isAlgTyCon )
import Id
import Var		( Var, globalIdDetails, idType )
import TyCon		( isUnboxedTupleTyCon, isPrimTyCon, isFunTyCon, isHiBootTyCon )
#ifdef ILX
import MkId		( unsafeCoerceId )
#endif
import IdInfo
import DataCon
import CostCentre	( noCCS )
import VarSet
import VarEnv
import Maybes		( maybeToBool )
import Name		( getOccName, isExternalName, nameOccName )
import OccName		( occNameUserString, occNameFS )
import BasicTypes       ( Arity )
import Packages		( HomeModules )
import StaticFlags	( opt_RuntimeTypes )
import Outputable

infixr 9 `thenLne`
\end{code}

%************************************************************************
%*									*
\subsection[live-vs-free-doc]{Documentation}
%*									*
%************************************************************************

(There is other relevant documentation in codeGen/CgLetNoEscape.)

The actual Stg datatype is decorated with {\em live variable}
information, as well as {\em free variable} information.  The two are
{\em not} the same.  Liveness is an operational property rather than a
semantic one.  A variable is live at a particular execution point if
it can be referred to {\em directly} again.  In particular, a dead
variable's stack slot (if it has one):
\begin{enumerate}
\item
should be stubbed to avoid space leaks, and
\item
may be reused for something else.
\end{enumerate}

There ought to be a better way to say this.  Here are some examples:
\begin{verbatim}
	let v = [q] \[x] -> e
	in
	...v...	 (but no q's)
\end{verbatim}

Just after the `in', v is live, but q is dead.	If the whole of that
let expression was enclosed in a case expression, thus:
\begin{verbatim}
	case (let v = [q] \[x] -> e in ...v...) of
		alts[...q...]
\end{verbatim}
(ie @alts@ mention @q@), then @q@ is live even after the `in'; because
we'll return later to the @alts@ and need it.

Let-no-escapes make this a bit more interesting:
\begin{verbatim}
	let-no-escape v = [q] \ [x] -> e
	in
	...v...
\end{verbatim}
Here, @q@ is still live at the `in', because @v@ is represented not by
a closure but by the current stack state.  In other words, if @v@ is
live then so is @q@.  Furthermore, if @e@ mentions an enclosing
let-no-escaped variable, then {\em its} free variables are also live
if @v@ is.

%************************************************************************
%*									*
\subsection[caf-info]{Collecting live CAF info}
%*									*
%************************************************************************

In this pass we also collect information on which CAFs are live for 
constructing SRTs (see SRT.lhs).  

A top-level Id has CafInfo, which is

	- MayHaveCafRefs, if it may refer indirectly to
	  one or more CAFs, or
	- NoCafRefs if it definitely doesn't

The CafInfo has already been calculated during the CoreTidy pass.

During CoreToStg, we then pin onto each binding and case expression, a
list of Ids which represents the "live" CAFs at that point.  The meaning
of "live" here is the same as for live variables, see above (which is
why it's convenient to collect CAF information here rather than elsewhere).

The later SRT pass takes these lists of Ids and uses them to construct
the actual nested SRTs, and replaces the lists of Ids with (offset,length)
pairs.


Interaction of let-no-escape with SRTs   [Sept 01]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider

	let-no-escape x = ...caf1...caf2...
	in
	...x...x...x...

where caf1,caf2 are CAFs.  Since x doesn't have a closure, we 
build SRTs just as if x's defn was inlined at each call site, and
that means that x's CAF refs get duplicated in the overall SRT.

This is unlike ordinary lets, in which the CAF refs are not duplicated.

We could fix this loss of (static) sharing by making a sort of pseudo-closure
for x, solely to put in the SRTs lower down.


%************************************************************************
%*									*
\subsection[binds-StgVarInfo]{Setting variable info: top-level, binds, RHSs}
%*									*
%************************************************************************

\begin{code}
coreToStg :: HomeModules -> [CoreBind] -> IO [StgBinding]
coreToStg hmods pgm
  = return pgm'
  where (_, _, pgm') = coreTopBindsToStg hmods emptyVarEnv pgm

coreExprToStg :: CoreExpr -> StgExpr
coreExprToStg expr 
  = new_expr where (new_expr,_,_) = initLne emptyVarEnv (coreToStgExpr expr)


coreTopBindsToStg
    :: HomeModules
    -> IdEnv HowBound		-- environment for the bindings
    -> [CoreBind]
    -> (IdEnv HowBound, FreeVarsInfo, [StgBinding])

coreTopBindsToStg hmods env [] = (env, emptyFVInfo, [])
coreTopBindsToStg hmods env (b:bs)
  = (env2, fvs2, b':bs')
  where
	-- env accumulates down the list of binds, fvs accumulates upwards
	(env1, fvs2, b' ) = coreTopBindToStg hmods env fvs1 b
  	(env2, fvs1, bs') = coreTopBindsToStg hmods env1 bs


coreTopBindToStg
	:: HomeModules
	-> IdEnv HowBound
	-> FreeVarsInfo		-- Info about the body
	-> CoreBind
	-> (IdEnv HowBound, FreeVarsInfo, StgBinding)

coreTopBindToStg hmods env body_fvs (NonRec id rhs)
  = let 
	env' 	  = extendVarEnv env id how_bound
	how_bound = LetBound TopLet (manifestArity rhs)

        (stg_rhs, fvs') = 
	    initLne env (
              coreToTopStgRhs hmods body_fvs (id,rhs)	`thenLne` \ (stg_rhs, fvs') ->
	      returnLne (stg_rhs, fvs')
           )
	
	bind = StgNonRec id stg_rhs
    in
    ASSERT2(manifestArity rhs == stgRhsArity stg_rhs, ppr id)
    ASSERT2(consistentCafInfo id bind, ppr id)
--    WARN(not (consistent caf_info bind), ppr id <+> ppr cafs <+> ppCafInfo caf_info)
    (env', fvs' `unionFVInfo` body_fvs, bind)

coreTopBindToStg hmods env body_fvs (Rec pairs)
  = let 
	(binders, rhss) = unzip pairs

	extra_env' = [ (b, LetBound TopLet (manifestArity rhs))
		     | (b, rhs) <- pairs ]
	env' = extendVarEnvList env extra_env'

        (stg_rhss, fvs')
	  = initLne env' (
	       mapAndUnzipLne (coreToTopStgRhs hmods body_fvs) pairs
						`thenLne` \ (stg_rhss, fvss') ->
	       let fvs' = unionFVInfos fvss' in
	       returnLne (stg_rhss, fvs')
           )

	bind = StgRec (zip binders stg_rhss)
    in
    ASSERT2(and [manifestArity rhs == stgRhsArity stg_rhs | (rhs,stg_rhs) <- rhss `zip` stg_rhss], ppr binders)<commit_msg>[project @ 2005-08-02 14:55:32 by simonmar] A little bit of strictness (doesn't actually help much)<commit_after>%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
\section[CoreToStg]{Converts Core to STG Syntax}

And, as we have the info in hand, we may convert some lets to
let-no-escapes.

\begin{code}
module CoreToStg ( coreToStg, coreExprToStg ) where

#include "HsVersions.h"

import CoreSyn
import CoreUtils	( rhsIsStatic, manifestArity, exprType, findDefault )
import StgSyn

import Type
import TyCon		( isAlgTyCon )
import Id
import Var		( Var, globalIdDetails, idType )
import TyCon		( isUnboxedTupleTyCon, isPrimTyCon, isFunTyCon, isHiBootTyCon )
#ifdef ILX
import MkId		( unsafeCoerceId )
#endif
import IdInfo
import DataCon
import CostCentre	( noCCS )
import VarSet
import VarEnv
import Maybes		( maybeToBool )
import Name		( getOccName, isExternalName, nameOccName )
import OccName		( occNameUserString, occNameFS )
import BasicTypes       ( Arity )
import Packages		( HomeModules )
import StaticFlags	( opt_RuntimeTypes )
import Outputable

infixr 9 `thenLne`
\end{code}

%************************************************************************
%*									*
\subsection[live-vs-free-doc]{Documentation}
%*									*
%************************************************************************

(There is other relevant documentation in codeGen/CgLetNoEscape.)

The actual Stg datatype is decorated with {\em live variable}
information, as well as {\em free variable} information.  The two are
{\em not} the same.  Liveness is an operational property rather than a
semantic one.  A variable is live at a particular execution point if
it can be referred to {\em directly} again.  In particular, a dead
variable's stack slot (if it has one):
\begin{enumerate}
\item
should be stubbed to avoid space leaks, and
\item
may be reused for something else.
\end{enumerate}

There ought to be a better way to say this.  Here are some examples:
\begin{verbatim}
	let v = [q] \[x] -> e
	in
	...v...	 (but no q's)
\end{verbatim}

Just after the `in', v is live, but q is dead.	If the whole of that
let expression was enclosed in a case expression, thus:
\begin{verbatim}
	case (let v = [q] \[x] -> e in ...v...) of
		alts[...q...]
\end{verbatim}
(ie @alts@ mention @q@), then @q@ is live even after the `in'; because
we'll return later to the @alts@ and need it.

Let-no-escapes make this a bit more interesting:
\begin{verbatim}
	let-no-escape v = [q] \ [x] -> e
	in
	...v...
\end{verbatim}
Here, @q@ is still live at the `in', because @v@ is represented not by
a closure but by the current stack state.  In other words, if @v@ is
live then so is @q@.  Furthermore, if @e@ mentions an enclosing
let-no-escaped variable, then {\em its} free variables are also live
if @v@ is.

%************************************************************************
%*									*
\subsection[caf-info]{Collecting live CAF info}
%*									*
%************************************************************************

In this pass we also collect information on which CAFs are live for 
constructing SRTs (see SRT.lhs).  

A top-level Id has CafInfo, which is

	- MayHaveCafRefs, if it may refer indirectly to
	  one or more CAFs, or
	- NoCafRefs if it definitely doesn't

The CafInfo has already been calculated during the CoreTidy pass.

During CoreToStg, we then pin onto each binding and case expression, a
list of Ids which represents the "live" CAFs at that point.  The meaning
of "live" here is the same as for live variables, see above (which is
why it's convenient to collect CAF information here rather than elsewhere).

The later SRT pass takes these lists of Ids and uses them to construct
the actual nested SRTs, and replaces the lists of Ids with (offset,length)
pairs.


Interaction of let-no-escape with SRTs   [Sept 01]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider

	let-no-escape x = ...caf1...caf2...
	in
	...x...x...x...

where caf1,caf2 are CAFs.  Since x doesn't have a closure, we 
build SRTs just as if x's defn was inlined at each call site, and
that means that x's CAF refs get duplicated in the overall SRT.

This is unlike ordinary lets, in which the CAF refs are not duplicated.

We could fix this loss of (static) sharing by making a sort of pseudo-closure
for x, solely to put in the SRTs lower down.


%************************************************************************
%*									*
\subsection[binds-StgVarInfo]{Setting variable info: top-level, binds, RHSs}
%*									*
%************************************************************************

\begin{code}
coreToStg :: HomeModules -> [CoreBind] -> IO [StgBinding]
coreToStg hmods pgm
  = return pgm'
  where (_, _, pgm') = coreTopBindsToStg hmods emptyVarEnv pgm

coreExprToStg :: CoreExpr -> StgExpr
coreExprToStg expr 
  = new_expr where (new_expr,_,_) = initLne emptyVarEnv (coreToStgExpr expr)


coreTopBindsToStg
    :: HomeModules
    -> IdEnv HowBound		-- environment for the bindings
    -> [CoreBind]
    -> (IdEnv HowBound, FreeVarsInfo, [StgBinding])

coreTopBindsToStg hmods env [] = (env, emptyFVInfo, [])
coreTopBindsToStg hmods env (b:bs)
  = (env2, fvs2, b':bs')
  where
	-- env accumulates down the list of binds, fvs accumulates upwards
	(env1, fvs2, b' ) = coreTopBindToStg hmods env fvs1 b
  	(env2, fvs1, bs') = coreTopBindsToStg hmods env1 bs


coreTopBindToStg
	:: HomeModules
	-> IdEnv HowBound
	-> FreeVarsInfo		-- Info about the body
	-> CoreBind
	-> (IdEnv HowBound, FreeVarsInfo, StgBinding)

coreTopBindToStg hmods env body_fvs (NonRec id rhs)
  = let 
	env' 	  = extendVarEnv env id how_bound
	how_bound = LetBound TopLet $! manifestArity rhs

        (stg_rhs, fvs') = 
	    initLne env (
              coreToTopStgRhs hmods body_fvs (id,rhs)	`thenLne` \ (stg_rhs, fvs') ->
	      returnLne (stg_rhs, fvs')
           )
	
	bind = StgNonRec id stg_rhs
    in
    ASSERT2(manifestArity rhs == stgRhsArity stg_rhs, ppr id)
    ASSERT2(consistentCafInfo id bind, ppr id)
--    WARN(not (consistent caf_info bind), ppr id <+> ppr cafs <+> ppCafInfo caf_info)
    (env', fvs' `unionFVInfo` body_fvs, bind)

coreTopBindToStg hmods env body_fvs (Rec pairs)
  = let 
	(binders, rhss) = unzip pairs

	extra_env' = [ (b, LetBound TopLet $! manifestArity rhs)
		     | (b, rhs) <- pairs ]
	env' = extendVarEnvList env extra_env'

        (stg_rhss, fvs')
	  = initLne env' (
	       mapAndUnzipLne (coreToTopStgRhs hmods body_fvs) pairs
						`thenLne` \ (stg_rhss, fvss') ->
	       let fvs' = unionFVInfos fvss' in
	       returnLne (stg_rhss, fvs')
           )

	bind = StgRec (zip binders stg_rhss)
    in
    ASSERT2(and [manifestArity rhs == stgRhsArity stg_rhs | (rhs,stg_rhs) <- rhss `zip` stg_rhss], ppr binders)
{'fraction_non_alphanumeric': 0.15966512184182988, 'fraction_numerical': 0.004933472865899237, 'mean_word_length': 3.810859403092413, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 37, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3083100', 'n_tokens_mistral': 4738, 'n_tokens_neox': 4428, 'n_words': 1600}