ghc/compiler/main/DriverFlags.hs

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