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

\begin{code}
module SimplCore ( core2core ) where

#include "HsVersions.h"

import CmdLineOpts	( CoreToDo(..), SimplifierSwitch(..), 
			  SwitchResult, switchIsOn,
			  opt_D_dump_occur_anal,
			  opt_D_dump_simpl_iterations,
			  opt_D_simplifier_stats,
			  opt_D_dump_simpl,
			  opt_D_verbose_core2core,
			  opt_D_dump_occur_anal
			)
import CoreLint		( beginPass, endPass )
import CoreSyn
import PprCore		( pprCoreBindings )
import OccurAnal	( occurAnalyseBinds )
import CoreUtils	( exprIsTrivial, coreExprType )
import Simplify		( simplBind )
import SimplUtils	( etaCoreExpr, findDefault )
import SimplMonad
import CoreUnfold
import Const		( Con(..), Literal(..), literalType, mkMachInt )
import ErrUtils		( dumpIfSet )
import FloatIn		( floatInwards )
import FloatOut		( floatOutwards )
import Id		( Id, mkSysLocal, mkUserId, isBottomingId,
			  idType, setIdType, idName, idInfo, idDetails
			)
import IdInfo		( InlinePragInfo(..), specInfo, setSpecInfo,
			  inlinePragInfo, setInlinePragInfo,
			  setUnfoldingInfo
			)
import VarEnv
import VarSet
import Module		( Module )
import Name		( mkLocalName, tidyOccName, tidyTopName, initTidyOccEnv, isExported,
			  NamedThing(..), OccName
			)
import TyCon		( TyCon, isDataTyCon )
import PrimOp		( PrimOp(..) )
import PrelInfo		( unpackCStringId, unpackCString2Id, addr2IntegerId )
import Type		( Type, splitAlgTyConApp_maybe, 
			  isUnLiftedType,
			  tidyType, tidyTypes, tidyTopType, tidyTyVar, tidyTyVars,
			  Type
			)
import Class		( Class, classSelIds )
import TysWiredIn	( smallIntegerDataCon, isIntegerTy )
import LiberateCase	( liberateCase )
import SAT		( doStaticArgs )
import Specialise	( specProgram)
import SpecEnv		( specEnvToList, specEnvFromList )
import StrictAnal	( saWwTopBinds )
import Var		( TyVar, mkId )
import Unique		( Unique, Uniquable(..),
			  ratioTyConKey, mkUnique, incrUnique, initTidyUniques
		        )
import UniqSupply	( UniqSupply, splitUniqSupply, uniqFromSupply )
import Constants	( tARGET_MIN_INT, tARGET_MAX_INT )
import Util		( mapAccumL )
import SrcLoc		( noSrcLoc )
import Bag
import Maybes
import IO		( hPutStr, stderr )
import Outputable

import Ratio 		( numerator, denominator )
\end{code}

\begin{code}
core2core :: [CoreToDo]		-- Spec of what core-to-core passes to do
	  -> Module		-- Module name (profiling only)
	  -> [Class]		-- Local classes
	  -> UniqSupply		-- A name supply
	  -> [CoreBind]		-- Input
	  -> IO [CoreBind]	-- Result

core2core core_todos module_name classes us binds
  = do
	let (us1, us2) = splitUniqSupply us

	-- Do the main business
	processed_binds <- doCorePasses us1 binds core_todos

	-- Do the post-simplification business
	post_simpl_binds <- doPostSimplification us2 processed_binds

	-- Do the final tidy-up
	final_binds <- tidyCorePgm module_name classes post_simpl_binds

	-- Return results
	return final_binds

doCorePasses us binds []
  = return binds

doCorePasses us binds (to_do : to_dos) 
  = do
	let (us1, us2) =  splitUniqSupply us
	binds1 	       <- doCorePass us1 binds to_do
	doCorePasses us2 binds1 to_dos

doCorePass us binds (CoreDoSimplify sw_chkr) = _scc_ "Simplify"       simplifyPgm sw_chkr us binds
doCorePass us binds CoreLiberateCase	     = _scc_ "LiberateCase"   liberateCase binds
doCorePass us binds CoreDoFloatInwards	     = _scc_ "FloatInwards"   floatInwards binds
doCorePass us binds CoreDoFullLaziness       = _scc_ "CoreFloating"   floatOutwards us binds
doCorePass us binds CoreDoStaticArgs	     = _scc_ "CoreStaticArgs" doStaticArgs us binds
doCorePass us binds CoreDoStrictness	     = _scc_ "CoreStranal"    saWwTopBinds us binds
doCorePass us binds CoreDoSpecialising	     = _scc_ "Specialise"     specProgram us binds
\end{code}


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

\begin{code}
simplifyPgm :: (SimplifierSwitch -> SwitchResult)
	    -> UniqSupply
	    -> [CoreBind]		-- Input
	    -> IO [CoreBind]		-- New bindings

simplifyPgm sw_chkr us binds
  = do {
	beginPass "Simplify";

	(termination_msg, it_count, counts, binds') <- iteration us 1 zeroSimplCount binds;
<commit_msg>[project @ 1999-04-09 01:55:15 by kglynn] (keving)<commit_after>%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[SimplCore]{Driver for simplifying @Core@ programs}

\begin{code}
module SimplCore ( core2core ) where

#include "HsVersions.h"

import CmdLineOpts	( CoreToDo(..), SimplifierSwitch(..), 
			  SwitchResult, switchIsOn,
			  opt_D_dump_occur_anal,
			  opt_D_dump_simpl_iterations,
			  opt_D_simplifier_stats,
			  opt_D_dump_simpl,
			  opt_D_verbose_core2core,
			  opt_D_dump_occur_anal
			)
import CoreLint		( beginPass, endPass )
import CoreSyn
import PprCore		( pprCoreBindings )
import OccurAnal	( occurAnalyseBinds )
import CoreUtils	( exprIsTrivial, coreExprType )
import Simplify		( simplBind )
import SimplUtils	( etaCoreExpr, findDefault )
import SimplMonad
import CoreUnfold
import Const		( Con(..), Literal(..), literalType, mkMachInt )
import ErrUtils		( dumpIfSet )
import FloatIn		( floatInwards )
import FloatOut		( floatOutwards )
import Id		( Id, mkSysLocal, mkUserId, isBottomingId,
			  idType, setIdType, idName, idInfo, idDetails
			)
import IdInfo		( InlinePragInfo(..), specInfo, setSpecInfo,
			  inlinePragInfo, setInlinePragInfo,
			  setUnfoldingInfo
			)
import VarEnv
import VarSet
import Module		( Module )
import Name		( mkLocalName, tidyOccName, tidyTopName, initTidyOccEnv, isExported,
			  NamedThing(..), OccName
			)
import TyCon		( TyCon, isDataTyCon )
import PrimOp		( PrimOp(..) )
import PrelInfo		( unpackCStringId, unpackCString2Id, addr2IntegerId )
import Type		( Type, splitAlgTyConApp_maybe, 
			  isUnLiftedType,
			  tidyType, tidyTypes, tidyTopType, tidyTyVar, tidyTyVars,
			  Type
			)
import Class		( Class, classSelIds )
import TysWiredIn	( smallIntegerDataCon, isIntegerTy )
import LiberateCase	( liberateCase )
import SAT		( doStaticArgs )
import Specialise	( specProgram)
import SpecEnv		( specEnvToList, specEnvFromList )
import StrictAnal	( saWwTopBinds )
import Var		( TyVar, mkId )
import Unique		( Unique, Uniquable(..),
			  ratioTyConKey, mkUnique, incrUnique, initTidyUniques
		        )
import UniqSupply	( UniqSupply, splitUniqSupply, uniqFromSupply )
import Constants	( tARGET_MIN_INT, tARGET_MAX_INT )
import Util		( mapAccumL )
import SrcLoc		( noSrcLoc )
import Bag
import Maybes
import IO		( hPutStr, stderr )
import Outputable

import Ratio 		( numerator, denominator )
\end{code}

\begin{code}
core2core :: [CoreToDo]		-- Spec of what core-to-core passes to do
	  -> Module		-- Module name (profiling only)
	  -> [Class]		-- Local classes
	  -> UniqSupply		-- A name supply
	  -> [CoreBind]		-- Input
	  -> IO [CoreBind]	-- Result

core2core core_todos module_name classes us binds
  = do
	let (us1, us2) = splitUniqSupply us

	-- Do the main business
	processed_binds <- doCorePasses us1 binds core_todos

	-- Do the post-simplification business
	post_simpl_binds <- doPostSimplification us2 processed_binds

	-- Do the final tidy-up
	final_binds <- tidyCorePgm module_name classes post_simpl_binds

	-- Return results
	return final_binds

doCorePasses us binds []
  = return binds

doCorePasses us binds (to_do : to_dos) 
  = do
	let (us1, us2) =  splitUniqSupply us
	binds1 	       <- doCorePass us1 binds to_do
	doCorePasses us2 binds1 to_dos

doCorePass us binds (CoreDoSimplify sw_chkr) = _scc_ "Simplify"       simplifyPgm sw_chkr us binds
doCorePass us binds CoreLiberateCase	     = _scc_ "LiberateCase"   liberateCase binds
doCorePass us binds CoreDoFloatInwards	     = _scc_ "FloatInwards"   floatInwards binds
doCorePass us binds CoreDoFullLaziness       = _scc_ "CoreFloating"   floatOutwards us binds
doCorePass us binds CoreDoStaticArgs	     = _scc_ "CoreStaticArgs" doStaticArgs us binds
doCorePass us binds CoreDoStrictness	     = _scc_ "CoreStranal"    saWwTopBinds us binds
doCorePass us binds CoreDoSpecialising	     = _scc_ "Specialise"     specProgram us binds
doCorePass us binds CoreDoPrintCore	     = _scc_ "PrintCore"      do
                                                                       putStr (showSDoc $ pprCoreBindings binds)
								       return binds
\end{code}


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

\begin{code}
simplifyPgm :: (SimplifierSwitch -> SwitchResult)
	    -> UniqSupply
	    -> [CoreBind]		-- Input
	    -> IO [CoreBind]		-- New bindings

simplifyPgm sw_chkr us binds
  = do {
	beginPass "Simplify";

	(termination_msg, it_count, counts, binds') <- iteration us 1 zeroSimplCount binds;

{'fraction_non_alphanumeric': 0.10839897925219127, 'fraction_numerical': 0.00710085432153556, 'mean_word_length': 3.914940021810251, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 21, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 3, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5378451', 'n_tokens_mistral': 3413, 'n_tokens_neox': 3045, 'n_words': 794}