ghc/compiler/main/DriverFlags.hs

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