ghc/compiler/main/DriverFlags.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: DriverFlags.hs,v 1.98 2002/07/03 15:15:24 sof 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 #ifdef darwin_TARGET_OS
 267         ------- Frameworks --------------------------------------------------
 268         -- -framework-path should really be -F ...
 269   ,  ( "framework-path" , HasArg (addToDirList v_Framework_paths) )
 270   ,  ( "framework"      , HasArg (add v_Cmdline_frameworks) )
 271 #endif
 272         ------- Packages ----------------------------------------------------
 273   ,  ( "package-name"   , HasArg (\s -> add v_Opt_C ("-inpackage="++s)) )
 274
 275   ,  ( "package-conf"   , HasArg (readPackageConf) )
 276   ,  ( "package"        , HasArg (addPackage) )
 277   ,  ( "syslib"         , HasArg (addPackage) ) -- for compatibility w/ old vsns
 278
 279         ------- Specific phases  --------------------------------------------
 280   ,  ( "pgmP"           , HasArg setPgmP )
 281   ,  ( "pgmF"           , HasArg setPgmF )
 282   ,  ( "pgmc"           , HasArg setPgmc )
 283   ,  ( "pgmm"           , HasArg setPgmm )
 284   ,  ( "pgms"           , HasArg setPgms )
 285   ,  ( "pgma"           , HasArg setPgma )
 286   ,  ( "pgml"           , HasArg setPgml )
 287 #ifdef ILX
 288   ,  ( "pgmI"           , HasArg setPgmI )
 289   ,  ( "pgmi"           , HasArg setPgmi )
 290 #endif
 291
 292   ,  ( "optdep"         , HasArg (add v_Opt_dep) )
 293   ,  ( "optl"           , HasArg (add v_Opt_l) )
 294   ,  ( "optdll"         , HasArg (add v_Opt_dll) )
 295
 296         ----- Linker --------------------------------------------------------
 297   ,  ( "static"         , NoArg (writeIORef v_Static True) )
 298   ,  ( "dynamic"        , NoArg (writeIORef v_Static False) )
 299   ,  ( "rdynamic"       , NoArg (return ()) ) -- ignored for compat w/ gcc
 300
 301         ----- RTS opts ------------------------------------------------------
 302   ,  ( "H"                 , HasArg (setHeapSize . fromIntegral . decodeSize) )
 303   ,  ( "Rghc-timing"       , NoArg  (enableTimingStats) )
 304
 305         ------ Compiler flags -----------------------------------------------
 306   ,  ( "O2-for-C"          , NoArg (writeIORef v_minus_o2_for_C True) )
 307   ,  ( "O"                 , NoArg (setOptLevel 1))
 308   ,  ( "Onot"              , NoArg (setOptLevel 0))
 309   ,  ( "O"                 , PrefixPred (all isDigit) (setOptLevel . read))
 310
 311   ,  ( "fno-asm-mangling"  , NoArg (writeIORef v_Do_asm_mangling False) )
 312
 313   ,  ( "fmax-simplifier-iterations",
 314                 Prefix (writeIORef v_MaxSimplifierIterations . read) )
 315
 316   ,  ( "frule-check",
 317                 SepArg (\s -> writeIORef v_RuleCheck (Just s)) )
 318
 319   ,  ( "fusagesp"          , NoArg (do writeIORef v_UsageSPInf True
 320                                        add v_Opt_C "-fusagesp-on") )
 321
 322   ,  ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True
 323                                        add v_Opt_C "-fexcess-precision"))
 324
 325         -- Optimisation flags are treated specially, so the normal
 326         -- -fno-* pattern below doesn't work.  We therefore allow
 327         -- certain optimisation passes to be turned off explicitly:
 328   ,  ( "fno-strictness"    , NoArg (writeIORef v_Strictness False) )
 329   ,  ( "fno-cse"           , NoArg (writeIORef v_CSE False) )
 330
 331         -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
 332   ,  ( "fno-",                  PrefixPred (\s -> isStaticHscFlag ("f"++s))
 333                                     (\s -> add v_Anti_opt_C ("-f"++s)) )
 334
 335         -- Pass all remaining "-f<blah>" options to hsc
 336   ,  ( "f",                     AnySuffixPred (isStaticHscFlag) (add v_Opt_C) )
 337   ]
 338
 339 dynamic_flags = [
 340
 341      ( "cpp",           NoArg  (updDynFlags (\s -> s{ cppFlag = True })) )
 342   ,  ( "F",             NoArg  (updDynFlags (\s -> s{ ppFlag = True })) )
 343   ,  ( "#include",      HasArg (addCmdlineHCInclude) )
 344
 345   ,  ( "v",             OptPrefix (setVerbosity) )
 346
 347   ,  ( "optL",          HasArg (addOpt_L) )
 348   ,  ( "optP",          HasArg (addOpt_P) )
 349   ,  ( "optF",          HasArg (addOpt_F) )
 350   ,  ( "optc",          HasArg (addOpt_c) )
 351   ,  ( "optm",          HasArg (addOpt_m) )
 352   ,  ( "opta",          HasArg (addOpt_a) )
 353 #ifdef ILX
 354   ,  ( "optI",          HasArg (addOpt_I) )
 355   ,  ( "opti",          HasArg (addOpt_i) )
 356 #endif
 357
 358         ------ HsCpp opts ---------------------------------------------------
 359         -- With a C compiler whose system() doesn't use a UNIX shell (i.e.
 360         -- mingwin gcc), -D and -U args must *not* be quoted, as the quotes
 361         -- will be interpreted as part of the arguments, and not stripped;
 362         -- on all other systems, quoting is necessary, to avoid interpretation
 363         -- of shell metacharacters in the arguments (e.g. green-card's
 364         -- -DBEGIN_GHC_ONLY='}-' trick).
 365 #ifndef mingw32_HOST_OS
 366   ,  ( "D",             Prefix (\s -> addOpt_P ("-D'"++s++"'") ) )
 367   ,  ( "U",             Prefix (\s -> addOpt_P ("-U'"++s++"'") ) )
 368 #else
 369   ,  ( "D",             Prefix (\s -> addOpt_P ("-D"++s) ) )
 370   ,  ( "U",             Prefix (\s -> addOpt_P ("-U"++s) ) )
 371 #endif
 372
 373         ------ Debugging ----------------------------------------------------
 374   ,  ( "dstg-stats",    NoArg (writeIORef v_StgStats True) )
 375
 376   ,  ( "ddump-absC",             NoArg (setDynFlag Opt_D_dump_absC) )
 377   ,  ( "ddump-asm",              NoArg (setDynFlag Opt_D_dump_asm) )
 378   ,  ( "ddump-cpranal",          NoArg (setDynFlag Opt_D_dump_cpranal) )
 379   ,  ( "ddump-deriv",            NoArg (setDynFlag Opt_D_dump_deriv) )
 380   ,  ( "ddump-ds",               NoArg (setDynFlag Opt_D_dump_ds) )
 381   ,  ( "ddump-flatC",            NoArg (setDynFlag Opt_D_dump_flatC) )
 382   ,  ( "ddump-foreign",          NoArg (setDynFlag Opt_D_dump_foreign) )
 383   ,  ( "ddump-inlinings",        NoArg (setDynFlag Opt_D_dump_inlinings) )
 384   ,  ( "ddump-occur-anal",       NoArg (setDynFlag Opt_D_dump_occur_anal) )
 385   ,  ( "ddump-parsed",           NoArg (setDynFlag Opt_D_dump_parsed) )
 386   ,  ( "ddump-realC",            NoArg (setDynFlag Opt_D_dump_realC) )
 387   ,  ( "ddump-rn",               NoArg (setDynFlag Opt_D_dump_rn) )
 388   ,  ( "ddump-simpl",            NoArg (setDynFlag Opt_D_dump_simpl) )
 389   ,  ( "ddump-simpl-iterations", NoArg (setDynFlag Opt_D_dump_simpl_iterations) )
 390   ,  ( "ddump-spec",             NoArg (setDynFlag Opt_D_dump_spec) )
 391   ,  ( "ddump-prep",             NoArg (setDynFlag Opt_D_dump_prep) )
 392   ,  ( "ddump-stg",              NoArg (setDynFlag Opt_D_dump_stg) )
 393   ,  ( "ddump-stranal",          NoArg (setDynFlag Opt_D_dump_stranal) )
 394   ,  ( "ddump-tc",               NoArg (setDynFlag Opt_D_dump_tc) )
 395   ,  ( "ddump-types",            NoArg (setDynFlag Opt_D_dump_types) )
 396   ,  ( "ddump-rules",            NoArg (setDynFlag Opt_D_dump_rules) )
 397   ,  ( "ddump-usagesp",          NoArg (setDynFlag Opt_D_dump_usagesp) )
 398   ,  ( "ddump-cse",              NoArg (setDynFlag Opt_D_dump_cse) )
 399   ,  ( "ddump-worker-wrapper",   NoArg (setDynFlag Opt_D_dump_worker_wrapper) )
 400   ,  ( "dshow-passes",           NoArg (setVerbosity "2") )
 401   ,  ( "ddump-rn-trace",         NoArg (setDynFlag Opt_D_dump_rn_trace) )
 402   ,  ( "ddump-tc-trace",         NoArg (setDynFlag Opt_D_dump_tc_trace) )
 403   ,  ( "ddump-rn-stats",         NoArg (setDynFlag Opt_D_dump_rn_stats) )
 404   ,  ( "ddump-stix",             NoArg (setDynFlag Opt_D_dump_stix) )
 405   ,  ( "ddump-simpl-stats",      NoArg (setDynFlag Opt_D_dump_simpl_stats) )
 406   ,  ( "ddump-bcos",             NoArg (setDynFlag Opt_D_dump_BCOs) )
 407   ,  ( "dsource-stats",          NoArg (setDynFlag Opt_D_source_stats) )
 408   ,  ( "dverbose-core2core",     NoArg (setDynFlag Opt_D_verbose_core2core) )
 409   ,  ( "dverbose-stg2stg",       NoArg (setDynFlag Opt_D_verbose_stg2stg) )
 410   ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs) )
 411   ,  ( "ddump-hi",               NoArg (setDynFlag Opt_D_dump_hi) )
 412   ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports) )
 413   ,  ( "ddump-vect",             NoArg (setDynFlag Opt_D_dump_vect) )
 414   ,  ( "dcore-lint",             NoArg (setDynFlag Opt_DoCoreLinting) )
 415   ,  ( "dstg-lint",              NoArg (setDynFlag Opt_DoStgLinting) )
 416   ,  ( "dusagesp-lint",          NoArg (setDynFlag Opt_DoUSPLinting) )
 417
 418         ------ Machine dependant (-m<blah>) stuff ---------------------------
 419
 420   ,  ( "monly-2-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 2}) ))
 421   ,  ( "monly-3-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 3}) ))
 422   ,  ( "monly-4-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 4}) ))
 423
 424         ------ Warning opts -------------------------------------------------
 425   ,  ( "W"              , NoArg (mapM_ setDynFlag   minusWOpts)    )
 426   ,  ( "Wall"           , NoArg (mapM_ setDynFlag   minusWallOpts) )
 427   ,  ( "Wnot"           , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
 428   ,  ( "w"              , NoArg (mapM_ unSetDynFlag minusWallOpts) )
 429
 430         ------ Compiler flags -----------------------------------------------
 431
 432   ,  ( "fasm",          AnySuffix (\_ -> setLang HscAsm) )
 433   ,  ( "fvia-c",        NoArg (setLang HscC) )
 434   ,  ( "fvia-C",        NoArg (setLang HscC) )
 435   ,  ( "filx",          NoArg (setLang HscILX) )
 436
 437         -- "active negatives"
 438   ,  ( "fno-implicit-prelude",  NoArg (setDynFlag Opt_NoImplicitPrelude) )
 439   ,  ( "fno-monomorphism-restriction",
 440                         NoArg (setDynFlag Opt_NoMonomorphismRestriction) )
 441
 442         -- the rest of the -f* and -fno-* flags
 443   ,  ( "fno-",          PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )
 444   ,  ( "f",             PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag f)) )
 445  ]
 446
 447 -- these -f<blah> flags can all be reversed with -fno-<blah>
 448
 449 fFlags = [
 450   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports ),
 451   ( "warn-hi-shadowing",                Opt_WarnHiShadows ),
 452   ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns ),
 453   ( "warn-missing-fields",              Opt_WarnMissingFields ),
 454   ( "warn-missing-methods",             Opt_WarnMissingMethods ),
 455   ( "warn-missing-signatures",          Opt_WarnMissingSigs ),
 456   ( "warn-name-shadowing",              Opt_WarnNameShadowing ),
 457   ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns ),
 458   ( "warn-simple-patterns",             Opt_WarnSimplePatterns ),
 459   ( "warn-type-defaults",               Opt_WarnTypeDefaults ),
 460   ( "warn-unused-binds",                Opt_WarnUnusedBinds ),
 461   ( "warn-unused-imports",              Opt_WarnUnusedImports ),
 462   ( "warn-unused-matches",              Opt_WarnUnusedMatches ),
 463   ( "warn-deprecations",                Opt_WarnDeprecations ),
 464   ( "glasgow-exts",                     Opt_GlasgowExts ),
 465   ( "fi",                               Opt_FFI ),  -- support `-ffi'...
 466   ( "ffi",                              Opt_FFI ),  -- ...and also `-fffi'
 467   ( "with",                             Opt_With ), -- with keyword
 468   ( "parr",                             Opt_PArr ),
 469   ( "allow-overlapping-instances",      Opt_AllowOverlappingInstances ),
 470   ( "allow-undecidable-instances",      Opt_AllowUndecidableInstances ),
 471   ( "allow-incoherent-instances",       Opt_AllowIncoherentInstances ),
 472   ( "generics",                         Opt_Generics )
 473   ]
 474
 475 isFFlag f = f `elem` (map fst fFlags)
 476 getFFlag f = fromJust (lookup f fFlags)
 477
 478 -----------------------------------------------------------------------------
 479 -- convert sizes like "3.5M" into integers
 480
 481 decodeSize :: String -> Integer
 482 decodeSize str
 483   | c == ""              = truncate n
 484   | c == "K" || c == "k" = truncate (n * 1000)
 485   | c == "M" || c == "m" = truncate (n * 1000 * 1000)
 486   | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
 487   | otherwise            = throwDyn (CmdLineError ("can't decode size: " ++ str))
 488   where (m, c) = span pred str
 489         n      = read m  :: Double
 490         pred c = isDigit c || c == '.'
 491
 492
 493 -----------------------------------------------------------------------------
 494 -- RTS Hooks
 495
 496 foreign import "setHeapSize"       unsafe setHeapSize       :: Int -> IO ()
 497 foreign import "enableTimingStats" unsafe enableTimingStats :: IO ()
 498
 499 -----------------------------------------------------------------------------
 500 -- Build the Hsc static command line opts
 501
 502 buildStaticHscOpts :: IO [String]
 503 buildStaticHscOpts = do
 504
 505   opt_C_ <- getStaticOpts v_Opt_C       -- misc hsc opts from the command line
 506
 507         -- optimisation
 508   minus_o <- readIORef v_OptLevel
 509   let optimisation_opts =
 510         case minus_o of
 511             0 -> hsc_minusNoO_flags
 512             1 -> hsc_minusO_flags
 513             2 -> hsc_minusO2_flags
 514             n -> throwDyn (CmdLineError ("unknown optimisation level: "
 515                                           ++ show n))
 516             -- ToDo: -Ofile
 517
 518         -- take into account -fno-* flags by removing the equivalent -f*
 519         -- flag from our list.
 520   anti_flags <- getStaticOpts v_Anti_opt_C
 521   let basic_opts = opt_C_ ++ optimisation_opts
 522       filtered_opts = filter (`notElem` anti_flags) basic_opts
 523
 524   static <- (do s <- readIORef v_Static; if s then return "-static"
 525                                               else return "")
 526
 527   return ( static : filtered_opts )
 528
 529 -----------------------------------------------------------------------------
 530 -- Via-C compilation stuff
 531
 532 -- flags returned are: ( all C compilations
 533 --                     , registerised HC compilations
 534 --                     )
 535
 536 machdepCCOpts
 537    | prefixMatch "alpha"   cTARGETPLATFORM
 538         = return ( ["-static", "-w", "-mieee"], [] )
 539         -- For now, to suppress the gcc warning "call-clobbered
 540         -- register used for global register variable", we simply
 541         -- disable all warnings altogether using the -w flag. Oh well.
 542
 543    | prefixMatch "hppa"    cTARGETPLATFORM
 544         -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
 545         -- (very nice, but too bad the HP /usr/include files don't agree.)
 546         = return ( ["-static", "-D_HPUX_SOURCE"], [] )
 547
 548    | prefixMatch "m68k"    cTARGETPLATFORM
 549       -- -fno-defer-pop : for the .hc files, we want all the pushing/
 550       --    popping of args to routines to be explicit; if we let things
 551       --    be deferred 'til after an STGJUMP, imminent death is certain!
 552       --
 553       -- -fomit-frame-pointer : *don't*
 554       --     It's better to have a6 completely tied up being a frame pointer
 555       --     rather than let GCC pick random things to do with it.
 556       --     (If we want to steal a6, then we would try to do things
 557       --     as on iX86, where we *do* steal the frame pointer [%ebp].)
 558         = return ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
 559
 560    | prefixMatch "i386"    cTARGETPLATFORM
 561       -- -fno-defer-pop : basically the same game as for m68k
 562       --
 563       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
 564       --   the fp (%ebp) for our register maps.
 565         = do n_regs <- dynFlag stolen_x86_regs
 566              sta    <- readIORef v_Static
 567              return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
 568 --                    , if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else ""
 569                       ],
 570                       [ "-fno-defer-pop", "-fomit-frame-pointer",
 571                         "-DSTOLEN_X86_REGS="++show n_regs ]
 572                     )
 573
 574    | prefixMatch "ia64"    cTARGETPLATFORM
 575         = return ( [], ["-fomit-frame-pointer", "-G0"] )
 576
 577    | prefixMatch "mips"    cTARGETPLATFORM
 578         = return ( ["-static"], [] )
 579
 580    | prefixMatch "sparc"    cTARGETPLATFORM
 581         = return ( [], ["-w"] )
 582         -- For now, to suppress the gcc warning "call-clobbered
 583         -- register used for global register variable", we simply
 584         -- disable all warnings altogether using the -w flag. Oh well.
 585
 586    | prefixMatch "powerpc-apple-darwin" cTARGETPLATFORM
 587        = return ( ["-no-cpp-precomp"], [""] )
 588
 589    | prefixMatch "powerpc" cTARGETPLATFORM || prefixMatch "rs6000" cTARGETPLATFORM
 590         = return ( ["-static"], ["-finhibit-size-directive"] )
 591
 592    | otherwise
 593         = return ( [], [] )
 594
 595 -----------------------------------------------------------------------------
 596 -- local utils
 597
 598 addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
 599 addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
 600 addOpt_F a = updDynFlags (\s -> s{opt_F = a : opt_F s})
 601 addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s})
 602 addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s})
 603 addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s})
 604 #ifdef ILX
 605 addOpt_I a = updDynFlags (\s -> s{opt_I = a : opt_I s})
 606 addOpt_i a = updDynFlags (\s -> s{opt_i = a : opt_i s})
 607 #endif
 608
 609 setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
 610 setVerbosity n
 611   | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
 612   | otherwise     = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
 613
 614 addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})