Make some profiling flags dynamic
[ghc-hetmet.git] / compiler / main / DynFlags.hs
index 5031ded..1e405ea 100644 (file)
@@ -1,19 +1,17 @@
 
------------------------------------------------------------------------------
---
+-- |
 -- Dynamic flags
 --
--- Most flags are dynamic flags, which means they can change from
--- compilation to compilation using OPTIONS_GHC pragmas, and in a
--- multi-session GHC each session can be using different dynamic
--- flags.  Dynamic flags can also be set at the prompt in GHCi.
 --
 -- (c) The University of Glasgow 2005
 --
------------------------------------------------------------------------------
 
+-- Most flags are dynamic flags, which means they can change from
+-- compilation to compilation using @OPTIONS_GHC@ pragmas, and in a
+-- multi-session GHC each session can be using different dynamic
+-- flags.  Dynamic flags can also be set at the prompt in GHCi.
 module DynFlags (
-        -- Dynamic flags
+        -- * Dynamic flags and associated configuration types
         DynFlag(..),
         DynFlags(..),
         HscTarget(..), isObjectTarget, defaultObjectTarget,
@@ -23,42 +21,53 @@ module DynFlags (
         Option(..),
         DynLibLoader(..),
         fFlags, xFlags,
-        DPHBackend(..),
+        dphPackage,
 
-        -- Configuration of the core-to-core and stg-to-stg phases
-        CoreToDo(..),
-        StgToDo(..),
-        SimplifierSwitch(..),
-        SimplifierMode(..), FloatOutSwitches(..),
-        getCoreToDo, getStgToDo,
-
-        -- Manipulating DynFlags
+        -- ** Manipulating DynFlags
         defaultDynFlags,                -- DynFlags
         initDynFlags,                   -- DynFlags -> IO DynFlags
 
         dopt,                           -- DynFlag -> DynFlags -> Bool
         dopt_set, dopt_unset,           -- DynFlags -> DynFlag -> DynFlags
-        getOpts,                        -- (DynFlags -> [a]) -> IO [a]
+        getOpts,                        -- DynFlags -> (DynFlags -> [a]) -> [a]
         getVerbFlag,
+        getMainFun,
         updOptLevel,
         setTmpDir,
         setPackageName,
 
-        -- parsing DynFlags
+        -- ** Parsing DynFlags
         parseDynamicFlags,
+        parseDynamicNoPackageFlags,
         allFlags,
 
-        -- misc stuff
+        supportedLanguages, languageOptions,
+
+        -- ** DynFlag C compiler options
         machdepCCOpts, picCCOpts,
-    supportedLanguages, languageOptions,
-    compilerInfo,
+
+        -- * Configuration of the core-to-core passes
+        CoreToDo(..),
+        SimplifierMode(..),
+        SimplifierSwitch(..),
+        FloatOutSwitches(..),
+        getCoreToDo,
+
+        -- * Configuration of the stg-to-stg passes
+        StgToDo(..),
+        getStgToDo,
+
+        -- * Compiler configuration suitable for display to the user
+        compilerInfo
   ) where
 
 #include "HsVersions.h"
 
 import Module
 import PackageConfig
-import PrelNames        ( mAIN )
+import PrelNames        ( mAIN, main_RDR_Unqual )
+import RdrName          ( RdrName, mkRdrUnqual )
+import OccName          ( mkVarOccFS )
 #ifdef i386_TARGET_ARCH
 import StaticFlags      ( opt_Static )
 #endif
@@ -73,7 +82,8 @@ import Panic
 import UniqFM           ( UniqFM )
 import Util
 import Maybes           ( orElse )
-import SrcLoc           ( SrcSpan )
+import SrcLoc
+import FastString
 import Outputable
 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 
@@ -81,12 +91,14 @@ import Data.IORef       ( readIORef )
 import Control.Monad    ( when )
 
 import Data.Char
+import Data.List        ( intersperse )
 import System.FilePath
 import System.IO        ( stderr, hPutChar )
 
 -- -----------------------------------------------------------------------------
 -- DynFlags
 
+-- | Enumerates the simple on-or-off dynamic flags
 data DynFlag
 
    -- debugging flags
@@ -135,6 +147,7 @@ data DynFlag
    | Opt_D_dump_BCOs
    | Opt_D_dump_vect
    | Opt_D_dump_hpc
+   | Opt_D_dump_rtti
    | Opt_D_source_stats
    | Opt_D_verbose_core2core
    | Opt_D_verbose_stg2stg
@@ -190,7 +203,7 @@ data DynFlag
    | Opt_TemplateHaskell
    | Opt_QuasiQuotes
    | Opt_ImplicitParams
-   | Opt_Generics
+   | Opt_Generics                      -- "Derivable type classes"
    | Opt_ImplicitPrelude
    | Opt_ScopedTypeVariables
    | Opt_UnboxedTuples
@@ -217,7 +230,6 @@ data DynFlag
    | Opt_MagicHash
    | Opt_EmptyDataDecls
    | Opt_KindSignatures
-   | Opt_PatternSignatures
    | Opt_ParallelListComp
    | Opt_TransformListComp
    | Opt_GeneralizedNewtypeDeriving
@@ -229,6 +241,8 @@ data DynFlag
    | Opt_RankNTypes
    | Opt_ImpredicativeTypes
    | Opt_TypeOperators
+   | Opt_PackageImports
+   | Opt_NewQualifiedOperators
 
    | Opt_PrintExplicitForalls
 
@@ -248,11 +262,17 @@ data DynFlag
    | Opt_UnboxStrictFields
    | Opt_MethodSharing
    | Opt_DictsCheap
-   | Opt_RewriteRules
+   | Opt_InlineIfEnoughArgs
+   | Opt_EnableRewriteRules            -- Apply rewrite rules during simplification
    | Opt_Vectorise
    | Opt_RegsGraph                      -- do graph coloring register allocation
    | Opt_RegsIterative                  -- do iterative coalescing graph coloring register allocation
 
+   -- profiling opts
+   | Opt_AutoSccsOnAllToplevs
+   | Opt_AutoSccsOnExportedToplevs
+   | Opt_AutoSccsOnIndividualCafs
+
    -- misc opts
    | Opt_Cpp
    | Opt_Pp
@@ -260,6 +280,7 @@ data DynFlag
    | Opt_DryRun
    | Opt_DoAsmMangling
    | Opt_ExcessPrecision
+   | Opt_EagerBlackHoling
    | Opt_ReadUserPackageConf
    | Opt_NoHsMain
    | Opt_SplitObjs
@@ -275,10 +296,14 @@ data DynFlag
    | Opt_PrintBindContents
    | Opt_GenManifest
    | Opt_EmbedManifest
+
+       -- temporary flags
+   | Opt_RunCPS
    | Opt_RunCPSZ
    | Opt_ConvertToZipCfgAndBack
    | Opt_AutoLinkPackages
    | Opt_ImplicitImportQualified
+   | Opt_TryNewCodeGen
 
    -- keeping stuff
    | Opt_KeepHiDiffs
@@ -286,43 +311,49 @@ data DynFlag
    | Opt_KeepSFiles
    | Opt_KeepRawSFiles
    | Opt_KeepTmpFiles
+   | Opt_KeepRawTokenStream
 
    deriving (Eq, Show)
 
+-- | Contains not only a collection of 'DynFlag's but also a plethora of
+-- information relating to the compilation of a single file or GHC session
 data DynFlags = DynFlags {
   ghcMode               :: GhcMode,
   ghcLink               :: GhcLink,
   coreToDo              :: Maybe [CoreToDo], -- reserved for -Ofile
   stgToDo               :: Maybe [StgToDo],  -- similarly
   hscTarget             :: HscTarget,
-  hscOutName            :: String,      -- name of the output file
-  extCoreName           :: String,      -- name of the .core output file
-  verbosity             :: Int,         -- verbosity level
-  optLevel              :: Int,         -- optimisation level
-  simplPhases           :: Int,         -- number of simplifier phases
-  maxSimplIterations    :: Int,         -- max simplifier iterations
+  hscOutName            :: String,      -- ^ Name of the output file
+  extCoreName           :: String,      -- ^ Name of the .hcr output file
+  verbosity             :: Int,         -- ^ Verbosity level: see "DynFlags#verbosity_levels"
+  optLevel              :: Int,         -- ^ Optimisation level
+  simplPhases           :: Int,         -- ^ Number of simplifier phases
+  maxSimplIterations    :: Int,         -- ^ Max simplifier iterations
   shouldDumpSimplPhase  :: SimplifierMode -> Bool,
   ruleCheck             :: Maybe String,
 
-  specConstrThreshold   :: Maybe Int,   -- Threshold for SpecConstr
-  specConstrCount       :: Maybe Int,   -- Max number of specialisations for any one function
-  liberateCaseThreshold :: Maybe Int,   -- Threshold for LiberateCase
+  specConstrThreshold   :: Maybe Int,   -- ^ Threshold for SpecConstr
+  specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function
+  liberateCaseThreshold :: Maybe Int,   -- ^ Threshold for LiberateCase
 
   stolen_x86_regs       :: Int,
-  cmdlineHcIncludes     :: [String],    -- -#includes
+  cmdlineHcIncludes     :: [String],    -- ^ @\-\#includes@
   importPaths           :: [FilePath],
   mainModIs             :: Module,
   mainFunIs             :: Maybe String,
-  ctxtStkDepth          :: Int,         -- Typechecker context stack depth
+  ctxtStkDepth          :: Int,         -- ^ Typechecker context stack depth
 
   dphBackend            :: DPHBackend,
 
-  thisPackage           :: PackageId,
+  thisPackage           :: PackageId,   -- ^ name of package currently being compiled
 
   -- ways
-  wayNames              :: [WayName],   -- way flags from the cmd line
-  buildTag              :: String,      -- the global "way" (eg. "p" for prof)
-  rtsBuildTag           :: String,      -- the RTS "way"
+  wayNames              :: [WayName],   -- ^ Way flags from the command line
+  buildTag              :: String,      -- ^ The global \"way\" (e.g. \"p\" for prof)
+  rtsBuildTag           :: String,      -- ^ The RTS \"way\"
+
+  -- For object splitting
+  splitInfo             :: Maybe (String,Int),
 
   -- paths etc.
   objectDir             :: Maybe String,
@@ -337,12 +368,12 @@ data DynFlags = DynFlags {
   outputHi              :: Maybe String,
   dynLibLoader          :: DynLibLoader,
 
-  -- | This is set by DriverPipeline.runPipeline based on where
+  -- | This is set by 'DriverPipeline.runPipeline' based on where
   --    its output is going.
   dumpPrefix            :: Maybe FilePath,
 
-  -- | Override the dumpPrefix set by runPipeline.
-  --    Set by -ddump-file-prefix
+  -- | Override the 'dumpPrefix' set by 'DriverPipeline.runPipeline'.
+  --    Set by @-ddump-file-prefix@
   dumpPrefixForce       :: Maybe FilePath,
 
   includePaths          :: [String],
@@ -354,7 +385,7 @@ data DynFlags = DynFlags {
   ghcUsagePath          :: FilePath,    -- Filled in by SysTools
   ghciUsagePath         :: FilePath,    -- ditto
 
-  hpcDir                :: String,      -- ^ path to store the .mix files
+  hpcDir                :: String,      -- ^ Path to store the .mix files
 
   -- options for particular phases
   opt_L                 :: [String],
@@ -385,17 +416,16 @@ data DynFlags = DynFlags {
   depIncludePkgDeps     :: Bool,
   depExcludeMods        :: [ModuleName],
   depSuffixes           :: [String],
-  depWarnings           :: Bool,
 
   --  Package flags
   extraPkgConfs         :: [FilePath],
   topDir                :: FilePath,    -- filled in by SysTools
   systemPackageConfig   :: FilePath,    -- ditto
-        -- The -package-conf flags given on the command line, in the order
+        -- ^ The @-package-conf@ flags given on the command line, in the order
         -- they appeared.
 
   packageFlags          :: [PackageFlag],
-        -- The -package and -hide-package flags from the command-line
+        -- ^ The @-package@ and @-hide-package@ flags from the command-line
 
   -- Package state
   -- NB. do not modify this field, it is calculated by
@@ -406,21 +436,41 @@ data DynFlags = DynFlags {
   -- hsc dynamic flags
   flags                 :: [DynFlag],
 
-  -- message output
+  -- | Message output action: use "ErrUtils" instead of this if you can
   log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
 
   haddockOptions :: Maybe String
  }
 
+-- | The target code type of the compilation (if any).
+--
+-- Whenever you change the target, also make sure to set 'ghcLink' to
+-- something sensible.
+--
+-- 'HscNothing' can be used to avoid generating any output, however, note
+-- that:
+--
+--  * This will not run the desugaring step, thus no warnings generated in
+--    this step will be output.  In particular, this includes warnings related
+--    to pattern matching.  You can run the desugarer manually using
+--    'GHC.desugarModule'.
+--
+--  * If a program uses Template Haskell the typechecker may try to run code
+--    from an imported module.  This will fail if no code has been generated
+--    for this module.  You can use 'GHC.needsTemplateHaskell' to detect
+--    whether this might be the case and choose to either switch to a
+--    different target or avoid typechecking such modules.  (The latter may
+--    preferable for security reasons.)
+--
 data HscTarget
-  = HscC
-  | HscAsm
-  | HscJava
-  | HscInterpreted
-  | HscNothing
+  = HscC           -- ^ Generate C code.
+  | HscAsm         -- ^ Generate assembly using the native code generator.
+  | HscJava        -- ^ Generate Java bytecode.
+  | HscInterpreted -- ^ Generate bytecode.  (Requires 'LinkInMemory')
+  | HscNothing     -- ^ Don't generate any code.  See notes above.
   deriving (Eq, Show)
 
--- | will this target result in an object file on the disk?
+-- | Will this target result in an object file on the disk?
 isObjectTarget :: HscTarget -> Bool
 isObjectTarget HscC     = True
 isObjectTarget HscAsm   = True
@@ -433,21 +483,27 @@ isObjectTarget _        = False
 -- imported modules, but in multi-module mode we look for source files
 -- in order to check whether they need to be recompiled.
 data GhcMode
-  = CompManager         -- ^ --make, GHCi, etc.
-  | OneShot             -- ^ ghc -c Foo.hs
-  | MkDepend            -- ^ ghc -M, see Finder for why we need this
+  = CompManager         -- ^ @\-\-make@, GHCi, etc.
+  | OneShot             -- ^ @ghc -c Foo.hs@
+  | MkDepend            -- ^ @ghc -M@, see "Finder" for why we need this
   deriving Eq
 
+instance Outputable GhcMode where
+  ppr CompManager = ptext (sLit "CompManager")
+  ppr OneShot     = ptext (sLit "OneShot")
+  ppr MkDepend    = ptext (sLit "MkDepend")
+
 isOneShot :: GhcMode -> Bool
 isOneShot OneShot = True
 isOneShot _other  = False
 
--- | What kind of linking to do.
-data GhcLink    -- What to do in the link step, if there is one
-  = NoLink              -- Don't link at all
-  | LinkBinary          -- Link object code into a binary
-  | LinkInMemory        -- Use the in-memory dynamic linker
-  | LinkDynLib          -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
+-- | What to do in the link step, if there is one.
+data GhcLink
+  = NoLink              -- ^ Don't link at all
+  | LinkBinary          -- ^ Link object code into a binary
+  | LinkInMemory        -- ^ Use the in-memory dynamic linker (works for both
+                        --   bytecode and object code).
+  | LinkDynLib          -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
   deriving (Eq, Show)
 
 isNoLink :: GhcLink -> Bool
@@ -463,7 +519,7 @@ data PackageFlag
 defaultHscTarget :: HscTarget
 defaultHscTarget = defaultObjectTarget
 
--- | the 'HscTarget' value corresponding to the default way to create
+-- | The 'HscTarget' value corresponding to the default way to create
 -- object files on the current platform.
 defaultObjectTarget :: HscTarget
 defaultObjectTarget
@@ -476,6 +532,7 @@ data DynLibLoader
   | SystemDependent
   deriving Eq
 
+-- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
 initDynFlags :: DynFlags -> IO DynFlags
 initDynFlags dflags = do
  -- someday these will be dynamic flags
@@ -488,6 +545,8 @@ initDynFlags dflags = do
         rtsBuildTag     = rts_build_tag
         }
 
+-- | The normal 'DynFlags'. Note that they is not suitable for use in this form
+-- and must be fully initialized by 'GHC.newSession' first.
 defaultDynFlags :: DynFlags
 defaultDynFlags =
      DynFlags {
@@ -541,7 +600,7 @@ defaultDynFlags =
 
         opt_L                   = [],
         opt_P                   = (if opt_PIC
-                                   then ["-D__PIC__"]
+                                   then ["-D__PIC__", "-U __PIC__"] -- this list is reversed
                                    else []),
         opt_F                   = [],
         opt_c                   = [],
@@ -557,11 +616,12 @@ defaultDynFlags =
         wayNames                = panic "defaultDynFlags: No wayNames",
         buildTag                = panic "defaultDynFlags: No buildTag",
         rtsBuildTag             = panic "defaultDynFlags: No rtsBuildTag",
+        splitInfo               = Nothing,
         -- initSysTools fills all these in
         ghcUsagePath            = panic "defaultDynFlags: No ghciUsagePath",
         ghciUsagePath           = panic "defaultDynFlags: No ghciUsagePath",
         topDir                  = panic "defaultDynFlags: No topDir",
-        systemPackageConfig     = panic "defaultDynFlags: No systemPackageConfig",
+        systemPackageConfig     = panic  "no systemPackageConfig: call GHC.setSessionDynFlags",
         pgm_L                   = panic "defaultDynFlags: No pgm_L",
         pgm_P                   = panic "defaultDynFlags: No pgm_P",
         pgm_F                   = panic "defaultDynFlags: No pgm_F",
@@ -580,7 +640,6 @@ defaultDynFlags =
         depIncludePkgDeps = False,
         depExcludeMods    = [],
         depSuffixes       = [],
-        depWarnings       = True,
         -- end of ghc -M values
         haddockOptions = Nothing,
         flags = [
@@ -619,6 +678,7 @@ defaultDynFlags =
       }
 
 {-
+    #verbosity_levels#
     Verbosity levels:
 
     0   |   print errors & warnings only
@@ -629,25 +689,34 @@ defaultDynFlags =
     5   |   "ghc -v -ddump-all"
 -}
 
+-- | Test whether a 'DynFlag' is set
 dopt :: DynFlag -> DynFlags -> Bool
 dopt f dflags  = f `elem` (flags dflags)
 
+-- | Set a 'DynFlag'
 dopt_set :: DynFlags -> DynFlag -> DynFlags
 dopt_set dfs f = dfs{ flags = f : flags dfs }
 
+-- | Unset a 'DynFlag'
 dopt_unset :: DynFlags -> DynFlag -> DynFlags
 dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
 
-getOpts :: DynFlags -> (DynFlags -> [a]) -> [a]
+-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
+getOpts :: DynFlags             -- ^ 'DynFlags' to retrieve the options from
+        -> (DynFlags -> [a])    -- ^ Relevant record accessor: one of the @opt_*@ accessors
+        -> [a]                  -- ^ Correctly ordered extracted options
 getOpts dflags opts = reverse (opts dflags)
         -- We add to the options from the front, so we need to reverse the list
 
+-- | Gets the verbosity flag for the current verbosity level. This is fed to
+-- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included
 getVerbFlag :: DynFlags -> String
 getVerbFlag dflags
   | verbosity dflags >= 3  = "-v"
   | otherwise =  ""
 
-setObjectDir, setHiDir, setStubDir, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
+setObjectDir, setHiDir, setStubDir, setOutputDir,
+         setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
          setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
          addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres,
          addCmdlineFramework, addHaddockOpts
@@ -660,6 +729,7 @@ setHiDir      f d = d{ hiDir      = Just f}
 setStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }
   -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
   -- \#included from the .hc file when compiling with -fvia-C.
+setOutputDir  f = setObjectDir f . setHiDir f . setStubDir f
 
 setObjectSuf  f d = d{ objectSuf  = f}
 setHiSuf      f d = d{ hiSuf      = f}
@@ -675,7 +745,7 @@ parseDynLibLoaderMode f d =
    ("wrapped", "")      -> d{ dynLibLoader = Wrapped Nothing }
    ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing }
    ("wrapped:", flex)   -> d{ dynLibLoader = Wrapped (Just flex) }
-   (_,_)                -> error "Unknown dynlib loader"
+   _                    -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f))
 
 setDumpPrefixForce f d = d { dumpPrefixForce = f}
 
@@ -715,9 +785,6 @@ addDepExcludeMod m d
 addDepSuffix :: FilePath -> DynFlags -> DynFlags
 addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d }
 
-setDepWarnings :: Bool -> DynFlags -> DynFlags
-setDepWarnings b d = d { depWarnings = b }
-
 -- XXX Legacy code:
 -- We used to use "-optdep-flag -optdeparg", so for legacy applications
 -- we need to strip the "-optdep" off of the arg
@@ -733,13 +800,12 @@ addHaddockOpts f d = d{ haddockOptions = Just f}
 -- -----------------------------------------------------------------------------
 -- Command-line options
 
--- When invoking external tools as part of the compilation pipeline, we
+-- | When invoking external tools as part of the compilation pipeline, we
 -- pass these a sequence of options on the command-line. Rather than
 -- just using a list of Strings, we use a type that allows us to distinguish
--- between filepaths and 'other stuff'. [The reason being, of course, that
+-- between filepaths and 'other stuff'. The reason for this is that
 -- this type gives us a handle on transforming filenames, and filenames only,
--- to whatever format they're expected to be on a particular platform.]
-
+-- to whatever format they're expected to be on a particular platform.
 data Option
  = FileOption -- an entry that _contains_ filename(s) / filepaths.
               String  -- a non-filepath prefix that shouldn't be
@@ -751,7 +817,7 @@ data Option
 -- Setting the optimisation level
 
 updOptLevel :: Int -> DynFlags -> DynFlags
--- Set dynflags appropriate to the optimisation level
+-- ^ Sets the 'DynFlags' to be appropriate to the optimisation level
 updOptLevel n dfs
   = dfs2{ optLevel = final_n }
   where
@@ -768,8 +834,8 @@ optLevelFlags
     , ([0],     Opt_OmitInterfacePragmas)
 
     , ([1,2],   Opt_IgnoreAsserts)
-    , ([1,2],   Opt_RewriteRules)       -- Off for -O0; see Note [Scoping for Builtin rules]
-                                        --              in PrelRules
+    , ([1,2],   Opt_EnableRewriteRules)  -- Off for -O0; see Note [Scoping for Builtin rules]
+                                         --              in PrelRules
     , ([1,2],   Opt_DoEtaReduction)
     , ([1,2],   Opt_CaseMerge)
     , ([1,2],   Opt_Strictness)
@@ -778,7 +844,16 @@ optLevelFlags
 
     , ([2],     Opt_LiberateCase)
     , ([2],     Opt_SpecConstr)
-    , ([2],     Opt_StaticArgumentTransformation)
+
+--     , ([2],     Opt_StaticArgumentTransformation)
+-- Max writes: I think it's probably best not to enable SAT with -O2 for the
+-- 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate
+-- several improvements to the heuristics, and I'm concerned that without
+-- those changes SAT will interfere with some attempts to write "high
+-- performance Haskell", as we saw in some posts on Haskell-Cafe earlier
+-- this year. In particular, the version in HEAD lacks the tail call
+-- criterion, so many things that look like reasonable loops will be
+-- turned into functions with extra (unneccesary) thunk creation.
 
     , ([0,1,2], Opt_DoLambdaEtaExpansion)
                 -- This one is important for a tiresome reason:
@@ -860,22 +935,48 @@ data CoreToDo           -- These are diff core-to-core passes,
   | CoreCSE
   | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
                                                 -- matching this string
-  | CoreDoVectorisation DPHBackend
+  | CoreDoVectorisation PackageId
   | CoreDoNothing                -- Useful when building up
   | CoreDoPasses [CoreToDo]      -- lists of these things
 
+
 data SimplifierMode             -- See comments in SimplMonad
   = SimplGently
   | SimplPhase Int [String]
 
+instance Outputable SimplifierMode where
+    ppr SimplGently       = ptext (sLit "gentle")
+    ppr (SimplPhase n ss) = int n <+> brackets (text (concat $ intersperse "," ss))
+
+
 data SimplifierSwitch
   = MaxSimplifierIterations Int
   | NoCaseOfCase
 
-data FloatOutSwitches
-  = FloatOutSw  Bool    -- True <=> float lambdas to top level
-                Bool    -- True <=> float constants to top level,
-                        --          even if they do not escape a lambda
+
+data FloatOutSwitches = FloatOutSwitches {
+        floatOutLambdas :: Bool,     -- ^ True <=> float lambdas to top level
+        floatOutConstants :: Bool    -- ^ True <=> float constants to top level,
+                                     --            even if they do not escape a lambda
+    }
+
+instance Outputable FloatOutSwitches where
+    ppr = pprFloatOutSwitches
+
+pprFloatOutSwitches :: FloatOutSwitches -> SDoc
+pprFloatOutSwitches sw = pp_not (floatOutLambdas sw) <+> text "lambdas" <> comma
+                     <+> pp_not (floatOutConstants sw) <+> text "constants"
+  where
+    pp_not True  = empty
+    pp_not False = text "not"
+
+-- | Switches that specify the minimum amount of floating out
+gentleFloatOutSwitches :: FloatOutSwitches
+gentleFloatOutSwitches = FloatOutSwitches False False
+
+-- | Switches that do not specify floating out of lambdas, just of constants
+constantsOnlyFloatOutSwitches :: FloatOutSwitches
+constantsOnlyFloatOutSwitches = FloatOutSwitches False True
 
 
 -- The core-to-core pass ordering is derived from the DynFlags:
@@ -915,7 +1016,7 @@ getCoreToDo dflags
 
     vectorisation
       = runWhen (dopt Opt_Vectorise dflags)
-        $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphBackend dflags) ]
+        $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphPackage dflags) ]
 
 
                 -- By default, we have 2 phases before phase 0.
@@ -973,7 +1074,7 @@ getCoreToDo dflags
         -- so that overloaded functions have all their dictionary lambdas manifest
         CoreDoSpecialising,
 
-        runWhen full_laziness (CoreDoFloatOutwards (FloatOutSw False False)),
+        runWhen full_laziness (CoreDoFloatOutwards gentleFloatOutSwitches),
 
         CoreDoFloatInwards,
 
@@ -1003,8 +1104,7 @@ getCoreToDo dflags
                 ]),
 
         runWhen full_laziness
-          (CoreDoFloatOutwards (FloatOutSw False    -- Not lambdas
-                                           True)),  -- Float constants
+          (CoreDoFloatOutwards constantsOnlyFloatOutSwitches),
                 -- nofib/spectral/hartel/wang doubles in speed if you
                 -- do full laziness late in the day.  It only happens
                 -- after fusion and other stuff, so the early pass doesn't
@@ -1115,7 +1215,7 @@ dynamic_flags = [
   , Flag "dep-makefile"             (HasArg (upd . setDepMakefile)) Supported
   , Flag "optdep-f"                 (HasArg (upd . setDepMakefile))
          (Deprecated "Use -dep-makefile instead")
-  , Flag "optdep-w"                 (NoArg  (upd (setDepWarnings False)))
+  , Flag "optdep-w"                 (NoArg  (return ()))
          (Deprecated "-optdep-w doesn't do anything")
   , Flag "include-pkg-deps" (NoArg  (upd (setDepIncludePkgDeps True))) Supported
   , Flag "optdep--include-prelude"  (NoArg  (upd (setDepIncludePkgDeps True)))
@@ -1157,6 +1257,7 @@ dynamic_flags = [
   , Flag "hidir"          (HasArg (upd . setHiDir)) Supported
   , Flag "tmpdir"         (HasArg (upd . setTmpDir)) Supported
   , Flag "stubdir"        (HasArg (upd . setStubDir)) Supported
+  , Flag "outputdir"      (HasArg (upd . setOutputDir)) Supported
   , Flag "ddump-file-prefix" (HasArg (upd . setDumpPrefixForce . Just))
          Supported
 
@@ -1185,20 +1286,6 @@ dynamic_flags = [
   , Flag "no-recomp"      (NoArg (setDynFlag   Opt_ForceRecomp))
          (Deprecated "Use -fforce-recomp instead")
 
-        ------- Packages ----------------------------------------------------
-  , Flag "package-conf"   (HasArg extraPkgConf_) Supported
-  , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
-         Supported
-  , Flag "package-name"   (HasArg (upd . setPackageName)) Supported
-  , Flag "package"        (HasArg exposePackage) Supported
-  , Flag "hide-package"   (HasArg hidePackage) Supported
-  , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
-         Supported
-  , Flag "ignore-package" (HasArg ignorePackage)
-         Supported
-  , Flag "syslib"         (HasArg exposePackage)
-         (Deprecated "Use -package instead")
-
         ------ HsCpp opts ---------------------------------------------------
   , Flag "D"              (AnySuffix (upd . addOptP)) Supported
   , Flag "U"              (AnySuffix (upd . addOptP)) Supported
@@ -1319,6 +1406,8 @@ dynamic_flags = [
          Supported
   , Flag "ddump-hi-diffs"          (setDumpFlag Opt_D_dump_hi_diffs)
          Supported
+  , Flag "ddump-rtti"             (setDumpFlag Opt_D_dump_rtti)
+         Supported
 
   , Flag "dcore-lint"              (NoArg (setDynFlag Opt_DoCoreLinting))
          Supported
@@ -1329,7 +1418,7 @@ dynamic_flags = [
   , Flag "dasm-lint"               (NoArg (setDynFlag Opt_DoAsmLinting))
          Supported
   , Flag "dshow-passes"
-         (NoArg (do setDynFlag Opt_ForceRecomp
+         (NoArg (do forceRecompile
                     setVerbosity (Just 2)))
          Supported
   , Flag "dfaststring-stats"       (NoArg (setDynFlag Opt_D_faststring_stats))
@@ -1400,13 +1489,48 @@ dynamic_flags = [
          (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
          Supported
 
+        ------ Profiling ----------------------------------------------------
+
+  -- XXX Should the -f* flags be deprecated?
+  -- They don't seem to be documented
+  , Flag "fauto-sccs-on-all-toplevs"
+         (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+         Supported
+  , Flag "auto-all"
+         (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
+         Supported
+  , Flag "no-auto-all"
+         (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs))
+         Supported
+  , Flag "fauto-sccs-on-exported-toplevs"
+         (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+         Supported
+  , Flag "auto"
+         (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
+         Supported
+  , Flag "no-auto"
+         (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs))
+         Supported
+  , Flag "fauto-sccs-on-individual-cafs"
+         (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+         Supported
+  , Flag "caf-all"
+         (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
+         Supported
+  , Flag "no-caf-all"
+         (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs))
+         Supported
+
         ------ DPH flags ----------------------------------------------------
 
   , Flag "fdph-seq"
-         (NoArg (upd (setDPHBackend DPHSeq)))
+         (NoArg (setDPHBackend DPHSeq))
          Supported
   , Flag "fdph-par"
-         (NoArg (upd (setDPHBackend DPHPar)))
+         (NoArg (setDPHBackend DPHPar))
+         Supported
+  , Flag "fdph-this"
+         (NoArg (setDPHBackend DPHThis))
          Supported
 
         ------ Compiler flags -----------------------------------------------
@@ -1429,8 +1553,25 @@ dynamic_flags = [
  ++ map (mkFlag True  "X"    setDynFlag  ) xFlags
  ++ map (mkFlag False "XNo"  unSetDynFlag) xFlags
 
-mkFlag :: Bool -- True => turn it on, False => turn it off
-       -> String
+package_flags :: [Flag DynP]
+package_flags = [
+        ------- Packages ----------------------------------------------------
+    Flag "package-conf"   (HasArg extraPkgConf_) Supported
+  , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
+         Supported
+  , Flag "package-name"   (HasArg (upd . setPackageName)) Supported
+  , Flag "package"        (HasArg exposePackage) Supported
+  , Flag "hide-package"   (HasArg hidePackage) Supported
+  , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
+         Supported
+  , Flag "ignore-package" (HasArg ignorePackage)
+         Supported
+  , Flag "syslib"         (HasArg exposePackage)
+         (Deprecated "Use -package instead")
+  ]
+
+mkFlag :: Bool                  -- ^ True <=> it should be turned on
+       -> String                -- ^ The flag prefix
        -> (DynFlag -> DynP ())
        -> (String, DynFlag, Bool -> Deprecated)
        -> Flag DynP
@@ -1438,12 +1579,19 @@ mkFlag turnOn flagPrefix f (name, dynflag, deprecated)
     = Flag (flagPrefix ++ name) (NoArg (f dynflag)) (deprecated turnOn)
 
 deprecatedForLanguage :: String -> Bool -> Deprecated
-deprecatedForLanguage lang turnOn =
-    Deprecated ("Use the " ++ prefix ++ lang ++ " language instead")
-    where prefix = if turnOn then "" else "No"
-
--- these -f<blah> flags can all be reversed with -fno-<blah>
+deprecatedForLanguage lang turn_on
+    = Deprecated ("use -X"  ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ "#-} instead")
+    where 
+      flag | turn_on    = lang
+           | otherwise = "No"++lang
+
+useInstead :: String -> Bool -> Deprecated
+useInstead flag turn_on
+  = Deprecated ("Use -f" ++ no ++ flag ++ " instead")
+  where
+    no = if turn_on then "" else "no-"
 
+-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
 fFlags :: [(String, DynFlag, Bool -> Deprecated)]
 fFlags = [
   ( "warn-dodgy-foreign-imports",       Opt_WarnDodgyForeignImports, const Supported ),
@@ -1465,6 +1613,7 @@ fFlags = [
   ( "warn-unused-imports",              Opt_WarnUnusedImports, const Supported ),
   ( "warn-unused-matches",              Opt_WarnUnusedMatches, const Supported ),
   ( "warn-warnings-deprecations",       Opt_WarnWarningsDeprecations, const Supported ),
+  ( "warn-deprecations",                Opt_WarnWarningsDeprecations, const Supported ),
   ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, const Supported ),
   ( "warn-orphans",                     Opt_WarnOrphans, const Supported ),
   ( "warn-tabs",                        Opt_WarnTabs, const Supported ),
@@ -1485,17 +1634,22 @@ fFlags = [
   ( "unbox-strict-fields",              Opt_UnboxStrictFields, const Supported ),
   ( "method-sharing",                   Opt_MethodSharing, const Supported ),
   ( "dicts-cheap",                      Opt_DictsCheap, const Supported ),
+  ( "inline-if-enough-args",            Opt_InlineIfEnoughArgs, const Supported ),
   ( "excess-precision",                 Opt_ExcessPrecision, const Supported ),
+  ( "eager-blackholing",                Opt_EagerBlackHoling, const Supported ),
   ( "asm-mangling",                     Opt_DoAsmMangling, const Supported ),
   ( "print-bind-result",                Opt_PrintBindResult, const Supported ),
   ( "force-recomp",                     Opt_ForceRecomp, const Supported ),
   ( "hpc-no-auto",                      Opt_Hpc_No_Auto, const Supported ),
-  ( "rewrite-rules",                    Opt_RewriteRules, const Supported ),
+  ( "rewrite-rules",                    Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ),
+  ( "enable-rewrite-rules",             Opt_EnableRewriteRules, const Supported ),
   ( "break-on-exception",               Opt_BreakOnException, const Supported ),
   ( "break-on-error",                   Opt_BreakOnError, const Supported ),
   ( "print-evld-with-show",             Opt_PrintEvldWithShow, const Supported ),
   ( "print-bind-contents",              Opt_PrintBindContents, const Supported ),
-  ( "run-cps",                          Opt_RunCPSZ, const Supported ),
+  ( "run-cps",                          Opt_RunCPS, const Supported ),
+  ( "run-cpsz",                         Opt_RunCPSZ, const Supported ),
+  ( "new-codegen",                      Opt_TryNewCodeGen, const Supported ),
   ( "convert-to-zipper-and-back",       Opt_ConvertToZipCfgAndBack, const Supported ),
   ( "vectorise",                        Opt_Vectorise, const Supported ),
   ( "regs-graph",                       Opt_RegsGraph, const Supported ),
@@ -1544,7 +1698,7 @@ supportedLanguages = [ name | (name, _, _) <- xFlags ]
 languageOptions :: [DynFlag]
 languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ]
 
--- These -X<blah> flags can all be reversed with -XNo<blah>
+-- | These -X<blah> flags can all be reversed with -XNo<blah>
 xFlags :: [(String, DynFlag, Bool -> Deprecated)]
 xFlags = [
   ( "CPP",                              Opt_Cpp, const Supported ),
@@ -1555,7 +1709,6 @@ xFlags = [
   ( "PolymorphicComponents",            Opt_PolymorphicComponents, const Supported ),
   ( "ExistentialQuantification",        Opt_ExistentialQuantification, const Supported ),
   ( "KindSignatures",                   Opt_KindSignatures, const Supported ),
-  ( "PatternSignatures",                Opt_PatternSignatures, const Supported ),
   ( "EmptyDataDecls",                   Opt_EmptyDataDecls, const Supported ),
   ( "ParallelListComp",                 Opt_ParallelListComp, const Supported ),
   ( "TransformListComp",                Opt_TransformListComp, const Supported ),
@@ -1592,6 +1745,10 @@ xFlags = [
   ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules, const Supported ),
   ( "ImplicitParams",                   Opt_ImplicitParams, const Supported ),
   ( "ScopedTypeVariables",              Opt_ScopedTypeVariables, const Supported ),
+
+  ( "PatternSignatures",                Opt_ScopedTypeVariables, 
+    deprecatedForLanguage "ScopedTypeVariables" ),
+
   ( "UnboxedTuples",                    Opt_UnboxedTuples, const Supported ),
   ( "StandaloneDeriving",               Opt_StandaloneDeriving, const Supported ),
   ( "DeriveDataTypeable",               Opt_DeriveDataTypeable, const Supported ),
@@ -1604,15 +1761,18 @@ xFlags = [
   ( "GeneralizedNewtypeDeriving",       Opt_GeneralizedNewtypeDeriving, const Supported ),
   ( "OverlappingInstances",             Opt_OverlappingInstances, const Supported ),
   ( "UndecidableInstances",             Opt_UndecidableInstances, const Supported ),
-  ( "IncoherentInstances",              Opt_IncoherentInstances, const Supported )
+  ( "IncoherentInstances",              Opt_IncoherentInstances, const Supported ),
+  ( "PackageImports",                   Opt_PackageImports, const Supported ),
+  ( "NewQualifiedOperators",            Opt_NewQualifiedOperators, const Supported )
   ]
 
-impliedFlags :: [(DynFlag, [DynFlag])]
-impliedFlags = [
-   ( Opt_GADTs,               [Opt_RelaxedPolyRec] )    -- We want type-sig variables to
-                                                        --      be completely rigid for GADTs
- , ( Opt_ScopedTypeVariables, [Opt_RelaxedPolyRec] )    -- Ditto for scoped type variables; see
-                                                        --      Note [Scoped tyvars] in TcBinds
+impliedFlags :: [(DynFlag, DynFlag)]
+impliedFlags
+  = [ (Opt_GADTs,               Opt_RelaxedPolyRec)  -- We want type-sig variables to
+                                                     --      be completely rigid for GADTs
+
+    , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec)  -- Ditto for scoped type variables; see
+                                                     --      Note [Scoped tyvars] in TcBinds
   ]
 
 glasgowExtsFlags :: [DynFlag]
@@ -1646,15 +1806,36 @@ glasgowExtsFlags = [
            , Opt_ParallelListComp
            , Opt_EmptyDataDecls
            , Opt_KindSignatures
-           , Opt_PatternSignatures
            , Opt_GeneralizedNewtypeDeriving
            , Opt_TypeFamilies ]
 
 -- -----------------------------------------------------------------------------
 -- Parsing the dynamic flags.
 
-parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags, [String], [String])
-parseDynamicFlags dflags args = do
+-- | Parse dynamic flags from a list of command line arguments.  Returns the
+-- the parsed 'DynFlags', the left-over arguments, and a list of warnings.
+-- Throws a 'UsageError' if errors occurred during parsing (such as unknown
+-- flags or missing arguments).
+parseDynamicFlags :: Monad m =>
+                     DynFlags -> [Located String]
+                  -> m (DynFlags, [Located String], [Located String])
+                     -- ^ Updated 'DynFlags', left-over arguments, and
+                     -- list of warnings.
+parseDynamicFlags dflags args = parseDynamicFlags_ dflags args True
+
+-- | Like 'parseDynamicFlags' but does not allow the package flags (-package,
+-- -hide-package, -ignore-package, -hide-all-packages, -package-conf).
+parseDynamicNoPackageFlags :: Monad m =>
+                     DynFlags -> [Located String]
+                  -> m (DynFlags, [Located String], [Located String])
+                     -- ^ Updated 'DynFlags', left-over arguments, and
+                     -- list of warnings.
+parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False
+
+parseDynamicFlags_ :: Monad m =>
+                      DynFlags -> [Located String] -> Bool
+                  -> m (DynFlags, [Located String], [Located String])
+parseDynamicFlags_ dflags args pkg_flags = do
   -- XXX Legacy support code
   -- We used to accept things like
   --     optdep-f  -optdepdepend
@@ -1662,14 +1843,18 @@ parseDynamicFlags dflags args = do
   --     optdep -f -optdepdepend
   --     optdep -f -optdep depend
   -- but the spaces trip up proper argument handling. So get rid of them.
-  let f ("-optdep" : x : xs) = ("-optdep" ++ x) : f xs
+  let f (L p "-optdep" : L _ x : xs) = (L p ("-optdep" ++ x)) : f xs
       f (x : xs) = x : f xs
       f xs = xs
       args' = f args
+
+      -- Note: -ignore-package (package_flags) must precede -i* (dynamic_flags)
+      flag_spec | pkg_flags = package_flags ++ dynamic_flags
+                | otherwise = dynamic_flags
+
   let ((leftover, errs, warns), dflags')
-          = runCmdLine (processArgs dynamic_flags args') dflags
-  when (not (null errs)) $ do
-    ghcError (UsageError (unlines errs))
+          = runCmdLine (processArgs flag_spec args') dflags
+  when (not (null errs)) $ ghcError $ errorsToGhcException errs
   return (dflags', leftover, warns)
 
 type DynP = CmdLineP DynFlags
@@ -1681,10 +1866,13 @@ upd f = do
 
 --------------------------
 setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
-setDynFlag f = upd (\dfs -> foldl dopt_set (dopt_set dfs f) deps)
+setDynFlag f = do { upd (\dfs -> dopt_set dfs f)
+                 ; mapM_ setDynFlag deps }
   where
-    deps = [ d | (f', ds) <- impliedFlags, f' == f, d <- ds ]
+    deps = [ d | (f', d) <- impliedFlags, f' == f ]
         -- When you set f, set the ones it implies
+       -- NB: use setDynFlag recursively, in case the implied flags
+       --     implies further flags
         -- When you un-set f, however, we don't un-set the things it implies
         --      (except for -fno-glasgow-exts, which is treated specially)
 
@@ -1693,24 +1881,31 @@ unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
 --------------------------
 setDumpFlag :: DynFlag -> OptKind DynP
 setDumpFlag dump_flag
-  | force_recomp   = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag)
-  | otherwise      = NoArg (setDynFlag dump_flag)
+  = NoArg (setDynFlag dump_flag >> when want_recomp forceRecompile)
   where
-        -- Whenver we -ddump, switch off the recompilation checker,
-        -- else you don't see the dump!
-        -- However, certain dumpy-things are really interested in what's going
+       -- Certain dumpy-things are really interested in what's going
         -- on during recompilation checking, so in those cases we
         -- don't want to turn it off.
-   force_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,
-                                       Opt_D_dump_hi_diffs]
+    want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,
+                                      Opt_D_dump_hi_diffs]
+
+forceRecompile :: DynP ()
+-- Whenver we -ddump, force recompilation (by switching off the 
+-- recompilation checker), else you don't see the dump! However, 
+-- don't switch it off in --make mode, else *everything* gets
+-- recompiled which probably isn't what you want
+forceRecompile = do { dfs <- getCmdLineState
+                   ; when (force_recomp dfs) (setDynFlag Opt_ForceRecomp) }
+       where
+         force_recomp dfs = isOneShot (ghcMode dfs)
 
 setVerboseCore2Core :: DynP ()
-setVerboseCore2Core = do setDynFlag Opt_ForceRecomp
-                         setDynFlag Opt_D_verbose_core2core
+setVerboseCore2Core = do setDynFlag Opt_D_verbose_core2core 
+                        forceRecompile
                          upd (\s -> s { shouldDumpSimplPhase = const True })
 
 setDumpSimplPhases :: String -> DynP ()
-setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp
+setDumpSimplPhases s = do forceRecompile
                           upd (\s -> s { shouldDumpSimplPhase = spec })
   where
     spec :: SimplifierMode -> Bool
@@ -1805,20 +2000,38 @@ setOptLevel n dflags
 --    -fdicts-cheap                     always inline dictionaries
 --    -fmax-simplifier-iterations20     this is necessary sometimes
 --    -fno-spec-constr-threshold        run SpecConstr even for big loops
+--    -fno-spec-constr-count            SpecConstr as much as possible
+--    -finline-enough-args              hack to prevent excessive inlining
 --
 setDPHOpt :: DynFlags -> DynFlags
 setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
                                          , specConstrThreshold = Nothing
+                                         , specConstrCount     = Nothing
                                          })
                    `dopt_set`   Opt_DictsCheap
                    `dopt_unset` Opt_MethodSharing
+                   `dopt_set`   Opt_InlineIfEnoughArgs
 
 data DPHBackend = DPHPar
                 | DPHSeq
+                | DPHThis
+        deriving(Eq, Ord, Enum, Show)
+
+setDPHBackend :: DPHBackend -> DynP ()
+setDPHBackend backend 
+  = do
+      upd $ \dflags -> dflags { dphBackend = backend }
+      mapM_ exposePackage (dph_packages backend)
+  where
+    dph_packages DPHThis = []
+    dph_packages DPHPar  = ["dph-prim-par", "dph-par"]
+    dph_packages DPHSeq  = ["dph-prim-seq", "dph-seq"]
 
-setDPHBackend :: DPHBackend -> DynFlags -> DynFlags
-setDPHBackend backend dflags = dflags { dphBackend = backend }
-
+dphPackage :: DynFlags -> PackageId
+dphPackage dflags = case dphBackend dflags of
+                      DPHPar  -> dphParPackageId
+                      DPHSeq  -> dphSeqPackageId
+                      DPHThis -> thisPackage dflags
 
 setMainIs :: String -> DynP ()
 setMainIs arg
@@ -1835,6 +2048,13 @@ setMainIs arg
   where
     (main_mod, main_fn) = splitLongestPrefix arg (== '.')
 
+-- | Get the unqualified name of the function to use as the \"main\" for the main module.
+-- Either returns the default name or the one configured on the command line with -main-is
+getMainFun :: DynFlags -> RdrName
+getMainFun dflags = case (mainFunIs dflags) of
+    Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn))
+    Nothing -> main_RDR_Unqual
+
 -----------------------------------------------------------------------------
 -- Paths & Libraries
 
@@ -2033,18 +2253,18 @@ picCCOpts _dflags
       --     in dynamic libraries.
 
     | opt_PIC
-        = ["-fno-common", "-D__PIC__"]
+        = ["-fno-common", "-U __PIC__","-D__PIC__"]
     | otherwise
         = ["-mdynamic-no-pic"]
 #elif mingw32_TARGET_OS
       -- no -fPIC for Windows
     | opt_PIC
-        = ["-D__PIC__"]
+        = ["-U __PIC__","-D__PIC__"]
     | otherwise
         = []
 #else
     | opt_PIC
-        = ["-fPIC", "-D__PIC__"]
+        = ["-fPIC", "-U __PIC__", "-D__PIC__"]
     | otherwise
         = []
 #endif