ghc/compiler/main/DriverFlags.hs

   1 {-# OPTIONS -#include "hschooks.h" #-}
   2
   3 -----------------------------------------------------------------------------
   4 -- $Id: DriverFlags.hs,v 1.85 2002/01/25 10:28:14 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         addCmdlineHCInclude,
  15         buildStaticHscOpts,
  16         machdepCCOpts
  17   ) where
  18
  19 #include "HsVersions.h"
  20 #include "../includes/config.h"
  21
  22 import DriverState
  23 import DriverPhases
  24 import DriverUtil
  25 import SysTools
  26 import CmdLineOpts
  27 import Config
  28 import Util
  29 import Panic
  30
  31 import Exception
  32 import IOExts
  33 import System           ( exitWith, ExitCode(..) )
  34
  35 import IO
  36 import Maybe
  37 import Monad
  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
  77 processArgs spec args@(('-':arg):args') spare = do
  78   case findArg spec arg of
  79     Just (rest,action) -> do args' <- processOneArg action rest args
  80                              processArgs spec args' spare
  81     Nothing            -> processArgs spec args' (('-':arg):spare)
  82
  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,
 131            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 / version ----------------------------------------------
 156      ( "?"               , NoArg showGhcUsage)
 157   ,  ( "-help"           , NoArg showGhcUsage)
 158   ,  ( "-print-libdir"   , NoArg (do getTopDir >>= putStrLn
 159                                      exitWith ExitSuccess))
 160   ,  ( "-version"        , NoArg (do putStrLn (cProjectName
 161                                       ++ ", version " ++ cProjectVersion)
 162                                      exitWith ExitSuccess))
 163   ,  ( "-numeric-version", NoArg (do putStrLn cProjectVersion
 164                                      exitWith ExitSuccess))
 165
 166       ------- verbosity ----------------------------------------------------
 167   ,  ( "n"              , NoArg setDryRun )
 168
 169       ------- primary modes ------------------------------------------------
 170   ,  ( "M"              , PassFlag (setMode DoMkDependHS))
 171   ,  ( "E"              , PassFlag (setMode (StopBefore Hsc)))
 172   ,  ( "C"              , PassFlag (\f -> do setMode (StopBefore HCc) f
 173                                              setLang HscC))
 174   ,  ( "S"              , PassFlag (setMode (StopBefore As)))
 175   ,  ( "c"              , PassFlag (setMode (StopBefore Ln)))
 176   ,  ( "-make"          , PassFlag (setMode DoMake))
 177   ,  ( "-interactive"   , PassFlag (setMode DoInteractive))
 178   ,  ( "-mk-dll"        , PassFlag (setMode DoMkDLL))
 179
 180         -- -fno-code says to stop after Hsc but don't generate any code.
 181   ,  ( "fno-code"       , PassFlag (\f -> do setMode (StopBefore HCc) f
 182                                              setLang HscNothing
 183                                              writeIORef v_Recomp False))
 184
 185         ------- GHCi -------------------------------------------------------
 186   ,  ( "ignore-dot-ghci", NoArg (writeIORef v_Read_DotGHCi False) )
 187   ,  ( "read-dot-ghci"  , NoArg (writeIORef v_Read_DotGHCi True) )
 188
 189         ------- recompilation checker --------------------------------------
 190   ,  ( "recomp"         , NoArg (writeIORef v_Recomp True) )
 191   ,  ( "no-recomp"      , NoArg (writeIORef v_Recomp False) )
 192
 193         ------- ways --------------------------------------------------------
 194   ,  ( "prof"           , NoArg (addNoDups v_Ways       WayProf) )
 195   ,  ( "unreg"          , NoArg (addNoDups v_Ways       WayUnreg) )
 196   ,  ( "ticky"          , NoArg (addNoDups v_Ways       WayTicky) )
 197   ,  ( "parallel"       , NoArg (addNoDups v_Ways       WayPar) )
 198   ,  ( "gransim"        , NoArg (addNoDups v_Ways       WayGran) )
 199   ,  ( "smp"            , NoArg (addNoDups v_Ways       WaySMP) )
 200   ,  ( "debug"          , NoArg (addNoDups v_Ways       WayDebug) )
 201         -- ToDo: user ways
 202
 203         ------ Debugging ----------------------------------------------------
 204   ,  ( "dppr-noprags",     PassFlag (add v_Opt_C) )
 205   ,  ( "dppr-debug",       PassFlag (add v_Opt_C) )
 206   ,  ( "dppr-user-length", AnySuffix (add v_Opt_C) )
 207       -- rest of the debugging flags are dynamic
 208
 209         --------- Profiling --------------------------------------------------
 210   ,  ( "auto-dicts"     , NoArg (add v_Opt_C "-fauto-sccs-on-dicts") )
 211   ,  ( "auto-all"       , NoArg (add v_Opt_C "-fauto-sccs-on-all-toplevs") )
 212   ,  ( "auto"           , NoArg (add v_Opt_C "-fauto-sccs-on-exported-toplevs") )
 213   ,  ( "caf-all"        , NoArg (add v_Opt_C "-fauto-sccs-on-individual-cafs") )
 214          -- "ignore-sccs"  doesn't work  (ToDo)
 215
 216   ,  ( "no-auto-dicts"  , NoArg (add v_Anti_opt_C "-fauto-sccs-on-dicts") )
 217   ,  ( "no-auto-all"    , NoArg (add v_Anti_opt_C "-fauto-sccs-on-all-toplevs") )
 218   ,  ( "no-auto"        , NoArg (add v_Anti_opt_C "-fauto-sccs-on-exported-toplevs") )
 219   ,  ( "no-caf-all"     , NoArg (add v_Anti_opt_C "-fauto-sccs-on-individual-cafs") )
 220
 221         ------- Miscellaneous -----------------------------------------------
 222   ,  ( "no-link-chk"    , NoArg (return ()) ) -- ignored for backwards compat
 223   ,  ( "no-hs-main"     , NoArg (writeIORef v_NoHsMain True) )
 224
 225         ------- Output Redirection ------------------------------------------
 226   ,  ( "odir"           , HasArg (writeIORef v_Output_dir  . Just) )
 227   ,  ( "o"              , SepArg (writeIORef v_Output_file . Just) )
 228   ,  ( "osuf"           , HasArg (writeIORef v_Object_suf  . Just) )
 229   ,  ( "hcsuf"          , HasArg (writeIORef v_HC_suf      . Just) )
 230   ,  ( "hisuf"          , HasArg (writeIORef v_Hi_suf) )
 231   ,  ( "hidir"          , HasArg (writeIORef v_Hi_dir . Just) )
 232   ,  ( "buildtag"       , HasArg (writeIORef v_Build_tag) )
 233   ,  ( "tmpdir"         , HasArg setTmpDir)
 234   ,  ( "ohi"            , HasArg (writeIORef v_Output_hi   . Just) )
 235         -- -odump?
 236
 237   ,  ( "keep-hc-file"   , AnySuffix (\_ -> writeIORef v_Keep_hc_files True) )
 238   ,  ( "keep-s-file"    , AnySuffix (\_ -> writeIORef v_Keep_s_files  True) )
 239   ,  ( "keep-raw-s-file", AnySuffix (\_ -> writeIORef v_Keep_raw_s_files  True) )
 240 #ifdef ILX
 241   ,  ( "keep-il-file"   , AnySuffix (\_ -> writeIORef v_Keep_il_files True) )
 242   ,  ( "keep-ilx-file"  , AnySuffix (\_ -> writeIORef v_Keep_ilx_files True) )
 243 #endif
 244   ,  ( "keep-tmp-files" , AnySuffix (\_ -> writeIORef v_Keep_tmp_files True) )
 245
 246   ,  ( "split-objs"     , NoArg (if can_split
 247                                     then do writeIORef v_Split_object_files True
 248                                             add v_Opt_C "-fglobalise-toplev-names"
 249                                     else hPutStrLn stderr
 250                                             "warning: don't know how to  split \
 251                                             \object files on this architecture"
 252                                 ) )
 253
 254         ------- Include/Import Paths ----------------------------------------
 255   ,  ( "i"              , OptPrefix (addToDirList v_Import_paths) )
 256   ,  ( "I"              , Prefix    (addToDirList v_Include_paths) )
 257
 258         ------- Libraries ---------------------------------------------------
 259   ,  ( "L"              , Prefix (addToDirList v_Library_paths) )
 260   ,  ( "l"              , Prefix (add v_Cmdline_libraries) )
 261
 262         ------- Packages ----------------------------------------------------
 263   ,  ( "package-name"   , HasArg (\s -> add v_Opt_C ("-inpackage="++s)) )
 264
 265   ,  ( "package-conf"   , HasArg (readPackageConf) )
 266   ,  ( "package"        , HasArg (addPackage) )
 267   ,  ( "syslib"         , HasArg (addPackage) ) -- for compatibility w/ old vsns
 268
 269         ------- Specific phases  --------------------------------------------
 270   ,  ( "pgm"           , HasArg setPgm )
 271
 272   ,  ( "optdep"         , HasArg (add v_Opt_dep) )
 273   ,  ( "optl"           , HasArg (add v_Opt_l) )
 274   ,  ( "optdll"         , HasArg (add v_Opt_dll) )
 275
 276         ----- Linker --------------------------------------------------------
 277   ,  ( "static"         , NoArg (writeIORef v_Static True) )
 278   ,  ( "dynamic"        , NoArg (writeIORef v_Static False) )
 279   ,  ( "rdynamic"       , NoArg (return ()) ) -- ignored for compat w/ gcc
 280
 281         ----- RTS opts ------------------------------------------------------
 282   ,  ( "H"                 , HasArg (setHeapSize . fromIntegral . decodeSize) )
 283   ,  ( "Rghc-timing"       , NoArg  (enableTimingStats) )
 284
 285         ------ Compiler flags -----------------------------------------------
 286   ,  ( "O2-for-C"          , NoArg (writeIORef v_minus_o2_for_C True) )
 287   ,  ( "O"                 , NoArg (setOptLevel 1))
 288   ,  ( "Onot"              , NoArg (setOptLevel 0))
 289   ,  ( "O"                 , PrefixPred (all isDigit) (setOptLevel . read))
 290
 291   ,  ( "fno-asm-mangling"  , NoArg (writeIORef v_Do_asm_mangling False) )
 292
 293   ,  ( "fmax-simplifier-iterations",
 294                 Prefix (writeIORef v_MaxSimplifierIterations . read) )
 295
 296   ,  ( "frule-check",
 297                 SepArg (\s -> writeIORef v_RuleCheck (Just s)) )
 298
 299   ,  ( "fusagesp"          , NoArg (do writeIORef v_UsageSPInf True
 300                                        add v_Opt_C "-fusagesp-on") )
 301
 302   ,  ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True
 303                                        add v_Opt_C "-fexcess-precision"))
 304
 305         -- Optimisation flags are treated specially, so the normal
 306         -- -fno-* pattern below doesn't work.  We therefore allow
 307         -- certain optimisation passes to be turned off explicitly:
 308   ,  ( "fno-strictness"    , NoArg (writeIORef v_Strictness False) )
 309 #ifdef DEBUG
 310   ,  ( "fno-cpr"           , NoArg (writeIORef v_CPR False) )
 311 #endif
 312   ,  ( "fno-cse"           , NoArg (writeIORef v_CSE False) )
 313
 314         -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
 315   ,  ( "fno-",                  PrefixPred (\s -> isStaticHscFlag ("f"++s))
 316                                     (\s -> add v_Anti_opt_C ("-f"++s)) )
 317
 318         -- Pass all remaining "-f<blah>" options to hsc
 319   ,  ( "f",                     AnySuffixPred (isStaticHscFlag) (add v_Opt_C) )
 320   ]
 321
 322 dynamic_flags = [
 323
 324      ( "cpp",           NoArg  (updDynFlags (\s -> s{ cppFlag = True })) )
 325   ,  ( "F",             NoArg  (updDynFlags (\s -> s{ ppFlag = True })) )
 326   ,  ( "#include",      HasArg (addCmdlineHCInclude) )
 327
 328   ,  ( "v",             OptPrefix (setVerbosity) )
 329
 330   ,  ( "optL",          HasArg (addOpt_L) )
 331   ,  ( "optP",          HasArg (addOpt_P) )
 332   ,  ( "optF",          HasArg (addOpt_F) )
 333   ,  ( "optc",          HasArg (addOpt_c) )
 334   ,  ( "optm",          HasArg (addOpt_m) )
 335   ,  ( "opta",          HasArg (addOpt_a) )
 336 #ifdef ILX
 337   ,  ( "optI",          HasArg (addOpt_I) )
 338   ,  ( "opti",          HasArg (addOpt_i) )
 339 #endif
 340
 341         ------ HsCpp opts ---------------------------------------------------
 342         -- With a C compiler whose system() doesn't use a UNIX shell (i.e.
 343         -- mingwin gcc), -D and -U args must *not* be quoted, as the quotes
 344         -- will be interpreted as part of the arguments, and not stripped;
 345         -- on all other systems, quoting is necessary, to avoid interpretation
 346         -- of shell metacharacters in the arguments (e.g. green-card's
 347         -- -DBEGIN_GHC_ONLY='}-' trick).
 348 #ifndef mingw32_TARGET_OS
 349   ,  ( "D",             Prefix (\s -> addOpt_P ("-D'"++s++"'") ) )
 350   ,  ( "U",             Prefix (\s -> addOpt_P ("-U'"++s++"'") ) )
 351 #else
 352   ,  ( "D",             Prefix (\s -> addOpt_P ("-D"++s) ) )
 353   ,  ( "U",             Prefix (\s -> addOpt_P ("-U"++s) ) )
 354 #endif
 355
 356         ------ Debugging ----------------------------------------------------
 357   ,  ( "dstg-stats",    NoArg (writeIORef v_StgStats True) )
 358
 359   ,  ( "ddump-absC",             NoArg (setDynFlag Opt_D_dump_absC) )
 360   ,  ( "ddump-asm",              NoArg (setDynFlag Opt_D_dump_asm) )
 361   ,  ( "ddump-cpranal",          NoArg (setDynFlag Opt_D_dump_cpranal) )
 362   ,  ( "ddump-deriv",            NoArg (setDynFlag Opt_D_dump_deriv) )
 363   ,  ( "ddump-ds",               NoArg (setDynFlag Opt_D_dump_ds) )
 364   ,  ( "ddump-flatC",            NoArg (setDynFlag Opt_D_dump_flatC) )
 365   ,  ( "ddump-foreign",          NoArg (setDynFlag Opt_D_dump_foreign) )
 366   ,  ( "ddump-inlinings",        NoArg (setDynFlag Opt_D_dump_inlinings) )
 367   ,  ( "ddump-occur-anal",       NoArg (setDynFlag Opt_D_dump_occur_anal) )
 368   ,  ( "ddump-parsed",           NoArg (setDynFlag Opt_D_dump_parsed) )
 369   ,  ( "ddump-realC",            NoArg (setDynFlag Opt_D_dump_realC) )
 370   ,  ( "ddump-rn",               NoArg (setDynFlag Opt_D_dump_rn) )
 371   ,  ( "ddump-simpl",            NoArg (setDynFlag Opt_D_dump_simpl) )
 372   ,  ( "ddump-simpl-iterations", NoArg (setDynFlag Opt_D_dump_simpl_iterations) )
 373   ,  ( "ddump-spec",             NoArg (setDynFlag Opt_D_dump_spec) )
 374   ,  ( "ddump-prep",             NoArg (setDynFlag Opt_D_dump_prep) )
 375   ,  ( "ddump-stg",              NoArg (setDynFlag Opt_D_dump_stg) )
 376   ,  ( "ddump-stranal",          NoArg (setDynFlag Opt_D_dump_stranal) )
 377   ,  ( "ddump-tc",               NoArg (setDynFlag Opt_D_dump_tc) )
 378   ,  ( "ddump-types",            NoArg (setDynFlag Opt_D_dump_types) )
 379   ,  ( "ddump-rules",            NoArg (setDynFlag Opt_D_dump_rules) )
 380   ,  ( "ddump-usagesp",          NoArg (setDynFlag Opt_D_dump_usagesp) )
 381   ,  ( "ddump-cse",              NoArg (setDynFlag Opt_D_dump_cse) )
 382   ,  ( "ddump-worker-wrapper",   NoArg (setDynFlag Opt_D_dump_worker_wrapper) )
 383   ,  ( "dshow-passes",           NoArg (setVerbosity "2") )
 384   ,  ( "ddump-rn-trace",         NoArg (setDynFlag Opt_D_dump_rn_trace) )
 385   ,  ( "ddump-tc-trace",         NoArg (setDynFlag Opt_D_dump_tc_trace) )
 386   ,  ( "ddump-rn-stats",         NoArg (setDynFlag Opt_D_dump_rn_stats) )
 387   ,  ( "ddump-stix",             NoArg (setDynFlag Opt_D_dump_stix) )
 388   ,  ( "ddump-simpl-stats",      NoArg (setDynFlag Opt_D_dump_simpl_stats) )
 389   ,  ( "ddump-bcos",             NoArg (setDynFlag Opt_D_dump_BCOs) )
 390   ,  ( "dsource-stats",          NoArg (setDynFlag Opt_D_source_stats) )
 391   ,  ( "dverbose-core2core",     NoArg (setDynFlag Opt_D_verbose_core2core) )
 392   ,  ( "dverbose-stg2stg",       NoArg (setDynFlag Opt_D_verbose_stg2stg) )
 393   ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs) )
 394   ,  ( "ddump-hi",               NoArg (setDynFlag Opt_D_dump_hi) )
 395   ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports) )
 396   ,  ( "dcore-lint",             NoArg (setDynFlag Opt_DoCoreLinting) )
 397   ,  ( "dstg-lint",              NoArg (setDynFlag Opt_DoStgLinting) )
 398   ,  ( "dusagesp-lint",          NoArg (setDynFlag Opt_DoUSPLinting) )
 399
 400         ------ Machine dependant (-m<blah>) stuff ---------------------------
 401
 402   ,  ( "monly-2-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 2}) ))
 403   ,  ( "monly-3-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 3}) ))
 404   ,  ( "monly-4-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 4}) ))
 405
 406         ------ Warning opts -------------------------------------------------
 407   ,  ( "W"              , NoArg (mapM_ setDynFlag   minusWOpts)    )
 408   ,  ( "Wall"           , NoArg (mapM_ setDynFlag   minusWallOpts) )
 409   ,  ( "Wnot"           , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
 410   ,  ( "w"              , NoArg (mapM_ unSetDynFlag minusWallOpts) )
 411
 412         ------ Compiler flags -----------------------------------------------
 413
 414   ,  ( "fasm",          AnySuffix (\_ -> setLang HscAsm) )
 415   ,  ( "fvia-c",        NoArg (setLang HscC) )
 416   ,  ( "fvia-C",        NoArg (setLang HscC) )
 417   ,  ( "filx",          NoArg (setLang HscILX) )
 418
 419         -- "active negatives"
 420   ,  ( "fno-implicit-prelude",  NoArg (setDynFlag Opt_NoImplicitPrelude) )
 421   ,  ( "fno-monomorphism-restriction",
 422                         NoArg (setDynFlag Opt_NoMonomorphismRestriction) )
 423
 424         -- the rest of the -f* and -fno-* flags
 425   ,  ( "fno-",          PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )
 426   ,  ( "f",             PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag f)) )
 427  ]
 428
 429 -- these -f<blah> flags can all be reversed with -fno-<blah>
 430
 431 fFlags = [
 432   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports ),
 433   ( "warn-hi-shadowing",                Opt_WarnHiShadows ),
 434   ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns ),
 435   ( "warn-missing-fields",              Opt_WarnMissingFields ),
 436   ( "warn-missing-methods",             Opt_WarnMissingMethods ),
 437   ( "warn-missing-signatures",          Opt_WarnMissingSigs ),
 438   ( "warn-name-shadowing",              Opt_WarnNameShadowing ),
 439   ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns ),
 440   ( "warn-simple-patterns",             Opt_WarnSimplePatterns ),
 441   ( "warn-type-defaults",               Opt_WarnTypeDefaults ),
 442   ( "warn-unused-binds",                Opt_WarnUnusedBinds ),
 443   ( "warn-unused-imports",              Opt_WarnUnusedImports ),
 444   ( "warn-unused-matches",              Opt_WarnUnusedMatches ),
 445   ( "warn-deprecations",                Opt_WarnDeprecations ),
 446   ( "glasgow-exts",                     Opt_GlasgowExts ),
 447   ( "allow-overlapping-instances",      Opt_AllowOverlappingInstances ),
 448   ( "allow-undecidable-instances",      Opt_AllowUndecidableInstances ),
 449   ( "allow-incoherent-instances",       Opt_AllowIncoherentInstances ),
 450   ( "generics",                         Opt_Generics )
 451   ]
 452
 453 isFFlag f = f `elem` (map fst fFlags)
 454 getFFlag f = fromJust (lookup f fFlags)
 455
 456 -----------------------------------------------------------------------------
 457 -- convert sizes like "3.5M" into integers
 458
 459 decodeSize :: String -> Integer
 460 decodeSize str
 461   | c == ""              = truncate n
 462   | c == "K" || c == "k" = truncate (n * 1000)
 463   | c == "M" || c == "m" = truncate (n * 1000 * 1000)
 464   | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
 465   | otherwise            = throwDyn (CmdLineError ("can't decode size: " ++ str))
 466   where (m, c) = span pred str
 467         n      = read m  :: Double
 468         pred c = isDigit c || c == '.'
 469
 470
 471 -----------------------------------------------------------------------------
 472 -- RTS Hooks
 473
 474 foreign import "setHeapSize"       unsafe setHeapSize       :: Int -> IO ()
 475 foreign import "enableTimingStats" unsafe enableTimingStats :: IO ()
 476
 477 -----------------------------------------------------------------------------
 478 -- Build the Hsc static command line opts
 479
 480 buildStaticHscOpts :: IO [String]
 481 buildStaticHscOpts = do
 482
 483   opt_C_ <- getStaticOpts v_Opt_C       -- misc hsc opts from the command line
 484
 485         -- optimisation
 486   minus_o <- readIORef v_OptLevel
 487   let optimisation_opts =
 488         case minus_o of
 489             0 -> hsc_minusNoO_flags
 490             1 -> hsc_minusO_flags
 491             2 -> hsc_minusO2_flags
 492             n -> throwDyn (CmdLineError ("unknown optimisation level: "
 493                                           ++ show n))
 494             -- ToDo: -Ofile
 495
 496         -- take into account -fno-* flags by removing the equivalent -f*
 497         -- flag from our list.
 498   anti_flags <- getStaticOpts v_Anti_opt_C
 499   let basic_opts = opt_C_ ++ optimisation_opts
 500       filtered_opts = filter (`notElem` anti_flags) basic_opts
 501
 502   static <- (do s <- readIORef v_Static; if s then return "-static"
 503                                               else return "")
 504
 505   return ( static : filtered_opts )
 506
 507 -----------------------------------------------------------------------------
 508 -- Via-C compilation stuff
 509
 510 -- flags returned are: ( all C compilations
 511 --                     , registerised HC compilations
 512 --                     )
 513
 514 machdepCCOpts
 515    | prefixMatch "alpha"   cTARGETPLATFORM
 516         = return ( ["-static", "-w", "-mieee"], [] )
 517         -- For now, to suppress the gcc warning "call-clobbered
 518         -- register used for global register variable", we simply
 519         -- disable all warnings altogether using the -w flag. Oh well.
 520
 521    | prefixMatch "hppa"    cTARGETPLATFORM
 522         -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
 523         -- (very nice, but too bad the HP /usr/include files don't agree.)
 524         = return ( ["-static", "-D_HPUX_SOURCE"], [] )
 525
 526    | prefixMatch "m68k"    cTARGETPLATFORM
 527       -- -fno-defer-pop : for the .hc files, we want all the pushing/
 528       --    popping of args to routines to be explicit; if we let things
 529       --    be deferred 'til after an STGJUMP, imminent death is certain!
 530       --
 531       -- -fomit-frame-pointer : *don't*
 532       --     It's better to have a6 completely tied up being a frame pointer
 533       --     rather than let GCC pick random things to do with it.
 534       --     (If we want to steal a6, then we would try to do things
 535       --     as on iX86, where we *do* steal the frame pointer [%ebp].)
 536         = return ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
 537
 538    | prefixMatch "i386"    cTARGETPLATFORM
 539       -- -fno-defer-pop : basically the same game as for m68k
 540       --
 541       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
 542       --   the fp (%ebp) for our register maps.
 543         = do n_regs <- dynFlag stolen_x86_regs
 544              sta    <- readIORef v_Static
 545              return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "",
 546                         if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" ],
 547                       [ "-fno-defer-pop", "-fomit-frame-pointer",
 548                         "-DSTOLEN_X86_REGS="++show n_regs ]
 549                     )
 550
 551    | prefixMatch "mips"    cTARGETPLATFORM
 552         = return ( ["-static"], [] )
 553
 554    | prefixMatch "sparc"    cTARGETPLATFORM
 555         = return ( [], ["-w"] )
 556         -- For now, to suppress the gcc warning "call-clobbered
 557         -- register used for global register variable", we simply
 558         -- disable all warnings altogether using the -w flag. Oh well.
 559
 560    | prefixMatch "powerpc-apple-darwin" cTARGETPLATFORM
 561        = return ( ["-no-cpp-precomp"], [""] )
 562
 563    | prefixMatch "powerpc" cTARGETPLATFORM || prefixMatch "rs6000" cTARGETPLATFORM
 564         = return ( ["-static"], ["-finhibit-size-directive"] )
 565
 566    | otherwise
 567         = return ( [], [] )
 568
 569 -----------------------------------------------------------------------------
 570 -- local utils
 571
 572 addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
 573 addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
 574 addOpt_F a = updDynFlags (\s -> s{opt_F = a : opt_F s})
 575 addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s})
 576 addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s})
 577 addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s})
 578 #ifdef ILX
 579 addOpt_I a = updDynFlags (\s -> s{opt_I = a : opt_I s})
 580 addOpt_i a = updDynFlags (\s -> s{opt_i = a : opt_i s})
 581 #endif
 582
 583 setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
 584 setVerbosity n
 585   | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
 586   | otherwise     = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
 587
 588 addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})