ghc/compiler/main/DriverFlags.hs

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