<commit_before>%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[SimplCore]{Driver for simplifying @Core@ programs}

\begin{code}
module SimplCore ( core2core, simplifyExpr ) where

#include "HsVersions.h"

import CmdLineOpts	( CoreToDo(..), SimplifierSwitch(..),
			  SimplifierMode(..), DynFlags, DynFlag(..), dopt,
			  dopt_CoreToDo, buildCoreToDo
			)
import CoreSyn
import TcIface		( loadImportedRules )
import HscTypes		( HscEnv(..), ModGuts(..), ExternalPackageState(..),
			  ModDetails(..), HomeModInfo(..), hscEPS )
import CSE		( cseProgram )
import Rules		( RuleBase, ruleBaseIds, emptyRuleBase,
			  extendRuleBaseList, pprRuleBase, ruleCheckProgram )
import Module		( moduleEnvElts )
import PprCore		( pprCoreBindings, pprCoreExpr, pprIdRules )
import OccurAnal	( occurAnalyseBinds, occurAnalyseGlobalExpr )
import CoreUtils	( coreBindsSize )
import Simplify		( simplTopBinds, simplExpr )
import SimplEnv		( SimplEnv, simplBinders, mkSimplEnv, setInScopeSet )
import SimplMonad
import ErrUtils		( dumpIfSet, dumpIfSet_dyn, showPass )
import CoreLint		( endPass )
import VarEnv		( mkInScopeSet )
import FloatIn		( floatInwards )
import FloatOut		( floatOutwards )
import Id		( idIsFrom, idSpecialisation, setIdSpecialisation )
import VarSet
import LiberateCase	( liberateCase )
import SAT		( doStaticArgs )
import Specialise	( specProgram)
import SpecConstr	( specConstrProgram)
import DmdAnal		( dmdAnalPgm )
import WorkWrap	        ( wwTopBinds )
#ifdef OLD_STRICTNESS
import StrictAnal	( saBinds )
import CprAnalyse       ( cprAnalyse )
#endif

import UniqSupply	( UniqSupply, mkSplitUniqSupply, splitUniqSupply )
import IO		( hPutStr, stderr )
import Outputable
import List		( partition )
import Maybes		( orElse )
\end{code}

%************************************************************************
%*									*
\subsection{The driver for the simplifier}
%*									*
%************************************************************************

\begin{code}
core2core :: HscEnv
	  -> ModGuts
	  -> IO ModGuts

core2core hsc_env guts
  = do
        let dflags = hsc_dflags hsc_env
	    core_todos
		| Just todo <- dopt_CoreToDo dflags  =  todo
		| otherwise			     =  buildCoreToDo dflags

	us <- mkSplitUniqSupply 's'
	let (cp_us, ru_us) = splitUniqSupply us

		-- COMPUTE THE RULE BASE TO USE
	(imp_rule_base, guts') <- prepareRules hsc_env guts ru_us

		-- DO THE BUSINESS
	(stats, guts'') <- doCorePasses hsc_env cp_us
			 		(zeroSimplCount dflags) 
					imp_rule_base guts' core_todos

	dumpIfSet_dyn dflags Opt_D_dump_simpl_stats
		  "Grand total simplifier statistics"
		  (pprSimplCount stats)

	return guts''


simplifyExpr :: DynFlags -- includes spec of what core-to-core passes to do
	     -> CoreExpr
	     -> IO CoreExpr
-- simplifyExpr is called by the driver to simplify an
-- expression typed in at the interactive prompt
simplifyExpr dflags expr
  = do	{
	; showPass dflags "Simplify"

	; us <-  mkSplitUniqSupply 's'

	; let (expr', _counts) = initSmpl dflags us $
				 simplExprGently gentleSimplEnv expr

	; dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
			(pprCoreExpr expr')

	; return expr'
	}

gentleSimplEnv :: SimplEnv
gentleSimplEnv = mkSimplEnv SimplGently 
			    (panic "simplifyExpr: switches")
			     emptyRuleBase

doCorePasses :: HscEnv
             -> UniqSupply      -- uniques
	     -> SimplCount      -- simplifier stats
             -> RuleBase        -- the main rule base
             -> ModGuts	        -- local binds in (with rules attached)
             -> [CoreToDo]      -- which passes to do
             -> IO (SimplCount, ModGuts)

doCorePasses hsc_env us stats rb guts []
  = return (stats, guts)

doCorePasses hsc_env us stats rb guts (to_do : to_dos) 
  = do
	let (us1, us2) = splitUniqSupply us
	(stats1, rb1, guts1) <- doCorePass to_do hsc_env us1 rb guts
	doCorePasses hsc_env us2 (stats `plusSimplCount` stats1) rb1 guts1 to_dos

doCorePass (CoreDoSimplify mode sws)   = _scc_ "Simplify"      simplifyPgm mode sws
doCorePass CoreCSE		       = _scc_ "CommonSubExpr" trBinds  cseProgram<commit_msg>[project @ 2004-12-27 18:28:21 by simonpj] Wibble<commit_after>%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[SimplCore]{Driver for simplifying @Core@ programs}

\begin{code}
module SimplCore ( core2core, simplifyExpr ) where

#include "HsVersions.h"

import CmdLineOpts	( CoreToDo(..), SimplifierSwitch(..),
			  SimplifierMode(..), DynFlags, DynFlag(..), dopt,
			  dopt_CoreToDo, buildCoreToDo
			)
import CoreSyn
import TcIface		( loadImportedRules )
import HscTypes		( HscEnv(..), ModGuts(..), ExternalPackageState(..),
			  ModDetails(..), HomeModInfo(..), hscEPS )
import CSE		( cseProgram )
import Rules		( RuleBase, ruleBaseIds, emptyRuleBase,
			  extendRuleBaseList, pprRuleBase, ruleCheckProgram )
import Module		( moduleEnvElts )
import PprCore		( pprCoreBindings, pprCoreExpr, pprIdRules )
import OccurAnal	( occurAnalyseBinds, occurAnalyseGlobalExpr )
import CoreUtils	( coreBindsSize )
import Simplify		( simplTopBinds, simplExpr )
import SimplEnv		( SimplEnv, simplBinders, mkSimplEnv, setInScopeSet )
import SimplMonad
import ErrUtils		( dumpIfSet, dumpIfSet_dyn, showPass )
import CoreLint		( endPass )
import VarEnv		( mkInScopeSet )
import FloatIn		( floatInwards )
import FloatOut		( floatOutwards )
import Id		( idIsFrom, idSpecialisation, setIdSpecialisation )
import VarSet
import LiberateCase	( liberateCase )
import SAT		( doStaticArgs )
import Specialise	( specProgram)
import SpecConstr	( specConstrProgram)
import DmdAnal		( dmdAnalPgm )
import WorkWrap	        ( wwTopBinds )
#ifdef OLD_STRICTNESS
import StrictAnal	( saBinds )
import CprAnalyse       ( cprAnalyse )
#endif

import UniqSupply	( UniqSupply, mkSplitUniqSupply, splitUniqSupply )
import IO		( hPutStr, stderr )
import Outputable
import List		( partition )
import Maybes		( orElse )
\end{code}

%************************************************************************
%*									*
\subsection{The driver for the simplifier}
%*									*
%************************************************************************

\begin{code}
core2core :: HscEnv
	  -> ModGuts
	  -> IO ModGuts

core2core hsc_env guts
  = do
        let dflags = hsc_dflags hsc_env
	    core_todos
		| Just todo <- dopt_CoreToDo dflags  =  todo
		| otherwise			     =  buildCoreToDo dflags

	us <- mkSplitUniqSupply 's'
	let (cp_us, ru_us) = splitUniqSupply us

		-- COMPUTE THE RULE BASE TO USE
	(imp_rule_base, guts') <- prepareRules hsc_env guts ru_us

		-- DO THE BUSINESS
	(stats, guts'') <- doCorePasses hsc_env cp_us
			 		(zeroSimplCount dflags) 
					imp_rule_base guts' core_todos

	dumpIfSet_dyn dflags Opt_D_dump_simpl_stats
		  "Grand total simplifier statistics"
		  (pprSimplCount stats)

	return guts''


simplifyExpr :: DynFlags -- includes spec of what core-to-core passes to do
	     -> CoreExpr
	     -> IO CoreExpr
-- simplifyExpr is called by the driver to simplify an
-- expression typed in at the interactive prompt
simplifyExpr dflags expr
  = do	{
	; showPass dflags "Simplify"

	; us <-  mkSplitUniqSupply 's'

	; let (expr', _counts) = initSmpl dflags us $
				 simplExprGently gentleSimplEnv expr

	; dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
			(pprCoreExpr expr')

	; return expr'
	}

gentleSimplEnv :: SimplEnv
gentleSimplEnv = mkSimplEnv SimplGently 
			    (isAmongSimpl [])
			    emptyRuleBase

doCorePasses :: HscEnv
             -> UniqSupply      -- uniques
	     -> SimplCount      -- simplifier stats
             -> RuleBase        -- the main rule base
             -> ModGuts	        -- local binds in (with rules attached)
             -> [CoreToDo]      -- which passes to do
             -> IO (SimplCount, ModGuts)

doCorePasses hsc_env us stats rb guts []
  = return (stats, guts)

doCorePasses hsc_env us stats rb guts (to_do : to_dos) 
  = do
	let (us1, us2) = splitUniqSupply us
	(stats1, rb1, guts1) <- doCorePass to_do hsc_env us1 rb guts
	doCorePasses hsc_env us2 (stats `plusSimplCount` stats1) rb1 guts1 to_dos

doCorePass (CoreDoSimplify mode sws)   = _scc_ "Simplify"      simplifyPgm mode sws
doCorePass CoreCSE		       = _scc_ "CommonSubExpr" trBinds  cseProgram
{'fraction_non_alphanumeric': 0.116290361738286, 'fraction_numerical': 0.006797766448167031, 'mean_word_length': 3.631253513209668, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 23, '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': '3851687', 'n_tokens_mistral': 3063, 'n_tokens_neox': 2776, 'n_words': 746}