Move all the CoreToDo stuff into CoreMonad
[ghc-hetmet.git] / compiler / main / DynFlags.hs
index 1e405ea..4ba19b0 100644 (file)
@@ -1,4 +1,3 @@
-
 -- |
 -- Dynamic flags
 --
@@ -18,10 +17,11 @@ module DynFlags (
         GhcMode(..), isOneShot,
         GhcLink(..), isNoLink,
         PackageFlag(..),
-        Option(..),
+        Option(..), showOpt,
         DynLibLoader(..),
         fFlags, xFlags,
         dphPackage,
+        wayNames,
 
         -- ** Manipulating DynFlags
         defaultDynFlags,                -- DynFlags
@@ -31,10 +31,10 @@ module DynFlags (
         dopt_set, dopt_unset,           -- DynFlags -> DynFlag -> DynFlags
         getOpts,                        -- DynFlags -> (DynFlags -> [a]) -> [a]
         getVerbFlag,
-        getMainFun,
         updOptLevel,
         setTmpDir,
         setPackageName,
+        doingTickyProfiling,
 
         -- ** Parsing DynFlags
         parseDynamicFlags,
@@ -46,52 +46,43 @@ module DynFlags (
         -- ** DynFlag C compiler options
         machdepCCOpts, picCCOpts,
 
-        -- * 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
+        Printable(..),
         compilerInfo
   ) where
 
 #include "HsVersions.h"
 
+#ifndef OMIT_NATIVE_CODEGEN
+import Platform
+#endif
 import Module
 import PackageConfig
-import PrelNames        ( mAIN, main_RDR_Unqual )
-import RdrName          ( RdrName, mkRdrUnqual )
-import OccName          ( mkVarOccFS )
-#ifdef i386_TARGET_ARCH
-import StaticFlags      ( opt_Static )
-#endif
-import StaticFlags      ( opt_PIC, WayName(..), v_Ways, v_Build_tag,
-                          v_RTS_Build_tag )
+import PrelNames        ( mAIN )
+import StaticFlags
 import {-# SOURCE #-} Packages (PackageState)
 import DriverPhases     ( Phase(..), phaseInputExt )
 import Config
 import CmdLineParser
 import Constants        ( mAX_CONTEXT_REDUCTION_DEPTH )
 import Panic
-import UniqFM           ( UniqFM )
 import Util
 import Maybes           ( orElse )
 import SrcLoc
 import FastString
+import FiniteMap
 import Outputable
 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 
-import Data.IORef       ( readIORef )
+import Data.IORef
 import Control.Monad    ( when )
 
 import Data.Char
-import Data.List        ( intersperse )
+import Data.List
 import System.FilePath
 import System.IO        ( stderr, hPutChar )
 
@@ -115,6 +106,7 @@ data DynFlag
    | Opt_D_dump_asm_regalloc_stages
    | Opt_D_dump_asm_conflicts
    | Opt_D_dump_asm_stats
+   | Opt_D_dump_asm_expanded
    | Opt_D_dump_cpranal
    | Opt_D_dump_deriv
    | Opt_D_dump_ds
@@ -183,11 +175,16 @@ data DynFlag
    | Opt_WarnUnusedMatches
    | Opt_WarnWarningsDeprecations
    | Opt_WarnDeprecatedFlags
+   | Opt_WarnDodgyExports
    | Opt_WarnDodgyImports
    | Opt_WarnOrphans
    | Opt_WarnTabs
    | Opt_WarnUnrecognisedPragmas
    | Opt_WarnDodgyForeignImports
+   | Opt_WarnLazyUnliftedBindings
+   | Opt_WarnUnusedDoBind
+   | Opt_WarnWrongDoBind
+
 
    -- language opts
    | Opt_OverlappingInstances
@@ -195,9 +192,11 @@ data DynFlag
    | Opt_IncoherentInstances
    | Opt_MonomorphismRestriction
    | Opt_MonoPatBinds
+   | Opt_MonoLocalBinds
    | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
    | Opt_ForeignFunctionInterface
    | Opt_UnliftedFFITypes
+   | Opt_GHCForeignImportPrim
    | Opt_PArr                           -- Syntactic support for parallel arrays
    | Opt_Arrows                         -- Arrow-notation syntax
    | Opt_TemplateHaskell
@@ -216,8 +215,14 @@ data DynFlag
    | Opt_ViewPatterns
    | Opt_GADTs
    | Opt_RelaxedPolyRec
+   | Opt_NPlusKPatterns
+
    | Opt_StandaloneDeriving
    | Opt_DeriveDataTypeable
+   | Opt_DeriveFunctor
+   | Opt_DeriveTraversable
+   | Opt_DeriveFoldable
+
    | Opt_TypeSynonymInstances
    | Opt_FlexibleContexts
    | Opt_FlexibleInstances
@@ -234,7 +239,9 @@ data DynFlag
    | Opt_TransformListComp
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo
+   | Opt_DoRec
    | Opt_PostfixOperators
+   | Opt_TupleSections
    | Opt_PatternGuards
    | Opt_LiberalTypeSynonyms
    | Opt_Rank2Types
@@ -243,18 +250,20 @@ data DynFlag
    | Opt_TypeOperators
    | Opt_PackageImports
    | Opt_NewQualifiedOperators
+   | Opt_ExplicitForAll
+   | Opt_AlternativeLayoutRule
 
    | Opt_PrintExplicitForalls
 
    -- optimisation opts
    | Opt_Strictness
    | Opt_FullLaziness
+   | Opt_FloatIn
+   | Opt_Specialise
    | Opt_StaticArgumentTransformation
    | Opt_CSE
    | Opt_LiberateCase
    | Opt_SpecConstr
-   | Opt_IgnoreInterfacePragmas
-   | Opt_OmitInterfacePragmas
    | Opt_DoLambdaEtaExpansion
    | Opt_IgnoreAsserts
    | Opt_DoEtaReduction
@@ -262,12 +271,16 @@ data DynFlag
    | Opt_UnboxStrictFields
    | Opt_MethodSharing
    | Opt_DictsCheap
-   | 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
 
+   -- Interface files
+   | Opt_IgnoreInterfacePragmas
+   | Opt_OmitInterfacePragmas
+   | Opt_ExposeAllUnfoldings
+
    -- profiling opts
    | Opt_AutoSccsOnAllToplevs
    | Opt_AutoSccsOnExportedToplevs
@@ -296,6 +309,9 @@ data DynFlag
    | Opt_PrintBindContents
    | Opt_GenManifest
    | Opt_EmbedManifest
+   | Opt_EmitExternalCore
+   | Opt_SharedImplib
+   | Opt_BuildingCabalPackage
 
        -- temporary flags
    | Opt_RunCPS
@@ -320,22 +336,24 @@ data DynFlag
 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 .hcr output file
-  verbosity             :: Int,         -- ^ Verbosity level: see "DynFlags#verbosity_levels"
+  verbosity             :: Int,         -- ^ Verbosity level: see Note [Verbosity levels]
   optLevel              :: Int,         -- ^ Optimisation level
   simplPhases           :: Int,         -- ^ Number of simplifier phases
   maxSimplIterations    :: Int,         -- ^ Max simplifier iterations
-  shouldDumpSimplPhase  :: SimplifierMode -> Bool,
+  shouldDumpSimplPhase  :: Maybe String,
   ruleCheck             :: Maybe String,
+  strictnessBefore      :: [Int],       -- ^ Additional demand analysis
 
   specConstrThreshold   :: Maybe Int,   -- ^ Threshold for SpecConstr
   specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function
   liberateCaseThreshold :: Maybe Int,   -- ^ Threshold for LiberateCase
 
+#ifndef OMIT_NATIVE_CODEGEN
+  targetPlatform       :: Platform,    -- ^ The platform we're compiling for. Used by the NCG.
+#endif
   stolen_x86_regs       :: Int,
   cmdlineHcIncludes     :: [String],    -- ^ @\-\#includes@
   importPaths           :: [FilePath],
@@ -348,7 +366,7 @@ data DynFlags = DynFlags {
   thisPackage           :: PackageId,   -- ^ name of package currently being compiled
 
   -- ways
-  wayNames              :: [WayName],   -- ^ Way flags from the command line
+  ways                  :: [Way],       -- ^ Way flags from the command line
   buildTag              :: String,      -- ^ The global \"way\" (e.g. \"p\" for prof)
   rtsBuildTag           :: String,      -- ^ The RTS \"way\"
 
@@ -357,6 +375,7 @@ data DynFlags = DynFlags {
 
   -- paths etc.
   objectDir             :: Maybe String,
+  dylibInstallName      :: Maybe String,
   hiDir                 :: Maybe String,
   stubDir               :: Maybe String,
 
@@ -430,9 +449,15 @@ data DynFlags = DynFlags {
   -- Package state
   -- NB. do not modify this field, it is calculated by
   -- Packages.initPackages and Packages.updatePackages.
-  pkgDatabase           :: Maybe (UniqFM PackageConfig),
+  pkgDatabase           :: Maybe [PackageConfig],
   pkgState              :: PackageState,
 
+  -- Temporary files
+  -- These have to be IORefs, because the defaultCleanupHandler needs to
+  -- know what to clean when an exception happens
+  filesToClean          :: IORef [FilePath],
+  dirsToClean           :: IORef (FiniteMap FilePath FilePath),
+
   -- hsc dynamic flags
   flags                 :: [DynFlag],
 
@@ -442,6 +467,9 @@ data DynFlags = DynFlags {
   haddockOptions :: Maybe String
  }
 
+wayNames :: DynFlags -> [WayName]
+wayNames = map wayName . ways
+
 -- | The target code type of the compilation (if any).
 --
 -- Whenever you change the target, also make sure to set 'ghcLink' to
@@ -510,8 +538,16 @@ isNoLink :: GhcLink -> Bool
 isNoLink NoLink = True
 isNoLink _      = False
 
+-- Is it worth evaluating this Bool and caching it in the DynFlags value
+-- during initDynFlags?
+doingTickyProfiling :: DynFlags -> Bool
+doingTickyProfiling _ = opt_Ticky
+  -- XXX -ticky is a static flag, because it implies -debug which is also
+  -- static.  If the way flags were made dynamic, we could fix this.
+
 data PackageFlag
   = ExposePackage  String
+  | ExposePackageId String
   | HidePackage    String
   | IgnorePackage  String
   deriving Eq
@@ -537,12 +573,14 @@ initDynFlags :: DynFlags -> IO DynFlags
 initDynFlags dflags = do
  -- someday these will be dynamic flags
  ways <- readIORef v_Ways
- build_tag <- readIORef v_Build_tag
- rts_build_tag <- readIORef v_RTS_Build_tag
+ refFilesToClean <- newIORef []
+ refDirsToClean <- newIORef emptyFM
  return dflags{
-        wayNames        = ways,
-        buildTag        = build_tag,
-        rtsBuildTag     = rts_build_tag
+        ways            = ways,
+        buildTag        = mkBuildTag (filter (not . wayRTSOnly) ways),
+        rtsBuildTag     = mkBuildTag ways,
+        filesToClean    = refFilesToClean,
+        dirsToClean     = refDirsToClean
         }
 
 -- | The normal 'DynFlags'. Note that they is not suitable for use in this form
@@ -552,8 +590,6 @@ defaultDynFlags =
      DynFlags {
         ghcMode                 = CompManager,
         ghcLink                 = LinkBinary,
-        coreToDo                = Nothing,
-        stgToDo                 = Nothing,
         hscTarget               = defaultHscTarget,
         hscOutName              = "",
         extCoreName             = "",
@@ -561,11 +597,16 @@ defaultDynFlags =
         optLevel                = 0,
         simplPhases             = 2,
         maxSimplIterations      = 4,
-        shouldDumpSimplPhase    = const False,
+        shouldDumpSimplPhase    = Nothing,
         ruleCheck               = Nothing,
         specConstrThreshold     = Just 200,
         specConstrCount         = Just 3,
         liberateCaseThreshold   = Just 200,
+        strictnessBefore        = [],
+
+#ifndef OMIT_NATIVE_CODEGEN
+        targetPlatform          = defaultTargetPlatform,
+#endif
         stolen_x86_regs         = 4,
         cmdlineHcIncludes       = [],
         importPaths             = ["."],
@@ -578,6 +619,7 @@ defaultDynFlags =
         thisPackage             = mainPackageId,
 
         objectDir               = Nothing,
+        dylibInstallName        = Nothing,
         hiDir                   = Nothing,
         stubDir                 = Nothing,
 
@@ -587,7 +629,7 @@ defaultDynFlags =
 
         outputFile              = Nothing,
         outputHi                = Nothing,
-        dynLibLoader            = Deployable,
+        dynLibLoader            = SystemDependent,
         dumpPrefix              = Nothing,
         dumpPrefixForce         = Nothing,
         includePaths            = [],
@@ -613,7 +655,7 @@ defaultDynFlags =
         packageFlags            = [],
         pkgDatabase             = Nothing,
         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
-        wayNames                = panic "defaultDynFlags: No wayNames",
+        ways                    = panic "defaultDynFlags: No ways",
         buildTag                = panic "defaultDynFlags: No buildTag",
         rtsBuildTag             = panic "defaultDynFlags: No rtsBuildTag",
         splitInfo               = Nothing,
@@ -641,6 +683,8 @@ defaultDynFlags =
         depExcludeMods    = [],
         depSuffixes       = [],
         -- end of ghc -M values
+        filesToClean   = panic "defaultDynFlags: No filesToClean",
+        dirsToClean    = panic "defaultDynFlags: No dirsToClean",
         haddockOptions = Nothing,
         flags = [
             Opt_AutoLinkPackages,
@@ -652,11 +696,14 @@ defaultDynFlags =
 
             Opt_ImplicitPrelude,
             Opt_MonomorphismRestriction,
+            Opt_NPlusKPatterns,
 
             Opt_MethodSharing,
 
             Opt_DoAsmMangling,
 
+            Opt_SharedImplib,
+
             Opt_GenManifest,
             Opt_EmbedManifest,
             Opt_PrintBindContents
@@ -678,9 +725,8 @@ defaultDynFlags =
       }
 
 {-
-    #verbosity_levels#
-    Verbosity levels:
-
+Note [Verbosity levels]
+~~~~~~~~~~~~~~~~~~~~~~~
     0   |   print errors & warnings only
     1   |   minimal verbosity: print "compiling M ... done." for each module.
     2   |   equivalent to -dshow-passes
@@ -715,7 +761,7 @@ getVerbFlag dflags
   | verbosity dflags >= 3  = "-v"
   | otherwise =  ""
 
-setObjectDir, setHiDir, setStubDir, setOutputDir,
+setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName,
          setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
          setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
          addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres,
@@ -730,6 +776,7 @@ 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
+setDylibInstallName  f d = d{ dylibInstallName = Just f}
 
 setObjectSuf  f d = d{ objectSuf  = f}
 setHiSuf      f d = d{ hiSuf      = f}
@@ -789,7 +836,7 @@ addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d }
 -- We used to use "-optdep-flag -optdeparg", so for legacy applications
 -- we need to strip the "-optdep" off of the arg
 deOptDep :: String -> String
-deOptDep x = case maybePrefixMatch "-optdep" x of
+deOptDep x = case stripPrefix "-optdep" x of
              Just rest -> rest
              Nothing -> x
 
@@ -813,6 +860,10 @@ data Option
               String  -- the filepath/filename portion
  | Option     String
 
+showOpt :: Option -> String
+showOpt (FileOption pre f) = pre ++ f
+showOpt (Option s)  = s
+
 -----------------------------------------------------------------------------
 -- Setting the optimisation level
 
@@ -841,6 +892,8 @@ optLevelFlags
     , ([1,2],   Opt_Strictness)
     , ([1,2],   Opt_CSE)
     , ([1,2],   Opt_FullLaziness)
+    , ([1,2],   Opt_Specialise)
+    , ([1,2],   Opt_FloatIn)
 
     , ([2],     Opt_LiberateCase)
     , ([2],     Opt_SpecConstr)
@@ -874,7 +927,9 @@ standardWarnings
         Opt_WarnMissingFields,
         Opt_WarnMissingMethods,
         Opt_WarnDuplicateExports,
-        Opt_WarnDodgyForeignImports
+        Opt_WarnLazyUnliftedBindings,
+        Opt_WarnDodgyForeignImports,
+        Opt_WarnWrongDoBind
       ]
 
 minusWOpts :: [DynFlag]
@@ -884,6 +939,7 @@ minusWOpts
         Opt_WarnUnusedMatches,
         Opt_WarnUnusedImports,
         Opt_WarnIncompletePatterns,
+        Opt_WarnDodgyExports,
         Opt_WarnDodgyImports
       ]
 
@@ -894,7 +950,8 @@ minusWallOpts
         Opt_WarnNameShadowing,
         Opt_WarnMissingSigs,
         Opt_WarnHiShadows,
-        Opt_WarnOrphans
+        Opt_WarnOrphans,
+        Opt_WarnUnusedDoBind
       ]
 
 -- minuswRemovesOpts should be every warning option
@@ -910,235 +967,6 @@ minuswRemovesOpts
       ]
 
 -- -----------------------------------------------------------------------------
--- CoreToDo:  abstraction of core-to-core passes to run.
-
-data CoreToDo           -- These are diff core-to-core passes,
-                        -- which may be invoked in any order,
-                        -- as many times as you like.
-
-  = CoreDoSimplify      -- The core-to-core simplifier.
-        SimplifierMode
-        [SimplifierSwitch]
-                        -- Each run of the simplifier can take a different
-                        -- set of simplifier-specific flags.
-  | CoreDoFloatInwards
-  | CoreDoFloatOutwards FloatOutSwitches
-  | CoreLiberateCase
-  | CoreDoPrintCore
-  | CoreDoStaticArgs
-  | CoreDoStrictness
-  | CoreDoWorkerWrapper
-  | CoreDoSpecialising
-  | CoreDoSpecConstr
-  | CoreDoOldStrictness
-  | CoreDoGlomBinds
-  | CoreCSE
-  | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
-                                                -- matching this string
-  | 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 = 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:
-runWhen :: Bool -> CoreToDo -> CoreToDo
-runWhen True  do_this = do_this
-runWhen False _       = CoreDoNothing
-
-runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo
-runMaybe (Just x) f = f x
-runMaybe Nothing  _ = CoreDoNothing
-
-getCoreToDo :: DynFlags -> [CoreToDo]
-getCoreToDo dflags
-  | Just todo <- coreToDo dflags = todo -- set explicitly by user
-  | otherwise = core_todo
-  where
-    opt_level     = optLevel dflags
-    phases        = simplPhases dflags
-    max_iter      = maxSimplIterations dflags
-    strictness    = dopt Opt_Strictness dflags
-    full_laziness = dopt Opt_FullLaziness dflags
-    cse           = dopt Opt_CSE dflags
-    spec_constr   = dopt Opt_SpecConstr dflags
-    liberate_case = dopt Opt_LiberateCase dflags
-    rule_check    = ruleCheck dflags
-    static_args   = dopt Opt_StaticArgumentTransformation dflags
-
-    maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
-
-    simpl_phase phase names iter
-      = CoreDoPasses
-          [ CoreDoSimplify (SimplPhase phase names) [
-              MaxSimplifierIterations iter
-            ],
-            maybe_rule_check phase
-          ]
-
-    vectorisation
-      = runWhen (dopt Opt_Vectorise dflags)
-        $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphPackage dflags) ]
-
-
-                -- By default, we have 2 phases before phase 0.
-
-                -- Want to run with inline phase 2 after the specialiser to give
-                -- maximum chance for fusion to work before we inline build/augment
-                -- in phase 1.  This made a difference in 'ansi' where an
-                -- overloaded function wasn't inlined till too late.
-
-                -- Need phase 1 so that build/augment get
-                -- inlined.  I found that spectral/hartel/genfft lost some useful
-                -- strictness in the function sumcode' if augment is not inlined
-                -- before strictness analysis runs
-    simpl_phases = CoreDoPasses [ simpl_phase phase ["main"] max_iter
-                                  | phase <- [phases, phases-1 .. 1] ]
-
-
-        -- initial simplify: mk specialiser happy: minimum effort please
-    simpl_gently = CoreDoSimplify SimplGently [
-                        --      Simplify "gently"
-                        -- Don't inline anything till full laziness has bitten
-                        -- In particular, inlining wrappers inhibits floating
-                        -- e.g. ...(case f x of ...)...
-                        --  ==> ...(case (case x of I# x# -> fw x#) of ...)...
-                        --  ==> ...(case x of I# x# -> case fw x# of ...)...
-                        -- and now the redex (f x) isn't floatable any more
-                        -- Similarly, don't apply any rules until after full
-                        -- laziness.  Notably, list fusion can prevent floating.
-
-            NoCaseOfCase,       -- Don't do case-of-case transformations.
-                                -- This makes full laziness work better
-            MaxSimplifierIterations max_iter
-        ]
-
-    core_todo =
-     if opt_level == 0 then
-       [vectorisation,
-        simpl_phase 0 ["final"] max_iter]
-     else {- opt_level >= 1 -} [
-
-    -- We want to do the static argument transform before full laziness as it
-    -- may expose extra opportunities to float things outwards. However, to fix
-    -- up the output of the transformation we need at do at least one simplify
-    -- after this before anything else
-        runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]),
-
-        -- We run vectorisation here for now, but we might also try to run
-        -- it later
-        vectorisation,
-
-        -- initial simplify: mk specialiser happy: minimum effort please
-        simpl_gently,
-
-        -- Specialisation is best done before full laziness
-        -- so that overloaded functions have all their dictionary lambdas manifest
-        CoreDoSpecialising,
-
-        runWhen full_laziness (CoreDoFloatOutwards gentleFloatOutSwitches),
-
-        CoreDoFloatInwards,
-
-        simpl_phases,
-
-                -- Phase 0: allow all Ids to be inlined now
-                -- This gets foldr inlined before strictness analysis
-
-                -- At least 3 iterations because otherwise we land up with
-                -- huge dead expressions because of an infelicity in the
-                -- simpifier.
-                --      let k = BIG in foldr k z xs
-                -- ==>  let k = BIG in letrec go = \xs -> ...(k x).... in go xs
-                -- ==>  let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
-                -- Don't stop now!
-        simpl_phase 0 ["main"] (max max_iter 3),
-
-
-#ifdef OLD_STRICTNESS
-        CoreDoOldStrictness,
-#endif
-        runWhen strictness (CoreDoPasses [
-                CoreDoStrictness,
-                CoreDoWorkerWrapper,
-                CoreDoGlomBinds,
-                simpl_phase 0 ["post-worker-wrapper"] max_iter
-                ]),
-
-        runWhen full_laziness
-          (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
-                -- catch it.  For the record, the redex is
-                --        f_el22 (f_el21 r_midblock)
-
-
-        runWhen cse CoreCSE,
-                -- We want CSE to follow the final full-laziness pass, because it may
-                -- succeed in commoning up things floated out by full laziness.
-                -- CSE used to rely on the no-shadowing invariant, but it doesn't any more
-
-        CoreDoFloatInwards,
-
-        maybe_rule_check 0,
-
-                -- Case-liberation for -O2.  This should be after
-                -- strictness analysis and the simplification which follows it.
-        runWhen liberate_case (CoreDoPasses [
-            CoreLiberateCase,
-            simpl_phase 0 ["post-liberate-case"] max_iter
-            ]),         -- Run the simplifier after LiberateCase to vastly
-                        -- reduce the possiblility of shadowing
-                        -- Reason: see Note [Shadowing] in SpecConstr.lhs
-
-        runWhen spec_constr CoreDoSpecConstr,
-
-        maybe_rule_check 0,
-
-        -- Final clean-up simplification:
-        simpl_phase 0 ["final"] max_iter
-     ]
-
--- -----------------------------------------------------------------------------
 -- StgToDo:  abstraction of stg-to-stg passes to run.
 
 data StgToDo
@@ -1149,8 +977,7 @@ data StgToDo
 
 getStgToDo :: DynFlags -> [StgToDo]
 getStgToDo dflags
-  | Just todo <- stgToDo dflags = todo -- set explicitly by user
-  | otherwise = todo2
+  = todo2
   where
         stg_stats = dopt Opt_StgStats dflags
 
@@ -1180,7 +1007,8 @@ dynamic_flags = [
     Flag "n"              (NoArg  (setDynFlag Opt_DryRun)) Supported
   , Flag "cpp"            (NoArg  (setDynFlag Opt_Cpp)) Supported
   , Flag "F"              (NoArg  (setDynFlag Opt_Pp)) Supported
-  , Flag "#include"       (HasArg (addCmdlineHCInclude)) Supported
+  , Flag "#include"       (HasArg (addCmdlineHCInclude))
+                             (Deprecated "No longer has any effect")
   , Flag "v"              (OptIntSuffix setVerbosity) Supported
 
         ------- Specific phases  --------------------------------------------
@@ -1237,6 +1065,7 @@ dynamic_flags = [
          Supported
   , Flag "dynload"        (HasArg (upd . parseDynLibLoaderMode))
          Supported
+  , Flag "dylib-install-name" (HasArg (upd . setDylibInstallName)) Supported
 
         ------- Libraries ---------------------------------------------------
   , Flag "L"              (Prefix addLibraryPath ) Supported
@@ -1324,6 +1153,8 @@ dynamic_flags = [
          Supported
   , Flag "ddump-asm-stats"         (setDumpFlag Opt_D_dump_asm_stats)
          Supported
+  , Flag "ddump-asm-expanded"      (setDumpFlag Opt_D_dump_asm_expanded)
+         Supported
   , Flag "ddump-cpranal"           (setDumpFlag Opt_D_dump_cpranal)
          Supported
   , Flag "ddump-deriv"             (setDumpFlag Opt_D_dump_deriv)
@@ -1386,7 +1217,8 @@ dynamic_flags = [
          Supported
   , Flag "dsource-stats"           (setDumpFlag Opt_D_source_stats)
          Supported
-  , Flag "dverbose-core2core"      (NoArg setVerboseCore2Core)
+  , Flag "dverbose-core2core"      (NoArg (do { setVerbosity (Just 2)
+                                              ; setVerboseCore2Core }))
          Supported
   , Flag "dverbose-stg2stg"        (setDumpFlag Opt_D_verbose_stg2stg)
          Supported
@@ -1489,6 +1321,10 @@ dynamic_flags = [
          (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
          Supported
 
+  , Flag "fstrictness-before"
+         (IntSuffix (\n -> upd (\dfs -> dfs{ strictnessBefore = n : strictnessBefore dfs })))
+         Supported
+
         ------ Profiling ----------------------------------------------------
 
   -- XXX Should the -f* flags be deprecated?
@@ -1560,6 +1396,7 @@ package_flags = [
   , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
          Supported
   , Flag "package-name"   (HasArg (upd . setPackageName)) Supported
+  , Flag "package-id"     (HasArg exposePackageId) Supported
   , Flag "package"        (HasArg exposePackage) Supported
   , Flag "hide-package"   (HasArg hidePackage) Supported
   , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
@@ -1580,7 +1417,7 @@ mkFlag turnOn flagPrefix f (name, dynflag, deprecated)
 
 deprecatedForLanguage :: String -> Bool -> Deprecated
 deprecatedForLanguage lang turn_on
-    = Deprecated ("use -X"  ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ "#-} instead")
+    = Deprecated ("use -X"  ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead")
     where 
       flag | turn_on    = lang
            | otherwise = "No"++lang
@@ -1595,6 +1432,7 @@ useInstead flag turn_on
 fFlags :: [(String, DynFlag, Bool -> Deprecated)]
 fFlags = [
   ( "warn-dodgy-foreign-imports",       Opt_WarnDodgyForeignImports, const Supported ),
+  ( "warn-dodgy-exports",               Opt_WarnDodgyExports, const Supported ),
   ( "warn-dodgy-imports",               Opt_WarnDodgyImports, const Supported ),
   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports, const Supported ),
   ( "warn-hi-shadowing",                Opt_WarnHiShadows, const Supported ),
@@ -1618,8 +1456,14 @@ fFlags = [
   ( "warn-orphans",                     Opt_WarnOrphans, const Supported ),
   ( "warn-tabs",                        Opt_WarnTabs, const Supported ),
   ( "warn-unrecognised-pragmas",        Opt_WarnUnrecognisedPragmas, const Supported ),
+  ( "warn-lazy-unlifted-bindings",      Opt_WarnLazyUnliftedBindings,
+    const $ Deprecated "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"),
+  ( "warn-unused-do-bind",              Opt_WarnUnusedDoBind, const Supported ),
+  ( "warn-wrong-do-bind",               Opt_WarnWrongDoBind, const Supported ),
   ( "print-explicit-foralls",           Opt_PrintExplicitForalls, const Supported ),
   ( "strictness",                       Opt_Strictness, const Supported ),
+  ( "specialise",                       Opt_Specialise, const Supported ),
+  ( "float-in",                         Opt_FloatIn, const Supported ),
   ( "static-argument-transformation",   Opt_StaticArgumentTransformation, const Supported ),
   ( "full-laziness",                    Opt_FullLaziness, const Supported ),
   ( "liberate-case",                    Opt_LiberateCase, const Supported ),
@@ -1627,6 +1471,7 @@ fFlags = [
   ( "cse",                              Opt_CSE, const Supported ),
   ( "ignore-interface-pragmas",         Opt_IgnoreInterfacePragmas, const Supported ),
   ( "omit-interface-pragmas",           Opt_OmitInterfacePragmas, const Supported ),
+  ( "expose-all-unfoldings",            Opt_ExposeAllUnfoldings, const Supported ),
   ( "do-lambda-eta-expansion",          Opt_DoLambdaEtaExpansion, const Supported ),
   ( "ignore-asserts",                   Opt_IgnoreAsserts, const Supported ),
   ( "do-eta-reduction",                 Opt_DoEtaReduction, const Supported ),
@@ -1634,7 +1479,6 @@ 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 ),
@@ -1688,6 +1532,9 @@ fFlags = [
     deprecatedForLanguage "IncoherentInstances" ),
   ( "gen-manifest",                     Opt_GenManifest, const Supported ),
   ( "embed-manifest",                   Opt_EmbedManifest, const Supported ),
+  ( "ext-core",                         Opt_EmitExternalCore, const Supported ),
+  ( "shared-implib",                    Opt_SharedImplib, const Supported ),
+  ( "building-cabal-package",           Opt_BuildingCabalPackage, const Supported ),
   ( "implicit-import-qualified",        Opt_ImplicitImportQualified, const Supported )
   ]
 
@@ -1703,6 +1550,7 @@ xFlags :: [(String, DynFlag, Bool -> Deprecated)]
 xFlags = [
   ( "CPP",                              Opt_Cpp, const Supported ),
   ( "PostfixOperators",                 Opt_PostfixOperators, const Supported ),
+  ( "TupleSections",                    Opt_TupleSections, const Supported ),
   ( "PatternGuards",                    Opt_PatternGuards, const Supported ),
   ( "UnicodeSyntax",                    Opt_UnicodeSyntax, const Supported ),
   ( "MagicHash",                        Opt_MagicHash, const Supported ),
@@ -1714,12 +1562,16 @@ xFlags = [
   ( "TransformListComp",                Opt_TransformListComp, const Supported ),
   ( "ForeignFunctionInterface",         Opt_ForeignFunctionInterface, const Supported ),
   ( "UnliftedFFITypes",                 Opt_UnliftedFFITypes, const Supported ),
+  ( "GHCForeignImportPrim",             Opt_GHCForeignImportPrim, const Supported ),
   ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, const Supported ),
   ( "Rank2Types",                       Opt_Rank2Types, const Supported ),
   ( "RankNTypes",                       Opt_RankNTypes, const Supported ),
-  ( "ImpredicativeTypes",               Opt_ImpredicativeTypes, const Supported ),
+  ( "ImpredicativeTypes",               Opt_ImpredicativeTypes, 
+        const $ Deprecated "impredicative polymorphism will be simplified or removed in GHC 6.14" ),
   ( "TypeOperators",                    Opt_TypeOperators, const Supported ),
-  ( "RecursiveDo",                      Opt_RecursiveDo, const Supported ),
+  ( "RecursiveDo",                      Opt_RecursiveDo,
+    deprecatedForLanguage "DoRec"),
+  ( "DoRec",                            Opt_DoRec, const Supported ),
   ( "Arrows",                           Opt_Arrows, const Supported ),
   ( "PArr",                             Opt_PArr, const Supported ),
   ( "TemplateHaskell",                  Opt_TemplateHaskell, const Supported ),
@@ -1739,8 +1591,13 @@ xFlags = [
   ( "BangPatterns",                     Opt_BangPatterns, const Supported ),
   -- On by default:
   ( "MonomorphismRestriction",          Opt_MonomorphismRestriction, const Supported ),
+  -- On by default:
+  ( "NPlusKPatterns",                   Opt_NPlusKPatterns, const Supported ),
   -- On by default (which is not strictly H98):
   ( "MonoPatBinds",                     Opt_MonoPatBinds, const Supported ),
+  ( "ExplicitForAll",                   Opt_ExplicitForAll, const Supported ),
+  ( "AlternativeLayoutRule",            Opt_AlternativeLayoutRule, const Supported ),
+  ( "MonoLocalBinds",                   Opt_MonoLocalBinds, const Supported ),
   ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec, const Supported ),
   ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules, const Supported ),
   ( "ImplicitParams",                   Opt_ImplicitParams, const Supported ),
@@ -1752,6 +1609,9 @@ xFlags = [
   ( "UnboxedTuples",                    Opt_UnboxedTuples, const Supported ),
   ( "StandaloneDeriving",               Opt_StandaloneDeriving, const Supported ),
   ( "DeriveDataTypeable",               Opt_DeriveDataTypeable, const Supported ),
+  ( "DeriveFunctor",                    Opt_DeriveFunctor, const Supported ),
+  ( "DeriveTraversable",                Opt_DeriveTraversable, const Supported ),
+  ( "DeriveFoldable",                   Opt_DeriveFoldable, const Supported ),
   ( "TypeSynonymInstances",             Opt_TypeSynonymInstances, const Supported ),
   ( "FlexibleContexts",                 Opt_FlexibleContexts, const Supported ),
   ( "FlexibleInstances",                Opt_FlexibleInstances, const Supported ),
@@ -1768,11 +1628,29 @@ xFlags = [
 
 impliedFlags :: [(DynFlag, DynFlag)]
 impliedFlags
-  = [ (Opt_GADTs,               Opt_RelaxedPolyRec)  -- We want type-sig variables to
+  = [ (Opt_RankNTypes,                Opt_ExplicitForAll)
+    , (Opt_Rank2Types,                Opt_ExplicitForAll)
+    , (Opt_ScopedTypeVariables,       Opt_ExplicitForAll)
+    , (Opt_LiberalTypeSynonyms,       Opt_ExplicitForAll)
+    , (Opt_ExistentialQuantification, Opt_ExplicitForAll)
+    , (Opt_PolymorphicComponents,     Opt_ExplicitForAll)
+
+    , (Opt_GADTs,               Opt_RelaxedPolyRec)  -- We want type-sig variables to
                                                      --      be completely rigid for GADTs
 
+    , (Opt_TypeFamilies,        Opt_RelaxedPolyRec)  -- Trac #2944 gives a nice example
+    , (Opt_TypeFamilies,        Opt_KindSignatures)  -- Type families use kind signatures
+                                                    -- all over the place
+
     , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec)  -- Ditto for scoped type variables; see
                                                      --      Note [Scoped tyvars] in TcBinds
+    , (Opt_ImpredicativeTypes,  Opt_RankNTypes)
+
+       -- Record wild-cards implies field disambiguation
+       -- Otherwise if you write (C {..}) you may well get
+       -- stuff like " 'a' not in scope ", which is a bit silly
+       -- if the compiler has just filled in field 'a' of constructor 'C'
+    , (Opt_RecordWildCards,     Opt_DisambiguateRecordFields)
   ]
 
 glasgowExtsFlags :: [DynFlag]
@@ -1787,6 +1665,9 @@ glasgowExtsFlags = [
            , Opt_TypeSynonymInstances
            , Opt_StandaloneDeriving
            , Opt_DeriveDataTypeable
+           , Opt_DeriveFunctor
+           , Opt_DeriveFoldable
+           , Opt_DeriveTraversable
            , Opt_FlexibleContexts
            , Opt_FlexibleInstances
            , Opt_ConstrainedClassMethods
@@ -1800,9 +1681,8 @@ glasgowExtsFlags = [
            , Opt_PatternGuards
            , Opt_LiberalTypeSynonyms
            , Opt_RankNTypes
-           , Opt_ImpredicativeTypes
            , Opt_TypeOperators
-           , Opt_RecursiveDo
+           , Opt_DoRec
            , Opt_ParallelListComp
            , Opt_EmptyDataDecls
            , Opt_KindSignatures
@@ -1835,7 +1715,7 @@ 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
+parseDynamicFlags_ dflags0 args pkg_flags = do
   -- XXX Legacy support code
   -- We used to accept things like
   --     optdep-f  -optdepdepend
@@ -1852,10 +1732,23 @@ parseDynamicFlags_ dflags args pkg_flags = do
       flag_spec | pkg_flags = package_flags ++ dynamic_flags
                 | otherwise = dynamic_flags
 
-  let ((leftover, errs, warns), dflags')
-          = runCmdLine (processArgs flag_spec args') dflags
+  let ((leftover, errs, warns), dflags1)
+          = runCmdLine (processArgs flag_spec args') dflags0
   when (not (null errs)) $ ghcError $ errorsToGhcException errs
-  return (dflags', leftover, warns)
+
+  -- Cannot use -fPIC with registerised -fvia-C, because the mangler
+  -- isn't up to the job.  We know that if hscTarget == HscC, then the
+  -- user has explicitly used -fvia-C, because -fasm is the default,
+  -- unless there is no NCG on this platform.  The latter case is
+  -- checked when the -fPIC flag is parsed.
+  --
+  let (pic_warns, dflags2) =
+        if opt_PIC && hscTarget dflags1 == HscC && cGhcUnregisterised == "NO"
+          then ([L noSrcSpan $ "Warning: -fvia-C is incompatible with -fPIC; ignoring -fvia-C"],
+                dflags1{ hscTarget = HscAsm })
+          else ([], dflags1)
+
+  return (dflags2, leftover, pic_warns ++ warns)
 
 type DynP = CmdLineP DynFlags
 
@@ -1881,7 +1774,8 @@ unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
 --------------------------
 setDumpFlag :: DynFlag -> OptKind DynP
 setDumpFlag dump_flag
-  = NoArg (setDynFlag dump_flag >> when want_recomp forceRecompile)
+  = NoArg (do { setDynFlag dump_flag
+              ; when want_recomp forceRecompile })
   where
        -- Certain dumpy-things are really interested in what's going
         -- on during recompilation checking, so in those cases we
@@ -1900,41 +1794,16 @@ forceRecompile = do { dfs <- getCmdLineState
          force_recomp dfs = isOneShot (ghcMode dfs)
 
 setVerboseCore2Core :: DynP ()
-setVerboseCore2Core = do setDynFlag Opt_D_verbose_core2core 
-                        forceRecompile
-                         upd (\s -> s { shouldDumpSimplPhase = const True })
+setVerboseCore2Core = do forceRecompile
+                         setDynFlag Opt_D_verbose_core2core 
+                         upd (\dfs -> dfs { shouldDumpSimplPhase = Nothing })
+                        
 
 setDumpSimplPhases :: String -> DynP ()
 setDumpSimplPhases s = do forceRecompile
-                          upd (\s -> s { shouldDumpSimplPhase = spec })
+                          upd (\dfs -> dfs { shouldDumpSimplPhase = Just spec })
   where
-    spec :: SimplifierMode -> Bool
-    spec = join (||)
-         . map (join (&&) . map match . split ':')
-         . split ','
-         $ case s of
-             '=' : s' -> s'
-             _        -> s
-
-    join :: (Bool -> Bool -> Bool)
-         -> [SimplifierMode -> Bool]
-         -> SimplifierMode -> Bool
-    join _  [] = const True
-    join op ss = foldr1 (\f g x -> f x `op` g x) ss
-
-    match :: String -> SimplifierMode -> Bool
-    match "" = const True
-    match s  = case reads s of
-                [(n,"")] -> phase_num  n
-                _        -> phase_name s
-
-    phase_num :: Int -> SimplifierMode -> Bool
-    phase_num n (SimplPhase k _) = n == k
-    phase_num _ _                = False
-
-    phase_name :: String -> SimplifierMode -> Bool
-    phase_name s SimplGently       = s == "gentle"
-    phase_name s (SimplPhase _ ss) = s `elem` ss
+    spec = case s of { ('=' : s') -> s';  _ -> s }
 
 setVerbosity :: Maybe Int -> DynP ()
 setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
@@ -1945,22 +1814,18 @@ addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes
 extraPkgConf_ :: FilePath -> DynP ()
 extraPkgConf_  p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
 
-exposePackage, hidePackage, ignorePackage :: String -> DynP ()
+exposePackage, exposePackageId, hidePackage, ignorePackage :: String -> DynP ()
 exposePackage p =
   upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
+exposePackageId p =
+  upd (\s -> s{ packageFlags = ExposePackageId p : packageFlags s })
 hidePackage p =
   upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
 ignorePackage p =
   upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
 
 setPackageName :: String -> DynFlags -> DynFlags
-setPackageName p
-  | Nothing <- unpackPackageId pid
-  = ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
-  | otherwise
-  = \s -> s{ thisPackage = pid }
-  where
-        pid = stringToPackageId p
+setPackageName p s =  s{ thisPackage = stringToPackageId p }
 
 -- If we're linking a binary, then only targets that produce object
 -- code are allowed (requests for other target types are ignored).
@@ -1999,18 +1864,20 @@ setOptLevel n dflags
 --                                      sometimes
 --    -fdicts-cheap                     always inline dictionaries
 --    -fmax-simplifier-iterations20     this is necessary sometimes
+--    -fsimplifier-phases=3             we use an additional simplifier phase
+--                                      for fusion
 --    -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
+                                         , simplPhases         = 3
                                          , specConstrThreshold = Nothing
                                          , specConstrCount     = Nothing
                                          })
                    `dopt_set`   Opt_DictsCheap
                    `dopt_unset` Opt_MethodSharing
-                   `dopt_set`   Opt_InlineIfEnoughArgs
 
 data DPHBackend = DPHPar
                 | DPHSeq
@@ -2048,13 +1915,6 @@ 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
 
@@ -2196,10 +2056,20 @@ machdepCCOpts _dflags
       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
       --   the fp (%ebp) for our register maps.
         =  let n_regs = stolen_x86_regs _dflags
-               sta = opt_Static
            in
-                    ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
+                    ( 
+#if darwin_TARGET_OS
+                      -- By default, gcc on OS X will generate SSE
+                      -- instructions, which need things 16-byte aligned,
+                      -- but we don't 16-byte align things. Thus drop
+                      -- back to generic i686 compatibility. Trac #2983.
+                      --
+                      -- Since Snow Leopard (10.6), gcc defaults to x86_64.
+                      ["-march=i686", "-m32"],
+#else
+                      [ if opt_Static then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
                       ],
+#endif
                       [ "-fno-defer-pop",
                         "-fomit-frame-pointer",
                         -- we want -fno-builtin, because when gcc inlines
@@ -2213,7 +2083,13 @@ machdepCCOpts _dflags
         = ( [], ["-fomit-frame-pointer", "-G0"] )
 
 #elif x86_64_TARGET_ARCH
-        = ( [], ["-fomit-frame-pointer",
+        = (
+#if darwin_TARGET_OS
+            ["-m64"],
+#else
+            [],
+#endif
+                ["-fomit-frame-pointer",
                  "-fno-asynchronous-unwind-tables",
                         -- the unwind tables are unnecessary for HC code,
                         -- and get in the way of -split-objs.  Another option
@@ -2263,7 +2139,7 @@ picCCOpts _dflags
     | otherwise
         = []
 #else
-    | opt_PIC
+    | opt_PIC || not opt_Static
         = ["-fPIC", "-U __PIC__", "-D__PIC__"]
     | otherwise
         = []
@@ -2278,21 +2154,24 @@ can_split = cSplitObjs == "YES"
 -- -----------------------------------------------------------------------------
 -- Compiler Info
 
-compilerInfo :: [(String, String)]
-compilerInfo = [("Project name",                cProjectName),
-                ("Project version",             cProjectVersion),
-                ("Booter version",              cBooterVersion),
-                ("Stage",                       cStage),
-                ("Interface file version",      cHscIfaceFileVersion),
-                ("Have interpreter",            cGhcWithInterpreter),
-                ("Object splitting",            cSplitObjs),
-                ("Have native code generator",  cGhcWithNativeCodeGen),
-                ("Support SMP",                 cGhcWithSMP),
-                ("Unregisterised",              cGhcUnregisterised),
-                ("Tables next to code",         cGhcEnableTablesNextToCode),
-                ("Win32 DLLs",                  cEnableWin32DLLs),
-                ("RTS ways",                    cGhcRTSWays),
-                ("Leading underscore",          cLeadingUnderscore),
-                ("Debug on",                    show debugIsOn)
+data Printable = String String
+               | FromDynFlags (DynFlags -> String)
+
+compilerInfo :: [(String, Printable)]
+compilerInfo = [("Project name",                String cProjectName),
+                ("Project version",             String cProjectVersion),
+                ("Booter version",              String cBooterVersion),
+                ("Stage",                       String cStage),
+                ("Have interpreter",            String cGhcWithInterpreter),
+                ("Object splitting",            String cSplitObjs),
+                ("Have native code generator",  String cGhcWithNativeCodeGen),
+                ("Support SMP",                 String cGhcWithSMP),
+                ("Unregisterised",              String cGhcUnregisterised),
+                ("Tables next to code",         String cGhcEnableTablesNextToCode),
+                ("Win32 DLLs",                  String cEnableWin32DLLs),
+                ("RTS ways",                    String cGhcRTSWays),
+                ("Leading underscore",          String cLeadingUnderscore),
+                ("Debug on",                    String (show debugIsOn)),
+                ("LibDir",                      FromDynFlags topDir)
                ]