ghc/compiler/main/DriverFlags.hs

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