Remove (most of) the FiniteMap wrapper
[ghc-hetmet.git] / compiler / main / DynFlags.hs
index 1775bbf..47d9f6d 100644 (file)
@@ -17,6 +17,7 @@ module DynFlags (
         DOpt(..),
         DynFlag(..),
         ExtensionFlag(..),
+        glasgowExtsFlags,
         flattenExtensionFlags,
         ensureFlattenedExtensionFlags,
         lopt_set_flattened,
@@ -60,7 +61,12 @@ module DynFlags (
 
         -- * 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"
@@ -82,7 +88,6 @@ import Util
 import Maybes           ( orElse )
 import SrcLoc
 import FastString
-import FiniteMap
 import Outputable
 import Foreign.C       ( CInt )
 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
@@ -93,6 +98,8 @@ import Control.Monad    ( when )
 
 import Data.Char
 import Data.List
+import Data.Map (Map)
+import qualified Data.Map as Map
 import System.FilePath
 import System.IO        ( stderr, hPutChar )
 
@@ -287,6 +294,7 @@ data ExtensionFlag
    | Opt_MonomorphismRestriction
    | Opt_MonoPatBinds
    | Opt_MonoLocalBinds
+   | Opt_RelaxedPolyRec                -- Deprecated
    | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
    | Opt_ForeignFunctionInterface
    | Opt_UnliftedFFITypes
@@ -308,7 +316,6 @@ data ExtensionFlag
    | Opt_RecordPuns
    | Opt_ViewPatterns
    | Opt_GADTs
-   | Opt_RelaxedPolyRec
    | Opt_NPlusKPatterns
    | Opt_DoAndIfThenElse
 
@@ -482,7 +489,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],
-  dirsToClean           :: IORef (FiniteMap FilePath FilePath),
+  dirsToClean           :: IORef (Map FilePath FilePath),
 
   -- hsc dynamic flags
   flags                 :: [DynFlag],
@@ -595,7 +602,6 @@ defaultObjectTarget
 
 data DynLibLoader
   = Deployable
-  | Wrapped (Maybe String)
   | SystemDependent
   deriving Eq
 
@@ -607,7 +613,7 @@ initDynFlags dflags = do
  -- 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),
@@ -725,24 +731,7 @@ defaultDynFlags =
         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 [],
 
@@ -807,6 +796,8 @@ languageExtensions Nothing
     = 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
+      -- SLPJ September 2010
     : languageExtensions (Just Haskell2010)
 languageExtensions (Just Haskell98)
     = [Opt_ImplicitPrelude,
@@ -927,9 +918,6 @@ parseDynLibLoaderMode f d =
  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}
@@ -1001,94 +989,6 @@ updOptLevel n dfs
    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.
 
@@ -1498,7 +1398,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
-                                -- False <=> we are turning the flag on
+                                -- False <=> we are turning the flag off
 
 
 mkFlag :: Bool                  -- ^ True <=> it should be turned on
@@ -1554,8 +1454,7 @@ fFlags = [
   ( "warn-orphans",                     Opt_WarnOrphans, 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 ),
@@ -1710,7 +1609,10 @@ xFlags = [
   ( "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 ),
@@ -1739,6 +1641,27 @@ xFlags = [
     \_ -> 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)
@@ -1748,15 +1671,13 @@ impliedFlags
     , (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_FunctionalDependencies, 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_ScopedTypeVariables, Opt_RelaxedPolyRec)  -- Ditto for scoped type variables; see
-                                                     --      Note [Scoped tyvars] in TcBinds
     , (Opt_ImpredicativeTypes,  Opt_RankNTypes)
 
        -- Record wild-cards implies field disambiguation
@@ -1766,6 +1687,95 @@ impliedFlags
     , (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_WarnSimplePatterns,
+       Opt_WarnMonomorphism,
+       Opt_WarnUnrecognisedPragmas,
+       Opt_WarnTabs
+      ]
+
 enableGlasgowExts :: DynP ()
 enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls
                        mapM_ setExtensionFlag glasgowExtsFlags
@@ -1809,12 +1819,13 @@ glasgowExtsFlags = [
            , Opt_GeneralizedNewtypeDeriving
            , Opt_TypeFamilies ]
 
+#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
-rtsIsProfiled = False -- unsafePerformIO rtsIsProfiledIO /= 0
+rtsIsProfiled = unsafePerformIO rtsIsProfiledIO /= 0
 
 checkTemplateHaskellOk :: Bool -> DynP ()
 checkTemplateHaskellOk turn_on 
@@ -1822,6 +1833,12 @@ checkTemplateHaskellOk turn_on
   = 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
 
 {- **********************************************************************
 %*                                                                     *
@@ -2138,7 +2155,12 @@ setOptHpcDir arg  = upd $ \ d -> d{hpcDir = arg}
 
 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
@@ -2173,19 +2195,9 @@ machdepCCOpts _dflags
       --   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 ""
                       ],
-#endif
                       [ "-fno-defer-pop",
                         "-fomit-frame-pointer",
                         -- we want -fno-builtin, because when gcc inlines
@@ -2200,11 +2212,7 @@ machdepCCOpts _dflags
 
 #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,