ghc/compiler/main/DriverFlags.hs

   1 {-# OPTIONS -#include "hschooks.h" #-}
   2
   3 -----------------------------------------------------------------------------
   4 -- $Id: DriverFlags.hs,v 1.56 2001/05/31 11:32:25 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   ,  ( "hcsuf"          , HasArg (writeIORef v_HC_suf      . Just) )
 210   ,  ( "hisuf"          , HasArg (writeIORef v_Hi_suf) )
 211   ,  ( "hidir"          , HasArg (writeIORef v_Hi_dir . Just) )
 212   ,  ( "buildtag"       , HasArg (writeIORef v_Build_tag) )
 213   ,  ( "tmpdir"         , HasArg (writeIORef v_TmpDir . (++ "/")) )
 214   ,  ( "ohi"            , HasArg (writeIORef v_Output_hi   . Just) )
 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         ------- Specific phases  --------------------------------------------
 245   ,  ( "pgmL"           , HasArg (writeIORef v_Pgm_L) )
 246   ,  ( "pgmP"           , HasArg (writeIORef v_Pgm_P) )
 247   ,  ( "pgmc"           , HasArg (writeIORef v_Pgm_c) )
 248   ,  ( "pgmm"           , HasArg (writeIORef v_Pgm_m) )
 249   ,  ( "pgms"           , HasArg (writeIORef v_Pgm_s) )
 250   ,  ( "pgma"           , HasArg (writeIORef v_Pgm_a) )
 251   ,  ( "pgml"           , HasArg (writeIORef v_Pgm_l) )
 252
 253   ,  ( "optdep"         , HasArg (add v_Opt_dep) )
 254   ,  ( "optl"           , HasArg (add v_Opt_l) )
 255   ,  ( "optdll"         , HasArg (add v_Opt_dll) )
 256
 257         ----- Linker --------------------------------------------------------
 258   ,  ( "static"         , NoArg (writeIORef v_Static True) )
 259   ,  ( "dynamic"        , NoArg (writeIORef v_Static False) )
 260   ,  ( "rdynamic"       , NoArg (return ()) ) -- ignored for compat w/ gcc
 261
 262         ----- RTS opts ------------------------------------------------------
 263   ,  ( "H"                 , HasArg (setHeapSize . fromIntegral . decodeSize) )
 264   ,  ( "Rghc-timing"       , NoArg  (enableTimingStats) )
 265
 266         ------ Compiler flags -----------------------------------------------
 267   ,  ( "O2-for-C"          , NoArg (writeIORef v_minus_o2_for_C True) )
 268   ,  ( "O"                 , OptPrefix (setOptLevel) )
 269
 270   ,  ( "fno-asm-mangling"  , NoArg (writeIORef v_Do_asm_mangling False) )
 271
 272   ,  ( "fmax-simplifier-iterations",
 273                 Prefix (writeIORef v_MaxSimplifierIterations . read) )
 274
 275   ,  ( "fusagesp"          , NoArg (do writeIORef v_UsageSPInf True
 276                                        add v_Opt_C "-fusagesp-on") )
 277
 278   ,  ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True
 279                                        add v_Opt_C "-fexcess-precision"))
 280
 281         -- Optimisation flags are treated specially, so the normal
 282         -- -fno-* pattern below doesn't work.  We therefore allow
 283         -- certain optimisation passes to be turned off explicitly:
 284   ,  ( "fno-strictness"    , NoArg (writeIORef v_Strictness False) )
 285   ,  ( "fno-cpr"           , NoArg (writeIORef v_CPR False) )
 286   ,  ( "fno-cse"           , NoArg (writeIORef v_CSE False) )
 287
 288         -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
 289   ,  ( "fno-",                  PrefixPred (\s -> isStaticHscFlag ("f"++s))
 290                                     (\s -> add v_Anti_opt_C ("-f"++s)) )
 291
 292         -- Pass all remaining "-f<blah>" options to hsc
 293   ,  ( "f",                     AnySuffixPred (isStaticHscFlag) (add v_Opt_C) )
 294   ]
 295
 296 -----------------------------------------------------------------------------
 297 -- parse the dynamic arguments
 298
 299 -- v_InitDynFlags
 300 --      is the "baseline" dynamic flags, initialised from
 301 --      the defaults and command line options, and updated by the
 302 --      ':s' command in GHCi.
 303 --
 304 -- v_DynFlags
 305 --      is the dynamic flags for the current compilation.  It is reset
 306 --      to the value of v_InitDynFlags before each compilation, then
 307 --      updated by reading any OPTIONS pragma in the current module.
 308
 309 GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
 310 GLOBAL_VAR(v_DynFlags,     defaultDynFlags, DynFlags)
 311
 312 updDynFlags f = do
 313    dfs <- readIORef v_DynFlags
 314    writeIORef v_DynFlags (f dfs)
 315
 316 getDynFlags :: IO DynFlags
 317 getDynFlags = readIORef v_DynFlags
 318
 319 dynFlag :: (DynFlags -> a) -> IO a
 320 dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
 321
 322 setDynFlag f   = updDynFlags (\dfs -> dopt_set dfs f)
 323 unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
 324
 325 addOpt_L     a = updDynFlags (\s -> s{opt_L =  a : opt_L s})
 326 addOpt_P     a = updDynFlags (\s -> s{opt_P =  a : opt_P s})
 327 addOpt_c     a = updDynFlags (\s -> s{opt_c =  a : opt_c s})
 328 addOpt_a     a = updDynFlags (\s -> s{opt_a =  a : opt_a s})
 329 addOpt_m     a = updDynFlags (\s -> s{opt_m =  a : opt_m s})
 330
 331 addCmdlineHCInclude a =
 332    updDynFlags (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
 333
 334         -- we add to the options from the front, so we need to reverse the list
 335 getOpts :: (DynFlags -> [a]) -> IO [a]
 336 getOpts opts = dynFlag opts >>= return . reverse
 337
 338 -- we can only change HscC to HscAsm and vice-versa with dynamic flags
 339 -- (-fvia-C and -fasm).
 340 -- NB: we can also set the new lang to ILX, via -filx.  I hope this is right
 341 setLang l = do
 342    dfs <- readIORef v_DynFlags
 343    case hscLang dfs of
 344         HscC   -> writeIORef v_DynFlags dfs{ hscLang = l }
 345         HscAsm -> writeIORef v_DynFlags dfs{ hscLang = l }
 346         HscILX -> writeIORef v_DynFlags dfs{ hscLang = l }
 347         _      -> return ()
 348
 349 setVerbosityAtLeast n =
 350   updDynFlags (\dfs -> if verbosity dfs < n
 351                           then dfs{ verbosity = n }
 352                           else dfs)
 353
 354 setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
 355 setVerbosity n
 356   | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
 357   | otherwise     = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
 358
 359 getVerbFlag = do
 360    verb <- dynFlag verbosity
 361    if verb >= 3  then return  "-v" else return ""
 362
 363 dynamic_flags = [
 364
 365      ( "cpp",           NoArg  (updDynFlags (\s -> s{ cppFlag = True })) )
 366   ,  ( "#include",      HasArg (addCmdlineHCInclude) )
 367
 368   ,  ( "v",             OptPrefix (setVerbosity) )
 369
 370   ,  ( "optL",          HasArg (addOpt_L) )
 371   ,  ( "optP",          HasArg (addOpt_P) )
 372   ,  ( "optc",          HasArg (addOpt_c) )
 373   ,  ( "optm",          HasArg (addOpt_m) )
 374   ,  ( "opta",          HasArg (addOpt_a) )
 375
 376         ------ HsCpp opts ---------------------------------------------------
 377   ,  ( "D",             Prefix (\s -> addOpt_P ("-D'"++s++"'") ) )
 378   ,  ( "U",             Prefix (\s -> addOpt_P ("-U'"++s++"'") ) )
 379
 380         ------ Debugging ----------------------------------------------------
 381   ,  ( "dstg-stats",    NoArg (writeIORef v_StgStats True) )
 382
 383   ,  ( "ddump-absC",             NoArg (setDynFlag Opt_D_dump_absC) )
 384   ,  ( "ddump-asm",              NoArg (setDynFlag Opt_D_dump_asm) )
 385   ,  ( "ddump-cpranal",          NoArg (setDynFlag Opt_D_dump_cpranal) )
 386   ,  ( "ddump-deriv",            NoArg (setDynFlag Opt_D_dump_deriv) )
 387   ,  ( "ddump-ds",               NoArg (setDynFlag Opt_D_dump_ds) )
 388   ,  ( "ddump-flatC",            NoArg (setDynFlag Opt_D_dump_flatC) )
 389   ,  ( "ddump-foreign",          NoArg (setDynFlag Opt_D_dump_foreign) )
 390   ,  ( "ddump-inlinings",        NoArg (setDynFlag Opt_D_dump_inlinings) )
 391   ,  ( "ddump-occur-anal",       NoArg (setDynFlag Opt_D_dump_occur_anal) )
 392   ,  ( "ddump-parsed",           NoArg (setDynFlag Opt_D_dump_parsed) )
 393   ,  ( "ddump-realC",            NoArg (setDynFlag Opt_D_dump_realC) )
 394   ,  ( "ddump-rn",               NoArg (setDynFlag Opt_D_dump_rn) )
 395   ,  ( "ddump-simpl",            NoArg (setDynFlag Opt_D_dump_simpl) )
 396   ,  ( "ddump-simpl-iterations", NoArg (setDynFlag Opt_D_dump_simpl_iterations) )
 397   ,  ( "ddump-spec",             NoArg (setDynFlag Opt_D_dump_spec) )
 398   ,  ( "ddump-sat",              NoArg (setDynFlag Opt_D_dump_sat) )
 399   ,  ( "ddump-stg",              NoArg (setDynFlag Opt_D_dump_stg) )
 400   ,  ( "ddump-stranal",          NoArg (setDynFlag Opt_D_dump_stranal) )
 401   ,  ( "ddump-tc",               NoArg (setDynFlag Opt_D_dump_tc) )
 402   ,  ( "ddump-types",            NoArg (setDynFlag Opt_D_dump_types) )
 403   ,  ( "ddump-rules",            NoArg (setDynFlag Opt_D_dump_rules) )
 404   ,  ( "ddump-usagesp",          NoArg (setDynFlag Opt_D_dump_usagesp) )
 405   ,  ( "ddump-cse",              NoArg (setDynFlag Opt_D_dump_cse) )
 406   ,  ( "ddump-worker-wrapper",   NoArg (setDynFlag Opt_D_dump_worker_wrapper) )
 407   ,  ( "dshow-passes",           NoArg (setVerbosity "2") )
 408   ,  ( "ddump-rn-trace",         NoArg (setDynFlag Opt_D_dump_rn_trace) )
 409   ,  ( "ddump-tc-trace",         NoArg (setDynFlag Opt_D_dump_tc_trace) )
 410   ,  ( "ddump-rn-stats",         NoArg (setDynFlag Opt_D_dump_rn_stats) )
 411   ,  ( "ddump-stix",             NoArg (setDynFlag Opt_D_dump_stix) )
 412   ,  ( "ddump-simpl-stats",      NoArg (setDynFlag Opt_D_dump_simpl_stats) )
 413   ,  ( "ddump-bcos",             NoArg (setDynFlag Opt_D_dump_BCOs) )
 414   ,  ( "dsource-stats",          NoArg (setDynFlag Opt_D_source_stats) )
 415   ,  ( "dverbose-core2core",     NoArg (setDynFlag Opt_D_verbose_core2core) )
 416   ,  ( "dverbose-stg2stg",       NoArg (setDynFlag Opt_D_verbose_stg2stg) )
 417   ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs) )
 418   ,  ( "ddump-hi",               NoArg (setDynFlag Opt_D_dump_hi) )
 419   ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports) )
 420   ,  ( "dcore-lint",             NoArg (setDynFlag Opt_DoCoreLinting) )
 421   ,  ( "dstg-lint",              NoArg (setDynFlag Opt_DoStgLinting) )
 422   ,  ( "dusagesp-lint",          NoArg (setDynFlag Opt_DoUSPLinting) )
 423
 424         ------ Machine dependant (-m<blah>) stuff ---------------------------
 425
 426   ,  ( "monly-2-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 2}) ))
 427   ,  ( "monly-3-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 3}) ))
 428   ,  ( "monly-4-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 4}) ))
 429
 430         ------ Warning opts -------------------------------------------------
 431   ,  ( "W"              , NoArg (mapM_ setDynFlag   minusWOpts)    )
 432   ,  ( "Wall"           , NoArg (mapM_ setDynFlag   minusWallOpts) )
 433   ,  ( "Wnot"           , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
 434   ,  ( "w"              , NoArg (mapM_ unSetDynFlag minusWallOpts) )
 435
 436         ------ Compiler flags -----------------------------------------------
 437
 438   ,  ( "fasm",          AnySuffix (\_ -> setLang HscAsm) )
 439   ,  ( "fvia-c",        NoArg (setLang HscC) )
 440   ,  ( "fvia-C",        NoArg (setLang HscC) )
 441   ,  ( "filx",          NoArg (setLang HscILX) )
 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 ( [], [] )