ghc/compiler/main/DriverFlags.hs

   1 {-# OPTIONS -#include "hschooks.h" #-}
   2
   3 -----------------------------------------------------------------------------
   4 -- $Id: DriverFlags.hs,v 1.55 2001/05/28 03:31:19 sof 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   ,  ( "buildtag"       , HasArg (writeIORef v_Build_tag) )
 212   ,  ( "tmpdir"         , HasArg (writeIORef v_TmpDir . (++ "/")) )
 213   ,  ( "ohi"            , HasArg (writeIORef v_Output_hi   . Just) )
 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         ------- Specific phases  --------------------------------------------
 244   ,  ( "pgmL"           , HasArg (writeIORef v_Pgm_L) )
 245   ,  ( "pgmP"           , HasArg (writeIORef v_Pgm_P) )
 246   ,  ( "pgmc"           , HasArg (writeIORef v_Pgm_c) )
 247   ,  ( "pgmm"           , HasArg (writeIORef v_Pgm_m) )
 248   ,  ( "pgms"           , HasArg (writeIORef v_Pgm_s) )
 249   ,  ( "pgma"           , HasArg (writeIORef v_Pgm_a) )
 250   ,  ( "pgml"           , HasArg (writeIORef v_Pgm_l) )
 251
 252   ,  ( "optdep"         , HasArg (add v_Opt_dep) )
 253   ,  ( "optl"           , HasArg (add v_Opt_l) )
 254   ,  ( "optdll"         , HasArg (add v_Opt_dll) )
 255
 256         ----- Linker --------------------------------------------------------
 257   ,  ( "static"         , NoArg (writeIORef v_Static True) )
 258   ,  ( "dynamic"        , NoArg (writeIORef v_Static False) )
 259   ,  ( "rdynamic"       , NoArg (return ()) ) -- ignored for compat w/ gcc
 260
 261         ----- RTS opts ------------------------------------------------------
 262   ,  ( "H"                 , HasArg (setHeapSize . fromIntegral . decodeSize) )
 263   ,  ( "Rghc-timing"       , NoArg  (enableTimingStats) )
 264
 265         ------ Compiler flags -----------------------------------------------
 266   ,  ( "O2-for-C"          , NoArg (writeIORef v_minus_o2_for_C True) )
 267   ,  ( "O"                 , OptPrefix (setOptLevel) )
 268
 269   ,  ( "fno-asm-mangling"  , NoArg (writeIORef v_Do_asm_mangling False) )
 270
 271   ,  ( "fmax-simplifier-iterations",
 272                 Prefix (writeIORef v_MaxSimplifierIterations . read) )
 273
 274   ,  ( "fusagesp"          , NoArg (do writeIORef v_UsageSPInf True
 275                                        add v_Opt_C "-fusagesp-on") )
 276
 277   ,  ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True
 278                                        add v_Opt_C "-fexcess-precision"))
 279
 280         -- Optimisation flags are treated specially, so the normal
 281         -- -fno-* pattern below doesn't work.  We therefore allow
 282         -- certain optimisation passes to be turned off explicitly:
 283   ,  ( "fno-strictness"    , NoArg (writeIORef v_Strictness False) )
 284   ,  ( "fno-cpr"           , NoArg (writeIORef v_CPR False) )
 285   ,  ( "fno-cse"           , NoArg (writeIORef v_CSE False) )
 286
 287         -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
 288   ,  ( "fno-",                  PrefixPred (\s -> isStaticHscFlag ("f"++s))
 289                                     (\s -> add v_Anti_opt_C ("-f"++s)) )
 290
 291         -- Pass all remaining "-f<blah>" options to hsc
 292   ,  ( "f",                     AnySuffixPred (isStaticHscFlag) (add v_Opt_C) )
 293   ]
 294
 295 -----------------------------------------------------------------------------
 296 -- parse the dynamic arguments
 297
 298 -- v_InitDynFlags
 299 --      is the "baseline" dynamic flags, initialised from
 300 --      the defaults and command line options, and updated by the
 301 --      ':s' command in GHCi.
 302 --
 303 -- v_DynFlags
 304 --      is the dynamic flags for the current compilation.  It is reset
 305 --      to the value of v_InitDynFlags before each compilation, then
 306 --      updated by reading any OPTIONS pragma in the current module.
 307
 308 GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
 309 GLOBAL_VAR(v_DynFlags,     defaultDynFlags, DynFlags)
 310
 311 updDynFlags f = do
 312    dfs <- readIORef v_DynFlags
 313    writeIORef v_DynFlags (f dfs)
 314
 315 getDynFlags :: IO DynFlags
 316 getDynFlags = readIORef v_DynFlags
 317
 318 dynFlag :: (DynFlags -> a) -> IO a
 319 dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
 320
 321 setDynFlag f   = updDynFlags (\dfs -> dopt_set dfs f)
 322 unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
 323
 324 addOpt_L     a = updDynFlags (\s -> s{opt_L =  a : opt_L s})
 325 addOpt_P     a = updDynFlags (\s -> s{opt_P =  a : opt_P s})
 326 addOpt_c     a = updDynFlags (\s -> s{opt_c =  a : opt_c s})
 327 addOpt_a     a = updDynFlags (\s -> s{opt_a =  a : opt_a s})
 328 addOpt_m     a = updDynFlags (\s -> s{opt_m =  a : opt_m s})
 329
 330 addCmdlineHCInclude a =
 331    updDynFlags (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
 332
 333         -- we add to the options from the front, so we need to reverse the list
 334 getOpts :: (DynFlags -> [a]) -> IO [a]
 335 getOpts opts = dynFlag opts >>= return . reverse
 336
 337 -- we can only change HscC to HscAsm and vice-versa with dynamic flags
 338 -- (-fvia-C and -fasm).
 339 -- NB: we can also set the new lang to ILX, via -filx.  I hope this is right
 340 setLang l = do
 341    dfs <- readIORef v_DynFlags
 342    case hscLang dfs of
 343         HscC   -> writeIORef v_DynFlags dfs{ hscLang = l }
 344         HscAsm -> writeIORef v_DynFlags dfs{ hscLang = l }
 345         HscILX -> writeIORef v_DynFlags dfs{ hscLang = l }
 346         _      -> return ()
 347
 348 setVerbosityAtLeast n =
 349   updDynFlags (\dfs -> if verbosity dfs < n
 350                           then dfs{ verbosity = n }
 351                           else dfs)
 352
 353 setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
 354 setVerbosity n
 355   | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
 356   | otherwise     = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
 357
 358 getVerbFlag = do
 359    verb <- dynFlag verbosity
 360    if verb >= 3  then return  "-v" else return ""
 361
 362 dynamic_flags = [
 363
 364      ( "cpp",           NoArg  (updDynFlags (\s -> s{ cppFlag = True })) )
 365   ,  ( "#include",      HasArg (addCmdlineHCInclude) )
 366
 367   ,  ( "v",             OptPrefix (setVerbosity) )
 368
 369   ,  ( "optL",          HasArg (addOpt_L) )
 370   ,  ( "optP",          HasArg (addOpt_P) )
 371   ,  ( "optc",          HasArg (addOpt_c) )
 372   ,  ( "optm",          HasArg (addOpt_m) )
 373   ,  ( "opta",          HasArg (addOpt_a) )
 374
 375         ------ HsCpp opts ---------------------------------------------------
 376   ,  ( "D",             Prefix (\s -> addOpt_P ("-D'"++s++"'") ) )
 377   ,  ( "U",             Prefix (\s -> addOpt_P ("-U'"++s++"'") ) )
 378
 379         ------ Debugging ----------------------------------------------------
 380   ,  ( "dstg-stats",    NoArg (writeIORef v_StgStats True) )
 381
 382   ,  ( "ddump-absC",             NoArg (setDynFlag Opt_D_dump_absC) )
 383   ,  ( "ddump-asm",              NoArg (setDynFlag Opt_D_dump_asm) )
 384   ,  ( "ddump-cpranal",          NoArg (setDynFlag Opt_D_dump_cpranal) )
 385   ,  ( "ddump-deriv",            NoArg (setDynFlag Opt_D_dump_deriv) )
 386   ,  ( "ddump-ds",               NoArg (setDynFlag Opt_D_dump_ds) )
 387   ,  ( "ddump-flatC",            NoArg (setDynFlag Opt_D_dump_flatC) )
 388   ,  ( "ddump-foreign",          NoArg (setDynFlag Opt_D_dump_foreign) )
 389   ,  ( "ddump-inlinings",        NoArg (setDynFlag Opt_D_dump_inlinings) )
 390   ,  ( "ddump-occur-anal",       NoArg (setDynFlag Opt_D_dump_occur_anal) )
 391   ,  ( "ddump-parsed",           NoArg (setDynFlag Opt_D_dump_parsed) )
 392   ,  ( "ddump-realC",            NoArg (setDynFlag Opt_D_dump_realC) )
 393   ,  ( "ddump-rn",               NoArg (setDynFlag Opt_D_dump_rn) )
 394   ,  ( "ddump-simpl",            NoArg (setDynFlag Opt_D_dump_simpl) )
 395   ,  ( "ddump-simpl-iterations", NoArg (setDynFlag Opt_D_dump_simpl_iterations) )
 396   ,  ( "ddump-spec",             NoArg (setDynFlag Opt_D_dump_spec) )
 397   ,  ( "ddump-sat",              NoArg (setDynFlag Opt_D_dump_sat) )
 398   ,  ( "ddump-stg",              NoArg (setDynFlag Opt_D_dump_stg) )
 399   ,  ( "ddump-stranal",          NoArg (setDynFlag Opt_D_dump_stranal) )
 400   ,  ( "ddump-tc",               NoArg (setDynFlag Opt_D_dump_tc) )
 401   ,  ( "ddump-types",            NoArg (setDynFlag Opt_D_dump_types) )
 402   ,  ( "ddump-rules",            NoArg (setDynFlag Opt_D_dump_rules) )
 403   ,  ( "ddump-usagesp",          NoArg (setDynFlag Opt_D_dump_usagesp) )
 404   ,  ( "ddump-cse",              NoArg (setDynFlag Opt_D_dump_cse) )
 405   ,  ( "ddump-worker-wrapper",   NoArg (setDynFlag Opt_D_dump_worker_wrapper) )
 406   ,  ( "dshow-passes",           NoArg (setVerbosity "2") )
 407   ,  ( "ddump-rn-trace",         NoArg (setDynFlag Opt_D_dump_rn_trace) )
 408   ,  ( "ddump-tc-trace",         NoArg (setDynFlag Opt_D_dump_tc_trace) )
 409   ,  ( "ddump-rn-stats",         NoArg (setDynFlag Opt_D_dump_rn_stats) )
 410   ,  ( "ddump-stix",             NoArg (setDynFlag Opt_D_dump_stix) )
 411   ,  ( "ddump-simpl-stats",      NoArg (setDynFlag Opt_D_dump_simpl_stats) )
 412   ,  ( "ddump-bcos",             NoArg (setDynFlag Opt_D_dump_BCOs) )
 413   ,  ( "dsource-stats",          NoArg (setDynFlag Opt_D_source_stats) )
 414   ,  ( "dverbose-core2core",     NoArg (setDynFlag Opt_D_verbose_core2core) )
 415   ,  ( "dverbose-stg2stg",       NoArg (setDynFlag Opt_D_verbose_stg2stg) )
 416   ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs) )
 417   ,  ( "ddump-hi",               NoArg (setDynFlag Opt_D_dump_hi) )
 418   ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports) )
 419   ,  ( "dcore-lint",             NoArg (setDynFlag Opt_DoCoreLinting) )
 420   ,  ( "dstg-lint",              NoArg (setDynFlag Opt_DoStgLinting) )
 421   ,  ( "dusagesp-lint",          NoArg (setDynFlag Opt_DoUSPLinting) )
 422
 423         ------ Machine dependant (-m<blah>) stuff ---------------------------
 424
 425   ,  ( "monly-2-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 2}) ))
 426   ,  ( "monly-3-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 3}) ))
 427   ,  ( "monly-4-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 4}) ))
 428
 429         ------ Warning opts -------------------------------------------------
 430   ,  ( "W"              , NoArg (mapM_ setDynFlag   minusWOpts)    )
 431   ,  ( "Wall"           , NoArg (mapM_ setDynFlag   minusWallOpts) )
 432   ,  ( "Wnot"           , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
 433   ,  ( "w"              , NoArg (mapM_ unSetDynFlag minusWallOpts) )
 434
 435         ------ Compiler flags -----------------------------------------------
 436
 437   ,  ( "fasm",          AnySuffix (\_ -> setLang HscAsm) )
 438   ,  ( "fvia-c",        NoArg (setLang HscC) )
 439   ,  ( "fvia-C",        NoArg (setLang HscC) )
 440   ,  ( "filx",          NoArg (setLang HscILX) )
 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" 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 ( [], [] )