compiler/main/DynFlags.hs

   1
   2 {-# OPTIONS -fno-warn-missing-fields #-}
   3 -- The above warning supression flag is a temporary kludge.
   4 -- While working on this module you are encouraged to remove it and fix
   5 -- any warnings in the module. See
   6 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
   7 -- for details
   8
   9 -----------------------------------------------------------------------------
  10 --
  11 -- Dynamic flags
  12 --
  13 -- Most flags are dynamic flags, which means they can change from
  14 -- compilation to compilation using OPTIONS_GHC pragmas, and in a
  15 -- multi-session GHC each session can be using different dynamic
  16 -- flags.  Dynamic flags can also be set at the prompt in GHCi.
  17 --
  18 -- (c) The University of Glasgow 2005
  19 --
  20 -----------------------------------------------------------------------------
  21
  22 module DynFlags (
  23         -- Dynamic flags
  24         DynFlag(..),
  25         DynFlags(..),
  26         HscTarget(..), isObjectTarget, defaultObjectTarget,
  27         GhcMode(..), isOneShot,
  28         GhcLink(..), isNoLink,
  29         PackageFlag(..),
  30         Option(..),
  31         DynLibLoader(..),
  32         fFlags, xFlags,
  33
  34         -- Configuration of the core-to-core and stg-to-stg phases
  35         CoreToDo(..),
  36         StgToDo(..),
  37         SimplifierSwitch(..),
  38         SimplifierMode(..), FloatOutSwitches(..),
  39         getCoreToDo, getStgToDo,
  40
  41         -- Manipulating DynFlags
  42         defaultDynFlags,                -- DynFlags
  43         initDynFlags,                   -- DynFlags -> IO DynFlags
  44
  45         dopt,                           -- DynFlag -> DynFlags -> Bool
  46         dopt_set, dopt_unset,           -- DynFlags -> DynFlag -> DynFlags
  47         getOpts,                        -- (DynFlags -> [a]) -> IO [a]
  48         getVerbFlag,
  49         updOptLevel,
  50         setTmpDir,
  51         setPackageName,
  52
  53         -- parsing DynFlags
  54         parseDynamicFlags,
  55         allFlags,
  56
  57         -- misc stuff
  58         machdepCCOpts, picCCOpts,
  59     supportedLanguages,
  60     compilerInfo,
  61   ) where
  62
  63 -- XXX This define is a bit of a hack, and should be done more nicely
  64 #define FAST_STRING_NOT_NEEDED 1
  65 #include "HsVersions.h"
  66
  67 import Module
  68 import PackageConfig
  69 import PrelNames        ( mAIN )
  70 #ifdef i386_TARGET_ARCH
  71 import StaticFlags      ( opt_Static )
  72 #endif
  73 import StaticFlags      ( opt_PIC, WayName(..), v_Ways, v_Build_tag,
  74                           v_RTS_Build_tag )
  75 import {-# SOURCE #-} Packages (PackageState)
  76 import DriverPhases     ( Phase(..), phaseInputExt )
  77 import Config
  78 import CmdLineParser
  79 import Constants        ( mAX_CONTEXT_REDUCTION_DEPTH )
  80 import Panic            ( panic, GhcException(..) )
  81 import UniqFM           ( UniqFM )
  82 import Util
  83 import Maybes           ( orElse, fromJust )
  84 import SrcLoc           ( SrcSpan )
  85 import Outputable
  86 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
  87
  88 import Data.IORef       ( readIORef )
  89 import Control.Exception ( throwDyn )
  90 import Control.Monad    ( when )
  91
  92 import Data.Char
  93 import System.FilePath
  94 import System.IO        ( hPutStrLn, stderr )
  95
  96 -- -----------------------------------------------------------------------------
  97 -- DynFlags
  98
  99 data DynFlag
 100
 101    -- debugging flags
 102    = Opt_D_dump_cmm
 103    | Opt_D_dump_cmmz
 104    | Opt_D_dump_cmmz_pretty
 105    | Opt_D_dump_cps_cmm
 106    | Opt_D_dump_cvt_cmm
 107    | Opt_D_dump_asm
 108    | Opt_D_dump_asm_native
 109    | Opt_D_dump_asm_liveness
 110    | Opt_D_dump_asm_coalesce
 111    | Opt_D_dump_asm_regalloc
 112    | Opt_D_dump_asm_regalloc_stages
 113    | Opt_D_dump_asm_conflicts
 114    | Opt_D_dump_asm_stats
 115    | Opt_D_dump_cpranal
 116    | Opt_D_dump_deriv
 117    | Opt_D_dump_ds
 118    | Opt_D_dump_flatC
 119    | Opt_D_dump_foreign
 120    | Opt_D_dump_inlinings
 121    | Opt_D_dump_rule_firings
 122    | Opt_D_dump_occur_anal
 123    | Opt_D_dump_parsed
 124    | Opt_D_dump_rn
 125    | Opt_D_dump_simpl
 126    | Opt_D_dump_simpl_iterations
 127    | Opt_D_dump_simpl_phases
 128    | Opt_D_dump_spec
 129    | Opt_D_dump_prep
 130    | Opt_D_dump_stg
 131    | Opt_D_dump_stranal
 132    | Opt_D_dump_tc
 133    | Opt_D_dump_types
 134    | Opt_D_dump_rules
 135    | Opt_D_dump_cse
 136    | Opt_D_dump_worker_wrapper
 137    | Opt_D_dump_rn_trace
 138    | Opt_D_dump_rn_stats
 139    | Opt_D_dump_opt_cmm
 140    | Opt_D_dump_simpl_stats
 141    | Opt_D_dump_tc_trace
 142    | Opt_D_dump_if_trace
 143    | Opt_D_dump_splices
 144    | Opt_D_dump_BCOs
 145    | Opt_D_dump_vect
 146    | Opt_D_dump_hpc
 147    | Opt_D_source_stats
 148    | Opt_D_verbose_core2core
 149    | Opt_D_verbose_stg2stg
 150    | Opt_D_dump_hi
 151    | Opt_D_dump_hi_diffs
 152    | Opt_D_dump_minimal_imports
 153    | Opt_D_dump_mod_cycles
 154    | Opt_D_dump_view_pattern_commoning
 155    | Opt_D_faststring_stats
 156    | Opt_DumpToFile                     -- ^ Append dump output to files instead of stdout.
 157    | Opt_DoCoreLinting
 158    | Opt_DoStgLinting
 159    | Opt_DoCmmLinting
 160    | Opt_DoAsmLinting
 161
 162    | Opt_WarnIsError                    -- -Werror; makes warnings fatal
 163    | Opt_WarnDuplicateExports
 164    | Opt_WarnHiShadows
 165    | Opt_WarnImplicitPrelude
 166    | Opt_WarnIncompletePatterns
 167    | Opt_WarnIncompletePatternsRecUpd
 168    | Opt_WarnMissingFields
 169    | Opt_WarnMissingMethods
 170    | Opt_WarnMissingSigs
 171    | Opt_WarnNameShadowing
 172    | Opt_WarnOverlappingPatterns
 173    | Opt_WarnSimplePatterns
 174    | Opt_WarnTypeDefaults
 175    | Opt_WarnMonomorphism
 176    | Opt_WarnUnusedBinds
 177    | Opt_WarnUnusedImports
 178    | Opt_WarnUnusedMatches
 179    | Opt_WarnDeprecations
 180    | Opt_WarnDodgyImports
 181    | Opt_WarnOrphans
 182    | Opt_WarnTabs
 183
 184    -- language opts
 185    | Opt_OverlappingInstances
 186    | Opt_UndecidableInstances
 187    | Opt_IncoherentInstances
 188    | Opt_MonomorphismRestriction
 189    | Opt_MonoPatBinds
 190    | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
 191    | Opt_ForeignFunctionInterface
 192    | Opt_UnliftedFFITypes
 193    | Opt_PArr                           -- Syntactic support for parallel arrays
 194    | Opt_Arrows                         -- Arrow-notation syntax
 195    | Opt_TemplateHaskell
 196    | Opt_QuasiQuotes
 197    | Opt_ImplicitParams
 198    | Opt_Generics
 199    | Opt_ImplicitPrelude
 200    | Opt_ScopedTypeVariables
 201    | Opt_UnboxedTuples
 202    | Opt_BangPatterns
 203    | Opt_TypeFamilies
 204    | Opt_OverloadedStrings
 205    | Opt_DisambiguateRecordFields
 206    | Opt_RecordWildCards
 207    | Opt_RecordPuns
 208    | Opt_ViewPatterns
 209    | Opt_GADTs
 210    | Opt_RelaxedPolyRec
 211    | Opt_StandaloneDeriving
 212    | Opt_DeriveDataTypeable
 213    | Opt_TypeSynonymInstances
 214    | Opt_FlexibleContexts
 215    | Opt_FlexibleInstances
 216    | Opt_ConstrainedClassMethods
 217    | Opt_MultiParamTypeClasses
 218    | Opt_FunctionalDependencies
 219    | Opt_UnicodeSyntax
 220    | Opt_PolymorphicComponents
 221    | Opt_ExistentialQuantification
 222    | Opt_MagicHash
 223    | Opt_EmptyDataDecls
 224    | Opt_KindSignatures
 225    | Opt_PatternSignatures
 226    | Opt_ParallelListComp
 227    | Opt_TransformListComp
 228    | Opt_GeneralizedNewtypeDeriving
 229    | Opt_RecursiveDo
 230    | Opt_PatternGuards
 231    | Opt_LiberalTypeSynonyms
 232    | Opt_Rank2Types
 233    | Opt_RankNTypes
 234    | Opt_ImpredicativeTypes
 235    | Opt_TypeOperators
 236
 237    | Opt_PrintExplicitForalls
 238
 239    -- optimisation opts
 240    | Opt_Strictness
 241    | Opt_FullLaziness
 242    | Opt_CSE
 243    | Opt_LiberateCase
 244    | Opt_SpecConstr
 245    | Opt_IgnoreInterfacePragmas
 246    | Opt_OmitInterfacePragmas
 247    | Opt_DoLambdaEtaExpansion
 248    | Opt_IgnoreAsserts
 249    | Opt_DoEtaReduction
 250    | Opt_CaseMerge
 251    | Opt_UnboxStrictFields
 252    | Opt_DictsCheap
 253    | Opt_RewriteRules
 254    | Opt_Vectorise
 255    | Opt_RegsGraph                      -- do graph coloring register allocation
 256    | Opt_RegsIterative                  -- do iterative coalescing graph coloring register allocation
 257
 258    -- misc opts
 259    | Opt_Cpp
 260    | Opt_Pp
 261    | Opt_ForceRecomp
 262    | Opt_DryRun
 263    | Opt_DoAsmMangling
 264    | Opt_ExcessPrecision
 265    | Opt_ReadUserPackageConf
 266    | Opt_NoHsMain
 267    | Opt_SplitObjs
 268    | Opt_StgStats
 269    | Opt_HideAllPackages
 270    | Opt_PrintBindResult
 271    | Opt_Haddock
 272    | Opt_HaddockOptions
 273    | Opt_Hpc_No_Auto
 274    | Opt_BreakOnException
 275    | Opt_BreakOnError
 276    | Opt_PrintEvldWithShow
 277    | Opt_PrintBindContents
 278    | Opt_GenManifest
 279    | Opt_EmbedManifest
 280    | Opt_RunCPSZ
 281    | Opt_ConvertToZipCfgAndBack
 282
 283    -- keeping stuff
 284    | Opt_KeepHiDiffs
 285    | Opt_KeepHcFiles
 286    | Opt_KeepSFiles
 287    | Opt_KeepRawSFiles
 288    | Opt_KeepTmpFiles
 289
 290    deriving (Eq, Show)
 291
 292 data DynFlags = DynFlags {
 293   ghcMode               :: GhcMode,
 294   ghcLink               :: GhcLink,
 295   coreToDo              :: Maybe [CoreToDo], -- reserved for -Ofile
 296   stgToDo               :: Maybe [StgToDo],  -- similarly
 297   hscTarget             :: HscTarget,
 298   hscOutName            :: String,      -- name of the output file
 299   extCoreName           :: String,      -- name of the .core output file
 300   verbosity             :: Int,         -- verbosity level
 301   optLevel              :: Int,         -- optimisation level
 302   simplPhases           :: Int,         -- number of simplifier phases
 303   maxSimplIterations    :: Int,         -- max simplifier iterations
 304   shouldDumpSimplPhase  :: SimplifierMode -> Bool,
 305   ruleCheck             :: Maybe String,
 306
 307   specConstrThreshold   :: Maybe Int,   -- Threshold for SpecConstr
 308   liberateCaseThreshold :: Maybe Int,   -- Threshold for LiberateCase
 309
 310   stolen_x86_regs       :: Int,
 311   cmdlineHcIncludes     :: [String],    -- -#includes
 312   importPaths           :: [FilePath],
 313   mainModIs             :: Module,
 314   mainFunIs             :: Maybe String,
 315   ctxtStkDepth          :: Int,         -- Typechecker context stack depth
 316
 317   thisPackage           :: PackageId,
 318
 319   -- ways
 320   wayNames              :: [WayName],   -- way flags from the cmd line
 321   buildTag              :: String,      -- the global "way" (eg. "p" for prof)
 322   rtsBuildTag           :: String,      -- the RTS "way"
 323
 324   -- paths etc.
 325   objectDir             :: Maybe String,
 326   hiDir                 :: Maybe String,
 327   stubDir               :: Maybe String,
 328
 329   objectSuf             :: String,
 330   hcSuf                 :: String,
 331   hiSuf                 :: String,
 332
 333   outputFile            :: Maybe String,
 334   outputHi              :: Maybe String,
 335   dynLibLoader          :: DynLibLoader,
 336
 337   -- | This is set by DriverPipeline.runPipeline based on where
 338   --    its output is going.
 339   dumpPrefix            :: Maybe FilePath,
 340
 341   -- | Override the dumpPrefix set by runPipeline.
 342   --    Set by -ddump-file-prefix
 343   dumpPrefixForce       :: Maybe FilePath,
 344
 345   includePaths          :: [String],
 346   libraryPaths          :: [String],
 347   frameworkPaths        :: [String],    -- used on darwin only
 348   cmdlineFrameworks     :: [String],    -- ditto
 349   tmpDir                :: String,      -- no trailing '/'
 350
 351   ghcUsagePath          :: FilePath,    -- Filled in by SysTools
 352   ghciUsagePath         :: FilePath,    -- ditto
 353
 354   hpcDir                :: String,      -- ^ path to store the .mix files
 355
 356   -- options for particular phases
 357   opt_L                 :: [String],
 358   opt_P                 :: [String],
 359   opt_F                 :: [String],
 360   opt_c                 :: [String],
 361   opt_m                 :: [String],
 362   opt_a                 :: [String],
 363   opt_l                 :: [String],
 364   opt_dep               :: [String],
 365   opt_windres           :: [String],
 366
 367   -- commands for particular phases
 368   pgm_L                 :: String,
 369   pgm_P                 :: (String,[Option]),
 370   pgm_F                 :: String,
 371   pgm_c                 :: (String,[Option]),
 372   pgm_m                 :: (String,[Option]),
 373   pgm_s                 :: (String,[Option]),
 374   pgm_a                 :: (String,[Option]),
 375   pgm_l                 :: (String,[Option]),
 376   pgm_dll               :: (String,[Option]),
 377   pgm_T                 :: String,
 378   pgm_sysman            :: String,
 379   pgm_windres           :: String,
 380
 381   --  Package flags
 382   extraPkgConfs         :: [FilePath],
 383   topDir                :: FilePath,    -- filled in by SysTools
 384   systemPackageConfig   :: FilePath,    -- ditto
 385         -- The -package-conf flags given on the command line, in the order
 386         -- they appeared.
 387
 388   packageFlags          :: [PackageFlag],
 389         -- The -package and -hide-package flags from the command-line
 390
 391   -- Package state
 392   -- NB. do not modify this field, it is calculated by
 393   -- Packages.initPackages and Packages.updatePackages.
 394   pkgDatabase           :: Maybe (UniqFM PackageConfig),
 395   pkgState              :: PackageState,
 396
 397   -- hsc dynamic flags
 398   flags                 :: [DynFlag],
 399
 400   -- message output
 401   log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
 402
 403   haddockOptions :: Maybe String
 404  }
 405
 406 data HscTarget
 407   = HscC
 408   | HscAsm
 409   | HscJava
 410   | HscInterpreted
 411   | HscNothing
 412   deriving (Eq, Show)
 413
 414 -- | will this target result in an object file on the disk?
 415 isObjectTarget :: HscTarget -> Bool
 416 isObjectTarget HscC     = True
 417 isObjectTarget HscAsm   = True
 418 isObjectTarget _        = False
 419
 420 -- | The 'GhcMode' tells us whether we're doing multi-module
 421 -- compilation (controlled via the "GHC" API) or one-shot
 422 -- (single-module) compilation.  This makes a difference primarily to
 423 -- the "Finder": in one-shot mode we look for interface files for
 424 -- imported modules, but in multi-module mode we look for source files
 425 -- in order to check whether they need to be recompiled.
 426 data GhcMode
 427   = CompManager         -- ^ --make, GHCi, etc.
 428   | OneShot             -- ^ ghc -c Foo.hs
 429   | MkDepend            -- ^ ghc -M, see Finder for why we need this
 430   deriving Eq
 431
 432 isOneShot :: GhcMode -> Bool
 433 isOneShot OneShot = True
 434 isOneShot _other  = False
 435
 436 -- | What kind of linking to do.
 437 data GhcLink    -- What to do in the link step, if there is one
 438   = NoLink              -- Don't link at all
 439   | LinkBinary          -- Link object code into a binary
 440   | LinkInMemory        -- Use the in-memory dynamic linker
 441   | LinkDynLib          -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
 442   deriving (Eq, Show)
 443
 444 isNoLink :: GhcLink -> Bool
 445 isNoLink NoLink = True
 446 isNoLink _      = False
 447
 448 data PackageFlag
 449   = ExposePackage  String
 450   | HidePackage    String
 451   | IgnorePackage  String
 452   deriving Eq
 453
 454 defaultHscTarget :: HscTarget
 455 defaultHscTarget = defaultObjectTarget
 456
 457 -- | the 'HscTarget' value corresponding to the default way to create
 458 -- object files on the current platform.
 459 defaultObjectTarget :: HscTarget
 460 defaultObjectTarget
 461   | cGhcWithNativeCodeGen == "YES"      =  HscAsm
 462   | otherwise                           =  HscC
 463
 464 data DynLibLoader
 465   = Deployable
 466   | Wrapped (Maybe String)
 467   | SystemDependent
 468   deriving Eq
 469
 470 initDynFlags :: DynFlags -> IO DynFlags
 471 initDynFlags dflags = do
 472  -- someday these will be dynamic flags
 473  ways <- readIORef v_Ways
 474  build_tag <- readIORef v_Build_tag
 475  rts_build_tag <- readIORef v_RTS_Build_tag
 476  return dflags{
 477         wayNames        = ways,
 478         buildTag        = build_tag,
 479         rtsBuildTag     = rts_build_tag
 480         }
 481
 482 defaultDynFlags :: DynFlags
 483 defaultDynFlags =
 484      DynFlags {
 485         ghcMode                 = CompManager,
 486         ghcLink                 = LinkBinary,
 487         coreToDo                = Nothing,
 488         stgToDo                 = Nothing,
 489         hscTarget               = defaultHscTarget,
 490         hscOutName              = "",
 491         extCoreName             = "",
 492         verbosity               = 0,
 493         optLevel                = 0,
 494         simplPhases             = 2,
 495         maxSimplIterations      = 4,
 496         shouldDumpSimplPhase    = const False,
 497         ruleCheck               = Nothing,
 498         specConstrThreshold     = Just 200,
 499         liberateCaseThreshold   = Just 200,
 500         stolen_x86_regs         = 4,
 501         cmdlineHcIncludes       = [],
 502         importPaths             = ["."],
 503         mainModIs               = mAIN,
 504         mainFunIs               = Nothing,
 505         ctxtStkDepth            = mAX_CONTEXT_REDUCTION_DEPTH,
 506
 507         thisPackage             = mainPackageId,
 508
 509         objectDir               = Nothing,
 510         hiDir                   = Nothing,
 511         stubDir                 = Nothing,
 512
 513         objectSuf               = phaseInputExt StopLn,
 514         hcSuf                   = phaseInputExt HCc,
 515         hiSuf                   = "hi",
 516
 517         outputFile              = Nothing,
 518         outputHi                = Nothing,
 519         dynLibLoader            = Deployable,
 520         dumpPrefix              = Nothing,
 521         dumpPrefixForce         = Nothing,
 522         includePaths            = [],
 523         libraryPaths            = [],
 524         frameworkPaths          = [],
 525         cmdlineFrameworks       = [],
 526         tmpDir                  = cDEFAULT_TMPDIR,
 527
 528         hpcDir                  = ".hpc",
 529
 530         opt_L                   = [],
 531         opt_P                   = (if opt_PIC
 532                                    then ["-D__PIC__"]
 533                                    else []),
 534         opt_F                   = [],
 535         opt_c                   = [],
 536         opt_a                   = [],
 537         opt_m                   = [],
 538         opt_l                   = [],
 539         opt_dep                 = [],
 540         opt_windres             = [],
 541
 542         extraPkgConfs           = [],
 543         packageFlags            = [],
 544         pkgDatabase             = Nothing,
 545         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
 546   haddockOptions = Nothing,
 547         flags = [
 548             Opt_ReadUserPackageConf,
 549
 550             Opt_MonoPatBinds,   -- Experimentally, I'm making this non-standard
 551                                 -- behaviour the default, to see if anyone notices
 552                                 -- SLPJ July 06
 553
 554             Opt_ImplicitPrelude,
 555             Opt_MonomorphismRestriction,
 556
 557             Opt_DoAsmMangling,
 558
 559             Opt_GenManifest,
 560             Opt_EmbedManifest,
 561             Opt_PrintBindContents
 562             ]
 563             ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
 564                     -- The default -O0 options
 565             ++ standardWarnings,
 566
 567         log_action = \severity srcSpan style msg ->
 568                         case severity of
 569                           SevInfo  -> hPutStrLn stderr (show (msg style))
 570                           SevFatal -> hPutStrLn stderr (show (msg style))
 571                           _        -> hPutStrLn stderr ('\n':show ((mkLocMessage srcSpan msg) style))
 572       }
 573
 574 {-
 575     Verbosity levels:
 576
 577     0   |   print errors & warnings only
 578     1   |   minimal verbosity: print "compiling M ... done." for each module.
 579     2   |   equivalent to -dshow-passes
 580     3   |   equivalent to existing "ghc -v"
 581     4   |   "ghc -v -ddump-most"
 582     5   |   "ghc -v -ddump-all"
 583 -}
 584
 585 dopt :: DynFlag -> DynFlags -> Bool
 586 dopt f dflags  = f `elem` (flags dflags)
 587
 588 dopt_set :: DynFlags -> DynFlag -> DynFlags
 589 dopt_set dfs f = dfs{ flags = f : flags dfs }
 590
 591 dopt_unset :: DynFlags -> DynFlag -> DynFlags
 592 dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
 593
 594 getOpts :: DynFlags -> (DynFlags -> [a]) -> [a]
 595 getOpts dflags opts = reverse (opts dflags)
 596         -- We add to the options from the front, so we need to reverse the list
 597
 598 getVerbFlag :: DynFlags -> String
 599 getVerbFlag dflags
 600   | verbosity dflags >= 3  = "-v"
 601   | otherwise =  ""
 602
 603 setObjectDir, setHiDir, setStubDir, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
 604          setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
 605          addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptdep, addOptwindres,
 606          addCmdlineFramework, addHaddockOpts
 607    :: String -> DynFlags -> DynFlags
 608 setOutputFile, setOutputHi, setDumpPrefixForce
 609    :: Maybe String -> DynFlags -> DynFlags
 610
 611 setObjectDir  f d = d{ objectDir  = Just f}
 612 setHiDir      f d = d{ hiDir      = Just f}
 613 setStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }
 614   -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
 615   -- #included from the .hc file when compiling with -fvia-C.
 616
 617 setObjectSuf  f d = d{ objectSuf  = f}
 618 setHiSuf      f d = d{ hiSuf      = f}
 619 setHcSuf      f d = d{ hcSuf      = f}
 620
 621 setOutputFile f d = d{ outputFile = f}
 622 setOutputHi   f d = d{ outputHi   = f}
 623
 624 parseDynLibLoaderMode f d =
 625  case splitAt 8 f of
 626    ("deploy", "")       -> d{ dynLibLoader = Deployable }
 627    ("sysdep", "")       -> d{ dynLibLoader = SystemDependent }
 628    ("wrapped", "")      -> d{ dynLibLoader = Wrapped Nothing }
 629    ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing }
 630    ("wrapped:", flex)   -> d{ dynLibLoader = Wrapped (Just flex) }
 631    (_,_)                -> error "Unknown dynlib loader"
 632
 633 setDumpPrefixForce f d = d { dumpPrefixForce = f}
 634
 635 -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
 636 -- Config.hs should really use Option.
 637 setPgmP   f d = let (pgm:args) = words f in d{ pgm_P   = (pgm, map Option args)}
 638
 639 setPgmL   f d = d{ pgm_L   = f}
 640 setPgmF   f d = d{ pgm_F   = f}
 641 setPgmc   f d = d{ pgm_c   = (f,[])}
 642 setPgmm   f d = d{ pgm_m   = (f,[])}
 643 setPgms   f d = d{ pgm_s   = (f,[])}
 644 setPgma   f d = d{ pgm_a   = (f,[])}
 645 setPgml   f d = d{ pgm_l   = (f,[])}
 646 setPgmdll f d = d{ pgm_dll = (f,[])}
 647 setPgmwindres f d = d{ pgm_windres = f}
 648
 649 addOptL   f d = d{ opt_L   = f : opt_L d}
 650 addOptP   f d = d{ opt_P   = f : opt_P d}
 651 addOptF   f d = d{ opt_F   = f : opt_F d}
 652 addOptc   f d = d{ opt_c   = f : opt_c d}
 653 addOptm   f d = d{ opt_m   = f : opt_m d}
 654 addOpta   f d = d{ opt_a   = f : opt_a d}
 655 addOptl   f d = d{ opt_l   = f : opt_l d}
 656 addOptdep f d = d{ opt_dep = f : opt_dep d}
 657 addOptwindres f d = d{ opt_windres = f : opt_windres d}
 658
 659 addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
 660
 661 addHaddockOpts f d = d{ haddockOptions = Just f}
 662
 663 -- -----------------------------------------------------------------------------
 664 -- Command-line options
 665
 666 -- When invoking external tools as part of the compilation pipeline, we
 667 -- pass these a sequence of options on the command-line. Rather than
 668 -- just using a list of Strings, we use a type that allows us to distinguish
 669 -- between filepaths and 'other stuff'. [The reason being, of course, that
 670 -- this type gives us a handle on transforming filenames, and filenames only,
 671 -- to whatever format they're expected to be on a particular platform.]
 672
 673 data Option
 674  = FileOption -- an entry that _contains_ filename(s) / filepaths.
 675               String  -- a non-filepath prefix that shouldn't be
 676                       -- transformed (e.g., "/out=")
 677               String  -- the filepath/filename portion
 678  | Option     String
 679
 680 -----------------------------------------------------------------------------
 681 -- Setting the optimisation level
 682
 683 updOptLevel :: Int -> DynFlags -> DynFlags
 684 -- Set dynflags appropriate to the optimisation level
 685 updOptLevel n dfs
 686   = dfs2{ optLevel = final_n }
 687   where
 688    final_n = max 0 (min 2 n)    -- Clamp to 0 <= n <= 2
 689    dfs1 = foldr (flip dopt_unset) dfs  remove_dopts
 690    dfs2 = foldr (flip dopt_set)   dfs1 extra_dopts
 691
 692    extra_dopts  = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
 693    remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]
 694
 695 optLevelFlags :: [([Int], DynFlag)]
 696 optLevelFlags
 697   = [ ([0],     Opt_IgnoreInterfacePragmas)
 698     , ([0],     Opt_OmitInterfacePragmas)
 699
 700     , ([1,2],   Opt_IgnoreAsserts)
 701     , ([1,2],   Opt_RewriteRules)       -- Off for -O0; see Note [Scoping for Builtin rules]
 702                                         --              in PrelRules
 703     , ([1,2],   Opt_DoEtaReduction)
 704     , ([1,2],   Opt_CaseMerge)
 705     , ([1,2],   Opt_Strictness)
 706     , ([1,2],   Opt_CSE)
 707     , ([1,2],   Opt_FullLaziness)
 708
 709     , ([2],     Opt_LiberateCase)
 710     , ([2],     Opt_SpecConstr)
 711
 712     , ([0,1,2], Opt_DoLambdaEtaExpansion)
 713                 -- This one is important for a tiresome reason:
 714                 -- we want to make sure that the bindings for data
 715                 -- constructors are eta-expanded.  This is probably
 716                 -- a good thing anyway, but it seems fragile.
 717     ]
 718
 719 -- -----------------------------------------------------------------------------
 720 -- Standard sets of warning options
 721
 722 standardWarnings :: [DynFlag]
 723 standardWarnings
 724     = [ Opt_WarnDeprecations,
 725         Opt_WarnOverlappingPatterns,
 726         Opt_WarnMissingFields,
 727         Opt_WarnMissingMethods,
 728         Opt_WarnDuplicateExports
 729       ]
 730
 731 minusWOpts :: [DynFlag]
 732 minusWOpts
 733     = standardWarnings ++
 734       [ Opt_WarnUnusedBinds,
 735         Opt_WarnUnusedMatches,
 736         Opt_WarnUnusedImports,
 737         Opt_WarnIncompletePatterns,
 738         Opt_WarnDodgyImports
 739       ]
 740
 741 minusWallOpts :: [DynFlag]
 742 minusWallOpts
 743     = minusWOpts ++
 744       [ Opt_WarnTypeDefaults,
 745         Opt_WarnNameShadowing,
 746         Opt_WarnMissingSigs,
 747         Opt_WarnHiShadows,
 748         Opt_WarnOrphans
 749       ]
 750
 751 -- minuswRemovesOpts should be every warning option
 752 minuswRemovesOpts :: [DynFlag]
 753 minuswRemovesOpts
 754     = minusWallOpts ++
 755       [Opt_WarnImplicitPrelude,
 756        Opt_WarnIncompletePatternsRecUpd,
 757        Opt_WarnSimplePatterns,
 758        Opt_WarnMonomorphism,
 759        Opt_WarnTabs
 760       ]
 761
 762 -- -----------------------------------------------------------------------------
 763 -- CoreToDo:  abstraction of core-to-core passes to run.
 764
 765 data CoreToDo           -- These are diff core-to-core passes,
 766                         -- which may be invoked in any order,
 767                         -- as many times as you like.
 768
 769   = CoreDoSimplify      -- The core-to-core simplifier.
 770         SimplifierMode
 771         [SimplifierSwitch]
 772                         -- Each run of the simplifier can take a different
 773                         -- set of simplifier-specific flags.
 774   | CoreDoFloatInwards
 775   | CoreDoFloatOutwards FloatOutSwitches
 776   | CoreLiberateCase
 777   | CoreDoPrintCore
 778   | CoreDoStaticArgs
 779   | CoreDoStrictness
 780   | CoreDoWorkerWrapper
 781   | CoreDoSpecialising
 782   | CoreDoSpecConstr
 783   | CoreDoOldStrictness
 784   | CoreDoGlomBinds
 785   | CoreCSE
 786   | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
 787                                                 -- matching this string
 788   | CoreDoVectorisation
 789   | CoreDoNothing                -- Useful when building up
 790   | CoreDoPasses [CoreToDo]      -- lists of these things
 791
 792 data SimplifierMode             -- See comments in SimplMonad
 793   = SimplGently
 794   | SimplPhase Int
 795
 796 data SimplifierSwitch
 797   = MaxSimplifierIterations Int
 798   | NoCaseOfCase
 799
 800 data FloatOutSwitches
 801   = FloatOutSw  Bool    -- True <=> float lambdas to top level
 802                 Bool    -- True <=> float constants to top level,
 803                         --          even if they do not escape a lambda
 804
 805
 806 -- The core-to-core pass ordering is derived from the DynFlags:
 807 runWhen :: Bool -> CoreToDo -> CoreToDo
 808 runWhen True  do_this = do_this
 809 runWhen False _       = CoreDoNothing
 810
 811 runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo
 812 runMaybe (Just x) f = f x
 813 runMaybe Nothing  _ = CoreDoNothing
 814
 815 getCoreToDo :: DynFlags -> [CoreToDo]
 816 getCoreToDo dflags
 817   | Just todo <- coreToDo dflags = todo -- set explicitly by user
 818   | otherwise = core_todo
 819   where
 820     opt_level     = optLevel dflags
 821     phases        = simplPhases dflags
 822     max_iter      = maxSimplIterations dflags
 823     strictness    = dopt Opt_Strictness dflags
 824     full_laziness = dopt Opt_FullLaziness dflags
 825     cse           = dopt Opt_CSE dflags
 826     spec_constr   = dopt Opt_SpecConstr dflags
 827     liberate_case = dopt Opt_LiberateCase dflags
 828     rule_check    = ruleCheck dflags
 829     vectorisation = dopt Opt_Vectorise dflags
 830
 831     maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
 832
 833     simpl_phase phase iter = CoreDoPasses
 834                                [ CoreDoSimplify (SimplPhase phase) [
 835                                    MaxSimplifierIterations iter
 836                                  ],
 837                                  maybe_rule_check phase
 838                                ]
 839
 840                 -- By default, we have 2 phases before phase 0.
 841
 842                 -- Want to run with inline phase 2 after the specialiser to give
 843                 -- maximum chance for fusion to work before we inline build/augment
 844                 -- in phase 1.  This made a difference in 'ansi' where an
 845                 -- overloaded function wasn't inlined till too late.
 846
 847                 -- Need phase 1 so that build/augment get
 848                 -- inlined.  I found that spectral/hartel/genfft lost some useful
 849                 -- strictness in the function sumcode' if augment is not inlined
 850                 -- before strictness analysis runs
 851     simpl_phases = CoreDoPasses [ simpl_phase phase max_iter
 852                                   | phase <- [phases, phases-1 .. 1] ]
 853
 854
 855         -- initial simplify: mk specialiser happy: minimum effort please
 856     simpl_gently = CoreDoSimplify SimplGently [
 857                         --      Simplify "gently"
 858                         -- Don't inline anything till full laziness has bitten
 859                         -- In particular, inlining wrappers inhibits floating
 860                         -- e.g. ...(case f x of ...)...
 861                         --  ==> ...(case (case x of I# x# -> fw x#) of ...)...
 862                         --  ==> ...(case x of I# x# -> case fw x# of ...)...
 863                         -- and now the redex (f x) isn't floatable any more
 864                         -- Similarly, don't apply any rules until after full
 865                         -- laziness.  Notably, list fusion can prevent floating.
 866
 867             NoCaseOfCase,       -- Don't do case-of-case transformations.
 868                                 -- This makes full laziness work better
 869             MaxSimplifierIterations max_iter
 870         ]
 871
 872     core_todo =
 873      if opt_level == 0 then
 874        [simpl_phase 0 max_iter]
 875      else {- opt_level >= 1 -} [
 876
 877         -- initial simplify: mk specialiser happy: minimum effort please
 878         simpl_gently,
 879
 880         -- We run vectorisation here for now, but we might also try to run
 881         -- it later
 882         runWhen vectorisation (CoreDoPasses [ CoreDoVectorisation, simpl_gently ]),
 883
 884         -- Specialisation is best done before full laziness
 885         -- so that overloaded functions have all their dictionary lambdas manifest
 886         CoreDoSpecialising,
 887
 888         runWhen full_laziness (CoreDoFloatOutwards (FloatOutSw False False)),
 889
 890         CoreDoFloatInwards,
 891
 892         simpl_phases,
 893
 894                 -- Phase 0: allow all Ids to be inlined now
 895                 -- This gets foldr inlined before strictness analysis
 896
 897                 -- At least 3 iterations because otherwise we land up with
 898                 -- huge dead expressions because of an infelicity in the
 899                 -- simpifier.
 900                 --      let k = BIG in foldr k z xs
 901                 -- ==>  let k = BIG in letrec go = \xs -> ...(k x).... in go xs
 902                 -- ==>  let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
 903                 -- Don't stop now!
 904         simpl_phase 0 (max max_iter 3),
 905
 906
 907 #ifdef OLD_STRICTNESS
 908         CoreDoOldStrictness,
 909 #endif
 910         runWhen strictness (CoreDoPasses [
 911                 CoreDoStrictness,
 912                 CoreDoWorkerWrapper,
 913                 CoreDoGlomBinds,
 914                 simpl_phase 0 max_iter
 915                 ]),
 916
 917         runWhen full_laziness
 918           (CoreDoFloatOutwards (FloatOutSw False    -- Not lambdas
 919                                            True)),  -- Float constants
 920                 -- nofib/spectral/hartel/wang doubles in speed if you
 921                 -- do full laziness late in the day.  It only happens
 922                 -- after fusion and other stuff, so the early pass doesn't
 923                 -- catch it.  For the record, the redex is
 924                 --        f_el22 (f_el21 r_midblock)
 925
 926
 927         runWhen cse CoreCSE,
 928                 -- We want CSE to follow the final full-laziness pass, because it may
 929                 -- succeed in commoning up things floated out by full laziness.
 930                 -- CSE used to rely on the no-shadowing invariant, but it doesn't any more
 931
 932         CoreDoFloatInwards,
 933
 934         maybe_rule_check 0,
 935
 936                 -- Case-liberation for -O2.  This should be after
 937                 -- strictness analysis and the simplification which follows it.
 938         runWhen liberate_case (CoreDoPasses [
 939             CoreLiberateCase,
 940             simpl_phase 0 max_iter
 941             ]),         -- Run the simplifier after LiberateCase to vastly
 942                         -- reduce the possiblility of shadowing
 943                         -- Reason: see Note [Shadowing] in SpecConstr.lhs
 944
 945         runWhen spec_constr CoreDoSpecConstr,
 946
 947         maybe_rule_check 0,
 948
 949         -- Final clean-up simplification:
 950         simpl_phase 0 max_iter
 951      ]
 952
 953 -- -----------------------------------------------------------------------------
 954 -- StgToDo:  abstraction of stg-to-stg passes to run.
 955
 956 data StgToDo
 957   = StgDoMassageForProfiling  -- should be (next to) last
 958   -- There's also setStgVarInfo, but its absolute "lastness"
 959   -- is so critical that it is hardwired in (no flag).
 960   | D_stg_stats
 961
 962 getStgToDo :: DynFlags -> [StgToDo]
 963 getStgToDo dflags
 964   | Just todo <- stgToDo dflags = todo -- set explicitly by user
 965   | otherwise = todo2
 966   where
 967         stg_stats = dopt Opt_StgStats dflags
 968
 969         todo1 = if stg_stats then [D_stg_stats] else []
 970
 971         todo2 | WayProf `elem` wayNames dflags
 972               = StgDoMassageForProfiling : todo1
 973               | otherwise
 974               = todo1
 975
 976 -- -----------------------------------------------------------------------------
 977 -- DynFlags parser
 978
 979 allFlags :: [String]
 980 allFlags = map ('-':) $
 981            [ name | (name, optkind) <- dynamic_flags, ok optkind ] ++
 982            map ("fno-"++) flags ++
 983            map ("f"++) flags ++
 984            map ("X"++) xs ++
 985            map ("XNo"++) xs
 986     where ok (PrefixPred _ _) = False
 987           ok _ = True
 988           flags = map fst fFlags
 989           xs = map fst xFlags
 990
 991 dynamic_flags :: [(String, OptKind DynP)]
 992 dynamic_flags = [
 993      ( "n"              , NoArg  (setDynFlag Opt_DryRun) )
 994   ,  ( "cpp"            , NoArg  (setDynFlag Opt_Cpp))
 995   ,  ( "F"              , NoArg  (setDynFlag Opt_Pp))
 996   ,  ( "#include"       , HasArg (addCmdlineHCInclude) )
 997   ,  ( "v"              , OptIntSuffix setVerbosity )
 998
 999         ------- Specific phases  --------------------------------------------
1000   ,  ( "pgmL"           , HasArg (upd . setPgmL) )
1001   ,  ( "pgmP"           , HasArg (upd . setPgmP) )
1002   ,  ( "pgmF"           , HasArg (upd . setPgmF) )
1003   ,  ( "pgmc"           , HasArg (upd . setPgmc) )
1004   ,  ( "pgmm"           , HasArg (upd . setPgmm) )
1005   ,  ( "pgms"           , HasArg (upd . setPgms) )
1006   ,  ( "pgma"           , HasArg (upd . setPgma) )
1007   ,  ( "pgml"           , HasArg (upd . setPgml) )
1008   ,  ( "pgmdll"         , HasArg (upd . setPgmdll) )
1009   ,  ( "pgmwindres"     , HasArg (upd . setPgmwindres) )
1010
1011   ,  ( "optL"           , HasArg (upd . addOptL) )
1012   ,  ( "optP"           , HasArg (upd . addOptP) )
1013   ,  ( "optF"           , HasArg (upd . addOptF) )
1014   ,  ( "optc"           , HasArg (upd . addOptc) )
1015   ,  ( "optm"           , HasArg (upd . addOptm) )
1016   ,  ( "opta"           , HasArg (upd . addOpta) )
1017   ,  ( "optl"           , HasArg (upd . addOptl) )
1018   ,  ( "optdep"         , HasArg (upd . addOptdep) )
1019   ,  ( "optwindres"     , HasArg (upd . addOptwindres) )
1020
1021   ,  ( "split-objs"     , NoArg (if can_split
1022                                     then setDynFlag Opt_SplitObjs
1023                                     else return ()) )
1024
1025         -------- Linking ----------------------------------------------------
1026   ,  ( "c"              , NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
1027   ,  ( "no-link"        , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep.
1028   ,  ( "shared"         , NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } ))
1029   ,  ( "dynload"        , HasArg (upd . parseDynLibLoaderMode))
1030
1031         ------- Libraries ---------------------------------------------------
1032   ,  ( "L"              , Prefix addLibraryPath )
1033   ,  ( "l"              , AnySuffix (\s -> do upd (addOptl s)))
1034
1035         ------- Frameworks --------------------------------------------------
1036         -- -framework-path should really be -F ...
1037   ,  ( "framework-path" , HasArg addFrameworkPath )
1038   ,  ( "framework"      , HasArg (upd . addCmdlineFramework) )
1039
1040         ------- Output Redirection ------------------------------------------
1041   ,  ( "odir"           , HasArg (upd . setObjectDir))
1042   ,  ( "o"              , SepArg (upd . setOutputFile . Just))
1043   ,  ( "ohi"            , HasArg (upd . setOutputHi   . Just ))
1044   ,  ( "osuf"           , HasArg (upd . setObjectSuf))
1045   ,  ( "hcsuf"          , HasArg (upd . setHcSuf))
1046   ,  ( "hisuf"          , HasArg (upd . setHiSuf))
1047   ,  ( "hidir"          , HasArg (upd . setHiDir))
1048   ,  ( "tmpdir"         , HasArg (upd . setTmpDir))
1049   ,  ( "stubdir"        , HasArg (upd . setStubDir))
1050   ,  ( "ddump-file-prefix", HasArg (upd . setDumpPrefixForce . Just))
1051
1052         ------- Keeping temporary files -------------------------------------
1053      -- These can be singular (think ghc -c) or plural (think ghc --make)
1054   ,  ( "keep-hc-file"    , NoArg (setDynFlag Opt_KeepHcFiles))
1055   ,  ( "keep-hc-files"   , NoArg (setDynFlag Opt_KeepHcFiles))
1056   ,  ( "keep-s-file"     , NoArg (setDynFlag Opt_KeepSFiles))
1057   ,  ( "keep-s-files"    , NoArg (setDynFlag Opt_KeepSFiles))
1058   ,  ( "keep-raw-s-file" , NoArg (setDynFlag Opt_KeepRawSFiles))
1059   ,  ( "keep-raw-s-files", NoArg (setDynFlag Opt_KeepRawSFiles))
1060      -- This only makes sense as plural
1061   ,  ( "keep-tmp-files"  , NoArg (setDynFlag Opt_KeepTmpFiles))
1062
1063         ------- Miscellaneous ----------------------------------------------
1064   ,  ( "no-hs-main"     , NoArg (setDynFlag Opt_NoHsMain))
1065   ,  ( "main-is"        , SepArg setMainIs )
1066   ,  ( "haddock"        , NoArg (setDynFlag Opt_Haddock) )
1067   ,  ( "haddock-opts"   , HasArg (upd . addHaddockOpts))
1068   ,  ( "hpcdir"         , SepArg setOptHpcDir )
1069
1070         ------- recompilation checker (DEPRECATED, use -fforce-recomp) -----
1071   ,  ( "recomp"         , NoArg (unSetDynFlag Opt_ForceRecomp) )
1072   ,  ( "no-recomp"      , NoArg (setDynFlag   Opt_ForceRecomp) )
1073
1074         ------- Packages ----------------------------------------------------
1075   ,  ( "package-conf"   , HasArg extraPkgConf_ )
1076   ,  ( "no-user-package-conf", NoArg (unSetDynFlag Opt_ReadUserPackageConf) )
1077   ,  ( "package-name"   , HasArg (upd . setPackageName) )
1078   ,  ( "package"        , HasArg exposePackage )
1079   ,  ( "hide-package"   , HasArg hidePackage )
1080   ,  ( "hide-all-packages", NoArg (setDynFlag Opt_HideAllPackages) )
1081   ,  ( "ignore-package" , HasArg ignorePackage )
1082   ,  ( "syslib"         , HasArg exposePackage )  -- for compatibility
1083
1084         ------ HsCpp opts ---------------------------------------------------
1085   ,  ( "D",             AnySuffix (upd . addOptP) )
1086   ,  ( "U",             AnySuffix (upd . addOptP) )
1087
1088         ------- Include/Import Paths ----------------------------------------
1089   ,  ( "I"              , Prefix    addIncludePath)
1090   ,  ( "i"              , OptPrefix addImportPath )
1091
1092         ------ Debugging ----------------------------------------------------
1093   ,  ( "dstg-stats",    NoArg (setDynFlag Opt_StgStats))
1094
1095   ,  ( "ddump-cmm",              setDumpFlag Opt_D_dump_cmm)
1096   ,  ( "ddump-cmmz",             setDumpFlag Opt_D_dump_cmmz)
1097   ,  ( "ddump-cmmz-pretty",      setDumpFlag Opt_D_dump_cmmz_pretty)
1098   ,  ( "ddump-cps-cmm",          setDumpFlag Opt_D_dump_cps_cmm)
1099   ,  ( "ddump-cvt-cmm",          setDumpFlag Opt_D_dump_cvt_cmm)
1100   ,  ( "ddump-asm",              setDumpFlag Opt_D_dump_asm)
1101   ,  ( "ddump-asm-native",       setDumpFlag Opt_D_dump_asm_native)
1102   ,  ( "ddump-asm-liveness",     setDumpFlag Opt_D_dump_asm_liveness)
1103   ,  ( "ddump-asm-coalesce",     setDumpFlag Opt_D_dump_asm_coalesce)
1104   ,  ( "ddump-asm-regalloc",     setDumpFlag Opt_D_dump_asm_regalloc)
1105   ,  ( "ddump-asm-conflicts",    setDumpFlag Opt_D_dump_asm_conflicts)
1106   ,  ( "ddump-asm-regalloc-stages",
1107                                  setDumpFlag Opt_D_dump_asm_regalloc_stages)
1108   ,  ( "ddump-asm-stats",        setDumpFlag Opt_D_dump_asm_stats)
1109   ,  ( "ddump-cpranal",          setDumpFlag Opt_D_dump_cpranal)
1110   ,  ( "ddump-deriv",            setDumpFlag Opt_D_dump_deriv)
1111   ,  ( "ddump-ds",               setDumpFlag Opt_D_dump_ds)
1112   ,  ( "ddump-flatC",            setDumpFlag Opt_D_dump_flatC)
1113   ,  ( "ddump-foreign",          setDumpFlag Opt_D_dump_foreign)
1114   ,  ( "ddump-inlinings",        setDumpFlag Opt_D_dump_inlinings)
1115   ,  ( "ddump-rule-firings",     setDumpFlag Opt_D_dump_rule_firings)
1116   ,  ( "ddump-occur-anal",       setDumpFlag Opt_D_dump_occur_anal)
1117   ,  ( "ddump-parsed",           setDumpFlag Opt_D_dump_parsed)
1118   ,  ( "ddump-rn",               setDumpFlag Opt_D_dump_rn)
1119   ,  ( "ddump-simpl",            setDumpFlag Opt_D_dump_simpl)
1120   ,  ( "ddump-simpl-iterations", setDumpFlag Opt_D_dump_simpl_iterations)
1121   ,  ( "ddump-simpl-phases",     OptPrefix setDumpSimplPhases)
1122   ,  ( "ddump-spec",             setDumpFlag Opt_D_dump_spec)
1123   ,  ( "ddump-prep",             setDumpFlag Opt_D_dump_prep)
1124   ,  ( "ddump-stg",              setDumpFlag Opt_D_dump_stg)
1125   ,  ( "ddump-stranal",          setDumpFlag Opt_D_dump_stranal)
1126   ,  ( "ddump-tc",               setDumpFlag Opt_D_dump_tc)
1127   ,  ( "ddump-types",            setDumpFlag Opt_D_dump_types)
1128   ,  ( "ddump-rules",            setDumpFlag Opt_D_dump_rules)
1129   ,  ( "ddump-cse",              setDumpFlag Opt_D_dump_cse)
1130   ,  ( "ddump-worker-wrapper",   setDumpFlag Opt_D_dump_worker_wrapper)
1131   ,  ( "ddump-rn-trace",         setDumpFlag Opt_D_dump_rn_trace)
1132   ,  ( "ddump-if-trace",         setDumpFlag Opt_D_dump_if_trace)
1133   ,  ( "ddump-tc-trace",         setDumpFlag Opt_D_dump_tc_trace)
1134   ,  ( "ddump-splices",          setDumpFlag Opt_D_dump_splices)
1135   ,  ( "ddump-rn-stats",         setDumpFlag Opt_D_dump_rn_stats)
1136   ,  ( "ddump-opt-cmm",          setDumpFlag Opt_D_dump_opt_cmm)
1137   ,  ( "ddump-simpl-stats",      setDumpFlag Opt_D_dump_simpl_stats)
1138   ,  ( "ddump-bcos",             setDumpFlag Opt_D_dump_BCOs)
1139   ,  ( "dsource-stats",          setDumpFlag Opt_D_source_stats)
1140   ,  ( "dverbose-core2core",     NoArg setVerboseCore2Core)
1141   ,  ( "dverbose-stg2stg",       setDumpFlag Opt_D_verbose_stg2stg)
1142   ,  ( "ddump-hi",               setDumpFlag Opt_D_dump_hi)
1143   ,  ( "ddump-minimal-imports",  setDumpFlag Opt_D_dump_minimal_imports)
1144   ,  ( "ddump-vect",             setDumpFlag Opt_D_dump_vect)
1145   ,  ( "ddump-hpc",              setDumpFlag Opt_D_dump_hpc)
1146   ,  ( "ddump-mod-cycles",       setDumpFlag Opt_D_dump_mod_cycles)
1147   ,  ( "ddump-view-pattern-commoning", setDumpFlag Opt_D_dump_view_pattern_commoning)
1148   ,  ( "ddump-to-file",          setDumpFlag Opt_DumpToFile)
1149   ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs))
1150   ,  ( "dcore-lint",             NoArg (setDynFlag Opt_DoCoreLinting))
1151   ,  ( "dstg-lint",              NoArg (setDynFlag Opt_DoStgLinting))
1152   ,  ( "dcmm-lint",              NoArg (setDynFlag Opt_DoCmmLinting))
1153   ,  ( "dasm-lint",              NoArg (setDynFlag Opt_DoAsmLinting))
1154   ,  ( "dshow-passes",           NoArg (do setDynFlag Opt_ForceRecomp
1155                                            setVerbosity (Just 2)) )
1156   ,  ( "dfaststring-stats",      NoArg (setDynFlag Opt_D_faststring_stats))
1157
1158         ------ Machine dependant (-m<blah>) stuff ---------------------------
1159
1160   ,  ( "monly-2-regs",  NoArg (upd (\s -> s{stolen_x86_regs = 2}) ))
1161   ,  ( "monly-3-regs",  NoArg (upd (\s -> s{stolen_x86_regs = 3}) ))
1162   ,  ( "monly-4-regs",  NoArg (upd (\s -> s{stolen_x86_regs = 4}) ))
1163
1164      ------ Warning opts -------------------------------------------------
1165   ,  ( "W"     , NoArg (mapM_ setDynFlag   minusWOpts)    )
1166   ,  ( "Werror", NoArg (setDynFlag         Opt_WarnIsError) )
1167   ,  ( "Wwarn" , NoArg (unSetDynFlag       Opt_WarnIsError) )
1168   ,  ( "Wall"  , NoArg (mapM_ setDynFlag   minusWallOpts) )
1169   ,  ( "Wnot"  , NoArg (mapM_ unSetDynFlag minusWallOpts) ) -- DEPRECATED
1170   ,  ( "w"     , NoArg (mapM_ unSetDynFlag minuswRemovesOpts) )
1171
1172         ------ Optimisation flags ------------------------------------------
1173   ,  ( "O"      , NoArg (upd (setOptLevel 1)))
1174   ,  ( "Onot"   , NoArg (upd (setOptLevel 0))) -- deprecated
1175   ,  ( "O"      , OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1))))
1176                 -- If the number is missing, use 1
1177
1178   ,  ( "fsimplifier-phases",         IntSuffix (\n ->
1179                 upd (\dfs -> dfs{ simplPhases = n })) )
1180   ,  ( "fmax-simplifier-iterations", IntSuffix (\n ->
1181                 upd (\dfs -> dfs{ maxSimplIterations = n })) )
1182
1183   ,  ( "fspec-constr-threshold",      IntSuffix (\n ->
1184                 upd (\dfs -> dfs{ specConstrThreshold = Just n })))
1185   ,  ( "fno-spec-constr-threshold",   NoArg (
1186                 upd (\dfs -> dfs{ specConstrThreshold = Nothing })))
1187   ,  ( "fliberate-case-threshold",    IntSuffix (\n ->
1188                 upd (\dfs -> dfs{ liberateCaseThreshold = Just n })))
1189   ,  ( "fno-liberate-case-threshold", NoArg (
1190                 upd (\dfs -> dfs{ liberateCaseThreshold = Nothing })))
1191
1192   ,  ( "frule-check",     SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
1193   ,  ( "fcontext-stack" , IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
1194
1195         ------ Compiler flags -----------------------------------------------
1196
1197   ,  ( "fasm",             NoArg (setObjTarget HscAsm) )
1198   ,  ( "fvia-c",           NoArg (setObjTarget HscC) )
1199   ,  ( "fvia-C",           NoArg (setObjTarget HscC) )
1200
1201   ,  ( "fno-code",         NoArg (setTarget HscNothing))
1202   ,  ( "fbyte-code",       NoArg (setTarget HscInterpreted) )
1203   ,  ( "fobject-code",     NoArg (setTarget defaultHscTarget) )
1204
1205   ,  ( "fglasgow-exts",    NoArg (mapM_ setDynFlag   glasgowExtsFlags) )
1206   ,  ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) )
1207
1208      -- the rest of the -f* and -fno-* flags
1209   ,  ( "f",                PrefixPred (isFlag   fFlags)
1210                            (\f -> setDynFlag   (getFlag   fFlags f)) )
1211   ,  ( "f",                PrefixPred (isPrefFlag "no-" fFlags)
1212                            (\f -> unSetDynFlag (getPrefFlag "no-" fFlags f)) )
1213
1214      -- the -X* and -XNo* flags
1215   ,  ( "X",                PrefixPred (isFlag   xFlags)
1216                            (\f -> setDynFlag   (getFlag   xFlags f)) )
1217   ,  ( "X",                PrefixPred (isPrefFlag "No" xFlags)
1218                            (\f -> unSetDynFlag (getPrefFlag "No" xFlags f)) )
1219  ]
1220
1221 -- these -f<blah> flags can all be reversed with -fno-<blah>
1222
1223 fFlags :: [(String, DynFlag)]
1224 fFlags = [
1225   ( "warn-dodgy-imports",               Opt_WarnDodgyImports ),
1226   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports ),
1227   ( "warn-hi-shadowing",                Opt_WarnHiShadows ),
1228   ( "warn-implicit-prelude",            Opt_WarnImplicitPrelude ),
1229   ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns ),
1230   ( "warn-incomplete-record-updates",   Opt_WarnIncompletePatternsRecUpd ),
1231   ( "warn-missing-fields",              Opt_WarnMissingFields ),
1232   ( "warn-missing-methods",             Opt_WarnMissingMethods ),
1233   ( "warn-missing-signatures",          Opt_WarnMissingSigs ),
1234   ( "warn-name-shadowing",              Opt_WarnNameShadowing ),
1235   ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns ),
1236   ( "warn-simple-patterns",             Opt_WarnSimplePatterns ),
1237   ( "warn-type-defaults",               Opt_WarnTypeDefaults ),
1238   ( "warn-monomorphism-restriction",    Opt_WarnMonomorphism ),
1239   ( "warn-unused-binds",                Opt_WarnUnusedBinds ),
1240   ( "warn-unused-imports",              Opt_WarnUnusedImports ),
1241   ( "warn-unused-matches",              Opt_WarnUnusedMatches ),
1242   ( "warn-deprecations",                Opt_WarnDeprecations ),
1243   ( "warn-orphans",                     Opt_WarnOrphans ),
1244   ( "warn-tabs",                        Opt_WarnTabs ),
1245   ( "print-explicit-foralls",           Opt_PrintExplicitForalls ),
1246   ( "strictness",                       Opt_Strictness ),
1247   ( "full-laziness",                    Opt_FullLaziness ),
1248   ( "liberate-case",                    Opt_LiberateCase ),
1249   ( "spec-constr",                      Opt_SpecConstr ),
1250   ( "cse",                              Opt_CSE ),
1251   ( "ignore-interface-pragmas",         Opt_IgnoreInterfacePragmas ),
1252   ( "omit-interface-pragmas",           Opt_OmitInterfacePragmas ),
1253   ( "do-lambda-eta-expansion",          Opt_DoLambdaEtaExpansion ),
1254   ( "ignore-asserts",                   Opt_IgnoreAsserts ),
1255   ( "do-eta-reduction",                 Opt_DoEtaReduction ),
1256   ( "case-merge",                       Opt_CaseMerge ),
1257   ( "unbox-strict-fields",              Opt_UnboxStrictFields ),
1258   ( "dicts-cheap",                      Opt_DictsCheap ),
1259   ( "excess-precision",                 Opt_ExcessPrecision ),
1260   ( "asm-mangling",                     Opt_DoAsmMangling ),
1261   ( "print-bind-result",                Opt_PrintBindResult ),
1262   ( "force-recomp",                     Opt_ForceRecomp ),
1263   ( "hpc-no-auto",                      Opt_Hpc_No_Auto ),
1264   ( "rewrite-rules",                    Opt_RewriteRules ),
1265   ( "break-on-exception",               Opt_BreakOnException ),
1266   ( "break-on-error",                   Opt_BreakOnError ),
1267   ( "print-evld-with-show",             Opt_PrintEvldWithShow ),
1268   ( "print-bind-contents",              Opt_PrintBindContents ),
1269   ( "run-cps",                          Opt_RunCPSZ ),
1270   ( "convert-to-zipper-and-back",       Opt_ConvertToZipCfgAndBack),
1271   ( "vectorise",                        Opt_Vectorise ),
1272   ( "regs-graph",                       Opt_RegsGraph),
1273   ( "regs-iterative",                   Opt_RegsIterative),
1274   -- Deprecated in favour of -XTemplateHaskell:
1275   ( "th",                               Opt_TemplateHaskell ),
1276   -- Deprecated in favour of -XForeignFunctionInterface:
1277   ( "fi",                               Opt_ForeignFunctionInterface ),
1278   -- Deprecated in favour of -XForeignFunctionInterface:
1279   ( "ffi",                              Opt_ForeignFunctionInterface ),
1280   -- Deprecated in favour of -XArrows:
1281   ( "arrows",                           Opt_Arrows ),
1282   -- Deprecated in favour of -XGenerics:
1283   ( "generics",                         Opt_Generics ),
1284   -- Deprecated in favour of -XImplicitPrelude:
1285   ( "implicit-prelude",                 Opt_ImplicitPrelude ),
1286   -- Deprecated in favour of -XBangPatterns:
1287   ( "bang-patterns",                    Opt_BangPatterns ),
1288   -- Deprecated in favour of -XMonomorphismRestriction:
1289   ( "monomorphism-restriction",         Opt_MonomorphismRestriction ),
1290   -- Deprecated in favour of -XMonoPatBinds:
1291   ( "mono-pat-binds",                   Opt_MonoPatBinds ),
1292   -- Deprecated in favour of -XExtendedDefaultRules:
1293   ( "extended-default-rules",           Opt_ExtendedDefaultRules ),
1294   -- Deprecated in favour of -XImplicitParams:
1295   ( "implicit-params",                  Opt_ImplicitParams ),
1296   -- Deprecated in favour of -XScopedTypeVariables:
1297   ( "scoped-type-variables",            Opt_ScopedTypeVariables ),
1298   -- Deprecated in favour of -XPArr:
1299   ( "parr",                             Opt_PArr ),
1300   -- Deprecated in favour of -XOverlappingInstances:
1301   ( "allow-overlapping-instances",      Opt_OverlappingInstances ),
1302   -- Deprecated in favour of -XUndecidableInstances:
1303   ( "allow-undecidable-instances",      Opt_UndecidableInstances ),
1304   -- Deprecated in favour of -XIncoherentInstances:
1305   ( "allow-incoherent-instances",       Opt_IncoherentInstances ),
1306   ( "gen-manifest",                     Opt_GenManifest ),
1307   ( "embed-manifest",                   Opt_EmbedManifest )
1308   ]
1309
1310 supportedLanguages :: [String]
1311 supportedLanguages = map fst xFlags
1312
1313 -- These -X<blah> flags can all be reversed with -XNo<blah>
1314 xFlags :: [(String, DynFlag)]
1315 xFlags = [
1316   ( "CPP",                              Opt_Cpp ),
1317   ( "PatternGuards",                    Opt_PatternGuards ),
1318   ( "UnicodeSyntax",                    Opt_UnicodeSyntax ),
1319   ( "MagicHash",                        Opt_MagicHash ),
1320   ( "PolymorphicComponents",            Opt_PolymorphicComponents ),
1321   ( "ExistentialQuantification",        Opt_ExistentialQuantification ),
1322   ( "KindSignatures",                   Opt_KindSignatures ),
1323   ( "PatternSignatures",                Opt_PatternSignatures ),
1324   ( "EmptyDataDecls",                   Opt_EmptyDataDecls ),
1325   ( "ParallelListComp",                 Opt_ParallelListComp ),
1326   ( "TransformListComp",                Opt_TransformListComp ),
1327   ( "ForeignFunctionInterface",         Opt_ForeignFunctionInterface ),
1328   ( "UnliftedFFITypes",                 Opt_UnliftedFFITypes ),
1329   ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms ),
1330   ( "Rank2Types",                       Opt_Rank2Types ),
1331   ( "RankNTypes",                       Opt_RankNTypes ),
1332   ( "ImpredicativeTypes",               Opt_ImpredicativeTypes ),
1333   ( "TypeOperators",                    Opt_TypeOperators ),
1334   ( "RecursiveDo",                      Opt_RecursiveDo ),
1335   ( "Arrows",                           Opt_Arrows ),
1336   ( "PArr",                             Opt_PArr ),
1337   ( "TemplateHaskell",                  Opt_TemplateHaskell ),
1338   ( "QuasiQuotes",                      Opt_QuasiQuotes ),
1339   ( "Generics",                         Opt_Generics ),
1340   -- On by default:
1341   ( "ImplicitPrelude",                  Opt_ImplicitPrelude ),
1342   ( "RecordWildCards",                  Opt_RecordWildCards ),
1343   ( "RecordPuns",                       Opt_RecordPuns ),
1344   ( "DisambiguateRecordFields",         Opt_DisambiguateRecordFields ),
1345   ( "OverloadedStrings",                Opt_OverloadedStrings ),
1346   ( "GADTs",                            Opt_GADTs ),
1347   ( "ViewPatterns",                     Opt_ViewPatterns),
1348   ( "TypeFamilies",                     Opt_TypeFamilies ),
1349   ( "BangPatterns",                     Opt_BangPatterns ),
1350   -- On by default:
1351   ( "MonomorphismRestriction",          Opt_MonomorphismRestriction ),
1352   -- On by default (which is not strictly H98):
1353   ( "MonoPatBinds",                     Opt_MonoPatBinds ),
1354   ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec),
1355   ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules ),
1356   ( "ImplicitParams",                   Opt_ImplicitParams ),
1357   ( "ScopedTypeVariables",              Opt_ScopedTypeVariables ),
1358   ( "UnboxedTuples",                    Opt_UnboxedTuples ),
1359   ( "StandaloneDeriving",               Opt_StandaloneDeriving ),
1360   ( "DeriveDataTypeable",               Opt_DeriveDataTypeable ),
1361   ( "TypeSynonymInstances",             Opt_TypeSynonymInstances ),
1362   ( "FlexibleContexts",                 Opt_FlexibleContexts ),
1363   ( "FlexibleInstances",                Opt_FlexibleInstances ),
1364   ( "ConstrainedClassMethods",          Opt_ConstrainedClassMethods ),
1365   ( "MultiParamTypeClasses",            Opt_MultiParamTypeClasses ),
1366   ( "FunctionalDependencies",           Opt_FunctionalDependencies ),
1367   ( "GeneralizedNewtypeDeriving",       Opt_GeneralizedNewtypeDeriving ),
1368   ( "OverlappingInstances",             Opt_OverlappingInstances ),
1369   ( "UndecidableInstances",             Opt_UndecidableInstances ),
1370   ( "IncoherentInstances",              Opt_IncoherentInstances )
1371   ]
1372
1373 impliedFlags :: [(DynFlag, [DynFlag])]
1374 impliedFlags = [
1375    ( Opt_GADTs,               [Opt_RelaxedPolyRec] )    -- We want type-sig variables to
1376                                                         --      be completely rigid for GADTs
1377  , ( Opt_ScopedTypeVariables, [Opt_RelaxedPolyRec] )    -- Ditto for scoped type variables; see
1378                                                         --      Note [Scoped tyvars] in TcBinds
1379   ]
1380
1381 glasgowExtsFlags :: [DynFlag]
1382 glasgowExtsFlags = [
1383              Opt_PrintExplicitForalls
1384            , Opt_ForeignFunctionInterface
1385            , Opt_UnliftedFFITypes
1386            , Opt_GADTs
1387            , Opt_ImplicitParams
1388            , Opt_ScopedTypeVariables
1389            , Opt_UnboxedTuples
1390            , Opt_TypeSynonymInstances
1391            , Opt_StandaloneDeriving
1392            , Opt_DeriveDataTypeable
1393            , Opt_FlexibleContexts
1394            , Opt_FlexibleInstances
1395            , Opt_ConstrainedClassMethods
1396            , Opt_MultiParamTypeClasses
1397            , Opt_FunctionalDependencies
1398            , Opt_MagicHash
1399            , Opt_PolymorphicComponents
1400            , Opt_ExistentialQuantification
1401            , Opt_UnicodeSyntax
1402            , Opt_PatternGuards
1403            , Opt_LiberalTypeSynonyms
1404            , Opt_RankNTypes
1405            , Opt_ImpredicativeTypes
1406            , Opt_TypeOperators
1407            , Opt_RecursiveDo
1408            , Opt_ParallelListComp
1409            , Opt_EmptyDataDecls
1410            , Opt_KindSignatures
1411            , Opt_PatternSignatures
1412            , Opt_GeneralizedNewtypeDeriving
1413            , Opt_TypeFamilies ]
1414
1415 ------------------
1416 isFlag :: [(String,a)] -> String -> Bool
1417 isFlag flags f = any (\(ff,_) -> ff == f) flags
1418
1419 isPrefFlag :: String -> [(String,a)] -> String -> Bool
1420 isPrefFlag pref flags no_f
1421   | Just f <- maybePrefixMatch pref no_f = isFlag flags f
1422   | otherwise                            = False
1423
1424 ------------------
1425 getFlag :: [(String,a)] -> String -> a
1426 getFlag flags f = case [ opt | (ff, opt) <- flags, ff == f] of
1427                       (o:_)  -> o
1428                       []     -> panic ("get_flag " ++ f)
1429
1430 getPrefFlag :: String -> [(String,a)] -> String -> a
1431 getPrefFlag pref flags f = getFlag flags (fromJust (maybePrefixMatch pref f))
1432 -- We should only be passed flags which match the prefix
1433
1434 -- -----------------------------------------------------------------------------
1435 -- Parsing the dynamic flags.
1436
1437 parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags,[String])
1438 parseDynamicFlags dflags args = do
1439   let ((leftover,errs),dflags')
1440           = runCmdLine (processArgs dynamic_flags args) dflags
1441   when (not (null errs)) $ do
1442     throwDyn (UsageError (unlines errs))
1443   return (dflags', leftover)
1444
1445
1446 type DynP = CmdLineP DynFlags
1447
1448 upd :: (DynFlags -> DynFlags) -> DynP ()
1449 upd f = do
1450    dfs <- getCmdLineState
1451    putCmdLineState $! (f dfs)
1452
1453 --------------------------
1454 setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
1455 setDynFlag f = upd (\dfs -> foldl dopt_set (dopt_set dfs f) deps)
1456   where
1457     deps = [ d | (f', ds) <- impliedFlags, f' == f, d <- ds ]
1458         -- When you set f, set the ones it implies
1459         -- When you un-set f, however, we don't un-set the things it implies
1460         --      (except for -fno-glasgow-exts, which is treated specially)
1461
1462 unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
1463
1464 --------------------------
1465 setDumpFlag :: DynFlag -> OptKind DynP
1466 setDumpFlag dump_flag
1467   = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag)
1468         -- Whenver we -ddump, switch off the recompilation checker,
1469         -- else you don't see the dump!
1470
1471 setVerboseCore2Core = do setDynFlag Opt_ForceRecomp
1472                          setDynFlag Opt_D_verbose_core2core
1473                          upd (\s -> s { shouldDumpSimplPhase = const True })
1474
1475 setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp
1476                           upd (\s -> s { shouldDumpSimplPhase = spec })
1477   where
1478     spec = join (||)
1479          . map (join (&&))
1480          . map (map match)
1481          . map (split '+')
1482          . split ','
1483          $ case s of
1484              '=' : s' -> s'
1485              _        -> s
1486
1487     join op [] = const True
1488     join op ss = foldr1 (\f g x -> f x `op` g x) ss
1489
1490     match "" = const True
1491     match s  = case reads s of
1492                 [(n,"")] -> phase_num  n
1493                 _        -> phase_name s
1494
1495     phase_num n (SimplPhase k) = n == k
1496     phase_num _ _              = False
1497
1498     phase_name "gentle" SimplGently = True
1499     phase_name _        _           = False
1500
1501 setVerbosity :: Maybe Int -> DynP ()
1502 setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
1503
1504 addCmdlineHCInclude :: String -> DynP ()
1505 addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
1506
1507 extraPkgConf_ :: FilePath -> DynP ()
1508 extraPkgConf_  p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
1509
1510 exposePackage, hidePackage, ignorePackage :: String -> DynP ()
1511 exposePackage p =
1512   upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
1513 hidePackage p =
1514   upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
1515 ignorePackage p =
1516   upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
1517
1518 setPackageName :: String -> DynFlags -> DynFlags
1519 setPackageName p
1520   | Nothing <- unpackPackageId pid
1521   = throwDyn (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
1522   | otherwise
1523   = \s -> s{ thisPackage = pid }
1524   where
1525         pid = stringToPackageId p
1526
1527 -- If we're linking a binary, then only targets that produce object
1528 -- code are allowed (requests for other target types are ignored).
1529 setTarget :: HscTarget -> DynP ()
1530 setTarget l = upd set
1531   where
1532    set dfs
1533      | ghcLink dfs /= LinkBinary || isObjectTarget l  = dfs{ hscTarget = l }
1534      | otherwise = dfs
1535
1536 -- Changes the target only if we're compiling object code.  This is
1537 -- used by -fasm and -fvia-C, which switch from one to the other, but
1538 -- not from bytecode to object-code.  The idea is that -fasm/-fvia-C
1539 -- can be safely used in an OPTIONS_GHC pragma.
1540 setObjTarget :: HscTarget -> DynP ()
1541 setObjTarget l = upd set
1542   where
1543    set dfs
1544      | isObjectTarget (hscTarget dfs) = dfs { hscTarget = l }
1545      | otherwise = dfs
1546
1547 setOptLevel :: Int -> DynFlags -> DynFlags
1548 setOptLevel n dflags
1549    | hscTarget dflags == HscInterpreted && n > 0
1550         = dflags
1551             -- not in IO any more, oh well:
1552             -- putStr "warning: -O conflicts with --interactive; -O ignored.\n"
1553    | otherwise
1554         = updOptLevel n dflags
1555
1556
1557 setMainIs :: String -> DynP ()
1558 setMainIs arg
1559   | not (null main_fn) && isLower (head main_fn)
1560      -- The arg looked like "Foo.Bar.baz"
1561   = upd $ \d -> d{ mainFunIs = Just main_fn,
1562                    mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
1563
1564   | isUpper (head arg)  -- The arg looked like "Foo" or "Foo.Bar"
1565   = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName arg) }
1566
1567   | otherwise                   -- The arg looked like "baz"
1568   = upd $ \d -> d{ mainFunIs = Just arg }
1569   where
1570     (main_mod, main_fn) = splitLongestPrefix arg (== '.')
1571
1572 -----------------------------------------------------------------------------
1573 -- Paths & Libraries
1574
1575 addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP ()
1576
1577 -- -i on its own deletes the import paths
1578 addImportPath "" = upd (\s -> s{importPaths = []})
1579 addImportPath p  = upd (\s -> s{importPaths = importPaths s ++ splitPathList p})
1580
1581
1582 addLibraryPath p =
1583   upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p})
1584
1585 addIncludePath p =
1586   upd (\s -> s{includePaths = includePaths s ++ splitPathList p})
1587
1588 addFrameworkPath p =
1589   upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})
1590
1591 #ifndef mingw32_TARGET_OS
1592 split_marker :: Char
1593 split_marker = ':'   -- not configurable (ToDo)
1594 #endif
1595
1596 splitPathList :: String -> [String]
1597 splitPathList s = filter notNull (splitUp s)
1598                 -- empty paths are ignored: there might be a trailing
1599                 -- ':' in the initial list, for example.  Empty paths can
1600                 -- cause confusion when they are translated into -I options
1601                 -- for passing to gcc.
1602   where
1603 #ifndef mingw32_TARGET_OS
1604     splitUp xs = split split_marker xs
1605 #else
1606      -- Windows: 'hybrid' support for DOS-style paths in directory lists.
1607      --
1608      -- That is, if "foo:bar:baz" is used, this interpreted as
1609      -- consisting of three entries, 'foo', 'bar', 'baz'.
1610      -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted
1611      -- as 3 elts, "c:/foo", "c:\\foo", "x:/bar"
1612      --
1613      -- Notice that no attempt is made to fully replace the 'standard'
1614      -- split marker ':' with the Windows / DOS one, ';'. The reason being
1615      -- that this will cause too much breakage for users & ':' will
1616      -- work fine even with DOS paths, if you're not insisting on being silly.
1617      -- So, use either.
1618     splitUp []             = []
1619     splitUp (x:':':div:xs) | div `elem` dir_markers
1620                            = ((x:':':div:p): splitUp rs)
1621                            where
1622                               (p,rs) = findNextPath xs
1623           -- we used to check for existence of the path here, but that
1624           -- required the IO monad to be threaded through the command-line
1625           -- parser which is quite inconvenient.  The
1626     splitUp xs = cons p (splitUp rs)
1627                where
1628                  (p,rs) = findNextPath xs
1629
1630                  cons "" xs = xs
1631                  cons x  xs = x:xs
1632
1633     -- will be called either when we've consumed nought or the
1634     -- "<Drive>:/" part of a DOS path, so splitting is just a Q of
1635     -- finding the next split marker.
1636     findNextPath xs =
1637         case break (`elem` split_markers) xs of
1638            (p, _:ds) -> (p, ds)
1639            (p, xs)   -> (p, xs)
1640
1641     split_markers :: [Char]
1642     split_markers = [':', ';']
1643
1644     dir_markers :: [Char]
1645     dir_markers = ['/', '\\']
1646 #endif
1647
1648 -- -----------------------------------------------------------------------------
1649 -- tmpDir, where we store temporary files.
1650
1651 setTmpDir :: FilePath -> DynFlags -> DynFlags
1652 setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir }
1653   where
1654 #if !defined(mingw32_HOST_OS)
1655      canonicalise p = normalise p
1656 #else
1657      -- Canonicalisation of temp path under win32 is a bit more
1658      -- involved: (a) strip trailing slash,
1659      --      (b) normalise slashes
1660      --     (c) just in case, if there is a prefix /cygdrive/x/, change to x:
1661      canonicalise path = removeTrailingSlash $ normalise $ xltCygdrive path
1662
1663      -- if we're operating under cygwin, and TMP/TEMP is of
1664      -- the form "/cygdrive/drive/path", translate this to
1665      -- "drive:/path" (as GHC isn't a cygwin app and doesn't
1666      -- understand /cygdrive paths.)
1667      cygdrivePrefix = [pathSeparator] ++ "/cygdrive/" ++ [pathSeparator]
1668      xltCygdrive path = case maybePrefixMatch cygdrivePrefix path of
1669                         Just (drive:sep:xs)
1670                          | isPathSeparator sep -> drive:':':pathSeparator:xs
1671                         _ -> path
1672
1673      -- strip the trailing backslash (awful, but we only do this once).
1674      removeTrailingSlash path
1675       | isPathSeparator (last path) = init path
1676       | otherwise                   = path
1677 #endif
1678
1679 -----------------------------------------------------------------------------
1680 -- Hpc stuff
1681
1682 setOptHpcDir :: String -> DynP ()
1683 setOptHpcDir arg  = upd $ \ d -> d{hpcDir = arg}
1684
1685 -----------------------------------------------------------------------------
1686 -- Via-C compilation stuff
1687
1688 -- There are some options that we need to pass to gcc when compiling
1689 -- Haskell code via C, but are only supported by recent versions of
1690 -- gcc.  The configure script decides which of these options we need,
1691 -- and puts them in the file "extra-gcc-opts" in $topdir, which is
1692 -- read before each via-C compilation.  The advantage of having these
1693 -- in a separate file is that the file can be created at install-time
1694 -- depending on the available gcc version, and even re-generated  later
1695 -- if gcc is upgraded.
1696 --
1697 -- The options below are not dependent on the version of gcc, only the
1698 -- platform.
1699
1700 machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
1701                               [String]) -- for registerised HC compilations
1702 machdepCCOpts _dflags
1703 #if alpha_TARGET_ARCH
1704         =       ( ["-w", "-mieee"
1705 #ifdef HAVE_THREADED_RTS_SUPPORT
1706                     , "-D_REENTRANT"
1707 #endif
1708                    ], [] )
1709         -- For now, to suppress the gcc warning "call-clobbered
1710         -- register used for global register variable", we simply
1711         -- disable all warnings altogether using the -w flag. Oh well.
1712
1713 #elif hppa_TARGET_ARCH
1714         -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
1715         -- (very nice, but too bad the HP /usr/include files don't agree.)
1716         = ( ["-D_HPUX_SOURCE"], [] )
1717
1718 #elif m68k_TARGET_ARCH
1719       -- -fno-defer-pop : for the .hc files, we want all the pushing/
1720       --    popping of args to routines to be explicit; if we let things
1721       --    be deferred 'til after an STGJUMP, imminent death is certain!
1722       --
1723       -- -fomit-frame-pointer : *don't*
1724       --     It's better to have a6 completely tied up being a frame pointer
1725       --     rather than let GCC pick random things to do with it.
1726       --     (If we want to steal a6, then we would try to do things
1727       --     as on iX86, where we *do* steal the frame pointer [%ebp].)
1728         = ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
1729
1730 #elif i386_TARGET_ARCH
1731       -- -fno-defer-pop : basically the same game as for m68k
1732       --
1733       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
1734       --   the fp (%ebp) for our register maps.
1735         =  let n_regs = stolen_x86_regs _dflags
1736                sta = opt_Static
1737            in
1738                     ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
1739 --                    , if "mingw32" `isSuffixOf` cTARGETPLATFORM then "-mno-cygwin" else ""
1740                       ],
1741                       [ "-fno-defer-pop",
1742                         "-fomit-frame-pointer",
1743                         -- we want -fno-builtin, because when gcc inlines
1744                         -- built-in functions like memcpy() it tends to
1745                         -- run out of registers, requiring -monly-n-regs
1746                         "-fno-builtin",
1747                         "-DSTOLEN_X86_REGS="++show n_regs ]
1748                     )
1749
1750 #elif ia64_TARGET_ARCH
1751         = ( [], ["-fomit-frame-pointer", "-G0"] )
1752
1753 #elif x86_64_TARGET_ARCH
1754         = ( [], ["-fomit-frame-pointer",
1755                  "-fno-asynchronous-unwind-tables",
1756                         -- the unwind tables are unnecessary for HC code,
1757                         -- and get in the way of -split-objs.  Another option
1758                         -- would be to throw them away in the mangler, but this
1759                         -- is easier.
1760                  "-fno-builtin"
1761                         -- calling builtins like strlen() using the FFI can
1762                         -- cause gcc to run out of regs, so use the external
1763                         -- version.
1764                 ] )
1765
1766 #elif sparc_TARGET_ARCH
1767         = ( [], ["-w"] )
1768         -- For now, to suppress the gcc warning "call-clobbered
1769         -- register used for global register variable", we simply
1770         -- disable all warnings altogether using the -w flag. Oh well.
1771
1772 #elif powerpc_apple_darwin_TARGET
1773       -- -no-cpp-precomp:
1774       --     Disable Apple's precompiling preprocessor. It's a great thing
1775       --     for "normal" programs, but it doesn't support register variable
1776       --     declarations.
1777         = ( [], ["-no-cpp-precomp"] )
1778 #else
1779         = ( [], [] )
1780 #endif
1781
1782 picCCOpts :: DynFlags -> [String]
1783 picCCOpts _dflags
1784 #if darwin_TARGET_OS
1785       -- Apple prefers to do things the other way round.
1786       -- PIC is on by default.
1787       -- -mdynamic-no-pic:
1788       --     Turn off PIC code generation.
1789       -- -fno-common:
1790       --     Don't generate "common" symbols - these are unwanted
1791       --     in dynamic libraries.
1792
1793     | opt_PIC
1794         = ["-fno-common", "-D__PIC__"]
1795     | otherwise
1796         = ["-mdynamic-no-pic"]
1797 #elif mingw32_TARGET_OS
1798       -- no -fPIC for Windows
1799     | opt_PIC
1800         = ["-D__PIC__"]
1801     | otherwise
1802         = []
1803 #else
1804     | opt_PIC
1805         = ["-fPIC", "-D__PIC__"]
1806     | otherwise
1807         = []
1808 #endif
1809
1810 -- -----------------------------------------------------------------------------
1811 -- Splitting
1812
1813 can_split :: Bool
1814 can_split = cSplitObjs == "YES"
1815
1816 -- -----------------------------------------------------------------------------
1817 -- Compiler Info
1818
1819 compilerInfo :: [(String, String)]
1820 compilerInfo = [("Project name",                cProjectName),
1821                 ("Project version",             cProjectVersion),
1822                 ("Booter version",              cBooterVersion),
1823                 ("Stage",                       cStage),
1824                 ("Interface file version",      cHscIfaceFileVersion),
1825                 ("Have interpreter",            cGhcWithInterpreter),
1826                 ("Object splitting",            cSplitObjs),
1827                 ("Have native code generator",  cGhcWithNativeCodeGen),
1828                 ("Support SMP",                 cGhcWithSMP),
1829                 ("Unregisterised",              cGhcUnregisterised),
1830                 ("Tables next to code",         cGhcEnableTablesNextToCode),
1831                 ("Win32 DLLs",                  cEnableWin32DLLs),
1832                 ("RTS ways",                    cGhcRTSWays),
1833                 ("Leading underscore",          cLeadingUnderscore)]
1834