ghc/compiler/main/DriverFlags.hs

   1 {-# OPTIONS -#include "hschooks.h" #-}
   2
   3 -----------------------------------------------------------------------------
   4 -- $Id: DriverFlags.hs,v 1.53 2001/05/09 09:38:18 simonmar Exp $
   5 --
   6 -- Driver flags
   7 --
   8 -- (c) Simon Marlow 2000
   9 --
  10 -----------------------------------------------------------------------------
  11
  12 module DriverFlags (
  13         processArgs, OptKind(..), static_flags, dynamic_flags,
  14         v_InitDynFlags, v_DynFlags, getDynFlags, dynFlag,
  15         getOpts, getVerbFlag, addCmdlineHCInclude,
  16         buildStaticHscOpts,
  17         runSomething,
  18         machdepCCOpts
  19   ) where
  20
  21 #include "HsVersions.h"
  22
  23 import DriverState
  24 import DriverUtil
  25 import TmpFiles         ( v_TmpDir, kludgedSystem )
  26 import CmdLineOpts
  27 import Config
  28 import Util
  29 import Panic
  30
  31 import Exception
  32 import IOExts
  33
  34 import IO
  35 import Maybe
  36 import Monad
  37 import System
  38 import Char
  39
  40 -----------------------------------------------------------------------------
  41 -- Flags
  42
  43 -- Flag parsing is now done in stages:
  44 --
  45 --     * parse the initial list of flags and remove any flags understood
  46 --       by the driver only.  Determine whether we're in multi-compilation
  47 --       or single-compilation mode (done in Main.main).
  48 --
  49 --     * gather the list of "static" hsc flags, and assign them to the global
  50 --       static hsc flags variable.
  51 --
  52 --     * build the inital DynFlags from the remaining flags.
  53 --
  54 --     * complain if we've got any flags left over.
  55 --
  56 --     * for each source file: grab the OPTIONS, and build a new DynFlags
  57 --       to pass to the compiler.
  58
  59 -----------------------------------------------------------------------------
  60 -- Process command-line
  61
  62 data OptKind
  63         = NoArg (IO ())                     -- flag with no argument
  64         | HasArg (String -> IO ())          -- flag has an argument (maybe prefix)
  65         | SepArg (String -> IO ())          -- flag has a separate argument
  66         | Prefix (String -> IO ())          -- flag is a prefix only
  67         | OptPrefix (String -> IO ())       -- flag may be a prefix
  68         | AnySuffix (String -> IO ())       -- flag is a prefix, pass whole arg to fn
  69         | PassFlag  (String -> IO ())       -- flag with no arg, pass flag to fn
  70         | PrefixPred (String -> Bool) (String -> IO ())
  71         | AnySuffixPred (String -> Bool) (String -> IO ())
  72
  73 processArgs :: [(String,OptKind)] -> [String] -> [String]
  74    -> IO [String]  -- returns spare args
  75 processArgs _spec [] spare = return (reverse spare)
  76 processArgs spec args@(('-':arg):args') spare = do
  77   case findArg spec arg of
  78     Just (rest,action) ->
  79       do args' <- processOneArg action rest args
  80          processArgs spec args' spare
  81     Nothing ->
  82       processArgs spec args' (('-':arg):spare)
  83 processArgs spec (arg:args) spare =
  84   processArgs spec args (arg:spare)
  85
  86 processOneArg :: OptKind -> String -> [String] -> IO [String]
  87 processOneArg action rest (dash_arg@('-':arg):args) =
  88   case action of
  89         NoArg  io ->
  90                 if rest == ""
  91                         then io >> return args
  92                         else unknownFlagErr dash_arg
  93
  94         HasArg fio ->
  95                 if rest /= ""
  96                         then fio rest >> return args
  97                         else case args of
  98                                 [] -> unknownFlagErr dash_arg
  99                                 (arg1:args1) -> fio arg1 >> return args1
 100
 101         SepArg fio ->
 102                 case args of
 103                         [] -> unknownFlagErr dash_arg
 104                         (arg1:args1) -> fio arg1 >> return args1
 105
 106         Prefix fio ->
 107                 if rest /= ""
 108                         then fio rest >> return args
 109                         else unknownFlagErr dash_arg
 110
 111         PrefixPred p fio ->
 112                 if rest /= ""
 113                         then fio rest >> return args
 114                         else unknownFlagErr dash_arg
 115
 116         OptPrefix fio       -> fio rest >> return args
 117
 118         AnySuffix fio       -> fio dash_arg >> return args
 119
 120         AnySuffixPred p fio -> fio dash_arg >> return args
 121
 122         PassFlag fio  ->
 123                 if rest /= ""
 124                         then unknownFlagErr dash_arg
 125                         else fio dash_arg >> return args
 126
 127 findArg :: [(String,OptKind)] -> String -> Maybe (String,OptKind)
 128 findArg spec arg
 129   = case [ (remove_spaces rest, k)
 130          | (pat,k) <- spec, Just rest <- [my_prefix_match pat arg],
 131            arg_ok k rest arg ]
 132     of
 133         []      -> Nothing
 134         (one:_) -> Just one
 135
 136 arg_ok (NoArg _)            rest arg = null rest
 137 arg_ok (HasArg _)           rest arg = True
 138 arg_ok (SepArg _)           rest arg = null rest
 139 arg_ok (Prefix _)           rest arg = not (null rest)
 140 arg_ok (PrefixPred p _)     rest arg = not (null rest) && p rest
 141 arg_ok (OptPrefix _)        rest arg = True
 142 arg_ok (PassFlag _)         rest arg = null rest
 143 arg_ok (AnySuffix _)        rest arg = True
 144 arg_ok (AnySuffixPred p _)  rest arg = p arg
 145
 146 -----------------------------------------------------------------------------
 147 -- Static flags
 148
 149 -- note that ordering is important in the following list: any flag which
 150 -- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
 151 -- flags further down the list with the same prefix.
 152
 153 static_flags =
 154   [  ------- help -------------------------------------------------------
 155      ( "?"              , NoArg long_usage)
 156   ,  ( "-help"          , NoArg long_usage)
 157
 158
 159       ------- version ----------------------------------------------------
 160   ,  ( "-version"        , NoArg (do hPutStrLn stdout (cProjectName
 161                                       ++ ", version " ++ cProjectVersion)
 162                                      exitWith ExitSuccess))
 163   ,  ( "-numeric-version", NoArg (do hPutStrLn stdout cProjectVersion
 164                                      exitWith ExitSuccess))
 165
 166       ------- verbosity ----------------------------------------------------
 167   ,  ( "n"              , NoArg (writeIORef v_Dry_run True) )
 168
 169         ------- recompilation checker --------------------------------------
 170   ,  ( "recomp"         , NoArg (writeIORef v_Recomp True) )
 171   ,  ( "no-recomp"      , NoArg (writeIORef v_Recomp False) )
 172
 173         ------- ways --------------------------------------------------------
 174   ,  ( "prof"           , NoArg (addNoDups v_Ways       WayProf) )
 175   ,  ( "unreg"          , NoArg (addNoDups v_Ways       WayUnreg) )
 176   ,  ( "ticky"          , NoArg (addNoDups v_Ways       WayTicky) )
 177   ,  ( "parallel"       , NoArg (addNoDups v_Ways       WayPar) )
 178   ,  ( "gransim"        , NoArg (addNoDups v_Ways       WayGran) )
 179   ,  ( "smp"            , NoArg (addNoDups v_Ways       WaySMP) )
 180   ,  ( "debug"          , NoArg (addNoDups v_Ways       WayDebug) )
 181         -- ToDo: user ways
 182
 183         ------ Debugging ----------------------------------------------------
 184   ,  ( "dppr-noprags",     PassFlag (add v_Opt_C) )
 185   ,  ( "dppr-debug",       PassFlag (add v_Opt_C) )
 186   ,  ( "dppr-user-length", AnySuffix (add v_Opt_C) )
 187       -- rest of the debugging flags are dynamic
 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   ,  ( "hcsuf"          , HasArg (writeIORef v_HC_suf      . Just) )
 210   ,  ( "hisuf"          , HasArg (writeIORef v_Hi_suf) )
 211   ,  ( "tmpdir"         , HasArg (writeIORef v_TmpDir . (++ "/")) )
 212   ,  ( "ohi"            , HasArg (writeIORef v_Output_hi   . Just) )
 213         -- -odump?
 214
 215   ,  ( "keep-hc-file"   , AnySuffix (\_ -> writeIORef v_Keep_hc_files True) )
 216   ,  ( "keep-s-file"    , AnySuffix (\_ -> writeIORef v_Keep_s_files  True) )
 217   ,  ( "keep-raw-s-file", AnySuffix (\_ -> writeIORef v_Keep_raw_s_files  True) )
 218   ,  ( "keep-tmp-files" , AnySuffix (\_ -> writeIORef v_Keep_tmp_files True) )
 219
 220   ,  ( "split-objs"     , NoArg (if can_split
 221                                     then do writeIORef v_Split_object_files True
 222                                             add v_Opt_C "-fglobalise-toplev-names"
 223                                     else hPutStrLn stderr
 224                                             "warning: don't know how to  split \
 225                                             \object files on this architecture"
 226                                 ) )
 227
 228         ------- Include/Import Paths ----------------------------------------
 229   ,  ( "i"              , OptPrefix (addToDirList v_Import_paths) )
 230   ,  ( "I"              , Prefix    (addToDirList v_Include_paths) )
 231
 232         ------- Libraries ---------------------------------------------------
 233   ,  ( "L"              , Prefix (addToDirList v_Library_paths) )
 234   ,  ( "l"              , Prefix (add v_Cmdline_libraries) )
 235
 236         ------- Packages ----------------------------------------------------
 237   ,  ( "package-name"   , HasArg (\s -> add v_Opt_C ("-inpackage="++s)) )
 238
 239   ,  ( "package"        , HasArg (addPackage) )
 240   ,  ( "syslib"         , HasArg (addPackage) ) -- for compatibility w/ old vsns
 241
 242         ------- Specific phases  --------------------------------------------
 243   ,  ( "pgmL"           , HasArg (writeIORef v_Pgm_L) )
 244   ,  ( "pgmP"           , HasArg (writeIORef v_Pgm_P) )
 245   ,  ( "pgmc"           , HasArg (writeIORef v_Pgm_c) )
 246   ,  ( "pgmm"           , HasArg (writeIORef v_Pgm_m) )
 247   ,  ( "pgms"           , HasArg (writeIORef v_Pgm_s) )
 248   ,  ( "pgma"           , HasArg (writeIORef v_Pgm_a) )
 249   ,  ( "pgml"           , HasArg (writeIORef v_Pgm_l) )
 250
 251   ,  ( "optdep"         , HasArg (add v_Opt_dep) )
 252   ,  ( "optl"           , HasArg (add v_Opt_l) )
 253   ,  ( "optdll"         , HasArg (add v_Opt_dll) )
 254
 255         ----- Linker --------------------------------------------------------
 256   ,  ( "static"         , NoArg (writeIORef v_Static True) )
 257   ,  ( "dynamic"        , NoArg (writeIORef v_Static False) )
 258   ,  ( "rdynamic"       , NoArg (return ()) ) -- ignored for compat w/ gcc
 259
 260         ----- RTS opts ------------------------------------------------------
 261   ,  ( "H"                 , HasArg (setHeapSize . fromIntegral . decodeSize) )
 262   ,  ( "Rghc-timing"       , NoArg  (enableTimingStats) )
 263
 264         ------ Compiler flags -----------------------------------------------
 265   ,  ( "O2-for-C"          , NoArg (writeIORef v_minus_o2_for_C True) )
 266   ,  ( "O"                 , OptPrefix (setOptLevel) )
 267
 268   ,  ( "fno-asm-mangling"  , NoArg (writeIORef v_Do_asm_mangling False) )
 269
 270   ,  ( "fmax-simplifier-iterations",
 271                 Prefix (writeIORef v_MaxSimplifierIterations . read) )
 272
 273   ,  ( "fusagesp"          , NoArg (do writeIORef v_UsageSPInf True
 274                                        add v_Opt_C "-fusagesp-on") )
 275
 276   ,  ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True
 277                                        add v_Opt_C "-fexcess-precision"))
 278
 279         -- Optimisation flags are treated specially, so the normal
 280         -- -fno-* pattern below doesn't work.  We therefore allow
 281         -- certain optimisation passes to be turned off explicitly:
 282   ,  ( "fno-strictness"    , NoArg (writeIORef v_Strictness False) )
 283   ,  ( "fno-cpr"           , NoArg (writeIORef v_CPR False) )
 284   ,  ( "fno-cse"           , NoArg (writeIORef v_CSE False) )
 285
 286         -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
 287   ,  ( "fno-",                  PrefixPred (\s -> isStaticHscFlag ("f"++s))
 288                                     (\s -> add v_Anti_opt_C ("-f"++s)) )
 289
 290         -- Pass all remaining "-f<blah>" options to hsc
 291   ,  ( "f",                     AnySuffixPred (isStaticHscFlag) (add v_Opt_C) )
 292   ]
 293
 294 -----------------------------------------------------------------------------
 295 -- parse the dynamic arguments
 296
 297 -- v_InitDynFlags
 298 --      is the "baseline" dynamic flags, initialised from
 299 --      the defaults and command line options, and updated by the
 300 --      ':s' command in GHCi.
 301 --
 302 -- v_DynFlags
 303 --      is the dynamic flags for the current compilation.  It is reset
 304 --      to the value of v_InitDynFlags before each compilation, then
 305 --      updated by reading any OPTIONS pragma in the current module.
 306
 307 GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
 308 GLOBAL_VAR(v_DynFlags,     defaultDynFlags, DynFlags)
 309
 310 updDynFlags f = do
 311    dfs <- readIORef v_DynFlags
 312    writeIORef v_DynFlags (f dfs)
 313
 314 getDynFlags :: IO DynFlags
 315 getDynFlags = readIORef v_DynFlags
 316
 317 dynFlag :: (DynFlags -> a) -> IO a
 318 dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
 319
 320 setDynFlag f   = updDynFlags (\dfs -> dopt_set dfs f)
 321 unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
 322
 323 addOpt_L     a = updDynFlags (\s -> s{opt_L =  a : opt_L s})
 324 addOpt_P     a = updDynFlags (\s -> s{opt_P =  a : opt_P s})
 325 addOpt_c     a = updDynFlags (\s -> s{opt_c =  a : opt_c s})
 326 addOpt_a     a = updDynFlags (\s -> s{opt_a =  a : opt_a s})
 327 addOpt_m     a = updDynFlags (\s -> s{opt_m =  a : opt_m s})
 328
 329 addCmdlineHCInclude a =
 330    updDynFlags (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
 331
 332         -- we add to the options from the front, so we need to reverse the list
 333 getOpts :: (DynFlags -> [a]) -> IO [a]
 334 getOpts opts = dynFlag opts >>= return . reverse
 335
 336 -- we can only change HscC to HscAsm and vice-versa with dynamic flags
 337 -- (-fvia-C and -fasm).
 338 -- NB: we can also set the new lang to ILX, via -filx.  I hope this is right
 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 = 3 })
 352 setVerbosity n
 353   | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
 354   | otherwise     = throwDyn (UsageError "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  (updDynFlags (\s -> s{ cppFlag = 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-tc-trace",         NoArg (setDynFlag Opt_D_dump_tc_trace) )
 407   ,  ( "ddump-rn-stats",         NoArg (setDynFlag Opt_D_dump_rn_stats) )
 408   ,  ( "ddump-stix",             NoArg (setDynFlag Opt_D_dump_stix) )
 409   ,  ( "ddump-simpl-stats",      NoArg (setDynFlag Opt_D_dump_simpl_stats) )
 410   ,  ( "ddump-bcos",             NoArg (setDynFlag Opt_D_dump_BCOs) )
 411   ,  ( "dsource-stats",          NoArg (setDynFlag Opt_D_source_stats) )
 412   ,  ( "dverbose-core2core",     NoArg (setDynFlag Opt_D_verbose_core2core) )
 413   ,  ( "dverbose-stg2stg",       NoArg (setDynFlag Opt_D_verbose_stg2stg) )
 414   ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs) )
 415   ,  ( "ddump-hi",               NoArg (setDynFlag Opt_D_dump_hi) )
 416   ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports) )
 417   ,  ( "dcore-lint",             NoArg (setDynFlag Opt_DoCoreLinting) )
 418   ,  ( "dstg-lint",              NoArg (setDynFlag Opt_DoStgLinting) )
 419   ,  ( "dusagesp-lint",          NoArg (setDynFlag Opt_DoUSPLinting) )
 420
 421         ------ Machine dependant (-m<blah>) stuff ---------------------------
 422
 423   ,  ( "monly-2-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 2}) ))
 424   ,  ( "monly-3-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 3}) ))
 425   ,  ( "monly-4-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 4}) ))
 426
 427         ------ Warning opts -------------------------------------------------
 428   ,  ( "W"              , NoArg (mapM_ setDynFlag   minusWOpts)    )
 429   ,  ( "Wall"           , NoArg (mapM_ setDynFlag   minusWallOpts) )
 430   ,  ( "Wnot"           , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
 431   ,  ( "w"              , NoArg (mapM_ unSetDynFlag minusWallOpts) )
 432
 433         ------ Compiler flags -----------------------------------------------
 434
 435   ,  ( "fasm",          AnySuffix (\_ -> setLang HscAsm) )
 436   ,  ( "fvia-c",        NoArg (setLang HscC) )
 437   ,  ( "fvia-C",        NoArg (setLang HscC) )
 438 #ifdef ILX
 439   ,  ( "filx",          NoArg (setLang HscILX) )
 440 #endif
 441
 442         -- "active negatives"
 443   ,  ( "fno-implicit-prelude",  NoArg (setDynFlag Opt_NoImplicitPrelude) )
 444
 445         -- the rest of the -f* and -fno-* flags
 446   ,  ( "fno-",          PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )
 447   ,  ( "f",             PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag f)) )
 448  ]
 449
 450 -- these -f<blah> flags can all be reversed with -fno-<blah>
 451
 452 fFlags = [
 453   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports ),
 454   ( "warn-hi-shadowing",                Opt_WarnHiShadows ),
 455   ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns ),
 456   ( "warn-missing-fields",              Opt_WarnMissingFields ),
 457   ( "warn-missing-methods",             Opt_WarnMissingMethods ),
 458   ( "warn-missing-signatures",          Opt_WarnMissingSigs ),
 459   ( "warn-name-shadowing",              Opt_WarnNameShadowing ),
 460   ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns ),
 461   ( "warn-simple-patterns",             Opt_WarnSimplePatterns ),
 462   ( "warn-type-defaults",               Opt_WarnTypeDefaults ),
 463   ( "warn-unused-binds",                Opt_WarnUnusedBinds ),
 464   ( "warn-unused-imports",              Opt_WarnUnusedImports ),
 465   ( "warn-unused-matches",              Opt_WarnUnusedMatches ),
 466   ( "warn-deprecations",                Opt_WarnDeprecations ),
 467   ( "glasgow-exts",                     Opt_GlasgowExts ),
 468   ( "allow-overlapping-instances",      Opt_AllowOverlappingInstances ),
 469   ( "allow-undecidable-instances",      Opt_AllowUndecidableInstances ),
 470   ( "generics",                         Opt_Generics )
 471   ]
 472
 473 isFFlag f = f `elem` (map fst fFlags)
 474 getFFlag f = fromJust (lookup f fFlags)
 475
 476 -----------------------------------------------------------------------------
 477 -- convert sizes like "3.5M" into integers
 478
 479 decodeSize :: String -> Integer
 480 decodeSize str
 481   | c == ""              = truncate n
 482   | c == "K" || c == "k" = truncate (n * 1000)
 483   | c == "M" || c == "m" = truncate (n * 1000 * 1000)
 484   | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
 485   | otherwise            = throwDyn (CmdLineError ("can't decode size: " ++ str))
 486   where (m, c) = span pred str
 487         n      = read m  :: Double
 488         pred c = isDigit c || c == '.'
 489
 490 floatOpt :: IORef Double -> String -> IO ()
 491 floatOpt ref str = writeIORef ref (read str :: Double)
 492
 493 -----------------------------------------------------------------------------
 494 -- RTS Hooks
 495
 496 foreign import "setHeapSize"       unsafe setHeapSize       :: Int -> IO ()
 497 foreign import "enableTimingStats" unsafe enableTimingStats :: IO ()
 498
 499 -----------------------------------------------------------------------------
 500 -- Build the Hsc static command line opts
 501
 502 buildStaticHscOpts :: IO [String]
 503 buildStaticHscOpts = do
 504
 505   opt_C_ <- getStaticOpts v_Opt_C       -- misc hsc opts from the command line
 506
 507         -- optimisation
 508   minus_o <- readIORef v_OptLevel
 509   let optimisation_opts =
 510         case minus_o of
 511             0 -> hsc_minusNoO_flags
 512             1 -> hsc_minusO_flags
 513             2 -> hsc_minusO2_flags
 514             _ -> error "unknown opt level"
 515             -- ToDo: -Ofile
 516
 517         -- take into account -fno-* flags by removing the equivalent -f*
 518         -- flag from our list.
 519   anti_flags <- getStaticOpts v_Anti_opt_C
 520   let basic_opts = opt_C_ ++ optimisation_opts
 521       filtered_opts = filter (`notElem` anti_flags) basic_opts
 522
 523   static <- (do s <- readIORef v_Static; if s then return "-static"
 524                                               else return "")
 525
 526   return ( static : filtered_opts )
 527
 528 -----------------------------------------------------------------------------
 529 -- Running an external program
 530
 531 -- sigh, here because both DriverMkDepend & DriverPipeline need it.
 532
 533 runSomething phase_name cmd
 534  = do
 535    verb <- dynFlag verbosity
 536    when (verb >= 2) $ hPutStrLn stderr ("*** " ++ phase_name)
 537    when (verb >= 3) $ hPutStrLn stderr cmd
 538    hFlush stderr
 539
 540    -- test for -n flag
 541    n <- readIORef v_Dry_run
 542    unless n $ do
 543
 544    -- and run it!
 545    exit_code <- kludgedSystem cmd phase_name
 546
 547    if exit_code /= ExitSuccess
 548         then throwDyn (PhaseFailed phase_name exit_code)
 549         else do when (verb >= 3) (hPutStr stderr "\n")
 550                 return ()
 551
 552 -----------------------------------------------------------------------------
 553 -- Via-C compilation stuff
 554
 555 -- flags returned are: ( all C compilations
 556 --                     , registerised HC compilations
 557 --                     )
 558
 559 machdepCCOpts
 560    | prefixMatch "alpha"   cTARGETPLATFORM
 561         = return ( ["-static"], [] )
 562
 563    | prefixMatch "hppa"    cTARGETPLATFORM
 564         -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
 565         -- (very nice, but too bad the HP /usr/include files don't agree.)
 566         = return ( ["-static", "-D_HPUX_SOURCE"], [] )
 567
 568    | prefixMatch "m68k"    cTARGETPLATFORM
 569       -- -fno-defer-pop : for the .hc files, we want all the pushing/
 570       --    popping of args to routines to be explicit; if we let things
 571       --    be deferred 'til after an STGJUMP, imminent death is certain!
 572       --
 573       -- -fomit-frame-pointer : *don't*
 574       --     It's better to have a6 completely tied up being a frame pointer
 575       --     rather than let GCC pick random things to do with it.
 576       --     (If we want to steal a6, then we would try to do things
 577       --     as on iX86, where we *do* steal the frame pointer [%ebp].)
 578         = return ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
 579
 580    | prefixMatch "i386"    cTARGETPLATFORM
 581       -- -fno-defer-pop : basically the same game as for m68k
 582       --
 583       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
 584       --   the fp (%ebp) for our register maps.
 585         = do n_regs <- dynFlag stolen_x86_regs
 586              sta    <- readIORef v_Static
 587              return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "",
 588                         if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin -mwin32" else "" ],
 589                       [ "-fno-defer-pop", "-fomit-frame-pointer",
 590                         "-DSTOLEN_X86_REGS="++show n_regs ]
 591                     )
 592
 593    | prefixMatch "mips"    cTARGETPLATFORM
 594         = return ( ["static"], [] )
 595
 596    | prefixMatch "powerpc" cTARGETPLATFORM || prefixMatch "rs6000" cTARGETPLATFORM
 597         = return ( ["static"], ["-finhibit-size-directive"] )
 598
 599    | otherwise
 600         = return ( [], [] )