<commit_before>-----------------------------------------------------------------------------
--
-- Static flags
--
-- Static flags can only be set once, on the command-line.  Inside GHC,
-- each static flag corresponds to a top-level value, usually of type Bool.
--
-- (c) The University of Glasgow 2005
--
-----------------------------------------------------------------------------

module StaticFlags (
	parseStaticFlags,
	staticFlags,

	-- Ways
	WayName(..), v_Ways, v_Build_tag, v_RTS_Build_tag,

	-- Output style options
	opt_PprUserLength,
	opt_PprStyle_Debug,

	-- profiling opts
	opt_AutoSccsOnAllToplevs,
	opt_AutoSccsOnExportedToplevs,
	opt_AutoSccsOnIndividualCafs,
	opt_SccProfilingOn,
	opt_DoTickyProfiling,

	-- language opts
	opt_DictsStrict,
	opt_IrrefutableTuples,
	opt_Parallel,
	opt_RuntimeTypes,
	opt_Flatten,

	-- optimisation opts
	opt_NoMethodSharing, 
	opt_NoStateHack,
	opt_LiberateCaseThreshold,
	opt_CprOff,
	opt_RulesOff,
	opt_SimplNoPreInlining,
	opt_SimplExcessPrecision,
	opt_MaxWorkerArgs,

	-- Unfolding control
	opt_UF_CreationThreshold,
	opt_UF_UseThreshold,
	opt_UF_FunAppDiscount,
	opt_UF_KeenessFactor,
	opt_UF_UpdateInPlace,
	opt_UF_DearOp,

	-- misc opts
	opt_IgnoreDotGhci,
	opt_ErrorSpans,
	opt_GranMacros,
	opt_HiVersion,
	opt_HistorySize,
	opt_OmitBlackHoling,
	opt_Static,
	opt_Unregisterised,
	opt_EmitExternalCore,
	opt_PIC,
	v_Ld_inputs,
	tablesNextToCode
  ) where

#include "HsVersions.h"

import CmdLineParser
import Config
import FastString	( FastString, mkFastString )
import Util
import Maybes		( firstJust )
import Panic		( GhcException(..), ghcError )

import Control.Exception ( throwDyn )
import Data.IORef
import System.IO.Unsafe	( unsafePerformIO )
import Control.Monad	( when )
import Data.Char	( isDigit )
import Data.List	( sort, intersperse, nub )

-----------------------------------------------------------------------------
-- Static flags

parseStaticFlags :: [String] -> IO [String]
parseStaticFlags args = do
  (leftover, errs) <- processArgs static_flags args
  when (not (null errs)) $ throwDyn (UsageError (unlines errs))

    -- deal with the way flags: the way (eg. prof) gives rise to
    -- futher flags, some of which might be static.
  way_flags <- findBuildTag

    -- if we're unregisterised, add some more flags
  let unreg_flags | cGhcUnregisterised == "YES" = unregFlags
		  | otherwise = []

    -- TABLES_NEXT_TO_CODE affects the info table layout.
  let cg_flags | tablesNextToCode = ["-optc-DTABLES_NEXT_TO_CODE"]
	       | otherwise	  = []

  (more_leftover, errs) <- processArgs static_flags 
				(unreg_flags ++ cg_flags ++ way_flags)
  when (not (null errs)) $ ghcError (UsageError (unlines errs))
  return (more_leftover++leftover)


-- note that ordering is important in the following list: any flag which
-- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
-- flags further down the list with the same prefix.

static_flags :: [(String, OptKind IO)]
static_flags = [
	------- GHCi -------------------------------------------------------
     ( "ignore-dot-ghci", PassFlag addOpt )
  ,  ( "read-dot-ghci"  , NoArg (removeOpt "-ignore-dot-ghci") )

	------- ways --------------------------------------------------------
  ,  ( "prof"		, NoArg (addWay WayProf) )
  ,  ( "unreg"		, NoArg (addWay WayUnreg) )
  ,  ( "ticky"		, NoArg (addWay WayTicky) )
  ,  ( "parallel"	, NoArg (addWay WayPar) )
  ,  ( "gransim"	, NoArg (addWay WayGran) )
  ,  ( "smp"		, NoArg (addWay WayThreaded) ) -- backwards compat.
  ,  ( "debug"		, NoArg (addWay WayDebug) )
  ,  ( "ndp"		, NoArg (addWay WayNDP) )
  ,  ( "threaded"	, NoArg (addWay WayThreaded) )
 	-- ToDo: user ways
<commit_msg>wibble in parseStaticFlags should fix profiling and unreg in HEAD<commit_after>-----------------------------------------------------------------------------
--
-- Static flags
--
-- Static flags can only be set once, on the command-line.  Inside GHC,
-- each static flag corresponds to a top-level value, usually of type Bool.
--
-- (c) The University of Glasgow 2005
--
-----------------------------------------------------------------------------

module StaticFlags (
	parseStaticFlags,
	staticFlags,

	-- Ways
	WayName(..), v_Ways, v_Build_tag, v_RTS_Build_tag,

	-- Output style options
	opt_PprUserLength,
	opt_PprStyle_Debug,

	-- profiling opts
	opt_AutoSccsOnAllToplevs,
	opt_AutoSccsOnExportedToplevs,
	opt_AutoSccsOnIndividualCafs,
	opt_SccProfilingOn,
	opt_DoTickyProfiling,

	-- language opts
	opt_DictsStrict,
	opt_IrrefutableTuples,
	opt_Parallel,
	opt_RuntimeTypes,
	opt_Flatten,

	-- optimisation opts
	opt_NoMethodSharing, 
	opt_NoStateHack,
	opt_LiberateCaseThreshold,
	opt_CprOff,
	opt_RulesOff,
	opt_SimplNoPreInlining,
	opt_SimplExcessPrecision,
	opt_MaxWorkerArgs,

	-- Unfolding control
	opt_UF_CreationThreshold,
	opt_UF_UseThreshold,
	opt_UF_FunAppDiscount,
	opt_UF_KeenessFactor,
	opt_UF_UpdateInPlace,
	opt_UF_DearOp,

	-- misc opts
	opt_IgnoreDotGhci,
	opt_ErrorSpans,
	opt_GranMacros,
	opt_HiVersion,
	opt_HistorySize,
	opt_OmitBlackHoling,
	opt_Static,
	opt_Unregisterised,
	opt_EmitExternalCore,
	opt_PIC,
	v_Ld_inputs,
	tablesNextToCode
  ) where

#include "HsVersions.h"

import CmdLineParser
import Config
import FastString	( FastString, mkFastString )
import Util
import Maybes		( firstJust )
import Panic		( GhcException(..), ghcError )

import Control.Exception ( throwDyn )
import Data.IORef
import System.IO.Unsafe	( unsafePerformIO )
import Control.Monad	( when )
import Data.Char	( isDigit )
import Data.List	( sort, intersperse, nub )

-----------------------------------------------------------------------------
-- Static flags

parseStaticFlags :: [String] -> IO [String]
parseStaticFlags args = do
  (leftover, errs) <- processArgs static_flags args
  when (not (null errs)) $ throwDyn (UsageError (unlines errs))

    -- deal with the way flags: the way (eg. prof) gives rise to
    -- futher flags, some of which might be static.
  way_flags <- findBuildTag

    -- if we're unregisterised, add some more flags
  let unreg_flags | cGhcUnregisterised == "YES" = unregFlags
		  | otherwise = []

  (more_leftover, errs) <- processArgs static_flags (unreg_flags ++ way_flags)

    -- TABLES_NEXT_TO_CODE affects the info table layout.
    -- Be careful to do this *after* all processArgs,
    -- because evaluating tablesNextToCode involves looking at the global
    -- static flags.  Those pesky global variables...
  let cg_flags | tablesNextToCode = ["-optc-DTABLES_NEXT_TO_CODE"]
	       | otherwise	  = []

  when (not (null errs)) $ ghcError (UsageError (unlines errs))
  return (cg_flags++more_leftover++leftover)


-- note that ordering is important in the following list: any flag which
-- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
-- flags further down the list with the same prefix.

static_flags :: [(String, OptKind IO)]
static_flags = [
	------- GHCi -------------------------------------------------------
     ( "ignore-dot-ghci", PassFlag addOpt )
  ,  ( "read-dot-ghci"  , NoArg (removeOpt "-ignore-dot-ghci") )

	------- ways --------------------------------------------------------
  ,  ( "prof"		, NoArg (addWay WayProf) )
  ,  ( "unreg"		, NoArg (addWay WayUnreg) )
  ,  ( "ticky"		, NoArg (addWay WayTicky) )
  ,  ( "parallel"	, NoArg (addWay WayPar) )
  ,  ( "gransim"	, NoArg (addWay WayGran) )
  ,  ( "smp"		, NoArg (addWay WayThreaded) ) -- backwards compat.
  ,  ( "debug"		, NoArg (addWay WayDebug) )
  ,  ( "ndp"		, NoArg (addWay WayNDP) )
  ,  ( "threaded"	, NoArg (addWay WayThreaded) )
 	-- ToDo: user ways

{'fraction_non_alphanumeric': 0.18462549277266754, 'fraction_numerical': 0.0010512483574244415, 'mean_word_length': 2.593484419263456, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 5, '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': '7631447', 'n_tokens_mistral': 2694, 'n_tokens_neox': 2554, 'n_words': 638}