ghc/compiler/main/DriverFlags.hs

   1 {-# OPTIONS -#include "hschooks.h" #-}
   2
   3 -----------------------------------------------------------------------------
   4 -- $Id: DriverFlags.hs,v 1.39 2001/01/12 11:04:45 simonmar Exp $
   5 --
   6 -- Driver flags
   7 --
   8 -- (c) Simon Marlow 2000
   9 --
  10 -----------------------------------------------------------------------------
  11
  12 module DriverFlags where
  13
  14 #include "HsVersions.h"
  15
  16 import PackageMaintenance
  17 import DriverState
  18 import DriverUtil
  19 import TmpFiles         ( v_TmpDir )
  20 import CmdLineOpts
  21 import Config
  22 import Util
  23 import Panic
  24
  25 import Exception
  26 import IOExts
  27
  28 import IO
  29 import Maybe
  30 import Monad
  31 import System
  32 import Char
  33
  34 -----------------------------------------------------------------------------
  35 -- Flags
  36
  37 -- Flag parsing is now done in stages:
  38 --
  39 --     * parse the initial list of flags and remove any flags understood
  40 --       by the driver only.  Determine whether we're in multi-compilation
  41 --       or single-compilation mode.
  42 --
  43 --     * gather the list of "static" hsc flags, and assign them to the global
  44 --       static hsc flags variable.
  45 --
  46 --     * build the inital DynFlags from the remaining flags.
  47 --
  48 --     * complain if we've got any flags left over.
  49 --
  50 --     * for each source file: grab the OPTIONS, and build a new DynFlags
  51 --       to pass to the compiler.
  52
  53 -----------------------------------------------------------------------------
  54 -- Process command-line
  55
  56 data OptKind
  57         = NoArg (IO ())                     -- flag with no argument
  58         | HasArg (String -> IO ())          -- flag has an argument (maybe prefix)
  59         | SepArg (String -> IO ())          -- flag has a separate argument
  60         | Prefix (String -> IO ())          -- flag is a prefix only
  61         | OptPrefix (String -> IO ())       -- flag may be a prefix
  62         | AnySuffix (String -> IO ())       -- flag is a prefix, pass whole arg to fn
  63         | PassFlag  (String -> IO ())       -- flag with no arg, pass flag to fn
  64         | PrefixPred (String -> Bool) (String -> IO ())
  65         | AnySuffixPred (String -> Bool) (String -> IO ())
  66
  67 processArgs :: [(String,OptKind)] -> [String] -> [String]
  68    -> IO [String]  -- returns spare args
  69 processArgs _spec [] spare = return (reverse spare)
  70 processArgs spec args@(('-':arg):args') spare = do
  71   case findArg spec arg of
  72     Just (rest,action) ->
  73       do args' <- processOneArg action rest args
  74          processArgs spec args' spare
  75     Nothing ->
  76       processArgs spec args' (('-':arg):spare)
  77 processArgs spec (arg:args) spare =
  78   processArgs spec args (arg:spare)
  79
  80 processOneArg :: OptKind -> String -> [String] -> IO [String]
  81 processOneArg action rest (dash_arg@('-':arg):args) =
  82   case action of
  83         NoArg  io ->
  84                 if rest == ""
  85                         then io >> return args
  86                         else unknownFlagErr dash_arg
  87
  88         HasArg fio ->
  89                 if rest /= ""
  90                         then fio rest >> return args
  91                         else case args of
  92                                 [] -> unknownFlagErr dash_arg
  93                                 (arg1:args1) -> fio arg1 >> return args1
  94
  95         SepArg fio ->
  96                 case args of
  97                         [] -> unknownFlagErr dash_arg
  98                         (arg1:args1) -> fio arg1 >> return args1
  99
 100         Prefix fio ->
 101                 if rest /= ""
 102                         then fio rest >> return args
 103                         else unknownFlagErr dash_arg
 104
 105         PrefixPred p fio ->
 106                 if rest /= ""
 107                         then fio rest >> return args
 108                         else unknownFlagErr dash_arg
 109
 110         OptPrefix fio       -> fio rest >> return args
 111
 112         AnySuffix fio       -> fio dash_arg >> return args
 113
 114         AnySuffixPred p fio -> fio dash_arg >> return args
 115
 116         PassFlag fio  ->
 117                 if rest /= ""
 118                         then unknownFlagErr dash_arg
 119                         else fio dash_arg >> return args
 120
 121 findArg :: [(String,OptKind)] -> String -> Maybe (String,OptKind)
 122 findArg spec arg
 123   = case [ (remove_spaces rest, k)
 124          | (pat,k) <- spec, Just rest <- [my_prefix_match pat arg],
 125            arg_ok k rest arg ]
 126     of
 127         []      -> Nothing
 128         (one:_) -> Just one
 129
 130 arg_ok (NoArg _)            rest arg = null rest
 131 arg_ok (HasArg _)           rest arg = True
 132 arg_ok (SepArg _)           rest arg = null rest
 133 arg_ok (Prefix _)           rest arg = not (null rest)
 134 arg_ok (PrefixPred p _)     rest arg = not (null rest) && p rest
 135 arg_ok (OptPrefix _)        rest arg = True
 136 arg_ok (PassFlag _)         rest arg = null rest
 137 arg_ok (AnySuffix _)        rest arg = True
 138 arg_ok (AnySuffixPred p _)  rest arg = p arg
 139
 140 -----------------------------------------------------------------------------
 141 -- Static flags
 142
 143 -- note that ordering is important in the following list: any flag which
 144 -- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
 145 -- flags further down the list with the same prefix.
 146
 147 static_flags =
 148   [  ------- help -------------------------------------------------------
 149      ( "?"              , NoArg long_usage)
 150   ,  ( "-help"          , NoArg long_usage)
 151
 152
 153       ------- version ----------------------------------------------------
 154   ,  ( "-version"        , NoArg (do hPutStrLn stdout (cProjectName
 155                                       ++ ", version " ++ cProjectVersion)
 156                                      exitWith ExitSuccess))
 157   ,  ( "-numeric-version", NoArg (do hPutStrLn stdout cProjectVersion
 158                                      exitWith ExitSuccess))
 159
 160       ------- verbosity ----------------------------------------------------
 161   ,  ( "n"              , NoArg (writeIORef v_Dry_run True) )
 162
 163         ------- recompilation checker --------------------------------------
 164   ,  ( "recomp"         , NoArg (writeIORef v_Recomp True) )
 165   ,  ( "no-recomp"      , NoArg (writeIORef v_Recomp False) )
 166
 167         ------- ways --------------------------------------------------------
 168   ,  ( "prof"           , NoArg (addNoDups v_Ways       WayProf) )
 169   ,  ( "unreg"          , NoArg (addNoDups v_Ways       WayUnreg) )
 170   ,  ( "ticky"          , NoArg (addNoDups v_Ways       WayTicky) )
 171   ,  ( "parallel"       , NoArg (addNoDups v_Ways       WayPar) )
 172   ,  ( "gransim"        , NoArg (addNoDups v_Ways       WayGran) )
 173   ,  ( "smp"            , NoArg (addNoDups v_Ways       WaySMP) )
 174   ,  ( "debug"          , NoArg (addNoDups v_Ways       WayDebug) )
 175         -- ToDo: user ways
 176
 177         ------ Debugging ----------------------------------------------------
 178   ,  ( "dppr-noprags",     PassFlag (add v_Opt_C) )
 179   ,  ( "dppr-debug",       PassFlag (add v_Opt_C) )
 180   ,  ( "dppr-user-length", AnySuffix (add v_Opt_C) )
 181       -- rest of the debugging flags are dynamic
 182
 183         ------- Interface files ---------------------------------------------
 184   ,  ( "hi"             , NoArg (writeIORef v_ProduceHi True) )
 185   ,  ( "nohi"           , NoArg (writeIORef v_ProduceHi False) )
 186
 187         --------- Profiling --------------------------------------------------
 188   ,  ( "auto-dicts"     , NoArg (add v_Opt_C "-fauto-sccs-on-dicts") )
 189   ,  ( "auto-all"       , NoArg (add v_Opt_C "-fauto-sccs-on-all-toplevs") )
 190   ,  ( "auto"           , NoArg (add v_Opt_C "-fauto-sccs-on-exported-toplevs") )
 191   ,  ( "caf-all"        , NoArg (add v_Opt_C "-fauto-sccs-on-individual-cafs") )
 192          -- "ignore-sccs"  doesn't work  (ToDo)
 193
 194   ,  ( "no-auto-dicts"  , NoArg (add v_Anti_opt_C "-fauto-sccs-on-dicts") )
 195   ,  ( "no-auto-all"    , NoArg (add v_Anti_opt_C "-fauto-sccs-on-all-toplevs") )
 196   ,  ( "no-auto"        , NoArg (add v_Anti_opt_C "-fauto-sccs-on-exported-toplevs") )
 197   ,  ( "no-caf-all"     , NoArg (add v_Anti_opt_C "-fauto-sccs-on-individual-cafs") )
 198
 199         ------- Miscellaneous -----------------------------------------------
 200   ,  ( "no-link-chk"    , NoArg (return ()) ) -- ignored for backwards compat
 201   ,  ( "no-hs-main"     , NoArg (writeIORef v_NoHsMain True) )
 202
 203         ------- Output Redirection ------------------------------------------
 204   ,  ( "odir"           , HasArg (writeIORef v_Output_dir  . Just) )
 205   ,  ( "o"              , SepArg (writeIORef v_Output_file . Just) )
 206   ,  ( "osuf"           , HasArg (writeIORef v_Object_suf  . Just) )
 207   ,  ( "hisuf"          , HasArg (writeIORef v_Hi_suf) )
 208   ,  ( "tmpdir"         , HasArg (writeIORef v_TmpDir . (++ "/")) )
 209   ,  ( "ohi"            , HasArg (\s -> case s of
 210                                           "-" -> writeIORef v_Hi_on_stdout True
 211                                           _   -> writeIORef v_Output_hi (Just s)) )
 212         -- -odump?
 213
 214   ,  ( "keep-hc-file"   , AnySuffix (\_ -> writeIORef v_Keep_hc_files True) )
 215   ,  ( "keep-s-file"    , AnySuffix (\_ -> writeIORef v_Keep_s_files  True) )
 216   ,  ( "keep-raw-s-file", AnySuffix (\_ -> writeIORef v_Keep_raw_s_files  True) )
 217   ,  ( "keep-tmp-files" , AnySuffix (\_ -> writeIORef v_Keep_tmp_files True) )
 218
 219   ,  ( "split-objs"     , NoArg (if can_split
 220                                     then do writeIORef v_Split_object_files True
 221                                             add v_Opt_C "-fglobalise-toplev-names"
 222                                     else hPutStrLn stderr
 223                                             "warning: don't know how to  split \
 224                                             \object files on this architecture"
 225                                 ) )
 226
 227         ------- Include/Import Paths ----------------------------------------
 228   ,  ( "i"              , OptPrefix (addToDirList v_Import_paths) )
 229   ,  ( "I"              , Prefix    (addToDirList v_Include_paths) )
 230
 231         ------- Libraries ---------------------------------------------------
 232   ,  ( "L"              , Prefix (addToDirList v_Library_paths) )
 233   ,  ( "l"              , Prefix (add v_Cmdline_libraries) )
 234
 235         ------- Packages ----------------------------------------------------
 236   ,  ( "package-name"   , HasArg (\s -> add v_Opt_C ("-inpackage="++s)) )
 237
 238   ,  ( "package"        , HasArg (addPackage) )
 239   ,  ( "syslib"         , HasArg (addPackage) ) -- for compatibility w/ old vsns
 240
 241   ,  ( "-list-packages"  , NoArg (listPackages) )
 242   ,  ( "-add-package"    , NoArg (newPackage) )
 243   ,  ( "-delete-package" , SepArg (deletePackage) )
 244
 245         ------- Specific phases  --------------------------------------------
 246   ,  ( "pgmL"           , HasArg (writeIORef v_Pgm_L) )
 247   ,  ( "pgmP"           , HasArg (writeIORef v_Pgm_P) )
 248   ,  ( "pgmc"           , HasArg (writeIORef v_Pgm_c) )
 249   ,  ( "pgmm"           , HasArg (writeIORef v_Pgm_m) )
 250   ,  ( "pgms"           , HasArg (writeIORef v_Pgm_s) )
 251   ,  ( "pgma"           , HasArg (writeIORef v_Pgm_a) )
 252   ,  ( "pgml"           , HasArg (writeIORef v_Pgm_l) )
 253
 254   ,  ( "optdep"         , HasArg (add v_Opt_dep) )
 255   ,  ( "optl"           , HasArg (add v_Opt_l) )
 256   ,  ( "optdll"         , HasArg (add v_Opt_dll) )
 257
 258         ------ Warning opts -------------------------------------------------
 259   ,  ( "W"              , NoArg (writeIORef v_Warning_opt W_) )
 260   ,  ( "Wall"           , NoArg (writeIORef v_Warning_opt W_all) )
 261   ,  ( "Wnot"           , NoArg (writeIORef v_Warning_opt W_not) )
 262   ,  ( "w"              , NoArg (writeIORef v_Warning_opt W_not) )
 263
 264         ----- Linker --------------------------------------------------------
 265   ,  ( "static"         , NoArg (writeIORef v_Static True) )
 266   ,  ( "dynamic"        , NoArg (writeIORef v_Static False) )
 267   ,  ( "rdynamic"       , NoArg (return ()) ) -- ignored for compat w/ gcc
 268
 269         ----- RTS opts ------------------------------------------------------
 270   ,  ( "H"                 , HasArg (setHeapSize . fromIntegral . decodeSize) )
 271   ,  ( "Rghc-timing"       , NoArg  (enableTimingStats) )
 272
 273         ------ Compiler flags -----------------------------------------------
 274   ,  ( "O2-for-C"          , NoArg (writeIORef v_minus_o2_for_C True) )
 275   ,  ( "O"                 , OptPrefix (setOptLevel) )
 276
 277   ,  ( "fno-asm-mangling"  , NoArg (writeIORef v_Do_asm_mangling False) )
 278
 279   ,  ( "fmax-simplifier-iterations",
 280                 Prefix (writeIORef v_MaxSimplifierIterations . read) )
 281
 282   ,  ( "fusagesp"          , NoArg (do writeIORef v_UsageSPInf True
 283                                        add v_Opt_C "-fusagesp-on") )
 284
 285   ,  ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True
 286                                        add v_Opt_C "-fexcess-precision"))
 287
 288         -- Optimisation flags are treated specially, so the normal
 289         -- -fno-* pattern below doesn't work.  We therefore allow
 290         -- certain optimisation passes to be turned off explicitly:
 291   ,  ( "fno-strictness"    , NoArg (writeIORef v_Strictness False) )
 292   ,  ( "fno-cpr"           , NoArg (writeIORef v_CPR False) )
 293   ,  ( "fno-cse"           , NoArg (writeIORef v_CSE False) )
 294
 295         -- flags that are "active negatives"
 296   ,  ( "fno-prune-tydecls"      , PassFlag (add v_Opt_C) )
 297   ,  ( "fno-prune-instdecls"    , PassFlag (add v_Opt_C) )
 298   ,  ( "fno-pre-inlining"       , PassFlag (add v_Opt_C) )
 299
 300         -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
 301   ,  ( "fno-",                  PrefixPred (\s -> isStaticHscFlag ("f"++s))
 302                                     (\s -> add v_Anti_opt_C ("-f"++s)) )
 303
 304         -- Pass all remaining "-f<blah>" options to hsc
 305   ,  ( "f",                     AnySuffixPred (isStaticHscFlag) (add v_Opt_C) )
 306   ]
 307
 308 -----------------------------------------------------------------------------
 309 -- parse the dynamic arguments
 310
 311 -- v_InitDynFlags
 312 --      is the "baseline" dynamic flags, initialised from
 313 --      the defaults and command line options.
 314 --
 315 -- v_DynFlags
 316 --      is the dynamic flags for the current compilation.  It is reset
 317 --      to the value of v_InitDynFlags before each compilation, then
 318 --      updated by reading any OPTIONS pragma in the current module.
 319
 320 GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
 321 GLOBAL_VAR(v_DynFlags,     defaultDynFlags, DynFlags)
 322
 323 updDynFlags f = do
 324    dfs <- readIORef v_DynFlags
 325    writeIORef v_DynFlags (f dfs)
 326
 327 getDynFlags :: IO DynFlags
 328 getDynFlags = readIORef v_DynFlags
 329
 330 dynFlag :: (DynFlags -> a) -> IO a
 331 dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
 332
 333 setDynFlag f   = updDynFlags (\dfs -> dfs{ flags = f : flags dfs })
 334 unSetDynFlag f = updDynFlags (\dfs -> dfs{ flags = filter (/= f) (flags dfs) })
 335
 336 -- we can only change HscC to HscAsm and vice-versa with dynamic flags
 337 -- (-fvia-C and -fasm).
 338 setLang l = do
 339    dfs <- readIORef v_DynFlags
 340    case hscLang dfs of
 341         HscC   -> writeIORef v_DynFlags dfs{ hscLang = l }
 342         HscAsm -> writeIORef v_DynFlags dfs{ hscLang = l }
 343         _      -> return ()
 344
 345 setVerbosityAtLeast n =
 346   updDynFlags (\dfs -> if verbosity dfs < n
 347                           then dfs{ verbosity = n }
 348                           else dfs)
 349
 350 setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
 351 setVerbosity n
 352   | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
 353   | otherwise     = throwDyn (OtherError "can't parse verbosity flag (-v<n>)")
 354
 355 getVerbFlag = do
 356    verb <- dynFlag verbosity
 357    if verb >= 3  then return  "-v" else return ""
 358
 359 dynamic_flags = [
 360
 361      ( "cpp",           NoArg  (updateState (\s -> s{ cpp_flag = True })) )
 362   ,  ( "#include",      HasArg (addCmdlineHCInclude) )
 363
 364   ,  ( "v",             OptPrefix (setVerbosity) )
 365
 366   ,  ( "optL",          HasArg (addOpt_L) )
 367   ,  ( "optP",          HasArg (addOpt_P) )
 368   ,  ( "optc",          HasArg (addOpt_c) )
 369   ,  ( "optm",          HasArg (addOpt_m) )
 370   ,  ( "opta",          HasArg (addOpt_a) )
 371
 372         ------ HsCpp opts ---------------------------------------------------
 373   ,  ( "D",             Prefix (\s -> addOpt_P ("-D'"++s++"'") ) )
 374   ,  ( "U",             Prefix (\s -> addOpt_P ("-U'"++s++"'") ) )
 375
 376         ------ Debugging ----------------------------------------------------
 377   ,  ( "dstg-stats",    NoArg (writeIORef v_StgStats True) )
 378
 379   ,  ( "ddump-absC",             NoArg (setDynFlag Opt_D_dump_absC) )
 380   ,  ( "ddump-asm",              NoArg (setDynFlag Opt_D_dump_asm) )
 381   ,  ( "ddump-cpranal",          NoArg (setDynFlag Opt_D_dump_cpranal) )
 382   ,  ( "ddump-deriv",            NoArg (setDynFlag Opt_D_dump_deriv) )
 383   ,  ( "ddump-ds",               NoArg (setDynFlag Opt_D_dump_ds) )
 384   ,  ( "ddump-flatC",            NoArg (setDynFlag Opt_D_dump_flatC) )
 385   ,  ( "ddump-foreign",          NoArg (setDynFlag Opt_D_dump_foreign) )
 386   ,  ( "ddump-inlinings",        NoArg (setDynFlag Opt_D_dump_inlinings) )
 387   ,  ( "ddump-occur-anal",       NoArg (setDynFlag Opt_D_dump_occur_anal) )
 388   ,  ( "ddump-parsed",           NoArg (setDynFlag Opt_D_dump_parsed) )
 389   ,  ( "ddump-realC",            NoArg (setDynFlag Opt_D_dump_realC) )
 390   ,  ( "ddump-rn",               NoArg (setDynFlag Opt_D_dump_rn) )
 391   ,  ( "ddump-simpl",            NoArg (setDynFlag Opt_D_dump_simpl) )
 392   ,  ( "ddump-simpl-iterations", NoArg (setDynFlag Opt_D_dump_simpl_iterations) )
 393   ,  ( "ddump-spec",             NoArg (setDynFlag Opt_D_dump_spec) )
 394   ,  ( "ddump-sat",              NoArg (setDynFlag Opt_D_dump_sat) )
 395   ,  ( "ddump-stg",              NoArg (setDynFlag Opt_D_dump_stg) )
 396   ,  ( "ddump-stranal",          NoArg (setDynFlag Opt_D_dump_stranal) )
 397   ,  ( "ddump-tc",               NoArg (setDynFlag Opt_D_dump_tc) )
 398   ,  ( "ddump-types",            NoArg (setDynFlag Opt_D_dump_types) )
 399   ,  ( "ddump-rules",            NoArg (setDynFlag Opt_D_dump_rules) )
 400   ,  ( "ddump-usagesp",          NoArg (setDynFlag Opt_D_dump_usagesp) )
 401   ,  ( "ddump-cse",              NoArg (setDynFlag Opt_D_dump_cse) )
 402   ,  ( "ddump-worker-wrapper",   NoArg (setDynFlag Opt_D_dump_worker_wrapper) )
 403   ,  ( "dshow-passes",           NoArg (setVerbosity "2") )
 404   ,  ( "ddump-rn-trace",         NoArg (setDynFlag Opt_D_dump_rn_trace) )
 405   ,  ( "ddump-rn-stats",         NoArg (setDynFlag Opt_D_dump_rn_stats) )
 406   ,  ( "ddump-stix",             NoArg (setDynFlag Opt_D_dump_stix) )
 407   ,  ( "ddump-simpl-stats",      NoArg (setDynFlag Opt_D_dump_simpl_stats) )
 408   ,  ( "ddump-bcos",             NoArg (setDynFlag Opt_D_dump_BCOs) )
 409   ,  ( "dsource-stats",          NoArg (setDynFlag Opt_D_source_stats) )
 410   ,  ( "dverbose-core2core",     NoArg (setDynFlag Opt_D_verbose_core2core) )
 411   ,  ( "dverbose-stg2stg",       NoArg (setDynFlag Opt_D_verbose_stg2stg) )
 412   ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs) )
 413   ,  ( "ddump-hi",               NoArg (setDynFlag Opt_D_dump_hi) )
 414   ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports) )
 415   ,  ( "dcore-lint",             NoArg (setDynFlag Opt_DoCoreLinting) )
 416   ,  ( "dstg-lint",              NoArg (setDynFlag Opt_DoStgLinting) )
 417   ,  ( "dusagesp-lint",          NoArg (setDynFlag Opt_DoUSPLinting) )
 418
 419         ------ Machine dependant (-m<blah>) stuff ---------------------------
 420
 421   ,  ( "monly-2-regs",  NoArg (updateState (\s -> s{stolen_x86_regs = 2}) ))
 422   ,  ( "monly-3-regs",  NoArg (updateState (\s -> s{stolen_x86_regs = 3}) ))
 423   ,  ( "monly-4-regs",  NoArg (updateState (\s -> s{stolen_x86_regs = 4}) ))
 424
 425         ------ Compiler flags -----------------------------------------------
 426
 427   ,  ( "fasm",          AnySuffix (\_ -> setLang HscAsm) )
 428   ,  ( "fvia-c",        NoArg (setLang HscC) )
 429   ,  ( "fvia-C",        NoArg (setLang HscC) )
 430
 431         -- "active negatives"
 432   ,  ( "fno-implicit-prelude",  NoArg (setDynFlag Opt_NoImplicitPrelude) )
 433
 434         -- the rest of the -f* and -fno-* flags
 435   ,  ( "fno-",          PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )
 436   ,  ( "f",             PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag f)) )
 437  ]
 438
 439 -- these -f<blah> flags can all be reversed with -fno-<blah>
 440
 441 fFlags = [
 442   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports ),
 443   ( "warn-hi-shadowing",                Opt_WarnHiShadows ),
 444   ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns ),
 445   ( "warn-missing-fields",              Opt_WarnMissingFields ),
 446   ( "warn-missing-methods",             Opt_WarnMissingMethods ),
 447   ( "warn-missing-signatures",          Opt_WarnMissingSigs ),
 448   ( "warn-name-shadowing",              Opt_WarnNameShadowing ),
 449   ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns ),
 450   ( "warn-simple-patterns",             Opt_WarnSimplePatterns ),
 451   ( "warn-type-defaults",               Opt_WarnTypeDefaults ),
 452   ( "warn-unused-binds",                Opt_WarnUnusedBinds ),
 453   ( "warn-unused-imports",              Opt_WarnUnusedImports ),
 454   ( "warn-unused-matches",              Opt_WarnUnusedMatches ),
 455   ( "warn-deprecations",                Opt_WarnDeprecations ),
 456   ( "glasgow-exts",                     Opt_GlasgowExts ),
 457   ( "allow-overlapping-instances",      Opt_AllowOverlappingInstances ),
 458   ( "allow-undecidable-instances",      Opt_AllowUndecidableInstances ),
 459   ( "fgenerics",                        Opt_Generics ),
 460   ( "report-compile",                   Opt_ReportCompile )
 461   ]
 462
 463 isFFlag f = f `elem` (map fst fFlags)
 464 getFFlag f = fromJust (lookup f fFlags)
 465
 466 -----------------------------------------------------------------------------
 467 -- convert sizes like "3.5M" into integers
 468
 469 decodeSize :: String -> Integer
 470 decodeSize str
 471   | c == ""              = truncate n
 472   | c == "K" || c == "k" = truncate (n * 1000)
 473   | c == "M" || c == "m" = truncate (n * 1000 * 1000)
 474   | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
 475   | otherwise            = throwDyn (OtherError ("can't decode size: " ++ str))
 476   where (m, c) = span pred str
 477         n      = read m  :: Double
 478         pred c = isDigit c || c == '.'
 479
 480 floatOpt :: IORef Double -> String -> IO ()
 481 floatOpt ref str = writeIORef ref (read str :: Double)
 482
 483 -----------------------------------------------------------------------------
 484 -- RTS Hooks
 485
 486 foreign import "setHeapSize"       unsafe setHeapSize       :: Int -> IO ()
 487 foreign import "enableTimingStats" unsafe enableTimingStats :: IO ()
 488
 489 -----------------------------------------------------------------------------
 490 -- Build the Hsc static command line opts
 491
 492 buildStaticHscOpts :: IO [String]
 493 buildStaticHscOpts = do
 494
 495   opt_C_ <- getStaticOpts v_Opt_C       -- misc hsc opts from the command line
 496
 497         -- optimisation
 498   minus_o <- readIORef v_OptLevel
 499   let optimisation_opts =
 500         case minus_o of
 501             0 -> hsc_minusNoO_flags
 502             1 -> hsc_minusO_flags
 503             2 -> hsc_minusO2_flags
 504             _ -> error "unknown opt level"
 505             -- ToDo: -Ofile
 506
 507         -- take into account -fno-* flags by removing the equivalent -f*
 508         -- flag from our list.
 509   anti_flags <- getStaticOpts v_Anti_opt_C
 510   let basic_opts = opt_C_ ++ optimisation_opts
 511       filtered_opts = filter (`notElem` anti_flags) basic_opts
 512
 513   static <- (do s <- readIORef v_Static; if s then return "-static"
 514                                               else return "")
 515
 516   return ( static : filtered_opts )
 517
 518 -----------------------------------------------------------------------------
 519 -- Running an external program
 520
 521 -- sigh, here because both DriverMkDepend & DriverPipeline need it.
 522
 523 runSomething phase_name cmd
 524  = do
 525    verb <- dynFlag verbosity
 526    when (verb >= 2) $ hPutStrLn stderr ("*** " ++ phase_name)
 527    when (verb >= 3) $ hPutStrLn stderr cmd
 528    hFlush stderr
 529
 530    -- test for -n flag
 531    n <- readIORef v_Dry_run
 532    unless n $ do
 533
 534    -- and run it!
 535    exit_code <- kludgedSystem cmd phase_name
 536
 537    if exit_code /= ExitSuccess
 538         then throwDyn (PhaseFailed phase_name exit_code)
 539         else do when (verb >= 3) (hPutStr stderr "\n")
 540                 return ()