ghc/compiler/main/DriverFlags.hs

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