Deprecate -fglasgow-exts

[ghc-hetmet.git] / compiler / main / DynFlags.hs

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 6c3ea22..056f367 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -14,13 +14,19 @@
 -- flags.  Dynamic flags can also be set at the prompt in GHCi.
 module DynFlags (
         -- * Dynamic flags and associated configuration types
 -- flags.  Dynamic flags can also be set at the prompt in GHCi.
 module DynFlags (
         -- * Dynamic flags and associated configuration types

-        DOpt(..),

         DynFlag(..),
         ExtensionFlag(..),
         DynFlag(..),
         ExtensionFlag(..),

+        glasgowExtsFlags,

         flattenExtensionFlags,
         ensureFlattenedExtensionFlags,
         flattenExtensionFlags,
         ensureFlattenedExtensionFlags,

-        lopt_set_flattened,
-        lopt_unset_flattened,
+        dopt,
+        dopt_set,
+        dopt_unset,
+        xopt,
+        xopt_set,
+        xopt_unset,
+        xopt_set_flattened,
+        xopt_unset_flattened,

         DynFlags(..),
         RtsOptsEnabled(..),
         HscTarget(..), isObjectTarget, defaultObjectTarget,
         DynFlags(..),
         RtsOptsEnabled(..),
         HscTarget(..), isObjectTarget, defaultObjectTarget,

@@ -60,7 +66,12 @@ module DynFlags (
 
         -- * Compiler configuration suitable for display to the user
         Printable(..),
 
         -- * Compiler configuration suitable for display to the user
         Printable(..),

-        compilerInfo, rtsIsProfiled
+        compilerInfo
+#ifdef GHCI
+-- Only in stage 2 can we be sure that the RTS 
+-- exposes the appropriate runtime boolean
+        , rtsIsProfiled
+#endif

   ) where
 
 #include "HsVersions.h"
   ) where
 
 #include "HsVersions.h"

@@ -82,7 +93,6 @@ import Util
 import Maybes           ( orElse )
 import SrcLoc
 import FastString
 import Maybes           ( orElse )
 import SrcLoc
 import FastString

-import FiniteMap

 import Outputable
 import Foreign.C       ( CInt )
 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 import Outputable
 import Foreign.C       ( CInt )
 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )

@@ -93,6 +103,8 @@ import Control.Monad    ( when )
 
 import Data.Char
 import Data.List
 
 import Data.Char
 import Data.List

+import Data.Map (Map)
+import qualified Data.Map as Map

 import System.FilePath
 import System.IO        ( stderr, hPutChar )
 
 import System.FilePath
 import System.IO        ( stderr, hPutChar )
 

@@ -177,9 +189,9 @@ data DynFlag
    | Opt_WarnMissingImportList
    | Opt_WarnMissingMethods
    | Opt_WarnMissingSigs
    | Opt_WarnMissingImportList
    | Opt_WarnMissingMethods
    | Opt_WarnMissingSigs

+   | Opt_WarnMissingLocalSigs

    | Opt_WarnNameShadowing
    | Opt_WarnOverlappingPatterns
    | Opt_WarnNameShadowing
    | Opt_WarnOverlappingPatterns

-   | Opt_WarnSimplePatterns

    | Opt_WarnTypeDefaults
    | Opt_WarnMonomorphism
    | Opt_WarnUnusedBinds
    | Opt_WarnTypeDefaults
    | Opt_WarnMonomorphism
    | Opt_WarnUnusedBinds

@@ -190,6 +202,7 @@ data DynFlag
    | Opt_WarnDodgyExports
    | Opt_WarnDodgyImports
    | Opt_WarnOrphans
    | Opt_WarnDodgyExports
    | Opt_WarnDodgyImports
    | Opt_WarnOrphans

+   | Opt_WarnAutoOrphans

    | Opt_WarnTabs
    | Opt_WarnUnrecognisedPragmas
    | Opt_WarnDodgyForeignImports
    | Opt_WarnTabs
    | Opt_WarnUnrecognisedPragmas
    | Opt_WarnDodgyForeignImports

@@ -287,6 +300,7 @@ data ExtensionFlag
    | Opt_MonomorphismRestriction
    | Opt_MonoPatBinds
    | Opt_MonoLocalBinds
    | Opt_MonomorphismRestriction
    | Opt_MonoPatBinds
    | Opt_MonoLocalBinds

+   | Opt_RelaxedPolyRec                -- Deprecated

    | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
    | Opt_ForeignFunctionInterface
    | Opt_UnliftedFFITypes
    | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
    | Opt_ForeignFunctionInterface
    | Opt_UnliftedFFITypes

@@ -308,7 +322,6 @@ data ExtensionFlag
    | Opt_RecordPuns
    | Opt_ViewPatterns
    | Opt_GADTs
    | Opt_RecordPuns
    | Opt_ViewPatterns
    | Opt_GADTs

-   | Opt_RelaxedPolyRec

    | Opt_NPlusKPatterns
    | Opt_DoAndIfThenElse
 
    | Opt_NPlusKPatterns
    | Opt_DoAndIfThenElse
 

@@ -482,7 +495,7 @@ data DynFlags = DynFlags {
   -- These have to be IORefs, because the defaultCleanupHandler needs to
   -- know what to clean when an exception happens
   filesToClean          :: IORef [FilePath],
   -- 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),
+  dirsToClean           :: IORef (Map FilePath FilePath),

 
   -- hsc dynamic flags
   flags                 :: [DynFlag],
 
   -- hsc dynamic flags
   flags                 :: [DynFlag],

@@ -595,7 +608,6 @@ defaultObjectTarget
 
 data DynLibLoader
   = Deployable
 
 data DynLibLoader
   = Deployable

-  | Wrapped (Maybe String)

   | SystemDependent
   deriving Eq
 
   | SystemDependent
   deriving Eq
 

@@ -607,7 +619,7 @@ initDynFlags dflags = do
  -- someday these will be dynamic flags
  ways <- readIORef v_Ways
  refFilesToClean <- newIORef []
  -- someday these will be dynamic flags
  ways <- readIORef v_Ways
  refFilesToClean <- newIORef []

- refDirsToClean <- newIORef emptyFM
+ refDirsToClean <- newIORef Map.empty

  return dflags{
         ways            = ways,
         buildTag        = mkBuildTag (filter (not . wayRTSOnly) ways),
  return dflags{
         ways            = ways,
         buildTag        = mkBuildTag (filter (not . wayRTSOnly) ways),

@@ -725,24 +737,7 @@ defaultDynFlags =
         filesToClean   = panic "defaultDynFlags: No filesToClean",
         dirsToClean    = panic "defaultDynFlags: No dirsToClean",
         haddockOptions = Nothing,
         filesToClean   = panic "defaultDynFlags: No filesToClean",
         dirsToClean    = panic "defaultDynFlags: No dirsToClean",
         haddockOptions = Nothing,

-        flags = [
-            Opt_AutoLinkPackages,
-            Opt_ReadUserPackageConf,
-
-            Opt_MethodSharing,
-
-            Opt_DoAsmMangling,
-
-            Opt_SharedImplib,
-
-            Opt_GenManifest,
-            Opt_EmbedManifest,
-            Opt_PrintBindContents
-            ]
-            ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
-                    -- The default -O0 options
-            ++ standardWarnings,
-
+        flags = defaultFlags,

         language = Nothing,
         extensionFlags = Left [],
 
         language = Nothing,
         extensionFlags = Left [],
 

@@ -807,6 +802,9 @@ languageExtensions Nothing
     = Opt_MonoPatBinds   -- Experimentally, I'm making this non-standard
                          -- behaviour the default, to see if anyone notices
                          -- SLPJ July 06
     = Opt_MonoPatBinds   -- Experimentally, I'm making this non-standard
                          -- behaviour the default, to see if anyone notices
                          -- SLPJ July 06

+      -- In due course I'd like Opt_MonoLocalBinds to be on by default
+      -- But NB it's implied by GADTs etc
+      -- SLPJ September 2010

     : languageExtensions (Just Haskell2010)
 languageExtensions (Just Haskell98)
     = [Opt_ImplicitPrelude,
     : languageExtensions (Just Haskell2010)
 languageExtensions (Just Haskell98)
     = [Opt_ImplicitPrelude,

@@ -823,64 +821,47 @@ languageExtensions (Just Haskell2010)
        Opt_DoAndIfThenElse,
        Opt_RelaxedPolyRec]
 
        Opt_DoAndIfThenElse,
        Opt_RelaxedPolyRec]
 

--- The DOpt class is a temporary workaround, to avoid having to do
--- a mass-renaming dopt->lopt at the moment
-class DOpt a where
-    dopt :: a -> DynFlags -> Bool
-    dopt_set :: DynFlags -> a -> DynFlags
-    dopt_unset :: DynFlags -> a -> DynFlags
-
-instance DOpt DynFlag where
-    dopt = dopt'
-    dopt_set = dopt_set'
-    dopt_unset = dopt_unset'
-
-instance DOpt ExtensionFlag where
-    dopt = lopt
-    dopt_set = lopt_set
-    dopt_unset = lopt_unset
-

 -- | Test whether a 'DynFlag' is set
 -- | Test whether a 'DynFlag' is set

-dopt' :: DynFlag -> DynFlags -> Bool
-dopt' f dflags  = f `elem` (flags dflags)
+dopt :: DynFlag -> DynFlags -> Bool
+dopt f dflags  = f `elem` (flags dflags)

 
 -- | Set a 'DynFlag'
 
 -- | Set a 'DynFlag'

-dopt_set' :: DynFlags -> DynFlag -> DynFlags
-dopt_set' dfs f = dfs{ flags = f : flags dfs }
+dopt_set :: DynFlags -> DynFlag -> DynFlags
+dopt_set dfs f = dfs{ flags = f : flags dfs }

 
 -- | Unset a 'DynFlag'
 
 -- | Unset a 'DynFlag'

-dopt_unset' :: DynFlags -> DynFlag -> DynFlags
-dopt_unset' dfs f = dfs{ flags = filter (/= f) (flags dfs) }
+dopt_unset :: DynFlags -> DynFlag -> DynFlags
+dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }

 
 -- | Test whether a 'ExtensionFlag' is set
 
 -- | Test whether a 'ExtensionFlag' is set

-lopt :: ExtensionFlag -> DynFlags -> Bool
-lopt f dflags = case extensionFlags dflags of
+xopt :: ExtensionFlag -> DynFlags -> Bool
+xopt f dflags = case extensionFlags dflags of

                 Left _ -> panic ("Testing for extension flag " ++ show f ++ " before flattening")
                 Right flags -> f `elem` flags
 
 -- | Set a 'ExtensionFlag'
                 Left _ -> panic ("Testing for extension flag " ++ show f ++ " before flattening")
                 Right flags -> f `elem` flags
 
 -- | Set a 'ExtensionFlag'

-lopt_set :: DynFlags -> ExtensionFlag -> DynFlags
-lopt_set dfs f = case extensionFlags dfs of
+xopt_set :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_set dfs f = case extensionFlags dfs of

                  Left onoffs -> dfs { extensionFlags = Left (On f : onoffs) }
                  Right _ -> panic ("Setting extension flag " ++ show f ++ " after flattening")
 
 -- | Set a 'ExtensionFlag'
                  Left onoffs -> dfs { extensionFlags = Left (On f : onoffs) }
                  Right _ -> panic ("Setting extension flag " ++ show f ++ " after flattening")
 
 -- | Set a 'ExtensionFlag'

-lopt_set_flattened :: DynFlags -> ExtensionFlag -> DynFlags
-lopt_set_flattened dfs f = case extensionFlags dfs of
+xopt_set_flattened :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_set_flattened dfs f = case extensionFlags dfs of

                            Left _ ->
                                panic ("Setting extension flag " ++ show f ++ " before flattening, but expected flattened")
                            Right flags ->
                                dfs { extensionFlags = Right (f : delete f flags) }
 
 -- | Unset a 'ExtensionFlag'
                            Left _ ->
                                panic ("Setting extension flag " ++ show f ++ " before flattening, but expected flattened")
                            Right flags ->
                                dfs { extensionFlags = Right (f : delete f flags) }
 
 -- | Unset a 'ExtensionFlag'

-lopt_unset :: DynFlags -> ExtensionFlag -> DynFlags
-lopt_unset dfs f = case extensionFlags dfs of
+xopt_unset :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_unset dfs f = case extensionFlags dfs of

                    Left onoffs -> dfs { extensionFlags = Left (Off f : onoffs) }
                    Right _ -> panic ("Unsetting extension flag " ++ show f ++ " after flattening")
 
 -- | Unset a 'ExtensionFlag'
                    Left onoffs -> dfs { extensionFlags = Left (Off f : onoffs) }
                    Right _ -> panic ("Unsetting extension flag " ++ show f ++ " after flattening")
 
 -- | Unset a 'ExtensionFlag'

-lopt_unset_flattened :: DynFlags -> ExtensionFlag -> DynFlags
-lopt_unset_flattened dfs f = case extensionFlags dfs of
+xopt_unset_flattened :: DynFlags -> ExtensionFlag -> DynFlags
+xopt_unset_flattened dfs f = case extensionFlags dfs of

                              Left _ ->
                                  panic ("Unsetting extension flag " ++ show f ++ " before flattening, but expected flattened")
                              Right flags ->
                              Left _ ->
                                  panic ("Unsetting extension flag " ++ show f ++ " before flattening, but expected flattened")
                              Right flags ->

@@ -927,9 +908,6 @@ parseDynLibLoaderMode f d =
  case splitAt 8 f of
    ("deploy", "")       -> d{ dynLibLoader = Deployable }
    ("sysdep", "")       -> d{ dynLibLoader = SystemDependent }
  case splitAt 8 f of
    ("deploy", "")       -> d{ dynLibLoader = Deployable }
    ("sysdep", "")       -> d{ dynLibLoader = SystemDependent }

-   ("wrapped", "")      -> d{ dynLibLoader = Wrapped Nothing }
-   ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing }
-   ("wrapped:", flex)   -> d{ dynLibLoader = Wrapped (Just flex) }

    _                    -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f))
 
 setDumpPrefixForce f d = d { dumpPrefixForce = f}
    _                    -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f))
 
 setDumpPrefixForce f d = d { dumpPrefixForce = f}

@@ -1001,94 +979,6 @@ updOptLevel n dfs
    extra_dopts  = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
    remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]
 
    extra_dopts  = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
    remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]
 

-optLevelFlags :: [([Int], DynFlag)]
-optLevelFlags
-  = [ ([0],     Opt_IgnoreInterfacePragmas)
-    , ([0],     Opt_OmitInterfacePragmas)
-
-    , ([1,2],   Opt_IgnoreAsserts)
-    , ([1,2],   Opt_EnableRewriteRules)  -- Off for -O0; see Note [Scoping for Builtin rules]
-                                         --              in PrelRules
-    , ([1,2],   Opt_DoEtaReduction)
-    , ([1,2],   Opt_CaseMerge)
-    , ([1,2],   Opt_Strictness)
-    , ([1,2],   Opt_CSE)
-    , ([1,2],   Opt_FullLaziness)
-    , ([1,2],   Opt_Specialise)
-    , ([1,2],   Opt_FloatIn)
-
-    , ([2],     Opt_LiberateCase)
-    , ([2],     Opt_SpecConstr)
-
---     , ([2],     Opt_StaticArgumentTransformation)
--- Max writes: I think it's probably best not to enable SAT with -O2 for the
--- 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate
--- several improvements to the heuristics, and I'm concerned that without
--- those changes SAT will interfere with some attempts to write "high
--- performance Haskell", as we saw in some posts on Haskell-Cafe earlier
--- this year. In particular, the version in HEAD lacks the tail call
--- criterion, so many things that look like reasonable loops will be
--- turned into functions with extra (unneccesary) thunk creation.
-
-    , ([0,1,2], Opt_DoLambdaEtaExpansion)
-                -- This one is important for a tiresome reason:
-                -- we want to make sure that the bindings for data
-                -- constructors are eta-expanded.  This is probably
-                -- a good thing anyway, but it seems fragile.
-    ]
-
--- -----------------------------------------------------------------------------
--- Standard sets of warning options
-
-standardWarnings :: [DynFlag]
-standardWarnings
-    = [ Opt_WarnWarningsDeprecations,
-        Opt_WarnDeprecatedFlags,
-        Opt_WarnUnrecognisedPragmas,
-        Opt_WarnOverlappingPatterns,
-        Opt_WarnMissingFields,
-        Opt_WarnMissingMethods,
-        Opt_WarnDuplicateExports,
-        Opt_WarnLazyUnliftedBindings,
-        Opt_WarnDodgyForeignImports,
-        Opt_WarnWrongDoBind,
-        Opt_WarnAlternativeLayoutRuleTransitional
-      ]
-
-minusWOpts :: [DynFlag]
-minusWOpts
-    = standardWarnings ++
-      [ Opt_WarnUnusedBinds,
-        Opt_WarnUnusedMatches,
-        Opt_WarnUnusedImports,
-        Opt_WarnIncompletePatterns,
-        Opt_WarnDodgyExports,
-        Opt_WarnDodgyImports
-      ]
-
-minusWallOpts :: [DynFlag]
-minusWallOpts
-    = minusWOpts ++
-      [ Opt_WarnTypeDefaults,
-        Opt_WarnNameShadowing,
-        Opt_WarnMissingSigs,
-        Opt_WarnHiShadows,
-        Opt_WarnOrphans,
-        Opt_WarnUnusedDoBind
-      ]
-
--- minuswRemovesOpts should be every warning option
-minuswRemovesOpts :: [DynFlag]
-minuswRemovesOpts
-    = minusWallOpts ++
-      [Opt_WarnImplicitPrelude,
-       Opt_WarnIncompletePatternsRecUpd,
-       Opt_WarnSimplePatterns,
-       Opt_WarnMonomorphism,
-       Opt_WarnUnrecognisedPragmas,
-       Opt_WarnTabs
-      ]
-

 -- -----------------------------------------------------------------------------
 -- StgToDo:  abstraction of stg-to-stg passes to run.
 
 -- -----------------------------------------------------------------------------
 -- StgToDo:  abstraction of stg-to-stg passes to run.
 

@@ -1176,8 +1066,9 @@ parseDynamicFlags_ dflags0 args pkg_flags = do
                 dflags1{ hscTarget = HscAsm })
 #if !(x86_64_TARGET_ARCH && linux_TARGET_OS)
         | (not opt_Static || opt_PIC) && hscTarget dflags1 == HscLlvm
                 dflags1{ hscTarget = HscAsm })
 #if !(x86_64_TARGET_ARCH && linux_TARGET_OS)
         | (not opt_Static || opt_PIC) && hscTarget dflags1 == HscLlvm

-        = ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and -dynamic on this"
-                ++ "platform; ignoring -fllvm"], dflags1{ hscTarget = HscAsm })
+        = ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and -"
+                ++ "dynamic on this platform;\n              ignoring -fllvm"],
+                dflags1{ hscTarget = HscAsm })

 #endif
         | otherwise = ([], dflags1)
 
 #endif
         | otherwise = ([], dflags1)
 

@@ -1465,8 +1356,8 @@ dynamic_flags = [
                                        setTarget HscNothing))
   , Flag "fbyte-code"       (NoArg (setTarget HscInterpreted))
   , Flag "fobject-code"     (NoArg (setTarget defaultHscTarget))
                                        setTarget HscNothing))
   , Flag "fbyte-code"       (NoArg (setTarget HscInterpreted))
   , Flag "fobject-code"     (NoArg (setTarget defaultHscTarget))

-  , Flag "fglasgow-exts"    (NoArg enableGlasgowExts)
-  , Flag "fno-glasgow-exts" (NoArg disableGlasgowExts)
+  , Flag "fglasgow-exts"    (NoArg (enableGlasgowExts >> deprecate "Use individual extensions instead"))
+  , Flag "fno-glasgow-exts" (NoArg (disableGlasgowExts >> deprecate "Use individual extensions instead"))

  ]
  ++ map (mkFlag True  "f"    setDynFlag  ) fFlags
  ++ map (mkFlag False "fno-" unSetDynFlag) fFlags
  ]
  ++ map (mkFlag True  "f"    setDynFlag  ) fFlags
  ++ map (mkFlag False "fno-" unSetDynFlag) fFlags

@@ -1497,7 +1388,7 @@ type FlagSpec flag
      , Bool -> DynP ())         -- Extra action to run when the flag is found
                                 -- Typically, emit a warning or error
                                 -- True  <=> we are turning the flag on
      , Bool -> DynP ())         -- Extra action to run when the flag is found
                                 -- Typically, emit a warning or error
                                 -- True  <=> we are turning the flag on

-                                -- False <=> we are turning the flag on
+                                -- False <=> we are turning the flag off

 
 
 mkFlag :: Bool                  -- ^ True <=> it should be turned on
 
 
 mkFlag :: Bool                  -- ^ True <=> it should be turned on

@@ -1539,9 +1430,9 @@ fFlags = [
   ( "warn-missing-import-lists",        Opt_WarnMissingImportList, nop ),
   ( "warn-missing-methods",             Opt_WarnMissingMethods, nop ),
   ( "warn-missing-signatures",          Opt_WarnMissingSigs, nop ),
   ( "warn-missing-import-lists",        Opt_WarnMissingImportList, nop ),
   ( "warn-missing-methods",             Opt_WarnMissingMethods, nop ),
   ( "warn-missing-signatures",          Opt_WarnMissingSigs, nop ),

+  ( "warn-missing-local-sigs",          Opt_WarnMissingLocalSigs, nop ),

   ( "warn-name-shadowing",              Opt_WarnNameShadowing, nop ),
   ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns, nop ),
   ( "warn-name-shadowing",              Opt_WarnNameShadowing, nop ),
   ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns, nop ),

-  ( "warn-simple-patterns",             Opt_WarnSimplePatterns, nop ),

   ( "warn-type-defaults",               Opt_WarnTypeDefaults, nop ),
   ( "warn-monomorphism-restriction",    Opt_WarnMonomorphism, nop ),
   ( "warn-unused-binds",                Opt_WarnUnusedBinds, nop ),
   ( "warn-type-defaults",               Opt_WarnTypeDefaults, nop ),
   ( "warn-monomorphism-restriction",    Opt_WarnMonomorphism, nop ),
   ( "warn-unused-binds",                Opt_WarnUnusedBinds, nop ),

@@ -1551,10 +1442,10 @@ fFlags = [
   ( "warn-deprecations",                Opt_WarnWarningsDeprecations, nop ),
   ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, nop ),
   ( "warn-orphans",                     Opt_WarnOrphans, nop ),
   ( "warn-deprecations",                Opt_WarnWarningsDeprecations, nop ),
   ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, nop ),
   ( "warn-orphans",                     Opt_WarnOrphans, nop ),

+  ( "warn-auto-orphans",                Opt_WarnAutoOrphans, nop ),

   ( "warn-tabs",                        Opt_WarnTabs, nop ),
   ( "warn-unrecognised-pragmas",        Opt_WarnUnrecognisedPragmas, nop ),
   ( "warn-tabs",                        Opt_WarnTabs, nop ),
   ( "warn-unrecognised-pragmas",        Opt_WarnUnrecognisedPragmas, nop ),

-  ( "warn-lazy-unlifted-bindings",      Opt_WarnLazyUnliftedBindings,
-    \_ -> deprecate "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"),
+  ( "warn-lazy-unlifted-bindings",      Opt_WarnLazyUnliftedBindings, nop),

   ( "warn-unused-do-bind",              Opt_WarnUnusedDoBind, nop ),
   ( "warn-wrong-do-bind",               Opt_WarnWrongDoBind, nop ),
   ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ),
   ( "warn-unused-do-bind",              Opt_WarnUnusedDoBind, nop ),
   ( "warn-wrong-do-bind",               Opt_WarnWrongDoBind, nop ),
   ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ),

@@ -1678,8 +1569,7 @@ xFlags = [
   ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, nop ),
   ( "Rank2Types",                       Opt_Rank2Types, nop ),
   ( "RankNTypes",                       Opt_RankNTypes, nop ),
   ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, nop ),
   ( "Rank2Types",                       Opt_Rank2Types, nop ),
   ( "RankNTypes",                       Opt_RankNTypes, nop ),

-  ( "ImpredicativeTypes",               Opt_ImpredicativeTypes, 
-        \_ -> deprecate "impredicative polymorphism will be simplified or removed in GHC 6.14" ),
+  ( "ImpredicativeTypes",               Opt_ImpredicativeTypes, nop), 

   ( "TypeOperators",                    Opt_TypeOperators, nop ),
   ( "RecursiveDo",                      Opt_RecursiveDo,
     deprecatedForExtension "DoRec"),
   ( "TypeOperators",                    Opt_TypeOperators, nop ),
   ( "RecursiveDo",                      Opt_RecursiveDo,
     deprecatedForExtension "DoRec"),

@@ -1709,7 +1599,10 @@ xFlags = [
   ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, nop ),
   ( "DatatypeContexts",                 Opt_DatatypeContexts, nop ),
   ( "MonoLocalBinds",                   Opt_MonoLocalBinds, nop ),
   ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, nop ),
   ( "DatatypeContexts",                 Opt_DatatypeContexts, nop ),
   ( "MonoLocalBinds",                   Opt_MonoLocalBinds, nop ),

-  ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec, nop ),
+  ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec, 
+    \ turn_on -> if not turn_on 
+                 then deprecate "You can't turn off RelaxedPolyRec any more"
+                 else return () ),

   ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules, nop ),
   ( "ImplicitParams",                   Opt_ImplicitParams, nop ),
   ( "ScopedTypeVariables",              Opt_ScopedTypeVariables, nop ),
   ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules, nop ),
   ( "ImplicitParams",                   Opt_ImplicitParams, nop ),
   ( "ScopedTypeVariables",              Opt_ScopedTypeVariables, nop ),

@@ -1738,6 +1631,27 @@ xFlags = [
     \_ -> deprecate "The new qualified operator syntax was rejected by Haskell'" )
   ]
 
     \_ -> deprecate "The new qualified operator syntax was rejected by Haskell'" )
   ]
 

+defaultFlags :: [DynFlag]
+defaultFlags 
+  = [ Opt_AutoLinkPackages,
+      Opt_ReadUserPackageConf,
+
+      Opt_MethodSharing,
+
+      Opt_DoAsmMangling,
+
+      Opt_SharedImplib,
+
+      Opt_GenManifest,
+      Opt_EmbedManifest,
+      Opt_PrintBindContents
+    ]
+
+    ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
+             -- The default -O0 options
+
+    ++ standardWarnings
+

 impliedFlags :: [(ExtensionFlag, ExtensionFlag)]
 impliedFlags
   = [ (Opt_RankNTypes,                Opt_ExplicitForAll)
 impliedFlags :: [(ExtensionFlag, ExtensionFlag)]
 impliedFlags
   = [ (Opt_RankNTypes,                Opt_ExplicitForAll)

@@ -1747,15 +1661,12 @@ impliedFlags
     , (Opt_ExistentialQuantification, Opt_ExplicitForAll)
     , (Opt_PolymorphicComponents,     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_GADTs,                  Opt_MonoLocalBinds)
+    , (Opt_TypeFamilies,           Opt_MonoLocalBinds)

 
 

-    , (Opt_TypeFamilies,        Opt_RelaxedPolyRec)  -- Trac #2944 gives a nice example

     , (Opt_TypeFamilies,        Opt_KindSignatures)  -- Type families use kind signatures
                                                     -- all over the place
 
     , (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
     , (Opt_ImpredicativeTypes,  Opt_RankNTypes)
 
        -- Record wild-cards implies field disambiguation

@@ -1765,6 +1676,95 @@ impliedFlags
     , (Opt_RecordWildCards,     Opt_DisambiguateRecordFields)
   ]
 
     , (Opt_RecordWildCards,     Opt_DisambiguateRecordFields)
   ]
 

+optLevelFlags :: [([Int], DynFlag)]
+optLevelFlags
+  = [ ([0],     Opt_IgnoreInterfacePragmas)
+    , ([0],     Opt_OmitInterfacePragmas)
+
+    , ([1,2],   Opt_IgnoreAsserts)
+    , ([1,2],   Opt_EnableRewriteRules)  -- Off for -O0; see Note [Scoping for Builtin rules]
+                                         --              in PrelRules
+    , ([1,2],   Opt_DoEtaReduction)
+    , ([1,2],   Opt_CaseMerge)
+    , ([1,2],   Opt_Strictness)
+    , ([1,2],   Opt_CSE)
+    , ([1,2],   Opt_FullLaziness)
+    , ([1,2],   Opt_Specialise)
+    , ([1,2],   Opt_FloatIn)
+
+    , ([2],     Opt_LiberateCase)
+    , ([2],     Opt_SpecConstr)
+    , ([2],     Opt_RegsGraph)
+
+--     , ([2],     Opt_StaticArgumentTransformation)
+-- Max writes: I think it's probably best not to enable SAT with -O2 for the
+-- 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate
+-- several improvements to the heuristics, and I'm concerned that without
+-- those changes SAT will interfere with some attempts to write "high
+-- performance Haskell", as we saw in some posts on Haskell-Cafe earlier
+-- this year. In particular, the version in HEAD lacks the tail call
+-- criterion, so many things that look like reasonable loops will be
+-- turned into functions with extra (unneccesary) thunk creation.
+
+    , ([0,1,2], Opt_DoLambdaEtaExpansion)
+                -- This one is important for a tiresome reason:
+                -- we want to make sure that the bindings for data
+                -- constructors are eta-expanded.  This is probably
+                -- a good thing anyway, but it seems fragile.
+    ]
+
+-- -----------------------------------------------------------------------------
+-- Standard sets of warning options
+
+standardWarnings :: [DynFlag]
+standardWarnings
+    = [ Opt_WarnWarningsDeprecations,
+        Opt_WarnDeprecatedFlags,
+        Opt_WarnUnrecognisedPragmas,
+        Opt_WarnOverlappingPatterns,
+        Opt_WarnMissingFields,
+        Opt_WarnMissingMethods,
+        Opt_WarnDuplicateExports,
+        Opt_WarnLazyUnliftedBindings,
+        Opt_WarnDodgyForeignImports,
+        Opt_WarnWrongDoBind,
+        Opt_WarnAlternativeLayoutRuleTransitional
+      ]
+
+minusWOpts :: [DynFlag]
+minusWOpts
+    = standardWarnings ++
+      [ Opt_WarnUnusedBinds,
+        Opt_WarnUnusedMatches,
+        Opt_WarnUnusedImports,
+        Opt_WarnIncompletePatterns,
+        Opt_WarnDodgyExports,
+        Opt_WarnDodgyImports
+      ]
+
+minusWallOpts :: [DynFlag]
+minusWallOpts
+    = minusWOpts ++
+      [ Opt_WarnTypeDefaults,
+        Opt_WarnNameShadowing,
+        Opt_WarnMissingSigs,
+        Opt_WarnHiShadows,
+        Opt_WarnOrphans,
+        Opt_WarnUnusedDoBind
+      ]
+
+-- minuswRemovesOpts should be every warning option
+minuswRemovesOpts :: [DynFlag]
+minuswRemovesOpts
+    = minusWallOpts ++
+      [Opt_WarnImplicitPrelude,
+       Opt_WarnIncompletePatternsRecUpd,
+       Opt_WarnMonomorphism,
+       Opt_WarnUnrecognisedPragmas,
+       Opt_WarnAutoOrphans,
+       Opt_WarnTabs
+      ]
+

 enableGlasgowExts :: DynP ()
 enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls
                        mapM_ setExtensionFlag glasgowExtsFlags
 enableGlasgowExts :: DynP ()
 enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls
                        mapM_ setExtensionFlag glasgowExtsFlags

@@ -1777,7 +1777,6 @@ glasgowExtsFlags :: [ExtensionFlag]
 glasgowExtsFlags = [
              Opt_ForeignFunctionInterface
            , Opt_UnliftedFFITypes
 glasgowExtsFlags = [
              Opt_ForeignFunctionInterface
            , Opt_UnliftedFFITypes

-           , Opt_GADTs

            , Opt_ImplicitParams
            , Opt_ScopedTypeVariables
            , Opt_UnboxedTuples
            , Opt_ImplicitParams
            , Opt_ScopedTypeVariables
            , Opt_UnboxedTuples

@@ -1805,15 +1804,15 @@ glasgowExtsFlags = [
            , Opt_ParallelListComp
            , Opt_EmptyDataDecls
            , Opt_KindSignatures
            , Opt_ParallelListComp
            , Opt_EmptyDataDecls
            , Opt_KindSignatures

-           , Opt_GeneralizedNewtypeDeriving
-           , Opt_TypeFamilies ]
+           , Opt_GeneralizedNewtypeDeriving ]

 
 

+#ifdef GHCI

 -- Consult the RTS to find whether GHC itself has been built profiled
 -- If so, you can't use Template Haskell
 foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt
 
 rtsIsProfiled :: Bool
 -- Consult the RTS to find whether GHC itself has been built profiled
 -- If so, you can't use Template Haskell
 foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt
 
 rtsIsProfiled :: Bool

-rtsIsProfiled = False -- unsafePerformIO rtsIsProfiledIO /= 0
+rtsIsProfiled = unsafePerformIO rtsIsProfiledIO /= 0

 
 checkTemplateHaskellOk :: Bool -> DynP ()
 checkTemplateHaskellOk turn_on 
 
 checkTemplateHaskellOk :: Bool -> DynP ()
 checkTemplateHaskellOk turn_on 

@@ -1821,6 +1820,12 @@ checkTemplateHaskellOk turn_on
   = addErr "You can't use Template Haskell with a profiled compiler"
   | otherwise
   = return ()
   = addErr "You can't use Template Haskell with a profiled compiler"
   | otherwise
   = return ()

+#else
+-- In stage 1 we don't know that the RTS has rts_isProfiled, 
+-- so we simply say "ok".  It doesn't matter because TH isn't
+-- available in stage 1 anyway.
+checkTemplateHaskellOk turn_on = return ()
+#endif

 
 {- **********************************************************************
 %*                                                                     *
 
 {- **********************************************************************
 %*                                                                     *

@@ -1865,7 +1870,7 @@ setLanguage l = upd (\dfs -> dfs { language = Just l })
 
 --------------------------
 setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP ()
 
 --------------------------
 setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP ()

-setExtensionFlag f = do { upd (\dfs -> lopt_set dfs f)
+setExtensionFlag f = do { upd (\dfs -> xopt_set dfs f)

                         ; mapM_ setExtensionFlag deps }
   where
     deps = [ d | (f', d) <- impliedFlags, f' == f ]
                         ; mapM_ setExtensionFlag deps }
   where
     deps = [ d | (f', d) <- impliedFlags, f' == f ]

@@ -1875,7 +1880,7 @@ setExtensionFlag f = do { upd (\dfs -> lopt_set dfs f)
         -- When you un-set f, however, we don't un-set the things it implies
         --      (except for -fno-glasgow-exts, which is treated specially)
 
         -- When you un-set f, however, we don't un-set the things it implies
         --      (except for -fno-glasgow-exts, which is treated specially)
 

-unSetExtensionFlag f = upd (\dfs -> lopt_unset dfs f)
+unSetExtensionFlag f = upd (\dfs -> xopt_unset dfs f)

 
 --------------------------
 setDumpFlag' :: DynFlag -> DynP ()
 
 --------------------------
 setDumpFlag' :: DynFlag -> DynP ()

@@ -2137,7 +2142,12 @@ setOptHpcDir arg  = upd $ \ d -> d{hpcDir = arg}
 
 machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
                               [String]) -- for registerised HC compilations
 
 machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
                               [String]) -- for registerised HC compilations

-machdepCCOpts _dflags
+machdepCCOpts dflags = let (flagsAll, flagsRegHc) = machdepCCOpts' dflags
+                       in (cCcOpts ++ flagsAll, flagsRegHc)
+
+machdepCCOpts' :: DynFlags -> ([String], -- flags for all C compilations
+                               [String]) -- for registerised HC compilations
+machdepCCOpts' _dflags

 #if alpha_TARGET_ARCH
         =       ( ["-w", "-mieee"
 #ifdef HAVE_THREADED_RTS_SUPPORT
 #if alpha_TARGET_ARCH
         =       ( ["-w", "-mieee"
 #ifdef HAVE_THREADED_RTS_SUPPORT

@@ -2172,19 +2182,9 @@ machdepCCOpts _dflags
       --   the fp (%ebp) for our register maps.
         =  let n_regs = stolen_x86_regs _dflags
            in
       --   the fp (%ebp) for our register maps.
         =  let n_regs = stolen_x86_regs _dflags
            in

-                    ( 
-#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 ""
                       ],
                       [ 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

@@ -2199,11 +2199,7 @@ machdepCCOpts _dflags
 
 #elif x86_64_TARGET_ARCH
         = (
 
 #elif x86_64_TARGET_ARCH
         = (

-#if darwin_TARGET_OS
-            ["-m64"],
-#else
-            [],
-#endif
+                [],

                 ["-fomit-frame-pointer",
                  "-fno-asynchronous-unwind-tables",
                         -- the unwind tables are unnecessary for HC code,
                 ["-fomit-frame-pointer",
                  "-fno-asynchronous-unwind-tables",
                         -- the unwind tables are unnecessary for HC code,

@@ -2289,6 +2285,7 @@ compilerInfo = [("Project name",                String cProjectName),
                 ("Object splitting",            String cSplitObjs),
                 ("Have native code generator",  String cGhcWithNativeCodeGen),
                 ("Have llvm code generator",    String cGhcWithLlvmCodeGen),
                 ("Object splitting",            String cSplitObjs),
                 ("Have native code generator",  String cGhcWithNativeCodeGen),
                 ("Have llvm code generator",    String cGhcWithLlvmCodeGen),

+                ("Use archives for ghci",       String (show cUseArchivesForGhci)),

                 ("Support SMP",                 String cGhcWithSMP),
                 ("Unregisterised",              String cGhcUnregisterised),
                 ("Tables next to code",         String cGhcEnableTablesNextToCode),
                 ("Support SMP",                 String cGhcWithSMP),
                 ("Unregisterised",              String cGhcUnregisterised),
                 ("Tables next to code",         String cGhcEnableTablesNextToCode),