projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Remove the (very) old strictness analyser
[ghc-hetmet.git] / compiler / main / DynFlags.hs
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 1aaa728..9e61b28 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -17,10 +17,11 @@ module DynFlags (
         GhcMode(..), isOneShot,
         GhcLink(..), isNoLink,
         PackageFlag(..),
         GhcMode(..), isOneShot,
         GhcLink(..), isNoLink,
         PackageFlag(..),
-        Option(..),
+        Option(..), showOpt,
         DynLibLoader(..),
         fFlags, xFlags,
         dphPackage,
         DynLibLoader(..),
         fFlags, xFlags,
         dphPackage,
+        wayNames,
 
         -- ** Manipulating DynFlags
         defaultDynFlags,                -- DynFlags
 
         -- ** Manipulating DynFlags
         defaultDynFlags,                -- DynFlags
@@ -69,18 +70,13 @@ import Platform
 import Module
 import PackageConfig
 import PrelNames        ( mAIN )
 import Module
 import PackageConfig
 import PrelNames        ( mAIN )
-#if defined(i386_TARGET_ARCH) || (!defined(mingw32_TARGET_OS) && !defined(darwin_TARGET_OS))
-import StaticFlags      ( opt_Static )
-#endif
-import StaticFlags      ( opt_PIC, WayName(..), v_Ways, v_Build_tag,
-                          v_RTS_Build_tag )
+import StaticFlags
 import {-# SOURCE #-} Packages (PackageState)
 import DriverPhases     ( Phase(..), phaseInputExt )
 import Config
 import CmdLineParser
 import Constants        ( mAX_CONTEXT_REDUCTION_DEPTH )
 import Panic
 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 Util
 import Maybes           ( orElse )
 import SrcLoc
@@ -186,6 +182,7 @@ data DynFlag
    | Opt_WarnUnusedMatches
    | Opt_WarnWarningsDeprecations
    | Opt_WarnDeprecatedFlags
    | Opt_WarnUnusedMatches
    | Opt_WarnWarningsDeprecations
    | Opt_WarnDeprecatedFlags
+   | Opt_WarnDodgyExports
    | Opt_WarnDodgyImports
    | Opt_WarnOrphans
    | Opt_WarnTabs
    | Opt_WarnDodgyImports
    | Opt_WarnOrphans
    | Opt_WarnTabs
@@ -225,6 +222,7 @@ data DynFlag
    | Opt_ViewPatterns
    | Opt_GADTs
    | Opt_RelaxedPolyRec
    | Opt_ViewPatterns
    | Opt_GADTs
    | Opt_RelaxedPolyRec
+   | Opt_NPlusKPatterns
 
    | Opt_StandaloneDeriving
    | Opt_DeriveDataTypeable
 
    | Opt_StandaloneDeriving
    | Opt_DeriveDataTypeable
@@ -248,7 +246,9 @@ data DynFlag
    | Opt_TransformListComp
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo
    | Opt_TransformListComp
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo
+   | Opt_DoRec
    | Opt_PostfixOperators
    | Opt_PostfixOperators
+   | Opt_TupleSections
    | Opt_PatternGuards
    | Opt_LiberalTypeSynonyms
    | Opt_Rank2Types
    | Opt_PatternGuards
    | Opt_LiberalTypeSynonyms
    | Opt_Rank2Types
@@ -257,18 +257,19 @@ data DynFlag
    | Opt_TypeOperators
    | Opt_PackageImports
    | Opt_NewQualifiedOperators
    | Opt_TypeOperators
    | Opt_PackageImports
    | Opt_NewQualifiedOperators
+   | Opt_ExplicitForAll
 
    | Opt_PrintExplicitForalls
 
    -- optimisation opts
    | Opt_Strictness
    | Opt_FullLaziness
 
    | Opt_PrintExplicitForalls
 
    -- optimisation opts
    | Opt_Strictness
    | Opt_FullLaziness
+   | Opt_FloatIn
+   | Opt_Specialise
    | Opt_StaticArgumentTransformation
    | Opt_CSE
    | Opt_LiberateCase
    | Opt_SpecConstr
    | Opt_StaticArgumentTransformation
    | Opt_CSE
    | Opt_LiberateCase
    | Opt_SpecConstr
-   | Opt_IgnoreInterfacePragmas
-   | Opt_OmitInterfacePragmas
    | Opt_DoLambdaEtaExpansion
    | Opt_IgnoreAsserts
    | Opt_DoEtaReduction
    | Opt_DoLambdaEtaExpansion
    | Opt_IgnoreAsserts
    | Opt_DoEtaReduction
@@ -276,12 +277,16 @@ data DynFlag
    | Opt_UnboxStrictFields
    | Opt_MethodSharing
    | Opt_DictsCheap
    | 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
 
    | 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
    -- profiling opts
    | Opt_AutoSccsOnAllToplevs
    | Opt_AutoSccsOnExportedToplevs
@@ -312,6 +317,7 @@ data DynFlag
    | Opt_EmbedManifest
    | Opt_EmitExternalCore
    | Opt_SharedImplib
    | Opt_EmbedManifest
    | Opt_EmitExternalCore
    | Opt_SharedImplib
+   | Opt_BuildingCabalPackage
 
        -- temporary flags
    | Opt_RunCPS
 
        -- temporary flags
    | Opt_RunCPS
@@ -341,12 +347,13 @@ data DynFlags = DynFlags {
   hscTarget             :: HscTarget,
   hscOutName            :: String,      -- ^ Name of the output file
   extCoreName           :: String,      -- ^ Name of the .hcr output file
   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,
   ruleCheck             :: Maybe String,
   optLevel              :: Int,         -- ^ Optimisation level
   simplPhases           :: Int,         -- ^ Number of simplifier phases
   maxSimplIterations    :: Int,         -- ^ Max simplifier iterations
   shouldDumpSimplPhase  :: SimplifierMode -> Bool,
   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
 
   specConstrThreshold   :: Maybe Int,   -- ^ Threshold for SpecConstr
   specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function
@@ -367,7 +374,7 @@ data DynFlags = DynFlags {
   thisPackage           :: PackageId,   -- ^ name of package currently being compiled
 
   -- ways
   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\"
 
   buildTag              :: String,      -- ^ The global \"way\" (e.g. \"p\" for prof)
   rtsBuildTag           :: String,      -- ^ The RTS \"way\"
 
@@ -449,7 +456,7 @@ data DynFlags = DynFlags {
   -- Package state
   -- NB. do not modify this field, it is calculated by
   -- Packages.initPackages and Packages.updatePackages.
   -- 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
   pkgState              :: PackageState,
 
   -- Temporary files
@@ -467,6 +474,9 @@ data DynFlags = DynFlags {
   haddockOptions :: Maybe String
  }
 
   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
 -- | The target code type of the compilation (if any).
 --
 -- Whenever you change the target, also make sure to set 'ghcLink' to
@@ -538,10 +548,13 @@ isNoLink _      = False
 -- Is it worth evaluating this Bool and caching it in the DynFlags value
 -- during initDynFlags?
 doingTickyProfiling :: DynFlags -> Bool
 -- Is it worth evaluating this Bool and caching it in the DynFlags value
 -- during initDynFlags?
 doingTickyProfiling :: DynFlags -> Bool
-doingTickyProfiling dflags = WayTicky `elem` wayNames dflags
+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
 
 data PackageFlag
   = ExposePackage  String
+  | ExposePackageId String
   | HidePackage    String
   | IgnorePackage  String
   deriving Eq
   | HidePackage    String
   | IgnorePackage  String
   deriving Eq
@@ -567,14 +580,12 @@ initDynFlags :: DynFlags -> IO DynFlags
 initDynFlags dflags = do
  -- someday these will be dynamic flags
  ways <- readIORef v_Ways
 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{
  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
         }
         filesToClean    = refFilesToClean,
         dirsToClean     = refDirsToClean
         }
@@ -600,6 +611,8 @@ defaultDynFlags =
         specConstrThreshold     = Just 200,
         specConstrCount         = Just 3,
         liberateCaseThreshold   = Just 200,
         specConstrThreshold     = Just 200,
         specConstrCount         = Just 3,
         liberateCaseThreshold   = Just 200,
+        strictnessBefore        = [],
+
 #ifndef OMIT_NATIVE_CODEGEN
         targetPlatform          = defaultTargetPlatform,
 #endif
 #ifndef OMIT_NATIVE_CODEGEN
         targetPlatform          = defaultTargetPlatform,
 #endif
@@ -650,7 +663,7 @@ defaultDynFlags =
         packageFlags            = [],
         pkgDatabase             = Nothing,
         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
         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,
         buildTag                = panic "defaultDynFlags: No buildTag",
         rtsBuildTag             = panic "defaultDynFlags: No rtsBuildTag",
         splitInfo               = Nothing,
@@ -691,6 +704,7 @@ defaultDynFlags =
 
             Opt_ImplicitPrelude,
             Opt_MonomorphismRestriction,
 
             Opt_ImplicitPrelude,
             Opt_MonomorphismRestriction,
+            Opt_NPlusKPatterns,
 
             Opt_MethodSharing,
 
 
             Opt_MethodSharing,
 
@@ -719,9 +733,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
     0   |   print errors & warnings only
     1   |   minimal verbosity: print "compiling M ... done." for each module.
     2   |   equivalent to -dshow-passes
@@ -854,6 +867,10 @@ data Option
               String  -- the filepath/filename portion
  | Option     String
 
               String  -- the filepath/filename portion
  | Option     String
 
+showOpt :: Option -> String
+showOpt (FileOption pre f) = pre ++ f
+showOpt (Option s)  = s
+
 -----------------------------------------------------------------------------
 -- Setting the optimisation level
 
 -----------------------------------------------------------------------------
 -- Setting the optimisation level
 
@@ -882,6 +899,8 @@ optLevelFlags
     , ([1,2],   Opt_Strictness)
     , ([1,2],   Opt_CSE)
     , ([1,2],   Opt_FullLaziness)
     , ([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)
 
     , ([2],     Opt_LiberateCase)
     , ([2],     Opt_SpecConstr)
@@ -927,6 +946,7 @@ minusWOpts
         Opt_WarnUnusedMatches,
         Opt_WarnUnusedImports,
         Opt_WarnIncompletePatterns,
         Opt_WarnUnusedMatches,
         Opt_WarnUnusedImports,
         Opt_WarnIncompletePatterns,
+        Opt_WarnDodgyExports,
         Opt_WarnDodgyImports
       ]
 
         Opt_WarnDodgyImports
       ]
 
@@ -986,18 +1006,27 @@ data CoreToDo           -- These are diff core-to-core passes,
 
 data SimplifierMode             -- See comments in SimplMonad
   = SimplGently
 
 data SimplifierMode             -- See comments in SimplMonad
   = SimplGently
-  | SimplPhase Int [String]
+       { sm_rules :: Bool      -- Whether RULES are enabled 
+        , sm_inline :: Bool }  -- Whether inlining is enabled
 
 
-instance Outputable SimplifierMode where
-    ppr SimplGently       = ptext (sLit "gentle")
-    ppr (SimplPhase n ss) = int n <+> brackets (text (concat $ intersperse "," ss))
+  | SimplPhase 
+        { sm_num :: Int          -- Phase number; counts downward so 0 is last phase
+        , sm_names :: [String] }  -- Name(s) of the phase
 
 
+instance Outputable SimplifierMode where
+    ppr (SimplPhase { sm_num = n, sm_names = ss })
+       = int n <+> brackets (text (concat $ intersperse "," ss))
+    ppr (SimplGently { sm_rules = r, sm_inline = i }) 
+       = ptext (sLit "gentle") <> 
+           brackets (pp_flag r (sLit "rules") <> comma <>
+                     pp_flag i (sLit "inline"))
+        where
+           pp_flag f s = ppUnless f (ptext (sLit "no")) <+> ptext s
 
 data SimplifierSwitch
   = MaxSimplifierIterations Int
   | NoCaseOfCase
 
 
 data SimplifierSwitch
   = MaxSimplifierIterations Int
   | NoCaseOfCase
 
-
 data FloatOutSwitches = FloatOutSwitches {
         floatOutLambdas :: Bool,     -- ^ True <=> float lambdas to top level
         floatOutConstants :: Bool    -- ^ True <=> float constants to top level,
 data FloatOutSwitches = FloatOutSwitches {
         floatOutLambdas :: Bool,     -- ^ True <=> float lambdas to top level
         floatOutConstants :: Bool    -- ^ True <=> float constants to top level,
@@ -1042,6 +1071,8 @@ getCoreToDo dflags
     max_iter      = maxSimplIterations dflags
     strictness    = dopt Opt_Strictness dflags
     full_laziness = dopt Opt_FullLaziness dflags
     max_iter      = maxSimplIterations dflags
     strictness    = dopt Opt_Strictness dflags
     full_laziness = dopt Opt_FullLaziness dflags
+    do_specialise = dopt Opt_Specialise dflags
+    do_float_in   = dopt Opt_FloatIn dflags
     cse           = dopt Opt_CSE dflags
     spec_constr   = dopt Opt_SpecConstr dflags
     liberate_case = dopt Opt_LiberateCase dflags
     cse           = dopt Opt_CSE dflags
     spec_constr   = dopt Opt_SpecConstr dflags
     liberate_case = dopt Opt_LiberateCase dflags
@@ -1050,9 +1081,13 @@ getCoreToDo dflags
 
     maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
 
 
     maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
 
+    maybe_strictness_before phase
+      = runWhen (phase `elem` strictnessBefore dflags) CoreDoStrictness
+
     simpl_phase phase names iter
       = CoreDoPasses
     simpl_phase phase names iter
       = CoreDoPasses
-          [ CoreDoSimplify (SimplPhase phase names) [
+          [ maybe_strictness_before phase,
+            CoreDoSimplify (SimplPhase phase names) [
               MaxSimplifierIterations iter
             ],
             maybe_rule_check phase
               MaxSimplifierIterations iter
             ],
             maybe_rule_check phase
@@ -1079,7 +1114,9 @@ getCoreToDo dflags
 
 
         -- initial simplify: mk specialiser happy: minimum effort please
 
 
         -- initial simplify: mk specialiser happy: minimum effort please
-    simpl_gently = CoreDoSimplify SimplGently [
+    simpl_gently = CoreDoSimplify 
+                       (SimplGently { sm_rules = True, sm_inline = False })
+                       [
                         --      Simplify "gently"
                         -- Don't inline anything till full laziness has bitten
                         -- In particular, inlining wrappers inhibits floating
                         --      Simplify "gently"
                         -- Don't inline anything till full laziness has bitten
                         -- In particular, inlining wrappers inhibits floating
@@ -1116,7 +1153,7 @@ getCoreToDo dflags
 
         -- Specialisation is best done before full laziness
         -- so that overloaded functions have all their dictionary lambdas manifest
 
         -- Specialisation is best done before full laziness
         -- so that overloaded functions have all their dictionary lambdas manifest
-        CoreDoSpecialising,
+        runWhen do_specialise CoreDoSpecialising,
 
         runWhen full_laziness (CoreDoFloatOutwards constantsOnlyFloatOutSwitches),
                -- Was: gentleFloatOutSwitches  
 
         runWhen full_laziness (CoreDoFloatOutwards constantsOnlyFloatOutSwitches),
                -- Was: gentleFloatOutSwitches  
@@ -1127,7 +1164,7 @@ getCoreToDo dflags
                --          rewrite's allocation by 19%, and made  0.0% difference
                --          to any other nofib benchmark
 
                --          rewrite's allocation by 19%, and made  0.0% difference
                --          to any other nofib benchmark
 
-        CoreDoFloatInwards,
+        runWhen do_float_in CoreDoFloatInwards,
 
         simpl_phases,
 
 
         simpl_phases,
 
@@ -1143,10 +1180,6 @@ getCoreToDo dflags
                 -- Don't stop now!
         simpl_phase 0 ["main"] (max max_iter 3),
 
                 -- Don't stop now!
         simpl_phase 0 ["main"] (max max_iter 3),
 
-
-#ifdef OLD_STRICTNESS
-        CoreDoOldStrictness,
-#endif
         runWhen strictness (CoreDoPasses [
                 CoreDoStrictness,
                 CoreDoWorkerWrapper,
         runWhen strictness (CoreDoPasses [
                 CoreDoStrictness,
                 CoreDoWorkerWrapper,
@@ -1168,7 +1201,7 @@ getCoreToDo dflags
                 -- 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
 
                 -- 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,
+        runWhen do_float_in CoreDoFloatInwards,
 
         maybe_rule_check 0,
 
 
         maybe_rule_check 0,
 
@@ -1231,7 +1264,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 "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  --------------------------------------------
   , Flag "v"              (OptIntSuffix setVerbosity) Supported
 
         ------- Specific phases  --------------------------------------------
@@ -1439,7 +1473,8 @@ dynamic_flags = [
          Supported
   , Flag "dsource-stats"           (setDumpFlag Opt_D_source_stats)
          Supported
          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
          Supported
   , Flag "dverbose-stg2stg"        (setDumpFlag Opt_D_verbose_stg2stg)
          Supported
@@ -1542,6 +1577,10 @@ dynamic_flags = [
          (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
          Supported
 
          (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?
         ------ Profiling ----------------------------------------------------
 
   -- XXX Should the -f* flags be deprecated?
@@ -1613,6 +1652,7 @@ package_flags = [
   , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
          Supported
   , Flag "package-name"   (HasArg (upd . setPackageName)) Supported
   , 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))
   , Flag "package"        (HasArg exposePackage) Supported
   , Flag "hide-package"   (HasArg hidePackage) Supported
   , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
@@ -1633,7 +1673,7 @@ mkFlag turnOn flagPrefix f (name, dynflag, deprecated)
 
 deprecatedForLanguage :: String -> Bool -> Deprecated
 deprecatedForLanguage lang turn_on
 
 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
     where 
       flag | turn_on    = lang
            | otherwise = "No"++lang
@@ -1648,6 +1688,7 @@ useInstead flag turn_on
 fFlags :: [(String, DynFlag, Bool -> Deprecated)]
 fFlags = [
   ( "warn-dodgy-foreign-imports",       Opt_WarnDodgyForeignImports, const Supported ),
 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 ),
   ( "warn-dodgy-imports",               Opt_WarnDodgyImports, const Supported ),
   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports, const Supported ),
   ( "warn-hi-shadowing",                Opt_WarnHiShadows, const Supported ),
@@ -1677,6 +1718,8 @@ fFlags = [
   ( "warn-wrong-do-bind",               Opt_WarnWrongDoBind, const Supported ),
   ( "print-explicit-foralls",           Opt_PrintExplicitForalls, const Supported ),
   ( "strictness",                       Opt_Strictness, 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 ),
   ( "static-argument-transformation",   Opt_StaticArgumentTransformation, const Supported ),
   ( "full-laziness",                    Opt_FullLaziness, const Supported ),
   ( "liberate-case",                    Opt_LiberateCase, const Supported ),
@@ -1684,6 +1727,7 @@ fFlags = [
   ( "cse",                              Opt_CSE, const Supported ),
   ( "ignore-interface-pragmas",         Opt_IgnoreInterfacePragmas, const Supported ),
   ( "omit-interface-pragmas",           Opt_OmitInterfacePragmas, const Supported ),
   ( "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 ),
   ( "do-lambda-eta-expansion",          Opt_DoLambdaEtaExpansion, const Supported ),
   ( "ignore-asserts",                   Opt_IgnoreAsserts, const Supported ),
   ( "do-eta-reduction",                 Opt_DoEtaReduction, const Supported ),
@@ -1691,7 +1735,6 @@ fFlags = [
   ( "unbox-strict-fields",              Opt_UnboxStrictFields, const Supported ),
   ( "method-sharing",                   Opt_MethodSharing, const Supported ),
   ( "dicts-cheap",                      Opt_DictsCheap, const Supported ),
   ( "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 ),
   ( "excess-precision",                 Opt_ExcessPrecision, const Supported ),
   ( "eager-blackholing",                Opt_EagerBlackHoling, const Supported ),
   ( "asm-mangling",                     Opt_DoAsmMangling, const Supported ),
@@ -1747,6 +1790,7 @@ fFlags = [
   ( "embed-manifest",                   Opt_EmbedManifest, const Supported ),
   ( "ext-core",                         Opt_EmitExternalCore, const Supported ),
   ( "shared-implib",                    Opt_SharedImplib, 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 )
   ]
 
   ( "implicit-import-qualified",        Opt_ImplicitImportQualified, const Supported )
   ]
 
@@ -1762,6 +1806,7 @@ xFlags :: [(String, DynFlag, Bool -> Deprecated)]
 xFlags = [
   ( "CPP",                              Opt_Cpp, const Supported ),
   ( "PostfixOperators",                 Opt_PostfixOperators, const Supported ),
 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 ),
   ( "PatternGuards",                    Opt_PatternGuards, const Supported ),
   ( "UnicodeSyntax",                    Opt_UnicodeSyntax, const Supported ),
   ( "MagicHash",                        Opt_MagicHash, const Supported ),
@@ -1777,9 +1822,12 @@ xFlags = [
   ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, const Supported ),
   ( "Rank2Types",                       Opt_Rank2Types, const Supported ),
   ( "RankNTypes",                       Opt_RankNTypes, 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 ),
   ( "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 ),
   ( "Arrows",                           Opt_Arrows, const Supported ),
   ( "PArr",                             Opt_PArr, const Supported ),
   ( "TemplateHaskell",                  Opt_TemplateHaskell, const Supported ),
@@ -1799,8 +1847,11 @@ xFlags = [
   ( "BangPatterns",                     Opt_BangPatterns, const Supported ),
   -- On by default:
   ( "MonomorphismRestriction",          Opt_MonomorphismRestriction, const Supported ),
   ( "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 ),
   -- On by default (which is not strictly H98):
   ( "MonoPatBinds",                     Opt_MonoPatBinds, const Supported ),
+  ( "ExplicitForAll",                   Opt_ExplicitForAll, const Supported ),
   ( "MonoLocalBinds",                   Opt_MonoLocalBinds, const Supported ),
   ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec, const Supported ),
   ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules, const Supported ),
   ( "MonoLocalBinds",                   Opt_MonoLocalBinds, const Supported ),
   ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec, const Supported ),
   ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules, const Supported ),
@@ -1832,7 +1883,14 @@ xFlags = [
 
 impliedFlags :: [(DynFlag, DynFlag)]
 impliedFlags
 
 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
                                                      --      be completely rigid for GADTs
 
     , (Opt_TypeFamilies,        Opt_RelaxedPolyRec)  -- Trac #2944 gives a nice example
@@ -1842,6 +1900,12 @@ impliedFlags
     , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec)  -- Ditto for scoped type variables; see
                                                      --      Note [Scoped tyvars] in TcBinds
     , (Opt_ImpredicativeTypes,  Opt_RankNTypes)
     , (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]
   ]
 
 glasgowExtsFlags :: [DynFlag]
@@ -1873,7 +1937,7 @@ glasgowExtsFlags = [
            , Opt_LiberalTypeSynonyms
            , Opt_RankNTypes
            , Opt_TypeOperators
            , Opt_LiberalTypeSynonyms
            , Opt_RankNTypes
            , Opt_TypeOperators
-           , Opt_RecursiveDo
+           , Opt_DoRec
            , Opt_ParallelListComp
            , Opt_EmptyDataDecls
            , Opt_KindSignatures
            , Opt_ParallelListComp
            , Opt_EmptyDataDecls
            , Opt_KindSignatures
@@ -1906,7 +1970,7 @@ parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False
 parseDynamicFlags_ :: Monad m =>
                       DynFlags -> [Located String] -> Bool
                   -> m (DynFlags, [Located String], [Located String])
 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
   -- XXX Legacy support code
   -- We used to accept things like
   --     optdep-f  -optdepdepend
@@ -1923,10 +1987,23 @@ parseDynamicFlags_ dflags args pkg_flags = do
       flag_spec | pkg_flags = package_flags ++ dynamic_flags
                 | otherwise = dynamic_flags
 
       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
   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
 
 
 type DynP = CmdLineP DynFlags
 
@@ -1952,7 +2029,8 @@ unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
 --------------------------
 setDumpFlag :: DynFlag -> OptKind DynP
 setDumpFlag dump_flag
 --------------------------
 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
   where
        -- Certain dumpy-things are really interested in what's going
         -- on during recompilation checking, so in those cases we
@@ -2004,8 +2082,8 @@ setDumpSimplPhases s = do forceRecompile
     phase_num _ _                = False
 
     phase_name :: String -> SimplifierMode -> Bool
     phase_num _ _                = False
 
     phase_name :: String -> SimplifierMode -> Bool
-    phase_name s SimplGently       = s == "gentle"
-    phase_name s (SimplPhase _ ss) = s `elem` ss
+    phase_name s (SimplGently {})               = s == "gentle"
+    phase_name s (SimplPhase { sm_names = ss }) = s `elem` ss
 
 setVerbosity :: Maybe Int -> DynP ()
 setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
 
 setVerbosity :: Maybe Int -> DynP ()
 setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
@@ -2016,22 +2094,18 @@ addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes
 extraPkgConf_ :: FilePath -> DynP ()
 extraPkgConf_  p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
 
 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 })
 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
 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).
 
 -- If we're linking a binary, then only targets that produce object
 -- code are allowed (requests for other target types are ignored).
@@ -2084,7 +2158,6 @@ setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
                                          })
                    `dopt_set`   Opt_DictsCheap
                    `dopt_unset` Opt_MethodSharing
                                          })
                    `dopt_set`   Opt_DictsCheap
                    `dopt_unset` Opt_MethodSharing
-                   `dopt_set`   Opt_InlineIfEnoughArgs
 
 data DPHBackend = DPHPar
                 | DPHSeq
 
 data DPHBackend = DPHPar
                 | DPHSeq
@@ -2263,10 +2336,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
       -- -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
            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
                       [ "-fno-defer-pop",
                         "-fomit-frame-pointer",
                         -- we want -fno-builtin, because when gcc inlines
@@ -2359,7 +2442,6 @@ compilerInfo = [("Project name",                String cProjectName),
                 ("Project version",             String cProjectVersion),
                 ("Booter version",              String cBooterVersion),
                 ("Stage",                       String cStage),
                 ("Project version",             String cProjectVersion),
                 ("Booter version",              String cBooterVersion),
                 ("Stage",                       String cStage),
-                ("Interface file version",      String cHscIfaceFileVersion),
                 ("Have interpreter",            String cGhcWithInterpreter),
                 ("Object splitting",            String cSplitObjs),
                 ("Have native code generator",  String cGhcWithNativeCodeGen),
                 ("Have interpreter",            String cGhcWithInterpreter),
                 ("Object splitting",            String cSplitObjs),
                 ("Have native code generator",  String cGhcWithNativeCodeGen),
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)