<commit_before>%
% (c) The AQUA Project, Glasgow University, 1996
%
\section[CmdLineOpts]{Things to do with command-line options}

\begin{code}
#include "HsVersions.h"

module CmdLineOpts (
	CoreToDo(..),
	SimplifierSwitch(..),
	StgToDo(..),
	SwitchResult(..),
	classifyOpts,

	intSwitchSet,
	switchIsOn,

	maybe_CompilingGhcInternals,
	opt_AllDemanded,
	opt_AllStrict,
	opt_AutoSccsOnAllToplevs,
	opt_AutoSccsOnExportedToplevs,
	opt_AutoSccsOnIndividualCafs,
	opt_CompilingGhcInternals,
	opt_D_dump_absC,
	opt_D_dump_asm,
	opt_D_dump_deforest,
	opt_D_dump_deriv,
	opt_D_dump_ds,
	opt_D_dump_flatC,
	opt_D_dump_occur_anal,
	opt_D_dump_rdr,
	opt_D_dump_realC,
	opt_D_dump_rn,
	opt_D_dump_simpl,
	opt_D_dump_simpl_iterations,
	opt_D_dump_spec,
	opt_D_dump_stg,
	opt_D_dump_stranal,
	opt_D_dump_tc,
	opt_D_show_passes,
	opt_D_show_rn_trace,
	opt_D_simplifier_stats,
	opt_D_source_stats,
	opt_D_verbose_core2core,
	opt_D_verbose_stg2stg,
	opt_DoCoreLinting,
	opt_DoStgLinting,
	opt_DoSemiTagging,
	opt_DoEtaReduction,
	opt_DoTickyProfiling,
	opt_EnsureSplittableC,
	opt_FoldrBuildOn,
	opt_FoldrBuildTrace,
	opt_ForConcurrent,
	opt_GlasgowExts,
	opt_GranMacros,
	opt_Haskell_1_3,
	opt_HiMap,
	opt_IgnoreIfacePragmas,
	opt_IgnoreStrictnessPragmas,
	opt_IrrefutableEverything,
	opt_IrrefutableTuples,
	opt_LiberateCaseThreshold,
	opt_NoImplicitPrelude,
	opt_NumbersStrict,
	opt_OmitBlackHoling,
	opt_OmitDefaultInstanceMethods,
	opt_OmitInterfacePragmas,
	opt_PprStyle_All,
	opt_PprStyle_Debug,
	opt_PprStyle_User,
	opt_PprUserLength,
	opt_ProduceC,
	opt_ProduceHi,
	opt_ProduceS,
	opt_ReportWhyUnfoldingsDisallowed,
	opt_ReturnInRegsThreshold,
	opt_SccGroup,
	opt_SccProfilingOn,
	opt_ShowImportSpecs,
	opt_ShowPragmaNameErrs,
	opt_SigsRequired,
	opt_SourceUnchanged,
	opt_SpecialiseAll,
	opt_SpecialiseImports,
	opt_SpecialiseOverloaded,
	opt_SpecialiseTrace,
	opt_SpecialiseUnboxed,
	opt_StgDoLetNoEscapes,

	opt_InterfaceUnfoldThreshold,
	opt_UnfoldingCreationThreshold,
	opt_UnfoldingConDiscount,
	opt_UnfoldingUseThreshold,

	opt_Verbose,
	opt_WarnNameShadowing,
	opt_WarnUnusedNames,
	opt_WarnIncompletePatterns,
	opt_PruneTyDecls, opt_PruneInstDecls,
	opt_D_show_unused_imports,
	opt_D_show_rn_stats
    ) where

IMPORT_1_3(Array(array, (//)))
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
import PreludeGlaST	-- bad bad bad boy, Will (_Array internals)
#else
import GlaExts
import ArrBase
-- 2.04 and later exports Lift from GlaExts
#if __GLASGOW_HASKELL__ < 204
import PrelBase (Lift(..))
#endif
#endif
import Argv

CHK_Ubiq() -- debugging consistency check

import Constants	-- Default values for some flags

import Maybes		( assocMaybe, firstJust, maybeToBool )
import Util		( startsWith, panic, panic#, assertPanic )
\end{code}

A command-line {\em switch} is (generally) either on or off; e.g., the
``verbose'' (-v) switch is either on or off.  (The \tr{-G<group>}
switch is an exception; it's set to a string, or nothing.)

A list of {\em ToDo}s is things to be done in a particular part of
processing.  A (fictitious) example for the Core-to-Core simplifier
might be: run the simplifier, then run the strictness analyser, then
run the simplifier again (three ``todos'').

There are three ``to-do processing centers'' at the moment.  In the
main loop (\tr{main/Main.lhs}), in the Core-to-Core processing loop
(\tr{simplCore/SimplCore.lhs), and in the STG-to-STG processing loop
(\tr{simplStg/SimplStg.lhs}).

%************************************************************************
%*									*
\subsection{Datatypes associated with command-line options}
%*									*
%************************************************************************

\begin{code}
data SwitchResult
  = SwBool	Bool		-- on/off
  | SwString	FAST_STRING	-- nothing or a String
  | SwInt	Int		-- nothing or an Int
\end{code}

\begin{code}
data CoreToDo		-- These are diff core-to-core passes,
			-- which may be invoked in any order,
  			-- as many times as you like.

  = CoreDoSimplify	-- The core-to-core simplifier.
	(SimplifierSwitch -> SwitchResult)
			-- Each run of the simplifier can take a different
			-- set of simplifier-specific flags.
  | CoreDoCalcInlinings1
  | CoreDoCalcInlinings2
  | CoreDoFloatInwards
  | CoreDoFullLaziness
  | CoreLiberateCase
  | CoreDoPrintCore
  | CoreDoStaticArgs
  | CoreDoStrictness
  | CoreDoSpecialising
  | CoreDoDeforest
  | CoreDoFoldrBuildWorkerWrapper
  | CoreDoFoldrBuildWWAnal
\end{code}

\begin{code}
data StgToDo
  = StgDoStaticArgs
  | StgDoUpdateAnalysis
  | StgDoLambdaLift
  | StgDoMassageForProfiling  -- should be (next to) last
  -- There's also setStgVarInfo, but its absolute "lastness"
  -- is so critical that it is hardwired in (no flag).
  | D_stg_stats
\end{code}

\begin{code}
data SimplifierSwitch
  = SimplOkToDupCode
  | SimplFloatLetsExposingWHNF
  | SimplOkToFloatPrimOps
  | SimplAlwaysFloatLetsFromLets
  | SimplDoCaseElim
  | SimplReuseCon
  | SimplCaseOfCase
  | SimplLetToCase
  | SimplMayDeleteConjurableIds
  | SimplPedanticBottoms -- see Simplifier for an explanation
  | SimplDoArityExpand	 -- expand arity of bindings
  | SimplDoFoldrBuild	 -- This is the per-simplification flag;
			 -- see also FoldrBuildOn, used elsewhere
			 -- in the compiler.
  | SimplDoInlineFoldrBuild
			 -- inline foldr/build (*after* f/b rule is used)

  | IgnoreINLINEPragma
  | SimplDoLambdaEtaExpansion

  | EssentialUnfoldingsOnly -- never mind the thresholds, only
			    -- do unfoldings that *must* be done
			    -- (to saturate constructors and primitives)

  | ShowSimplifierProgress  -- report counts on every interation

  | MaxSimplifierIterations Int

  | KeepSpecPragmaIds	    -- We normally *toss* Ids we can do without
  | KeepUnusedBindings

  | SimplNoLetFromCase	    -- used when turning off floating entirely
  | SimplNoLetFromApp	    -- (for experimentation only) WDP 95/10
  | SimplNoLetFromStrictLet

  | SimplDontFoldBackAppend
		 	-- we fold `foldr (:)' back into flip (++),
			-- but we *don't* want to do it when compiling
			-- List.hs, otherwise
			-- xs ++ ys = foldr (:) ys xs
			-- {- via our loopback -}
			-- xs ++ ys = xs ++ ys
			-- Oops!
			-- So only use this flag inside List.hs
			-- (Sigh, what a HACK, Andy.  WDP 96/01)

  | SimplCaseMerge
  | SimplCaseScrutinee	-- This flag tells that the expression being simplified is
			-- the scrutinee of a case expression, so we should
			-- apply the scrutinee discount when considering inlinings.
			-- See SimplVar.lhs
\end{code}

%************************************************************************
%*									*
\subsection{Classifying command-line options}
%*									*
%************************************************************************

\begin{code}
lookUp	       :: FAST_STRING -> Bool
lookup_int     :: String -> Maybe Int
lookup_def_int :: String -> Int -> Int
lookup_str     :: String -> Maybe String

lookUp     sw = maybeToBool (assoc_opts sw)
	
lookup_str sw = firstJust (map (startsWith sw) unpacked_opts)

lookup_int sw = case (lookup_str sw) of
		  Nothing -> Nothing
		  Just xx -> Just (read xx)

lookup_def_int sw def = case (lookup_str sw) of
			    Nothing -> def		-- Use default
		  	    Just xx -> read xx

assoc_opts    = assocMaybe [ (a, True) | a <- argv ]
unpacked_opts = map _UNPK_ argv
\end{code}

\begin{code}
opt_AllDemanded			= lookUp  SLIT("-fall-demanded")
opt_AllStrict			= lookUp  SLIT("-fall-strict")
opt_AutoSccsOnAllToplevs	= lookUp  SLIT("-fauto-sccs-on-all-toplevs")
opt_AutoSccsOnExportedToplevs	= lookUp  SLIT("-fauto-sccs-on-exported-toplevs")
opt_AutoSccsOnIndividualCafs	= lookUp  SLIT("-fauto-sccs-on-individual-cafs")
opt_CompilingGhcInternals	= maybeToBool maybe_CompilingGhcInternals
maybe_CompilingGhcInternals	= lookup_str "-fcompiling-ghc-internals="
opt_D_dump_absC			= lookUp  SLIT("-ddump-absC")
opt_D_dump_asm			= lookUp  SLIT("-ddump-asm")
opt_D_dump_deforest		= lookUp  SLIT("-ddump-deforest")
opt_D_dump_deriv		= lookUp  SLIT("-ddump-deriv")
opt_D_dump_ds			= lookUp  SLIT("-ddump-ds")
opt_D_dump_flatC		= lookUp  SLIT("-ddump-flatC")
opt_D_dump_occur_anal		= lookUp  SLIT("-ddump-occur-anal")
opt_D_dump_rdr			= lookUp  SLIT("-ddump-rdr")
opt_D_dump_realC		= lookUp  SLIT("-ddump-realC")
opt_D_dump_rn			= lookUp  SLIT("-ddump-rn")
opt_D_dump_simpl		= lookUp  SLIT("-ddump-simpl")
opt_D_dump_simpl_iterations	= lookUp  SLIT("-ddump-simpl-iterations")
opt_D_dump_spec			= lookUp  SLIT("-ddump-spec")
opt_D_dump_stg			= lookUp  SLIT("-ddump-stg")
opt_D_dump_stranal		= lookUp  SLIT("-ddump-stranal")
opt_D_dump_tc			= lookUp  SLIT("-ddump-tc")
opt_D_show_passes		= lookUp  SLIT("-dshow-passes")
opt_D_show_rn_trace		= lookUp  SLIT("-dshow-rn-trace")
opt_D_simplifier_stats		= lookUp  SLIT("-dsimplifier-stats")
opt_D_source_stats		= lookUp  SLIT("-dsource-stats")
opt_D_verbose_core2core		= lookUp  SLIT("-dverbose-simpl")
opt_D_verbose_stg2stg		= lookUp  SLIT("-dverbose-stg")
opt_DoCoreLinting		= lookUp  SLIT("-dcore-lint")
opt_DoStgLinting		= lookUp  SLIT("-dstg-lint")
opt_DoSemiTagging		= lookUp  SLIT("-fsemi-tagging")
opt_DoTickyProfiling		= lookUp  SLIT("-fticky-ticky")
opt_DoEtaReduction		= lookUp  SLIT("-fdo-eta-reduction")
opt_EnsureSplittableC		= lookUp  SLIT("-fglobalise-toplev-names")
opt_FoldrBuildOn		= lookUp  SLIT("-ffoldr-build-on")
opt_FoldrBuildTrace		= lookUp  SLIT("-ffoldr-build-trace")
opt_ForConcurrent		= lookUp  SLIT("-fconcurrent")
opt_GranMacros			= lookUp  SLIT("-fgransim")
opt_GlasgowExts			= lookUp  SLIT("-fglasgow-exts")
opt_Haskell_1_3			= lookUp  SLIT("-fhaskell-1.3")
opt_HiMap 			= lookup_str "-himap="  -- file saying where to look for .hi files
opt_IgnoreIfacePragmas		= lookUp  SLIT("-fignore-interface-pragmas")
opt_IgnoreStrictnessPragmas	= lookUp  SLIT("-fignore-strictness-pragmas")
opt_IrrefutableEverything	= lookUp  SLIT("-firrefutable-everything")
opt_IrrefutableTuples		= lookUp  SLIT("-firrefutable-tuples")
opt_NoImplicitPrelude		= lookUp  SLIT("-fno-implicit-prelude")
opt_NumbersStrict		= lookUp  SLIT("-fnumbers-strict")
opt_OmitBlackHoling		= lookUp  SLIT("-dno-black-holing")
opt_OmitDefaultInstanceMethods	= lookUp  SLIT("-fomit-default-instance-methods")
opt_OmitInterfacePragmas	= lookUp  SLIT("-fomit-interface-pragmas")
opt_PprStyle_All		= lookUp  SLIT("-dppr-all")
opt_PprStyle_Debug		= lookUp  SLIT("-dppr-debug")
opt_PprStyle_User		= lookUp  SLIT("-dppr-user")
opt_PprUserLength	        = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
opt_ProduceC  			= lookup_str "-C="
opt_ProduceS  			= lookup_str "-S="
opt_ProduceHi 			= lookup_str "-hifile=" -- the one to produce this time 
opt_ReportWhyUnfoldingsDisallowed= lookUp SLIT("-freport-disallowed-unfoldings")
opt_SccProfilingOn		= lookUp  SLIT("-fscc-profiling")
opt_ShowImportSpecs		= lookUp  SLIT("-fshow-import-specs")
opt_ShowPragmaNameErrs		= lookUp  SLIT("-fshow-pragma-name-errs")
opt_SigsRequired		= lookUp  SLIT("-fsignatures-required")
opt_SourceUnchanged		= lookUp  SLIT("-fsource-unchanged")
opt_SpecialiseAll		= lookUp  SLIT("-fspecialise-all")
opt_SpecialiseImports		= lookUp  SLIT("-fspecialise-imports")
opt_SpecialiseOverloaded	= lookUp  SLIT("-fspecialise-overloaded")
opt_SpecialiseTrace		= lookUp  SLIT("-ftrace-specialisation")
opt_SpecialiseUnboxed		= lookUp  SLIT("-fspecialise-unboxed")
opt_StgDoLetNoEscapes		= lookUp  SLIT("-flet-no-escape")
opt_ReturnInRegsThreshold	= lookup_int "-freturn-in-regs-threshold"
opt_SccGroup  			= lookup_str "-G="
opt_Verbose			= lookUp  SLIT("-v")

opt_InterfaceUnfoldThreshold	= lookup_def_int "-funfolding-interface-threshold" iNTERFACE_UNFOLD_THRESHOLD
opt_UnfoldingCreationThreshold	= lookup_def_int "-funfolding-creation-threshold"  uNFOLDING_CREATION_THRESHOLD
opt_UnfoldingUseThreshold	= lookup_def_int "-funfolding-use-threshold"	   uNFOLDING_USE_THRESHOLD
opt_UnfoldingConDiscount	= lookup_def_int "-funfolding-con-discount"	   uNFOLDING_CON_DISCOUNT_WEIGHT
			
opt_LiberateCaseThreshold	= lookup_def_int "-fliberate-case-threshold"	   lIBERATE_CASE_THRESHOLD
opt_WarnNameShadowing		= lookUp  SLIT("-fwarn-name-shadowing")
opt_WarnIncompletePatterns	= not (lookUp  SLIT("-fno-warn-incomplete-patterns"))
opt_WarnUnusedNames		= lookUp  SLIT("-fwarn-unused-names")
opt_PruneTyDecls		= not (lookUp SLIT("-fno-prune-tydecls"))
opt_PruneInstDecls		= not (lookUp SLIT("-fno-prune-instdecls"))
opt_D_show_unused_imports	= lookUp SLIT("-dshow-unused-imports")
opt_D_show_rn_stats		= lookUp SLIT("-dshow-rn-stats")

-- opt_UnfoldingOverrideThreshold	= lookup_int "-funfolding-override-threshold"
\end{code}

\begin{code}
classifyOpts :: ([CoreToDo],	-- Core-to-Core processing spec
		 [StgToDo])	-- STG-to-STG   processing spec

classifyOpts = sep argv [] [] -- accumulators...
  where
    sep :: [FAST_STRING]			 -- cmd-line opts (input)
	-> [CoreToDo] -> [StgToDo]	 -- to_do accumulators
	-> ([CoreToDo], [StgToDo])	 -- result

    sep [] core_td stg_td -- all done!
      = (reverse core_td, reverse stg_td)

#	define CORE_TD(to_do) sep opts (to_do:core_td) stg_td
#	define STG_TD(to_do)  sep opts core_td (to_do:stg_td)
#	define IGNORE_ARG()   sep opts core_td stg_td
<commit_msg>[project @ 1997-06-05 20:58:10 by sof] new option: opt_WarnOverlappedPatterns<commit_after>%
% (c) The AQUA Project, Glasgow University, 1996
%
\section[CmdLineOpts]{Things to do with command-line options}

\begin{code}
#include "HsVersions.h"

module CmdLineOpts (
	CoreToDo(..),
	SimplifierSwitch(..),
	StgToDo(..),
	SwitchResult(..),
	classifyOpts,

	intSwitchSet,
	switchIsOn,

	maybe_CompilingGhcInternals,
	opt_AllDemanded,
	opt_AllStrict,
	opt_AutoSccsOnAllToplevs,
	opt_AutoSccsOnExportedToplevs,
	opt_AutoSccsOnIndividualCafs,
	opt_CompilingGhcInternals,
	opt_D_dump_absC,
	opt_D_dump_asm,
	opt_D_dump_deforest,
	opt_D_dump_deriv,
	opt_D_dump_ds,
	opt_D_dump_flatC,
	opt_D_dump_occur_anal,
	opt_D_dump_rdr,
	opt_D_dump_realC,
	opt_D_dump_rn,
	opt_D_dump_simpl,
	opt_D_dump_simpl_iterations,
	opt_D_dump_spec,
	opt_D_dump_stg,
	opt_D_dump_stranal,
	opt_D_dump_tc,
	opt_D_show_passes,
	opt_D_show_rn_trace,
	opt_D_simplifier_stats,
	opt_D_source_stats,
	opt_D_verbose_core2core,
	opt_D_verbose_stg2stg,
	opt_DoCoreLinting,
	opt_DoStgLinting,
	opt_DoSemiTagging,
	opt_DoEtaReduction,
	opt_DoTickyProfiling,
	opt_EnsureSplittableC,
	opt_FoldrBuildOn,
	opt_FoldrBuildTrace,
	opt_ForConcurrent,
	opt_GlasgowExts,
	opt_GranMacros,
	opt_Haskell_1_3,
	opt_HiMap,
	opt_IgnoreIfacePragmas,
	opt_IgnoreStrictnessPragmas,
	opt_IrrefutableEverything,
	opt_IrrefutableTuples,
	opt_LiberateCaseThreshold,
	opt_NoImplicitPrelude,
	opt_NumbersStrict,
	opt_OmitBlackHoling,
	opt_OmitDefaultInstanceMethods,
	opt_OmitInterfacePragmas,
	opt_PprStyle_All,
	opt_PprStyle_Debug,
	opt_PprStyle_User,
	opt_PprUserLength,
	opt_ProduceC,
	opt_ProduceHi,
	opt_ProduceS,
	opt_ReportWhyUnfoldingsDisallowed,
	opt_ReturnInRegsThreshold,
	opt_SccGroup,
	opt_SccProfilingOn,
	opt_ShowImportSpecs,
	opt_ShowPragmaNameErrs,
	opt_SigsRequired,
	opt_SourceUnchanged,
	opt_SpecialiseAll,
	opt_SpecialiseImports,
	opt_SpecialiseOverloaded,
	opt_SpecialiseTrace,
	opt_SpecialiseUnboxed,
	opt_StgDoLetNoEscapes,

	opt_InterfaceUnfoldThreshold,
	opt_UnfoldingCreationThreshold,
	opt_UnfoldingConDiscount,
	opt_UnfoldingUseThreshold,

	opt_Verbose,
	opt_WarnNameShadowing,
	opt_WarnUnusedNames,
	opt_WarnIncompletePatterns, opt_WarnOverlappedPatterns,
	opt_PruneTyDecls, opt_PruneInstDecls,
	opt_D_show_unused_imports,
	opt_D_show_rn_stats
    ) where

IMPORT_1_3(Array(array, (//)))
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
import PreludeGlaST	-- bad bad bad boy, Will (_Array internals)
#else
import GlaExts
import ArrBase
-- 2.04 and later exports Lift from GlaExts
#if __GLASGOW_HASKELL__ < 204
import PrelBase (Lift(..))
#endif
#endif
import Argv

CHK_Ubiq() -- debugging consistency check

import Constants	-- Default values for some flags

import Maybes		( assocMaybe, firstJust, maybeToBool )
import Util		( startsWith, panic, panic#, assertPanic )
\end{code}

A command-line {\em switch} is (generally) either on or off; e.g., the
``verbose'' (-v) switch is either on or off.  (The \tr{-G<group>}
switch is an exception; it's set to a string, or nothing.)

A list of {\em ToDo}s is things to be done in a particular part of
processing.  A (fictitious) example for the Core-to-Core simplifier
might be: run the simplifier, then run the strictness analyser, then
run the simplifier again (three ``todos'').

There are three ``to-do processing centers'' at the moment.  In the
main loop (\tr{main/Main.lhs}), in the Core-to-Core processing loop
(\tr{simplCore/SimplCore.lhs), and in the STG-to-STG processing loop
(\tr{simplStg/SimplStg.lhs}).

%************************************************************************
%*									*
\subsection{Datatypes associated with command-line options}
%*									*
%************************************************************************

\begin{code}
data SwitchResult
  = SwBool	Bool		-- on/off
  | SwString	FAST_STRING	-- nothing or a String
  | SwInt	Int		-- nothing or an Int
\end{code}

\begin{code}
data CoreToDo		-- These are diff core-to-core passes,
			-- which may be invoked in any order,
  			-- as many times as you like.

  = CoreDoSimplify	-- The core-to-core simplifier.
	(SimplifierSwitch -> SwitchResult)
			-- Each run of the simplifier can take a different
			-- set of simplifier-specific flags.
  | CoreDoCalcInlinings1
  | CoreDoCalcInlinings2
  | CoreDoFloatInwards
  | CoreDoFullLaziness
  | CoreLiberateCase
  | CoreDoPrintCore
  | CoreDoStaticArgs
  | CoreDoStrictness
  | CoreDoSpecialising
  | CoreDoDeforest
  | CoreDoFoldrBuildWorkerWrapper
  | CoreDoFoldrBuildWWAnal
\end{code}

\begin{code}
data StgToDo
  = StgDoStaticArgs
  | StgDoUpdateAnalysis
  | StgDoLambdaLift
  | StgDoMassageForProfiling  -- should be (next to) last
  -- There's also setStgVarInfo, but its absolute "lastness"
  -- is so critical that it is hardwired in (no flag).
  | D_stg_stats
\end{code}

\begin{code}
data SimplifierSwitch
  = SimplOkToDupCode
  | SimplFloatLetsExposingWHNF
  | SimplOkToFloatPrimOps
  | SimplAlwaysFloatLetsFromLets
  | SimplDoCaseElim
  | SimplReuseCon
  | SimplCaseOfCase
  | SimplLetToCase
  | SimplMayDeleteConjurableIds
  | SimplPedanticBottoms -- see Simplifier for an explanation
  | SimplDoArityExpand	 -- expand arity of bindings
  | SimplDoFoldrBuild	 -- This is the per-simplification flag;
			 -- see also FoldrBuildOn, used elsewhere
			 -- in the compiler.
  | SimplDoInlineFoldrBuild
			 -- inline foldr/build (*after* f/b rule is used)

  | IgnoreINLINEPragma
  | SimplDoLambdaEtaExpansion

  | EssentialUnfoldingsOnly -- never mind the thresholds, only
			    -- do unfoldings that *must* be done
			    -- (to saturate constructors and primitives)

  | ShowSimplifierProgress  -- report counts on every interation

  | MaxSimplifierIterations Int

  | KeepSpecPragmaIds	    -- We normally *toss* Ids we can do without
  | KeepUnusedBindings

  | SimplNoLetFromCase	    -- used when turning off floating entirely
  | SimplNoLetFromApp	    -- (for experimentation only) WDP 95/10
  | SimplNoLetFromStrictLet

  | SimplDontFoldBackAppend
		 	-- we fold `foldr (:)' back into flip (++),
			-- but we *don't* want to do it when compiling
			-- List.hs, otherwise
			-- xs ++ ys = foldr (:) ys xs
			-- {- via our loopback -}
			-- xs ++ ys = xs ++ ys
			-- Oops!
			-- So only use this flag inside List.hs
			-- (Sigh, what a HACK, Andy.  WDP 96/01)

  | SimplCaseMerge
  | SimplCaseScrutinee	-- This flag tells that the expression being simplified is
			-- the scrutinee of a case expression, so we should
			-- apply the scrutinee discount when considering inlinings.
			-- See SimplVar.lhs
\end{code}

%************************************************************************
%*									*
\subsection{Classifying command-line options}
%*									*
%************************************************************************

\begin{code}
lookUp	       :: FAST_STRING -> Bool
lookup_int     :: String -> Maybe Int
lookup_def_int :: String -> Int -> Int
lookup_str     :: String -> Maybe String

lookUp     sw = maybeToBool (assoc_opts sw)
	
lookup_str sw = firstJust (map (startsWith sw) unpacked_opts)

lookup_int sw = case (lookup_str sw) of
		  Nothing -> Nothing
		  Just xx -> Just (read xx)

lookup_def_int sw def = case (lookup_str sw) of
			    Nothing -> def		-- Use default
		  	    Just xx -> read xx

assoc_opts    = assocMaybe [ (a, True) | a <- argv ]
unpacked_opts = map _UNPK_ argv
\end{code}

\begin{code}
opt_AllDemanded			= lookUp  SLIT("-fall-demanded")
opt_AllStrict			= lookUp  SLIT("-fall-strict")
opt_AutoSccsOnAllToplevs	= lookUp  SLIT("-fauto-sccs-on-all-toplevs")
opt_AutoSccsOnExportedToplevs	= lookUp  SLIT("-fauto-sccs-on-exported-toplevs")
opt_AutoSccsOnIndividualCafs	= lookUp  SLIT("-fauto-sccs-on-individual-cafs")
opt_CompilingGhcInternals	= maybeToBool maybe_CompilingGhcInternals
maybe_CompilingGhcInternals	= lookup_str "-fcompiling-ghc-internals="
opt_D_dump_absC			= lookUp  SLIT("-ddump-absC")
opt_D_dump_asm			= lookUp  SLIT("-ddump-asm")
opt_D_dump_deforest		= lookUp  SLIT("-ddump-deforest")
opt_D_dump_deriv		= lookUp  SLIT("-ddump-deriv")
opt_D_dump_ds			= lookUp  SLIT("-ddump-ds")
opt_D_dump_flatC		= lookUp  SLIT("-ddump-flatC")
opt_D_dump_occur_anal		= lookUp  SLIT("-ddump-occur-anal")
opt_D_dump_rdr			= lookUp  SLIT("-ddump-rdr")
opt_D_dump_realC		= lookUp  SLIT("-ddump-realC")
opt_D_dump_rn			= lookUp  SLIT("-ddump-rn")
opt_D_dump_simpl		= lookUp  SLIT("-ddump-simpl")
opt_D_dump_simpl_iterations	= lookUp  SLIT("-ddump-simpl-iterations")
opt_D_dump_spec			= lookUp  SLIT("-ddump-spec")
opt_D_dump_stg			= lookUp  SLIT("-ddump-stg")
opt_D_dump_stranal		= lookUp  SLIT("-ddump-stranal")
opt_D_dump_tc			= lookUp  SLIT("-ddump-tc")
opt_D_show_passes		= lookUp  SLIT("-dshow-passes")
opt_D_show_rn_trace		= lookUp  SLIT("-dshow-rn-trace")
opt_D_simplifier_stats		= lookUp  SLIT("-dsimplifier-stats")
opt_D_source_stats		= lookUp  SLIT("-dsource-stats")
opt_D_verbose_core2core		= lookUp  SLIT("-dverbose-simpl")
opt_D_verbose_stg2stg		= lookUp  SLIT("-dverbose-stg")
opt_DoCoreLinting		= lookUp  SLIT("-dcore-lint")
opt_DoStgLinting		= lookUp  SLIT("-dstg-lint")
opt_DoSemiTagging		= lookUp  SLIT("-fsemi-tagging")
opt_DoTickyProfiling		= lookUp  SLIT("-fticky-ticky")
opt_DoEtaReduction		= lookUp  SLIT("-fdo-eta-reduction")
opt_EnsureSplittableC		= lookUp  SLIT("-fglobalise-toplev-names")
opt_FoldrBuildOn		= lookUp  SLIT("-ffoldr-build-on")
opt_FoldrBuildTrace		= lookUp  SLIT("-ffoldr-build-trace")
opt_ForConcurrent		= lookUp  SLIT("-fconcurrent")
opt_GranMacros			= lookUp  SLIT("-fgransim")
opt_GlasgowExts			= lookUp  SLIT("-fglasgow-exts")
opt_Haskell_1_3			= lookUp  SLIT("-fhaskell-1.3")
opt_HiMap 			= lookup_str "-himap="  -- file saying where to look for .hi files
opt_IgnoreIfacePragmas		= lookUp  SLIT("-fignore-interface-pragmas")
opt_IgnoreStrictnessPragmas	= lookUp  SLIT("-fignore-strictness-pragmas")
opt_IrrefutableEverything	= lookUp  SLIT("-firrefutable-everything")
opt_IrrefutableTuples		= lookUp  SLIT("-firrefutable-tuples")
opt_NoImplicitPrelude		= lookUp  SLIT("-fno-implicit-prelude")
opt_NumbersStrict		= lookUp  SLIT("-fnumbers-strict")
opt_OmitBlackHoling		= lookUp  SLIT("-dno-black-holing")
opt_OmitDefaultInstanceMethods	= lookUp  SLIT("-fomit-default-instance-methods")
opt_OmitInterfacePragmas	= lookUp  SLIT("-fomit-interface-pragmas")
opt_PprStyle_All		= lookUp  SLIT("-dppr-all")
opt_PprStyle_Debug		= lookUp  SLIT("-dppr-debug")
opt_PprStyle_User		= lookUp  SLIT("-dppr-user")
opt_PprUserLength	        = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
opt_ProduceC  			= lookup_str "-C="
opt_ProduceS  			= lookup_str "-S="
opt_ProduceHi 			= lookup_str "-hifile=" -- the one to produce this time 
opt_ReportWhyUnfoldingsDisallowed= lookUp SLIT("-freport-disallowed-unfoldings")
opt_SccProfilingOn		= lookUp  SLIT("-fscc-profiling")
opt_ShowImportSpecs		= lookUp  SLIT("-fshow-import-specs")
opt_ShowPragmaNameErrs		= lookUp  SLIT("-fshow-pragma-name-errs")
opt_SigsRequired		= lookUp  SLIT("-fsignatures-required")
opt_SourceUnchanged		= lookUp  SLIT("-fsource-unchanged")
opt_SpecialiseAll		= lookUp  SLIT("-fspecialise-all")
opt_SpecialiseImports		= lookUp  SLIT("-fspecialise-imports")
opt_SpecialiseOverloaded	= lookUp  SLIT("-fspecialise-overloaded")
opt_SpecialiseTrace		= lookUp  SLIT("-ftrace-specialisation")
opt_SpecialiseUnboxed		= lookUp  SLIT("-fspecialise-unboxed")
opt_StgDoLetNoEscapes		= lookUp  SLIT("-flet-no-escape")
opt_ReturnInRegsThreshold	= lookup_int "-freturn-in-regs-threshold"
opt_SccGroup  			= lookup_str "-G="
opt_Verbose			= lookUp  SLIT("-v")

opt_InterfaceUnfoldThreshold	= lookup_def_int "-funfolding-interface-threshold" iNTERFACE_UNFOLD_THRESHOLD
opt_UnfoldingCreationThreshold	= lookup_def_int "-funfolding-creation-threshold"  uNFOLDING_CREATION_THRESHOLD
opt_UnfoldingUseThreshold	= lookup_def_int "-funfolding-use-threshold"	   uNFOLDING_USE_THRESHOLD
opt_UnfoldingConDiscount	= lookup_def_int "-funfolding-con-discount"	   uNFOLDING_CON_DISCOUNT_WEIGHT
			
opt_LiberateCaseThreshold	= lookup_def_int "-fliberate-case-threshold"	   lIBERATE_CASE_THRESHOLD
opt_WarnNameShadowing		= lookUp  SLIT("-fwarn-name-shadowing")
opt_WarnIncompletePatterns	= not (lookUp  SLIT("-fno-warn-incomplete-patterns"))
opt_WarnOverlappedPatterns	= not (lookUp  SLIT("-fno-warn-overlapped-patterns"))
opt_WarnUnusedNames		= lookUp  SLIT("-fwarn-unused-names")
opt_PruneTyDecls		= not (lookUp SLIT("-fno-prune-tydecls"))
opt_PruneInstDecls		= not (lookUp SLIT("-fno-prune-instdecls"))
opt_D_show_unused_imports	= lookUp SLIT("-dshow-unused-imports")
opt_D_show_rn_stats		= lookUp SLIT("-dshow-rn-stats")

-- opt_UnfoldingOverrideThreshold	= lookup_int "-funfolding-override-threshold"
\end{code}

\begin{code}
classifyOpts :: ([CoreToDo],	-- Core-to-Core processing spec
		 [StgToDo])	-- STG-to-STG   processing spec

classifyOpts = sep argv [] [] -- accumulators...
  where
    sep :: [FAST_STRING]			 -- cmd-line opts (input)
	-> [CoreToDo] -> [StgToDo]	 -- to_do accumulators
	-> ([CoreToDo], [StgToDo])	 -- result

    sep [] core_td stg_td -- all done!
      = (reverse core_td, reverse stg_td)

#	define CORE_TD(to_do) sep opts (to_do:core_td) stg_td
#	define STG_TD(to_do)  sep opts core_td (to_do:stg_td)
#	define IGNORE_ARG()   sep opts core_td stg_td

{'fraction_non_alphanumeric': 0.12131781476286159, 'fraction_numerical': 0.003260416271751905, 'mean_word_length': 4.769466316710411, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 31, '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': '7465967', 'n_tokens_mistral': 10602, 'n_tokens_neox': 10264, 'n_words': 1936}