ghc/compiler/main/DriverFlags.hs

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