ghc/compiler/main/DriverFlags.hs

   1 {-# OPTIONS -#include "hschooks.h" #-}
   2
   3 -----------------------------------------------------------------------------
   4 -- $Id: DriverFlags.hs,v 1.51 2001/03/28 11:01:19 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         v_InitDynFlags, v_DynFlags, getDynFlags, dynFlag,
  15         getOpts, getVerbFlag, addCmdlineHCInclude,
  16         buildStaticHscOpts,
  17         runSomething,
  18         machdepCCOpts
  19   ) where
  20
  21 #include "HsVersions.h"
  22
  23 import DriverState
  24 import DriverUtil
  25 import TmpFiles         ( v_TmpDir, kludgedSystem )
  26 import CmdLineOpts
  27 import Config
  28 import Util
  29 import Panic
  30
  31 import Exception
  32 import IOExts
  33
  34 import IO
  35 import Maybe
  36 import Monad
  37 import System
  38 import Char
  39
  40 -----------------------------------------------------------------------------
  41 -- Flags
  42
  43 -- Flag parsing is now done in stages:
  44 --
  45 --     * parse the initial list of flags and remove any flags understood
  46 --       by the driver only.  Determine whether we're in multi-compilation
  47 --       or single-compilation mode (done in Main.main).
  48 --
  49 --     * gather the list of "static" hsc flags, and assign them to the global
  50 --       static hsc flags variable.
  51 --
  52 --     * build the inital DynFlags from the remaining flags.
  53 --
  54 --     * complain if we've got any flags left over.
  55 --
  56 --     * for each source file: grab the OPTIONS, and build a new DynFlags
  57 --       to pass to the compiler.
  58
  59 -----------------------------------------------------------------------------
  60 -- Process command-line
  61
  62 data OptKind
  63         = NoArg (IO ())                     -- flag with no argument
  64         | HasArg (String -> IO ())          -- flag has an argument (maybe prefix)
  65         | SepArg (String -> IO ())          -- flag has a separate argument
  66         | Prefix (String -> IO ())          -- flag is a prefix only
  67         | OptPrefix (String -> IO ())       -- flag may be a prefix
  68         | AnySuffix (String -> IO ())       -- flag is a prefix, pass whole arg to fn
  69         | PassFlag  (String -> IO ())       -- flag with no arg, pass flag to fn
  70         | PrefixPred (String -> Bool) (String -> IO ())
  71         | AnySuffixPred (String -> Bool) (String -> IO ())
  72
  73 processArgs :: [(String,OptKind)] -> [String] -> [String]
  74    -> IO [String]  -- returns spare args
  75 processArgs _spec [] spare = return (reverse spare)
  76 processArgs spec args@(('-':arg):args') spare = do
  77   case findArg spec arg of
  78     Just (rest,action) ->
  79       do args' <- processOneArg action rest args
  80          processArgs spec args' spare
  81     Nothing ->
  82       processArgs spec args' (('-':arg):spare)
  83 processArgs spec (arg:args) spare =
  84   processArgs spec args (arg:spare)
  85
  86 processOneArg :: OptKind -> String -> [String] -> IO [String]
  87 processOneArg action rest (dash_arg@('-':arg):args) =
  88   case action of
  89         NoArg  io ->
  90                 if rest == ""
  91                         then io >> return args
  92                         else unknownFlagErr dash_arg
  93
  94         HasArg fio ->
  95                 if rest /= ""
  96                         then fio rest >> return args
  97                         else case args of
  98                                 [] -> unknownFlagErr dash_arg
  99                                 (arg1:args1) -> fio arg1 >> return args1
 100
 101         SepArg fio ->
 102                 case args of
 103                         [] -> unknownFlagErr dash_arg
 104                         (arg1:args1) -> fio arg1 >> return args1
 105
 106         Prefix fio ->
 107                 if rest /= ""
 108                         then fio rest >> return args
 109                         else unknownFlagErr dash_arg
 110
 111         PrefixPred p fio ->
 112                 if rest /= ""
 113                         then fio rest >> return args
 114                         else unknownFlagErr dash_arg
 115
 116         OptPrefix fio       -> fio rest >> return args
 117
 118         AnySuffix fio       -> fio dash_arg >> return args
 119
 120         AnySuffixPred p fio -> fio dash_arg >> return args
 121
 122         PassFlag fio  ->
 123                 if rest /= ""
 124                         then unknownFlagErr dash_arg
 125                         else fio dash_arg >> return args
 126
 127 findArg :: [(String,OptKind)] -> String -> Maybe (String,OptKind)
 128 findArg spec arg
 129   = case [ (remove_spaces rest, k)
 130          | (pat,k) <- spec, 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 = not (null rest)
 140 arg_ok (PrefixPred p _)     rest arg = not (null 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 -------------------------------------------------------
 155      ( "?"              , NoArg long_usage)
 156   ,  ( "-help"          , NoArg long_usage)
 157
 158
 159       ------- version ----------------------------------------------------
 160   ,  ( "-version"        , NoArg (do hPutStrLn stdout (cProjectName
 161                                       ++ ", version " ++ cProjectVersion)
 162                                      exitWith ExitSuccess))
 163   ,  ( "-numeric-version", NoArg (do hPutStrLn stdout cProjectVersion
 164                                      exitWith ExitSuccess))
 165
 166       ------- verbosity ----------------------------------------------------
 167   ,  ( "n"              , NoArg (writeIORef v_Dry_run True) )
 168
 169         ------- recompilation checker --------------------------------------
 170   ,  ( "recomp"         , NoArg (writeIORef v_Recomp True) )
 171   ,  ( "no-recomp"      , NoArg (writeIORef v_Recomp False) )
 172
 173         ------- ways --------------------------------------------------------
 174   ,  ( "prof"           , NoArg (addNoDups v_Ways       WayProf) )
 175   ,  ( "unreg"          , NoArg (addNoDups v_Ways       WayUnreg) )
 176   ,  ( "ticky"          , NoArg (addNoDups v_Ways       WayTicky) )
 177   ,  ( "parallel"       , NoArg (addNoDups v_Ways       WayPar) )
 178   ,  ( "gransim"        , NoArg (addNoDups v_Ways       WayGran) )
 179   ,  ( "smp"            , NoArg (addNoDups v_Ways       WaySMP) )
 180   ,  ( "debug"          , NoArg (addNoDups v_Ways       WayDebug) )
 181         -- ToDo: user ways
 182
 183         ------ Debugging ----------------------------------------------------
 184   ,  ( "dppr-noprags",     PassFlag (add v_Opt_C) )
 185   ,  ( "dppr-debug",       PassFlag (add v_Opt_C) )
 186   ,  ( "dppr-user-length", AnySuffix (add v_Opt_C) )
 187       -- rest of the debugging flags are dynamic
 188
 189         --------- Profiling --------------------------------------------------
 190   ,  ( "auto-dicts"     , NoArg (add v_Opt_C "-fauto-sccs-on-dicts") )
 191   ,  ( "auto-all"       , NoArg (add v_Opt_C "-fauto-sccs-on-all-toplevs") )
 192   ,  ( "auto"           , NoArg (add v_Opt_C "-fauto-sccs-on-exported-toplevs") )
 193   ,  ( "caf-all"        , NoArg (add v_Opt_C "-fauto-sccs-on-individual-cafs") )
 194          -- "ignore-sccs"  doesn't work  (ToDo)
 195
 196   ,  ( "no-auto-dicts"  , NoArg (add v_Anti_opt_C "-fauto-sccs-on-dicts") )
 197   ,  ( "no-auto-all"    , NoArg (add v_Anti_opt_C "-fauto-sccs-on-all-toplevs") )
 198   ,  ( "no-auto"        , NoArg (add v_Anti_opt_C "-fauto-sccs-on-exported-toplevs") )
 199   ,  ( "no-caf-all"     , NoArg (add v_Anti_opt_C "-fauto-sccs-on-individual-cafs") )
 200
 201         ------- Miscellaneous -----------------------------------------------
 202   ,  ( "no-link-chk"    , NoArg (return ()) ) -- ignored for backwards compat
 203   ,  ( "no-hs-main"     , NoArg (writeIORef v_NoHsMain True) )
 204
 205         ------- Output Redirection ------------------------------------------
 206   ,  ( "odir"           , HasArg (writeIORef v_Output_dir  . Just) )
 207   ,  ( "o"              , SepArg (writeIORef v_Output_file . Just) )
 208   ,  ( "osuf"           , HasArg (writeIORef v_Object_suf  . Just) )
 209   ,  ( "hisuf"          , HasArg (writeIORef v_Hi_suf) )
 210   ,  ( "tmpdir"         , HasArg (writeIORef v_TmpDir . (++ "/")) )
 211   ,  ( "ohi"            , HasArg (\s -> case s of
 212                                           "-" -> writeIORef v_Hi_on_stdout True
 213                                           _   -> writeIORef v_Output_hi (Just s)) )
 214         -- -odump?
 215
 216   ,  ( "keep-hc-file"   , AnySuffix (\_ -> writeIORef v_Keep_hc_files True) )
 217   ,  ( "keep-s-file"    , AnySuffix (\_ -> writeIORef v_Keep_s_files  True) )
 218   ,  ( "keep-raw-s-file", AnySuffix (\_ -> writeIORef v_Keep_raw_s_files  True) )
 219   ,  ( "keep-tmp-files" , AnySuffix (\_ -> writeIORef v_Keep_tmp_files True) )
 220
 221   ,  ( "split-objs"     , NoArg (if can_split
 222                                     then do writeIORef v_Split_object_files True
 223                                             add v_Opt_C "-fglobalise-toplev-names"
 224                                     else hPutStrLn stderr
 225                                             "warning: don't know how to  split \
 226                                             \object files on this architecture"
 227                                 ) )
 228
 229         ------- Include/Import Paths ----------------------------------------
 230   ,  ( "i"              , OptPrefix (addToDirList v_Import_paths) )
 231   ,  ( "I"              , Prefix    (addToDirList v_Include_paths) )
 232
 233         ------- Libraries ---------------------------------------------------
 234   ,  ( "L"              , Prefix (addToDirList v_Library_paths) )
 235   ,  ( "l"              , Prefix (add v_Cmdline_libraries) )
 236
 237         ------- Packages ----------------------------------------------------
 238   ,  ( "package-name"   , HasArg (\s -> add v_Opt_C ("-inpackage="++s)) )
 239
 240   ,  ( "package"        , HasArg (addPackage) )
 241   ,  ( "syslib"         , HasArg (addPackage) ) -- for compatibility w/ old vsns
 242
 243         ------- Specific phases  --------------------------------------------
 244   ,  ( "pgmL"           , HasArg (writeIORef v_Pgm_L) )
 245   ,  ( "pgmP"           , HasArg (writeIORef v_Pgm_P) )
 246   ,  ( "pgmc"           , HasArg (writeIORef v_Pgm_c) )
 247   ,  ( "pgmm"           , HasArg (writeIORef v_Pgm_m) )
 248   ,  ( "pgms"           , HasArg (writeIORef v_Pgm_s) )
 249   ,  ( "pgma"           , HasArg (writeIORef v_Pgm_a) )
 250   ,  ( "pgml"           , HasArg (writeIORef v_Pgm_l) )
 251
 252   ,  ( "optdep"         , HasArg (add v_Opt_dep) )
 253   ,  ( "optl"           , HasArg (add v_Opt_l) )
 254   ,  ( "optdll"         , HasArg (add v_Opt_dll) )
 255
 256         ----- Linker --------------------------------------------------------
 257   ,  ( "static"         , NoArg (writeIORef v_Static True) )
 258   ,  ( "dynamic"        , NoArg (writeIORef v_Static False) )
 259   ,  ( "rdynamic"       , NoArg (return ()) ) -- ignored for compat w/ gcc
 260
 261         ----- RTS opts ------------------------------------------------------
 262   ,  ( "H"                 , HasArg (setHeapSize . fromIntegral . decodeSize) )
 263   ,  ( "Rghc-timing"       , NoArg  (enableTimingStats) )
 264
 265         ------ Compiler flags -----------------------------------------------
 266   ,  ( "O2-for-C"          , NoArg (writeIORef v_minus_o2_for_C True) )
 267   ,  ( "O"                 , OptPrefix (setOptLevel) )
 268
 269   ,  ( "fno-asm-mangling"  , NoArg (writeIORef v_Do_asm_mangling False) )
 270
 271   ,  ( "fmax-simplifier-iterations",
 272                 Prefix (writeIORef v_MaxSimplifierIterations . read) )
 273
 274   ,  ( "fusagesp"          , NoArg (do writeIORef v_UsageSPInf True
 275                                        add v_Opt_C "-fusagesp-on") )
 276
 277   ,  ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True
 278                                        add v_Opt_C "-fexcess-precision"))
 279
 280         -- Optimisation flags are treated specially, so the normal
 281         -- -fno-* pattern below doesn't work.  We therefore allow
 282         -- certain optimisation passes to be turned off explicitly:
 283   ,  ( "fno-strictness"    , NoArg (writeIORef v_Strictness False) )
 284   ,  ( "fno-cpr"           , NoArg (writeIORef v_CPR False) )
 285   ,  ( "fno-cse"           , NoArg (writeIORef v_CSE False) )
 286
 287         -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
 288   ,  ( "fno-",                  PrefixPred (\s -> isStaticHscFlag ("f"++s))
 289                                     (\s -> add v_Anti_opt_C ("-f"++s)) )
 290
 291         -- Pass all remaining "-f<blah>" options to hsc
 292   ,  ( "f",                     AnySuffixPred (isStaticHscFlag) (add v_Opt_C) )
 293   ]
 294
 295 -----------------------------------------------------------------------------
 296 -- parse the dynamic arguments
 297
 298 -- v_InitDynFlags
 299 --      is the "baseline" dynamic flags, initialised from
 300 --      the defaults and command line options, and updated by the
 301 --      ':s' command in GHCi.
 302 --
 303 -- v_DynFlags
 304 --      is the dynamic flags for the current compilation.  It is reset
 305 --      to the value of v_InitDynFlags before each compilation, then
 306 --      updated by reading any OPTIONS pragma in the current module.
 307
 308 GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
 309 GLOBAL_VAR(v_DynFlags,     defaultDynFlags, DynFlags)
 310
 311 updDynFlags f = do
 312    dfs <- readIORef v_DynFlags
 313    writeIORef v_DynFlags (f dfs)
 314
 315 getDynFlags :: IO DynFlags
 316 getDynFlags = readIORef v_DynFlags
 317
 318 dynFlag :: (DynFlags -> a) -> IO a
 319 dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
 320
 321 setDynFlag f   = updDynFlags (\dfs -> dopt_set dfs f)
 322 unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
 323
 324 addOpt_L     a = updDynFlags (\s -> s{opt_L =  a : opt_L s})
 325 addOpt_P     a = updDynFlags (\s -> s{opt_P =  a : opt_P s})
 326 addOpt_c     a = updDynFlags (\s -> s{opt_c =  a : opt_c s})
 327 addOpt_a     a = updDynFlags (\s -> s{opt_a =  a : opt_a s})
 328 addOpt_m     a = updDynFlags (\s -> s{opt_m =  a : opt_m s})
 329
 330 addCmdlineHCInclude a =
 331    updDynFlags (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
 332
 333         -- we add to the options from the front, so we need to reverse the list
 334 getOpts :: (DynFlags -> [a]) -> IO [a]
 335 getOpts opts = dynFlag opts >>= return . reverse
 336
 337 -- we can only change HscC to HscAsm and vice-versa with dynamic flags
 338 -- (-fvia-C and -fasm).
 339 -- NB: we can also set the new lang to ILX, via -filx.  I hope this is right
 340 setLang l = do
 341    dfs <- readIORef v_DynFlags
 342    case hscLang dfs of
 343         HscC   -> writeIORef v_DynFlags dfs{ hscLang = l }
 344         HscAsm -> writeIORef v_DynFlags dfs{ hscLang = l }
 345         _      -> return ()
 346
 347 setVerbosityAtLeast n =
 348   updDynFlags (\dfs -> if verbosity dfs < n
 349                           then dfs{ verbosity = n }
 350                           else dfs)
 351
 352 setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
 353 setVerbosity n
 354   | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
 355   | otherwise     = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
 356
 357 getVerbFlag = do
 358    verb <- dynFlag verbosity
 359    if verb >= 3  then return  "-v" else return ""
 360
 361 dynamic_flags = [
 362
 363      ( "cpp",           NoArg  (updDynFlags (\s -> s{ cppFlag = True })) )
 364   ,  ( "#include",      HasArg (addCmdlineHCInclude) )
 365
 366   ,  ( "v",             OptPrefix (setVerbosity) )
 367
 368   ,  ( "optL",          HasArg (addOpt_L) )
 369   ,  ( "optP",          HasArg (addOpt_P) )
 370   ,  ( "optc",          HasArg (addOpt_c) )
 371   ,  ( "optm",          HasArg (addOpt_m) )
 372   ,  ( "opta",          HasArg (addOpt_a) )
 373
 374         ------ HsCpp opts ---------------------------------------------------
 375   ,  ( "D",             Prefix (\s -> addOpt_P ("-D'"++s++"'") ) )
 376   ,  ( "U",             Prefix (\s -> addOpt_P ("-U'"++s++"'") ) )
 377
 378         ------ Debugging ----------------------------------------------------
 379   ,  ( "dstg-stats",    NoArg (writeIORef v_StgStats True) )
 380
 381   ,  ( "ddump-absC",             NoArg (setDynFlag Opt_D_dump_absC) )
 382   ,  ( "ddump-asm",              NoArg (setDynFlag Opt_D_dump_asm) )
 383   ,  ( "ddump-cpranal",          NoArg (setDynFlag Opt_D_dump_cpranal) )
 384   ,  ( "ddump-deriv",            NoArg (setDynFlag Opt_D_dump_deriv) )
 385   ,  ( "ddump-ds",               NoArg (setDynFlag Opt_D_dump_ds) )
 386   ,  ( "ddump-flatC",            NoArg (setDynFlag Opt_D_dump_flatC) )
 387   ,  ( "ddump-foreign",          NoArg (setDynFlag Opt_D_dump_foreign) )
 388   ,  ( "ddump-inlinings",        NoArg (setDynFlag Opt_D_dump_inlinings) )
 389   ,  ( "ddump-occur-anal",       NoArg (setDynFlag Opt_D_dump_occur_anal) )
 390   ,  ( "ddump-parsed",           NoArg (setDynFlag Opt_D_dump_parsed) )
 391   ,  ( "ddump-realC",            NoArg (setDynFlag Opt_D_dump_realC) )
 392   ,  ( "ddump-rn",               NoArg (setDynFlag Opt_D_dump_rn) )
 393   ,  ( "ddump-simpl",            NoArg (setDynFlag Opt_D_dump_simpl) )
 394   ,  ( "ddump-simpl-iterations", NoArg (setDynFlag Opt_D_dump_simpl_iterations) )
 395   ,  ( "ddump-spec",             NoArg (setDynFlag Opt_D_dump_spec) )
 396   ,  ( "ddump-sat",              NoArg (setDynFlag Opt_D_dump_sat) )
 397   ,  ( "ddump-stg",              NoArg (setDynFlag Opt_D_dump_stg) )
 398   ,  ( "ddump-stranal",          NoArg (setDynFlag Opt_D_dump_stranal) )
 399   ,  ( "ddump-tc",               NoArg (setDynFlag Opt_D_dump_tc) )
 400   ,  ( "ddump-types",            NoArg (setDynFlag Opt_D_dump_types) )
 401   ,  ( "ddump-rules",            NoArg (setDynFlag Opt_D_dump_rules) )
 402   ,  ( "ddump-usagesp",          NoArg (setDynFlag Opt_D_dump_usagesp) )
 403   ,  ( "ddump-cse",              NoArg (setDynFlag Opt_D_dump_cse) )
 404   ,  ( "ddump-worker-wrapper",   NoArg (setDynFlag Opt_D_dump_worker_wrapper) )
 405   ,  ( "dshow-passes",           NoArg (setVerbosity "2") )
 406   ,  ( "ddump-rn-trace",         NoArg (setDynFlag Opt_D_dump_rn_trace) )
 407   ,  ( "ddump-tc-trace",         NoArg (setDynFlag Opt_D_dump_tc_trace) )
 408   ,  ( "ddump-rn-stats",         NoArg (setDynFlag Opt_D_dump_rn_stats) )
 409   ,  ( "ddump-stix",             NoArg (setDynFlag Opt_D_dump_stix) )
 410   ,  ( "ddump-simpl-stats",      NoArg (setDynFlag Opt_D_dump_simpl_stats) )
 411   ,  ( "ddump-bcos",             NoArg (setDynFlag Opt_D_dump_BCOs) )
 412   ,  ( "dsource-stats",          NoArg (setDynFlag Opt_D_source_stats) )
 413   ,  ( "dverbose-core2core",     NoArg (setDynFlag Opt_D_verbose_core2core) )
 414   ,  ( "dverbose-stg2stg",       NoArg (setDynFlag Opt_D_verbose_stg2stg) )
 415   ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs) )
 416   ,  ( "ddump-hi",               NoArg (setDynFlag Opt_D_dump_hi) )
 417   ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports) )
 418   ,  ( "dcore-lint",             NoArg (setDynFlag Opt_DoCoreLinting) )
 419   ,  ( "dstg-lint",              NoArg (setDynFlag Opt_DoStgLinting) )
 420   ,  ( "dusagesp-lint",          NoArg (setDynFlag Opt_DoUSPLinting) )
 421
 422         ------ Machine dependant (-m<blah>) stuff ---------------------------
 423
 424   ,  ( "monly-2-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 2}) ))
 425   ,  ( "monly-3-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 3}) ))
 426   ,  ( "monly-4-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 4}) ))
 427
 428         ------ Warning opts -------------------------------------------------
 429   ,  ( "W"              , NoArg (mapM_ setDynFlag   minusWOpts)    )
 430   ,  ( "Wall"           , NoArg (mapM_ setDynFlag   minusWallOpts) )
 431   ,  ( "Wnot"           , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
 432   ,  ( "w"              , NoArg (mapM_ unSetDynFlag minusWallOpts) )
 433
 434         ------ Compiler flags -----------------------------------------------
 435
 436   ,  ( "fasm",          AnySuffix (\_ -> setLang HscAsm) )
 437   ,  ( "fvia-c",        NoArg (setLang HscC) )
 438   ,  ( "fvia-C",        NoArg (setLang HscC) )
 439 #ifdef ILX
 440   ,  ( "filx",          NoArg (setLang HscILX) )
 441 #endif
 442
 443         -- "active negatives"
 444   ,  ( "fno-implicit-prelude",  NoArg (setDynFlag Opt_NoImplicitPrelude) )
 445
 446         -- the rest of the -f* and -fno-* flags
 447   ,  ( "fno-",          PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )
 448   ,  ( "f",             PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag f)) )
 449  ]
 450
 451 -- these -f<blah> flags can all be reversed with -fno-<blah>
 452
 453 fFlags = [
 454   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports ),
 455   ( "warn-hi-shadowing",                Opt_WarnHiShadows ),
 456   ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns ),
 457   ( "warn-missing-fields",              Opt_WarnMissingFields ),
 458   ( "warn-missing-methods",             Opt_WarnMissingMethods ),
 459   ( "warn-missing-signatures",          Opt_WarnMissingSigs ),
 460   ( "warn-name-shadowing",              Opt_WarnNameShadowing ),
 461   ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns ),
 462   ( "warn-simple-patterns",             Opt_WarnSimplePatterns ),
 463   ( "warn-type-defaults",               Opt_WarnTypeDefaults ),
 464   ( "warn-unused-binds",                Opt_WarnUnusedBinds ),
 465   ( "warn-unused-imports",              Opt_WarnUnusedImports ),
 466   ( "warn-unused-matches",              Opt_WarnUnusedMatches ),
 467   ( "warn-deprecations",                Opt_WarnDeprecations ),
 468   ( "glasgow-exts",                     Opt_GlasgowExts ),
 469   ( "allow-overlapping-instances",      Opt_AllowOverlappingInstances ),
 470   ( "allow-undecidable-instances",      Opt_AllowUndecidableInstances ),
 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 floatOpt :: IORef Double -> String -> IO ()
 492 floatOpt ref str = writeIORef ref (read str :: Double)
 493
 494 -----------------------------------------------------------------------------
 495 -- RTS Hooks
 496
 497 foreign import "setHeapSize"       unsafe setHeapSize       :: Int -> IO ()
 498 foreign import "enableTimingStats" unsafe enableTimingStats :: IO ()
 499
 500 -----------------------------------------------------------------------------
 501 -- Build the Hsc static command line opts
 502
 503 buildStaticHscOpts :: IO [String]
 504 buildStaticHscOpts = do
 505
 506   opt_C_ <- getStaticOpts v_Opt_C       -- misc hsc opts from the command line
 507
 508         -- optimisation
 509   minus_o <- readIORef v_OptLevel
 510   let optimisation_opts =
 511         case minus_o of
 512             0 -> hsc_minusNoO_flags
 513             1 -> hsc_minusO_flags
 514             2 -> hsc_minusO2_flags
 515             _ -> error "unknown opt level"
 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 -- Running an external program
 531
 532 -- sigh, here because both DriverMkDepend & DriverPipeline need it.
 533
 534 runSomething phase_name cmd
 535  = do
 536    verb <- dynFlag verbosity
 537    when (verb >= 2) $ hPutStrLn stderr ("*** " ++ phase_name)
 538    when (verb >= 3) $ hPutStrLn stderr cmd
 539    hFlush stderr
 540
 541    -- test for -n flag
 542    n <- readIORef v_Dry_run
 543    unless n $ do
 544
 545    -- and run it!
 546    exit_code <- kludgedSystem cmd phase_name
 547
 548    if exit_code /= ExitSuccess
 549         then throwDyn (PhaseFailed phase_name exit_code)
 550         else do when (verb >= 3) (hPutStr stderr "\n")
 551                 return ()
 552
 553 -----------------------------------------------------------------------------
 554 -- Via-C compilation stuff
 555
 556 -- flags returned are: ( all C compilations
 557 --                     , registerised HC compilations
 558 --                     )
 559
 560 machdepCCOpts
 561    | prefixMatch "alpha"   cTARGETPLATFORM
 562         = return ( ["-static"], [] )
 563
 564    | prefixMatch "hppa"    cTARGETPLATFORM
 565         -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
 566         -- (very nice, but too bad the HP /usr/include files don't agree.)
 567         = return ( ["-static", "-D_HPUX_SOURCE"], [] )
 568
 569    | prefixMatch "m68k"    cTARGETPLATFORM
 570       -- -fno-defer-pop : for the .hc files, we want all the pushing/
 571       --    popping of args to routines to be explicit; if we let things
 572       --    be deferred 'til after an STGJUMP, imminent death is certain!
 573       --
 574       -- -fomit-frame-pointer : *don't*
 575       --     It's better to have a6 completely tied up being a frame pointer
 576       --     rather than let GCC pick random things to do with it.
 577       --     (If we want to steal a6, then we would try to do things
 578       --     as on iX86, where we *do* steal the frame pointer [%ebp].)
 579         = return ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
 580
 581    | prefixMatch "i386"    cTARGETPLATFORM
 582       -- -fno-defer-pop : basically the same game as for m68k
 583       --
 584       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
 585       --   the fp (%ebp) for our register maps.
 586         = do n_regs <- dynFlag stolen_x86_regs
 587              sta    <- readIORef v_Static
 588              return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "",
 589                         if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" ],
 590                       [ "-fno-defer-pop", "-fomit-frame-pointer",
 591                         "-DSTOLEN_X86_REGS="++show n_regs ]
 592                     )
 593
 594    | prefixMatch "mips"    cTARGETPLATFORM
 595         = return ( ["static"], [] )
 596
 597    | prefixMatch "powerpc" cTARGETPLATFORM || prefixMatch "rs6000" cTARGETPLATFORM
 598         = return ( ["static"], ["-finhibit-size-directive"] )
 599
 600    | otherwise
 601         = return ( [], [] )