ghc/compiler/main/DriverFlags.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Driver flags
   4 --
   5 -- (c) The University of Glasgow 2000-2003
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module DriverFlags (
  10         processArgs, OptKind(..), static_flags, dynamic_flags,
  11         addCmdlineHCInclude,
  12         buildStaticHscOpts,
  13         machdepCCOpts
  14   ) where
  15
  16 #include "HsVersions.h"
  17 #include "../includes/config.h"
  18
  19 import MkIface          ( showIface )
  20 import DriverState
  21 import DriverPhases
  22 import DriverUtil
  23 import SysTools
  24 import CmdLineOpts
  25 import Config
  26 import Util
  27 import Panic
  28
  29 import EXCEPTION
  30 import DATA_IOREF       ( readIORef, writeIORef )
  31
  32 import System           ( exitWith, ExitCode(..) )
  33 import IO
  34 import Maybe
  35 import Monad
  36 import Char
  37
  38 -----------------------------------------------------------------------------
  39 -- Flags
  40
  41 -- Flag parsing is now done in stages:
  42 --
  43 --     * parse the initial list of flags and remove any flags understood
  44 --       by the driver only.  Determine whether we're in multi-compilation
  45 --       or single-compilation mode (done in Main.main).
  46 --
  47 --     * gather the list of "static" hsc flags, and assign them to the global
  48 --       static hsc flags variable.
  49 --
  50 --     * build the inital DynFlags from the remaining flags.
  51 --
  52 --     * complain if we've got any flags left over.
  53 --
  54 --     * for each source file: grab the OPTIONS, and build a new DynFlags
  55 --       to pass to the compiler.
  56
  57 -----------------------------------------------------------------------------
  58 -- Process command-line
  59
  60 data OptKind
  61         = NoArg (IO ())                     -- flag with no argument
  62         | HasArg (String -> IO ())          -- flag has an argument (maybe prefix)
  63         | SepArg (String -> IO ())          -- flag has a separate argument
  64         | Prefix (String -> IO ())          -- flag is a prefix only
  65         | OptPrefix (String -> IO ())       -- flag may be a prefix
  66         | AnySuffix (String -> IO ())       -- flag is a prefix, pass whole arg to fn
  67         | PassFlag  (String -> IO ())       -- flag with no arg, pass flag to fn
  68         | PrefixPred (String -> Bool) (String -> IO ())
  69         | AnySuffixPred (String -> Bool) (String -> IO ())
  70
  71 processArgs :: [(String,OptKind)] -> [String] -> [String]
  72             -> IO [String]  -- returns spare args
  73 processArgs _spec [] spare = return (reverse spare)
  74
  75 processArgs spec args@(('-':arg):args') spare = do
  76   case findArg spec arg of
  77     Just (rest,action) -> do args' <- processOneArg action rest args
  78                              processArgs spec args' spare
  79     Nothing            -> processArgs spec args' (('-':arg):spare)
  80
  81 processArgs spec (arg:args) spare =
  82   processArgs spec args (arg:spare)
  83
  84 processOneArg :: OptKind -> String -> [String] -> IO [String]
  85 processOneArg action rest (dash_arg@('-':arg):args) =
  86   case action of
  87         NoArg  io ->
  88                 if rest == ""
  89                         then io >> return args
  90                         else unknownFlagErr dash_arg
  91
  92         HasArg fio ->
  93                 if rest /= ""
  94                         then fio rest >> return args
  95                         else case args of
  96                                 [] -> missingArgErr dash_arg
  97                                 (arg1:args1) -> fio arg1 >> return args1
  98
  99         SepArg fio ->
 100                 case args of
 101                         [] -> unknownFlagErr dash_arg
 102                         (arg1:args1) -> fio arg1 >> return args1
 103
 104         Prefix fio ->
 105                 if rest /= ""
 106                         then fio rest >> return args
 107                         else unknownFlagErr dash_arg
 108
 109         PrefixPred p fio ->
 110                 if rest /= ""
 111                         then fio rest >> return args
 112                         else unknownFlagErr dash_arg
 113
 114         OptPrefix fio       -> fio rest >> return args
 115
 116         AnySuffix fio       -> fio dash_arg >> return args
 117
 118         AnySuffixPred p fio -> fio dash_arg >> return args
 119
 120         PassFlag fio  ->
 121                 if rest /= ""
 122                         then unknownFlagErr dash_arg
 123                         else fio dash_arg >> return args
 124
 125 findArg :: [(String,OptKind)] -> String -> Maybe (String,OptKind)
 126 findArg spec arg
 127   = case [ (remove_spaces rest, k)
 128          | (pat,k)   <- spec,
 129            Just rest <- [maybePrefixMatch pat arg],
 130            arg_ok k rest arg ]
 131     of
 132         []      -> Nothing
 133         (one:_) -> Just one
 134
 135 arg_ok (NoArg _)            rest arg = null rest
 136 arg_ok (HasArg _)           rest arg = True
 137 arg_ok (SepArg _)           rest arg = null rest
 138 arg_ok (Prefix _)           rest arg = notNull rest
 139 arg_ok (PrefixPred p _)     rest arg = notNull rest && p rest
 140 arg_ok (OptPrefix _)        rest arg = True
 141 arg_ok (PassFlag _)         rest arg = null rest
 142 arg_ok (AnySuffix _)        rest arg = True
 143 arg_ok (AnySuffixPred p _)  rest arg = p arg
 144
 145 -----------------------------------------------------------------------------
 146 -- Static flags
 147
 148 -- note that ordering is important in the following list: any flag which
 149 -- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
 150 -- flags further down the list with the same prefix.
 151
 152 static_flags =
 153   [  ------- help / version ----------------------------------------------
 154      ( "?"               , NoArg showGhcUsage)
 155   ,  ( "-help"           , NoArg showGhcUsage)
 156   ,  ( "-print-libdir"   , NoArg (do getTopDir >>= putStrLn
 157                                      exitWith ExitSuccess))
 158   ,  ( "V"               , NoArg showVersion)
 159   ,  ( "-version"        , NoArg showVersion)
 160   ,  ( "-numeric-version", NoArg (do putStrLn cProjectVersion
 161                                      exitWith ExitSuccess))
 162
 163       ------- interfaces ----------------------------------------------------
 164   ,  ( "-show-iface"     , HasArg (\f -> do showIface f
 165                                             exitWith ExitSuccess))
 166
 167       ------- verbosity ----------------------------------------------------
 168   ,  ( "n"              , NoArg setDryRun )
 169
 170       ------- primary modes ------------------------------------------------
 171   ,  ( "M"              , PassFlag (setMode DoMkDependHS))
 172   ,  ( "E"              , PassFlag (setMode (StopBefore Hsc)))
 173   ,  ( "C"              , PassFlag (\f -> do setMode (StopBefore HCc) f
 174                                              setLang HscC))
 175   ,  ( "S"              , PassFlag (setMode (StopBefore As)))
 176   ,  ( "c"              , PassFlag (setMode (StopBefore Ln)))
 177   ,  ( "-make"          , PassFlag (setMode DoMake))
 178   ,  ( "-interactive"   , PassFlag (setMode DoInteractive))
 179   ,  ( "-mk-dll"        , PassFlag (setMode DoMkDLL))
 180   ,  ( "e"              , HasArg   (\s -> setMode (DoEval s) "-e"))
 181
 182         -- -fno-code says to stop after Hsc but don't generate any code.
 183   ,  ( "fno-code"       , PassFlag (\f -> do setMode (StopBefore HCc) f
 184                                              setLang HscNothing
 185                                              writeIORef v_Recomp False))
 186
 187         ------- GHCi -------------------------------------------------------
 188   ,  ( "ignore-dot-ghci", NoArg (writeIORef v_Read_DotGHCi False) )
 189   ,  ( "read-dot-ghci"  , NoArg (writeIORef v_Read_DotGHCi True) )
 190
 191         ------- recompilation checker --------------------------------------
 192   ,  ( "recomp"         , NoArg (writeIORef v_Recomp True) )
 193   ,  ( "no-recomp"      , NoArg (writeIORef v_Recomp False) )
 194
 195         ------- ways --------------------------------------------------------
 196   ,  ( "prof"           , NoArg (addNoDups v_Ways       WayProf) )
 197   ,  ( "unreg"          , NoArg (addNoDups v_Ways       WayUnreg) )
 198   ,  ( "ticky"          , NoArg (addNoDups v_Ways       WayTicky) )
 199   ,  ( "parallel"       , NoArg (addNoDups v_Ways       WayPar) )
 200   ,  ( "gransim"        , NoArg (addNoDups v_Ways       WayGran) )
 201   ,  ( "smp"            , NoArg (addNoDups v_Ways       WaySMP) )
 202   ,  ( "debug"          , NoArg (addNoDups v_Ways       WayDebug) )
 203   ,  ( "ndp"            , NoArg (addNoDups v_Ways       WayNDP) )
 204         -- ToDo: user ways
 205
 206         ------ Debugging ----------------------------------------------------
 207   ,  ( "dppr-noprags",     PassFlag (add v_Opt_C) )
 208   ,  ( "dppr-debug",       PassFlag (add v_Opt_C) )
 209   ,  ( "dppr-user-length", AnySuffix (add v_Opt_C) )
 210       -- rest of the debugging flags are dynamic
 211
 212         --------- Profiling --------------------------------------------------
 213   ,  ( "auto-dicts"     , NoArg (add v_Opt_C "-fauto-sccs-on-dicts") )
 214   ,  ( "auto-all"       , NoArg (add v_Opt_C "-fauto-sccs-on-all-toplevs") )
 215   ,  ( "auto"           , NoArg (add v_Opt_C "-fauto-sccs-on-exported-toplevs") )
 216   ,  ( "caf-all"        , NoArg (add v_Opt_C "-fauto-sccs-on-individual-cafs") )
 217          -- "ignore-sccs"  doesn't work  (ToDo)
 218
 219   ,  ( "no-auto-dicts"  , NoArg (add v_Anti_opt_C "-fauto-sccs-on-dicts") )
 220   ,  ( "no-auto-all"    , NoArg (add v_Anti_opt_C "-fauto-sccs-on-all-toplevs") )
 221   ,  ( "no-auto"        , NoArg (add v_Anti_opt_C "-fauto-sccs-on-exported-toplevs") )
 222   ,  ( "no-caf-all"     , NoArg (add v_Anti_opt_C "-fauto-sccs-on-individual-cafs") )
 223
 224         ------- Miscellaneous -----------------------------------------------
 225   ,  ( "no-link-chk"    , NoArg (return ()) ) -- ignored for backwards compat
 226   ,  ( "no-hs-main"     , NoArg (writeIORef v_NoHsMain True) )
 227   ,  ( "main-is"        , SepArg setMainIs )
 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) )
 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"              , AnySuffix (\s -> add v_Opt_l s >> add v_Opt_dll s) )
 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   ,  ( "pgmL"           , HasArg setPgmL )
 281   ,  ( "pgmP"           , HasArg setPgmP )
 282   ,  ( "pgmF"           , HasArg setPgmF )
 283   ,  ( "pgmc"           , HasArg setPgmc )
 284   ,  ( "pgmm"           , HasArg setPgmm )
 285   ,  ( "pgms"           , HasArg setPgms )
 286   ,  ( "pgma"           , HasArg setPgma )
 287   ,  ( "pgml"           , HasArg setPgml )
 288   ,  ( "pgmdll"         , HasArg setPgmDLL )
 289 #ifdef ILX
 290   ,  ( "pgmI"           , HasArg setPgmI )
 291   ,  ( "pgmi"           , HasArg setPgmi )
 292 #endif
 293
 294   ,  ( "optdep"         , HasArg (add v_Opt_dep) )
 295   ,  ( "optl"           , HasArg (add v_Opt_l) )
 296   ,  ( "optdll"         , HasArg (add v_Opt_dll) )
 297
 298         ----- Linker --------------------------------------------------------
 299   ,  ( "no-link"        , NoArg (writeIORef v_NoLink True) )
 300   ,  ( "static"         , NoArg (writeIORef v_Static True) )
 301   ,  ( "dynamic"        , NoArg (writeIORef v_Static False) )
 302   ,  ( "rdynamic"       , NoArg (return ()) ) -- ignored for compat w/ gcc
 303
 304         ----- RTS opts ------------------------------------------------------
 305   ,  ( "H"                 , HasArg (setHeapSize . fromIntegral . decodeSize) )
 306   ,  ( "Rghc-timing"       , NoArg  (enableTimingStats) )
 307
 308         ------ Compiler flags -----------------------------------------------
 309   ,  ( "fno-asm-mangling"  , NoArg (writeIORef v_Do_asm_mangling False) )
 310
 311   ,  ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True
 312                                        add v_Opt_C "-fexcess-precision"))
 313
 314         -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
 315   ,  ( "fno-",                  PrefixPred (\s -> isStaticHscFlag ("f"++s))
 316                                     (\s -> add v_Anti_opt_C ("-f"++s)) )
 317
 318         -- Pass all remaining "-f<blah>" options to hsc
 319   ,  ( "f",                     AnySuffixPred (isStaticHscFlag) (add v_Opt_C) )
 320   ]
 321
 322 dynamic_flags = [
 323
 324      ( "cpp",           NoArg  (updDynFlags (\s -> s{ cppFlag = True })) )
 325   ,  ( "F",             NoArg  (updDynFlags (\s -> s{ ppFlag = True })) )
 326   ,  ( "#include",      HasArg (addCmdlineHCInclude) )
 327
 328   ,  ( "v",             OptPrefix (setVerbosity) )
 329
 330   ,  ( "optL",          HasArg (addOpt_L) )
 331   ,  ( "optP",          HasArg (addOpt_P) )
 332   ,  ( "optF",          HasArg (addOpt_F) )
 333   ,  ( "optc",          HasArg (addOpt_c) )
 334   ,  ( "optm",          HasArg (addOpt_m) )
 335   ,  ( "opta",          HasArg (addOpt_a) )
 336 #ifdef ILX
 337   ,  ( "optI",          HasArg (addOpt_I) )
 338   ,  ( "opti",          HasArg (addOpt_i) )
 339 #endif
 340
 341         ------ HsCpp opts ---------------------------------------------------
 342   ,  ( "D",             AnySuffix addOpt_P )
 343   ,  ( "U",             AnySuffix addOpt_P )
 344
 345         ------ Debugging ----------------------------------------------------
 346   ,  ( "dstg-stats",    NoArg (writeIORef v_StgStats True) )
 347
 348   ,  ( "ddump-absC",             NoArg (setDynFlag Opt_D_dump_absC) )
 349   ,  ( "ddump-asm",              NoArg (setDynFlag Opt_D_dump_asm) )
 350   ,  ( "ddump-cpranal",          NoArg (setDynFlag Opt_D_dump_cpranal) )
 351   ,  ( "ddump-deriv",            NoArg (setDynFlag Opt_D_dump_deriv) )
 352   ,  ( "ddump-ds",               NoArg (setDynFlag Opt_D_dump_ds) )
 353   ,  ( "ddump-flatC",            NoArg (setDynFlag Opt_D_dump_flatC) )
 354   ,  ( "ddump-foreign",          NoArg (setDynFlag Opt_D_dump_foreign) )
 355   ,  ( "ddump-inlinings",        NoArg (setDynFlag Opt_D_dump_inlinings) )
 356   ,  ( "ddump-occur-anal",       NoArg (setDynFlag Opt_D_dump_occur_anal) )
 357   ,  ( "ddump-parsed",           NoArg (setDynFlag Opt_D_dump_parsed) )
 358   ,  ( "ddump-realC",            NoArg (setDynFlag Opt_D_dump_realC) )
 359   ,  ( "ddump-rn",               NoArg (setDynFlag Opt_D_dump_rn) )
 360   ,  ( "ddump-simpl",            NoArg (setDynFlag Opt_D_dump_simpl) )
 361   ,  ( "ddump-simpl-iterations", NoArg (setDynFlag Opt_D_dump_simpl_iterations) )
 362   ,  ( "ddump-spec",             NoArg (setDynFlag Opt_D_dump_spec) )
 363   ,  ( "ddump-prep",             NoArg (setDynFlag Opt_D_dump_prep) )
 364   ,  ( "ddump-stg",              NoArg (setDynFlag Opt_D_dump_stg) )
 365   ,  ( "ddump-stranal",          NoArg (setDynFlag Opt_D_dump_stranal) )
 366   ,  ( "ddump-tc",               NoArg (setDynFlag Opt_D_dump_tc) )
 367   ,  ( "ddump-types",            NoArg (setDynFlag Opt_D_dump_types) )
 368   ,  ( "ddump-rules",            NoArg (setDynFlag Opt_D_dump_rules) )
 369   ,  ( "ddump-cse",              NoArg (setDynFlag Opt_D_dump_cse) )
 370   ,  ( "ddump-worker-wrapper",   NoArg (setDynFlag Opt_D_dump_worker_wrapper) )
 371   ,  ( "dshow-passes",           NoArg (setVerbosity "2") )
 372   ,  ( "ddump-rn-trace",         NoArg (setDynFlag Opt_D_dump_rn_trace) )
 373   ,  ( "ddump-if-trace",         NoArg (setDynFlag Opt_D_dump_if_trace) )
 374   ,  ( "ddump-tc-trace",         NoArg (setDynFlag Opt_D_dump_tc_trace) )
 375   ,  ( "ddump-splices",          NoArg (setDynFlag Opt_D_dump_splices) )
 376   ,  ( "ddump-rn-stats",         NoArg (setDynFlag Opt_D_dump_rn_stats) )
 377   ,  ( "ddump-stix",             NoArg (setDynFlag Opt_D_dump_stix) )
 378   ,  ( "ddump-simpl-stats",      NoArg (setDynFlag Opt_D_dump_simpl_stats) )
 379   ,  ( "ddump-bcos",             NoArg (setDynFlag Opt_D_dump_BCOs) )
 380   ,  ( "dsource-stats",          NoArg (setDynFlag Opt_D_source_stats) )
 381   ,  ( "dverbose-core2core",     NoArg (setDynFlag Opt_D_verbose_core2core) )
 382   ,  ( "dverbose-stg2stg",       NoArg (setDynFlag Opt_D_verbose_stg2stg) )
 383   ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs) )
 384   ,  ( "ddump-hi",               NoArg (setDynFlag Opt_D_dump_hi) )
 385   ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports) )
 386   ,  ( "ddump-vect",             NoArg (setDynFlag Opt_D_dump_vect) )
 387   ,  ( "dcore-lint",             NoArg (setDynFlag Opt_DoCoreLinting) )
 388   ,  ( "dstg-lint",              NoArg (setDynFlag Opt_DoStgLinting) )
 389
 390         ------ Machine dependant (-m<blah>) stuff ---------------------------
 391
 392   ,  ( "monly-2-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 2}) ))
 393   ,  ( "monly-3-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 3}) ))
 394   ,  ( "monly-4-regs",  NoArg (updDynFlags (\s -> s{stolen_x86_regs = 4}) ))
 395
 396         ------ Warning opts -------------------------------------------------
 397   ,  ( "W"              , NoArg (mapM_ setDynFlag   minusWOpts)    )
 398   ,  ( "Werror"         , NoArg (setDynFlag         Opt_WarnIsError) )
 399   ,  ( "Wall"           , NoArg (mapM_ setDynFlag   minusWallOpts) )
 400   ,  ( "Wnot"           , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
 401   ,  ( "w"              , NoArg (mapM_ unSetDynFlag minusWallOpts) )
 402
 403         ------ Optimisation flags ------------------------------------------
 404   ,  ( "O"                 , NoArg (setOptLevel 1))
 405   ,  ( "Onot"              , NoArg (setOptLevel 0))
 406   ,  ( "O"                 , PrefixPred (all isDigit) (setOptLevel . read))
 407
 408   ,  ( "fmax-simplifier-iterations",
 409                 PrefixPred (all isDigit)
 410                   (\n -> updDynFlags (\dfs ->
 411                         dfs{ maxSimplIterations = read n })) )
 412
 413   ,  ( "frule-check",
 414                 SepArg (\s -> updDynFlags (\dfs -> dfs{ ruleCheck = Just s })))
 415
 416         ------ Compiler flags -----------------------------------------------
 417
 418   ,  ( "fasm",          AnySuffix (\_ -> setLang HscAsm) )
 419   ,  ( "fvia-c",        NoArg (setLang HscC) )
 420   ,  ( "fvia-C",        NoArg (setLang HscC) )
 421   ,  ( "filx",          NoArg (setLang HscILX) )
 422
 423   ,  ( "fglasgow-exts",    NoArg (mapM_ setDynFlag   glasgowExtsFlags) )
 424   ,  ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) )
 425
 426         -- "active negatives"
 427   ,  ( "fno-implicit-prelude",  NoArg (setDynFlag Opt_NoImplicitPrelude) )
 428   ,  ( "fno-monomorphism-restriction",
 429                         NoArg (setDynFlag Opt_NoMonomorphismRestriction) )
 430
 431         -- the rest of the -f* and -fno-* flags
 432   ,  ( "fno-",          PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )
 433   ,  ( "f",             PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag f)) )
 434  ]
 435
 436 -- these -f<blah> flags can all be reversed with -fno-<blah>
 437
 438 fFlags = [
 439   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports ),
 440   ( "warn-hi-shadowing",                Opt_WarnHiShadows ),
 441   ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns ),
 442   ( "warn-missing-fields",              Opt_WarnMissingFields ),
 443   ( "warn-missing-methods",             Opt_WarnMissingMethods ),
 444   ( "warn-missing-signatures",          Opt_WarnMissingSigs ),
 445   ( "warn-name-shadowing",              Opt_WarnNameShadowing ),
 446   ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns ),
 447   ( "warn-simple-patterns",             Opt_WarnSimplePatterns ),
 448   ( "warn-type-defaults",               Opt_WarnTypeDefaults ),
 449   ( "warn-unused-binds",                Opt_WarnUnusedBinds ),
 450   ( "warn-unused-imports",              Opt_WarnUnusedImports ),
 451   ( "warn-unused-matches",              Opt_WarnUnusedMatches ),
 452   ( "warn-deprecations",                Opt_WarnDeprecations ),
 453   ( "fi",                               Opt_FFI ),  -- support `-ffi'...
 454   ( "ffi",                              Opt_FFI ),  -- ...and also `-fffi'
 455   ( "arrows",                           Opt_Arrows ), -- arrow syntax
 456   ( "parr",                             Opt_PArr ),
 457   ( "th",                               Opt_TH ),
 458   ( "implicit-params",                  Opt_ImplicitParams ),
 459   ( "allow-overlapping-instances",      Opt_AllowOverlappingInstances ),
 460   ( "allow-undecidable-instances",      Opt_AllowUndecidableInstances ),
 461   ( "allow-incoherent-instances",       Opt_AllowIncoherentInstances ),
 462   ( "generics",                         Opt_Generics ),
 463   ( "strictness",                       Opt_Strictness ),
 464   ( "cse",                              Opt_CSE ),
 465   ( "ignore-interface-pragmas",         Opt_IgnoreInterfacePragmas ),
 466   ( "omit-interface-pragmas",           Opt_OmitInterfacePragmas ),
 467   ( "do-lambda-eta-expansion",          Opt_DoLambdaEtaExpansion ),
 468   ( "ignore-asserts",                   Opt_IgnoreAsserts ),
 469   ( "do-eta-reduction",                 Opt_DoEtaReduction ),
 470   ( "case-merge",                       Opt_CaseMerge ),
 471   ( "unbox-strict-fields",              Opt_UnboxStrictFields )
 472   ]
 473
 474 glasgowExtsFlags = [ Opt_GlasgowExts, Opt_FFI, Opt_TH, Opt_ImplicitParams ]
 475
 476 isFFlag f = f `elem` (map fst fFlags)
 477 getFFlag f = fromJust (lookup f fFlags)
 478
 479 -----------------------------------------------------------------------------
 480 -- convert sizes like "3.5M" into integers
 481
 482 decodeSize :: String -> Integer
 483 decodeSize str
 484   | c == ""              = truncate n
 485   | c == "K" || c == "k" = truncate (n * 1000)
 486   | c == "M" || c == "m" = truncate (n * 1000 * 1000)
 487   | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
 488   | otherwise            = throwDyn (CmdLineError ("can't decode size: " ++ str))
 489   where (m, c) = span pred str
 490         n      = read m  :: Double
 491         pred c = isDigit c || c == '.'
 492
 493
 494 -----------------------------------------------------------------------------
 495 -- RTS Hooks
 496
 497 #if __GLASGOW_HASKELL__ >= 504
 498 foreign import ccall unsafe "setHeapSize"       setHeapSize       :: Int -> IO ()
 499 foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
 500 #else
 501 foreign import "setHeapSize"       unsafe setHeapSize       :: Int -> IO ()
 502 foreign import "enableTimingStats" unsafe enableTimingStats :: IO ()
 503 #endif
 504
 505 -----------------------------------------------------------------------------
 506 -- Build the Hsc static command line opts
 507
 508 buildStaticHscOpts :: IO [String]
 509 buildStaticHscOpts = do
 510
 511   opt_C_ <- getStaticOpts v_Opt_C       -- misc hsc opts from the command line
 512
 513         -- take into account -fno-* flags by removing the equivalent -f*
 514         -- flag from our list.
 515   anti_flags <- getStaticOpts v_Anti_opt_C
 516   let basic_opts = opt_C_
 517       filtered_opts = filter (`notElem` anti_flags) basic_opts
 518
 519   static <- (do s <- readIORef v_Static; if s then return "-static"
 520                                               else return "")
 521
 522   return ( static : filtered_opts )
 523
 524 setMainIs :: String -> IO ()
 525 setMainIs arg
 526   | not (null main_mod)         -- The arg looked like "Foo.baz"
 527   = do { writeIORef v_MainFunIs (Just main_fn) ;
 528          writeIORef v_MainModIs (Just main_mod) }
 529
 530   | isUpper (head main_fn)      -- The arg looked like "Foo"
 531   = writeIORef v_MainModIs (Just main_fn)
 532
 533   | otherwise                   -- The arg looked like "baz"
 534   = writeIORef v_MainFunIs (Just main_fn)
 535   where
 536     (main_mod, main_fn) = split_longest_prefix arg (== '.')
 537
 538
 539 -----------------------------------------------------------------------------
 540 -- Via-C compilation stuff
 541
 542 -- flags returned are: ( all C compilations
 543 --                     , registerised HC compilations
 544 --                     )
 545
 546 machdepCCOpts
 547    | prefixMatch "alpha"   cTARGETPLATFORM
 548         = return ( ["-static", "-w", "-mieee"
 549 #ifdef HAVE_THREADED_RTS_SUPPORT
 550                     , "-D_REENTRANT"
 551 #endif
 552                    ], [] )
 553         -- For now, to suppress the gcc warning "call-clobbered
 554         -- register used for global register variable", we simply
 555         -- disable all warnings altogether using the -w flag. Oh well.
 556
 557    | prefixMatch "hppa"    cTARGETPLATFORM
 558         -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
 559         -- (very nice, but too bad the HP /usr/include files don't agree.)
 560         = return ( ["-static", "-D_HPUX_SOURCE"], [] )
 561
 562    | prefixMatch "m68k"    cTARGETPLATFORM
 563       -- -fno-defer-pop : for the .hc files, we want all the pushing/
 564       --    popping of args to routines to be explicit; if we let things
 565       --    be deferred 'til after an STGJUMP, imminent death is certain!
 566       --
 567       -- -fomit-frame-pointer : *don't*
 568       --     It's better to have a6 completely tied up being a frame pointer
 569       --     rather than let GCC pick random things to do with it.
 570       --     (If we want to steal a6, then we would try to do things
 571       --     as on iX86, where we *do* steal the frame pointer [%ebp].)
 572         = return ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
 573
 574    | prefixMatch "i386"    cTARGETPLATFORM
 575       -- -fno-defer-pop : basically the same game as for m68k
 576       --
 577       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
 578       --   the fp (%ebp) for our register maps.
 579         = do n_regs <- dynFlag stolen_x86_regs
 580              sta    <- readIORef v_Static
 581              return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
 582 --                    , if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else ""
 583                       ],
 584                       [ "-fno-defer-pop",
 585 #ifdef HAVE_GCC_MNO_OMIT_LFPTR
 586                         -- Some gccs are configured with
 587                         -- -momit-leaf-frame-pointer on by default, and it
 588                         -- apparently takes precedence over
 589                         -- -fomit-frame-pointer, so we disable it first here.
 590                         "-mno-omit-leaf-frame-pointer",
 591 #endif
 592                         "-fomit-frame-pointer",
 593                         -- we want -fno-builtin, because when gcc inlines
 594                         -- built-in functions like memcpy() it tends to
 595                         -- run out of registers, requiring -monly-n-regs
 596                         "-fno-builtin",
 597                         "-DSTOLEN_X86_REGS="++show n_regs ]
 598                     )
 599
 600    | prefixMatch "ia64"    cTARGETPLATFORM
 601         = return ( [], ["-fomit-frame-pointer", "-G0"] )
 602
 603    | prefixMatch "x86_64"  cTARGETPLATFORM
 604         = return ( [], ["-fomit-frame-pointer"] )
 605
 606    | prefixMatch "mips"    cTARGETPLATFORM
 607         = return ( ["-static"], [] )
 608
 609    | prefixMatch "sparc"    cTARGETPLATFORM
 610         = return ( [], ["-w"] )
 611         -- For now, to suppress the gcc warning "call-clobbered
 612         -- register used for global register variable", we simply
 613         -- disable all warnings altogether using the -w flag. Oh well.
 614
 615    | prefixMatch "powerpc-apple-darwin" cTARGETPLATFORM
 616       -- -no-cpp-precomp:
 617       --     Disable Apple's precompiling preprocessor. It's a great thing
 618       --     for "normal" programs, but it doesn't support register variable
 619       --     declarations.
 620       -- -mdynamic-no-pic:
 621       --     As we don't support haskell code in shared libraries anyway,
 622       --     we might as well turn of PIC code generation and save space and time.
 623       --     This is completely optional.
 624        = return ( ["-no-cpp-precomp","-mdynamic-no-pic"], [] )
 625
 626    | prefixMatch "powerpc" cTARGETPLATFORM || prefixMatch "rs6000" cTARGETPLATFORM
 627         = return ( ["-static"], ["-finhibit-size-directive"] )
 628
 629    | otherwise
 630         = return ( [], [] )
 631
 632 -----------------------------------------------------------------------------
 633 -- local utils
 634
 635 addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
 636 addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
 637 addOpt_F a = updDynFlags (\s -> s{opt_F = a : opt_F s})
 638 addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s})
 639 addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s})
 640 addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s})
 641 #ifdef ILX
 642 addOpt_I a = updDynFlags (\s -> s{opt_I = a : opt_I s})
 643 addOpt_i a = updDynFlags (\s -> s{opt_i = a : opt_i s})
 644 #endif
 645
 646 setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
 647 setVerbosity n
 648   | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
 649   | otherwise     = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
 650
 651 addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
 652
 653 -- -----------------------------------------------------------------------------
 654 -- Version and usage messages
 655
 656 showVersion :: IO ()
 657 showVersion = do
 658   putStrLn (cProjectName ++ ", version " ++ cProjectVersion)
 659   exitWith ExitSuccess
 660
 661 showGhcUsage = do
 662   (ghc_usage_path,ghci_usage_path) <- getUsageMsgPaths
 663   mode <- readIORef v_GhcMode
 664   let usage_path
 665         | mode == DoInteractive  = ghci_usage_path
 666         | otherwise              = ghc_usage_path
 667   usage <- readFile usage_path
 668   dump usage
 669   exitWith ExitSuccess
 670   where
 671      dump ""          = return ()
 672      dump ('$':'$':s) = hPutStr stderr progName >> dump s
 673      dump (c:s)       = hPutChar stderr c >> dump s