Commit 89a8960b authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Improve command-line parser (add OptIntSuffix); make -fliberate-case-threshold dynamic

parent 5226794f
......@@ -28,6 +28,7 @@ data OptKind m -- Suppose the flag is -f
| Prefix (String -> m ()) -- -farg
| OptPrefix (String -> m ()) -- -f or -farg (i.e. the arg is optional)
| OptIntSuffix (Maybe Int -> m ()) -- -f or -f=n; pass n to fn
| IntSuffix (Int -> m ()) -- -f or -f=n; pass n to fn
| PassFlag (String -> m ()) -- -f; pass "-f" fn
| AnySuffix (String -> m ()) -- -f or -farg; pass entire "-farg" to fn
| PrefixPred (String -> Bool) (String -> m ())
......@@ -82,15 +83,18 @@ processOneArg action rest arg args
PassFlag f | notNull rest -> unknownFlagErr dash_arg
| otherwise -> Right (f dash_arg, args)
OptIntSuffix f | Just n <- parseInt rest -> Right (f n, args)
OptIntSuffix f | null rest -> Right (f Nothing, args)
| Just n <- parseInt rest -> Right (f (Just n), args)
| otherwise -> Left ("malformed integer argument in " ++ dash_arg)
IntSuffix f | Just n <- parseInt rest -> Right (f n, args)
| otherwise -> Left ("malformed integer argument in " ++ dash_arg)
OptPrefix f -> Right (f rest, args)
AnySuffix f -> Right (f dash_arg, args)
AnySuffixPred p f -> Right (f dash_arg, args)
findArg :: [(String,OptKind a)] -> String -> Maybe (String,OptKind a)
findArg spec arg
= case [ (removeSpaces rest, k)
......@@ -107,21 +111,19 @@ arg_ok (SepArg _) rest arg = null rest
arg_ok (Prefix _) rest arg = notNull rest
arg_ok (PrefixPred p _) rest arg = notNull rest && p rest
arg_ok (OptIntSuffix _) rest arg = True
arg_ok (IntSuffix _) rest arg = True
arg_ok (OptPrefix _) rest arg = True
arg_ok (PassFlag _) rest arg = null rest
arg_ok (AnySuffix _) rest arg = True
arg_ok (AnySuffixPred p _) rest arg = p arg
parseInt :: String -> Maybe (Maybe Int)
parseInt :: String -> Maybe Int
-- Looks for "433" or "=342", with no trailing gubbins
-- empty string => Just Nothing
-- n or =n => Just (Just n)
-- n or =n => Just n
-- gibberish => Nothing
parseInt s
| null s = Just Nothing
| otherwise = case reads (dropEq s) of
((n,""):_) -> Just (Just n)
other -> Nothing
parseInt s = case reads (dropEq s) of
((n,""):_) -> Just n
other -> Nothing
dropEq :: String -> String
-- Discards a leading equals sign
......
......@@ -81,7 +81,7 @@ import Data.List ( isPrefixOf )
import Util ( split )
#endif
import Data.Char ( isDigit, isUpper )
import Data.Char ( isUpper )
import System.IO ( hPutStrLn, stderr )
#ifdef GHCI
......@@ -229,6 +229,8 @@ data DynFlags = DynFlags {
optLevel :: Int, -- optimisation level
maxSimplIterations :: Int, -- max simplifier iterations
ruleCheck :: Maybe String,
libCaseThreshold :: Int, -- Threshold for liberate-case
stolen_x86_regs :: Int,
cmdlineHcIncludes :: [String], -- -#includes
importPaths :: [FilePath],
......@@ -383,6 +385,7 @@ defaultDynFlags =
optLevel = 0,
maxSimplIterations = 4,
ruleCheck = Nothing,
libCaseThreshold = 20,
stolen_x86_regs = 4,
cmdlineHcIncludes = [],
importPaths = ["."],
......@@ -832,6 +835,7 @@ dynamic_flags = [
, ( "F" , NoArg (setDynFlag Opt_Pp))
, ( "#include" , HasArg (addCmdlineHCInclude) )
, ( "v" , OptIntSuffix setVerbosity )
------- Specific phases --------------------------------------------
, ( "pgmL" , HasArg (upd . setPgmL) )
, ( "pgmP" , HasArg (upd . setPgmP) )
......@@ -980,18 +984,16 @@ dynamic_flags = [
, ( "w" , NoArg (mapM_ unSetDynFlag minusWallOpts) )
------ Optimisation flags ------------------------------------------
, ( "O" , NoArg (upd (setOptLevel 1)))
, ( "Onot" , NoArg (upd (setOptLevel 0)))
, ( "O" , PrefixPred (all isDigit)
(\f -> upd (setOptLevel (read f))))
, ( "fmax-simplifier-iterations",
PrefixPred (all isDigit)
(\n -> upd (\dfs ->
dfs{ maxSimplIterations = read n })) )
, ( "O" , NoArg (upd (setOptLevel 1)))
, ( "Onot" , NoArg (upd (setOptLevel 0)))
, ( "O" , OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1))))
-- If the number is missing, use 1
, ( "frule-check",
SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
, ( "fmax-simplifier-iterations", IntSuffix (\n ->
upd (\dfs -> dfs{ maxSimplIterations = n })) )
, ( "fliberate-case-threshold", IntSuffix (\n -> upd (\dfs -> dfs{ libCaseThreshold = n })))
, ( "frule-check", SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
, ( "fcontext-stack" , IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
------ Compiler flags -----------------------------------------------
......@@ -1003,8 +1005,6 @@ dynamic_flags = [
, ( "fglasgow-exts", NoArg (mapM_ setDynFlag glasgowExtsFlags) )
, ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) )
, ( "fcontext-stack" , OptIntSuffix $ \mb_n -> upd $ \dfs ->
dfs{ ctxtStkDepth = mb_n `orElse` 3 })
-- the rest of the -f* and -fno-* flags
, ( "fno-", PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )
......
......@@ -41,7 +41,6 @@ module StaticFlags (
-- optimisation opts
opt_NoMethodSharing,
opt_NoStateHack,
opt_LiberateCaseThreshold,
opt_CprOff,
opt_RulesOff,
opt_SimplNoPreInlining,
......@@ -292,7 +291,6 @@ opt_NoMethodSharing = lookUp FSLIT("-fno-method-sharing")
opt_CprOff = lookUp FSLIT("-fcpr-off")
opt_RulesOff = lookUp FSLIT("-frules-off")
-- Switch off CPR analysis in the new demand analyser
opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" (10::Int)
opt_MaxWorkerArgs = lookup_def_int "-fmax-worker-args" (10::Int)
opt_GranMacros = lookUp FSLIT("-fgransim")
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment