Improve command-line parser (add OptIntSuffix); make -fliberate-case-threshold dynamic
[ghc-hetmet.git] / compiler / main / DynFlags.hs
index e4b82c8..d0fce4a 100644 (file)
@@ -39,13 +39,14 @@ module DynFlags (
        getVerbFlag,
        updOptLevel,
        setTmpDir,
+       setPackageName,
        
        -- parsing DynFlags
        parseDynamicFlags,
         allFlags,
 
        -- misc stuff
-       machdepCCOpts, picCCOpts,
+       machdepCCOpts, picCCOpts
   ) where
 
 #include "HsVersions.h"
@@ -68,21 +69,25 @@ import UniqFM           ( UniqFM )
 import Util            ( notNull, splitLongestPrefix, normalisePath )
 import Maybes          ( fromJust, orElse )
 import SrcLoc           ( SrcSpan )
+import Outputable
+import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 
-import DATA_IOREF      ( readIORef )
-import EXCEPTION       ( throwDyn )
-import Monad           ( when )
+import Data.IORef      ( readIORef )
+import Control.Exception ( throwDyn )
+import Control.Monad   ( when )
 #ifdef mingw32_TARGET_OS
 import Data.List       ( isPrefixOf )
 #else
 import Util            ( split )
 #endif
 
-import Char            ( isDigit, isUpper )
-import Outputable
+import Data.Char       ( isUpper )
 import System.IO        ( hPutStrLn, stderr )
-import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 
+#ifdef GHCI
+import Breakpoints      ( BkptHandler )
+import Module           ( ModuleName )
+#endif
 -- -----------------------------------------------------------------------------
 -- DynFlags
 
@@ -120,6 +125,7 @@ data DynFlag
    | Opt_D_dump_splices
    | Opt_D_dump_BCOs
    | Opt_D_dump_vect
+   | Opt_D_dump_hpc
    | Opt_D_source_stats
    | Opt_D_verbose_core2core
    | Opt_D_verbose_stg2stg
@@ -195,7 +201,12 @@ data DynFlag
    | Opt_SplitObjs
    | Opt_StgStats
    | Opt_HideAllPackages
+#if defined(GHCI) && defined(DEBUGGER)
+   | Opt_Debugging
+#endif
    | Opt_PrintBindResult
+   | Opt_Haddock
+   | Opt_Hpc_No_Auto
 
    -- keeping stuff
    | Opt_KeepHiDiffs
@@ -218,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],
@@ -253,6 +266,8 @@ data DynFlags = DynFlags {
   ghcUsagePath          :: FilePath,    -- Filled in by SysTools
   ghciUsagePath         :: FilePath,    -- ditto
 
+  hpcDir               :: String,      -- ^ path to store the .mix files
+
   -- options for particular phases
   opt_L                        :: [String],
   opt_P                        :: [String],
@@ -298,13 +313,17 @@ data DynFlags = DynFlags {
   
   -- message output
   log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO ()
+
+#ifdef GHCI
+  -- breakpoint handling
+ ,bkptHandler           :: Maybe (BkptHandler Module)
+#endif
  }
 
 data HscTarget
   = HscC
   | HscAsm
   | HscJava
-  | HscILX
   | HscInterpreted
   | HscNothing
   deriving (Eq, Show)
@@ -366,6 +385,7 @@ defaultDynFlags =
        optLevel                = 0,
        maxSimplIterations      = 4,
        ruleCheck               = Nothing,
+       libCaseThreshold        = 20,
        stolen_x86_regs         = 4,
        cmdlineHcIncludes       = [],
        importPaths             = ["."],
@@ -391,6 +411,8 @@ defaultDynFlags =
        cmdlineFrameworks       = [],
        tmpDir                  = cDEFAULT_TMPDIR,
        
+        hpcDir                 = ".hpc",
+
        opt_L                   = [],
        opt_P                   = [],
        opt_F                   = [],
@@ -405,7 +427,9 @@ defaultDynFlags =
        packageFlags            = [],
         pkgDatabase             = Nothing,
         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
-       
+#ifdef GHCI
+        bkptHandler             = Nothing,
+#endif
        flags = [ 
            Opt_ReadUserPackageConf,
     
@@ -532,9 +556,7 @@ data Option
 updOptLevel :: Int -> DynFlags -> DynFlags
 -- Set dynflags appropriate to the optimisation level
 updOptLevel n dfs
-  = if (n >= 1)
-     then dfs2{ hscTarget = HscC, optLevel = n } -- turn on -fvia-C with -O
-     else dfs2{ optLevel = n }
+  = dfs2{ optLevel = n }
   where
    dfs1 = foldr (flip dopt_unset) dfs  remove_dopts
    dfs2 = foldr (flip dopt_set)   dfs1 extra_dopts
@@ -874,6 +896,8 @@ dynamic_flags = [
        ------- Miscellaneous ----------------------------------------------
   ,  ( "no-hs-main"     , NoArg (setDynFlag Opt_NoHsMain))
   ,  ( "main-is"       , SepArg setMainIs )
+  ,  ( "haddock"       , NoArg (setDynFlag Opt_Haddock) )
+  ,  ( "hpcdir"                , SepArg setOptHpcDir )
 
        ------- recompilation checker (DEPRECATED, use -fforce-recomp) -----
   ,  ( "recomp"                , NoArg (unSetDynFlag Opt_ForceRecomp) )
@@ -882,7 +906,7 @@ dynamic_flags = [
         ------- Packages ----------------------------------------------------
   ,  ( "package-conf"   , HasArg extraPkgConf_ )
   ,  ( "no-user-package-conf", NoArg (unSetDynFlag Opt_ReadUserPackageConf) )
-  ,  ( "package-name"   , HasArg setPackageName )
+  ,  ( "package-name"   , HasArg (upd . setPackageName) )
   ,  ( "package"        , HasArg exposePackage )
   ,  ( "hide-package"   , HasArg hidePackage )
   ,  ( "hide-all-packages", NoArg (setDynFlag Opt_HideAllPackages) )
@@ -937,6 +961,8 @@ dynamic_flags = [
   ,  ( "ddump-hi",               setDumpFlag Opt_D_dump_hi)
   ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports))
   ,  ( "ddump-vect",            setDumpFlag Opt_D_dump_vect)
+  ,  ( "ddump-hpc",             setDumpFlag Opt_D_dump_hpc)
+  
   ,  ( "dcore-lint",            NoArg (setDynFlag Opt_DoCoreLinting))
   ,  ( "dstg-lint",             NoArg (setDynFlag Opt_DoStgLinting))
   ,  ( "dcmm-lint",             NoArg (setDynFlag Opt_DoCmmLinting))
@@ -958,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))))
+  ,  ( "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
 
-  ,  ( "fmax-simplifier-iterations", 
-               PrefixPred (all isDigit) 
-                 (\n -> upd (\dfs -> 
-                       dfs{ maxSimplIterations = read n })) )
-
-  ,  ( "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 -----------------------------------------------
 
@@ -977,13 +1001,10 @@ dynamic_flags = [
   ,  ( "fasm",         AnySuffix (\_ -> setTarget HscAsm) )
   ,  ( "fvia-c",       NoArg (setTarget HscC) )
   ,  ( "fvia-C",       NoArg (setTarget HscC) )
-  ,  ( "filx",         NoArg (setTarget HscILX) )
 
   ,  ( "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)) )
@@ -1041,7 +1062,11 @@ fFlags = [
   ( "excess-precision",                        Opt_ExcessPrecision ),
   ( "asm-mangling",                    Opt_DoAsmMangling ),
   ( "print-bind-result",               Opt_PrintBindResult ),
-  ( "force-recomp",                    Opt_ForceRecomp )
+#if defined(GHCI) && defined(DEBUGGER)
+  ( "debugging",                        Opt_Debugging),
+#endif
+  ( "force-recomp",                    Opt_ForceRecomp ),
+  ( "hpc-no-auto",                     Opt_Hpc_No_Auto )
   ]
 
 
@@ -1097,20 +1122,20 @@ hidePackage p =
   upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
 ignorePackage p = 
   upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
+
 setPackageName p
   | Nothing <- unpackPackageId pid
   = throwDyn (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
   | otherwise
-  = upd (\s -> s{ thisPackage = pid })
+  = \s -> s{ thisPackage = pid }
   where
         pid = stringToPackageId p
 
--- we can only switch between HscC, HscAsmm, and HscILX with dynamic flags 
+-- we can only switch between HscC, and HscAsmm with dynamic flags 
 -- (-fvia-C, -fasm, -filx respectively).
 setTarget l = upd (\dfs -> case hscTarget dfs of
                                        HscC   -> dfs{ hscTarget = l }
                                        HscAsm -> dfs{ hscTarget = l }
-                                       HscILX -> dfs{ hscTarget = l }
                                        _      -> dfs)
 
 setOptLevel :: Int -> DynFlags -> DynFlags
@@ -1244,6 +1269,12 @@ setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir }
 #endif
 
 -----------------------------------------------------------------------------
+-- Hpc stuff
+
+setOptHpcDir :: String -> DynP ()
+setOptHpcDir arg  = upd $ \ d -> d{hpcDir = arg}
+
+-----------------------------------------------------------------------------
 -- Via-C compilation stuff
 
 machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
@@ -1333,9 +1364,6 @@ machdepCCOpts dflags
                        -- version.
                ] )
 
-#elif mips_TARGET_ARCH
-       = ( ["-static"], [] )
-
 #elif sparc_TARGET_ARCH
        = ( [], ["-w"] )
        -- For now, to suppress the gcc warning "call-clobbered