ghc/compiler/main/DriverFlags.hs

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