ghc/compiler/main/DriverFlags.hs

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