Add tuple sections as a new feature
[ghc-hetmet.git] / compiler / main / DynFlags.hs
index d04dade..500d257 100644 (file)
@@ -1,4 +1,3 @@
-
 -- |
 -- Dynamic flags
 --
@@ -18,7 +17,7 @@ module DynFlags (
         GhcMode(..), isOneShot,
         GhcLink(..), isNoLink,
         PackageFlag(..),
-        Option(..),
+        Option(..), showOpt,
         DynLibLoader(..),
         fFlags, xFlags,
         dphPackage,
@@ -31,7 +30,6 @@ module DynFlags (
         dopt_set, dopt_unset,           -- DynFlags -> DynFlag -> DynFlags
         getOpts,                        -- DynFlags -> (DynFlags -> [a]) -> [a]
         getVerbFlag,
-        getMainFun,
         updOptLevel,
         setTmpDir,
         setPackageName,
@@ -59,17 +57,19 @@ module DynFlags (
         getStgToDo,
 
         -- * Compiler configuration suitable for display to the user
+        Printable(..),
         compilerInfo
   ) where
 
 #include "HsVersions.h"
 
+#ifndef OMIT_NATIVE_CODEGEN
+import Platform
+#endif
 import Module
 import PackageConfig
-import PrelNames        ( mAIN, main_RDR_Unqual )
-import RdrName          ( RdrName, mkRdrUnqual )
-import OccName          ( mkVarOccFS )
-#ifdef i386_TARGET_ARCH
+import 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,
@@ -93,7 +93,7 @@ import Data.IORef
 import Control.Monad    ( when )
 
 import Data.Char
-import Data.List        ( intersperse )
+import Data.List
 import System.FilePath
 import System.IO        ( stderr, hPutChar )
 
@@ -117,6 +117,7 @@ data DynFlag
    | Opt_D_dump_asm_regalloc_stages
    | Opt_D_dump_asm_conflicts
    | Opt_D_dump_asm_stats
+   | Opt_D_dump_asm_expanded
    | Opt_D_dump_cpranal
    | Opt_D_dump_deriv
    | Opt_D_dump_ds
@@ -185,11 +186,16 @@ data DynFlag
    | Opt_WarnUnusedMatches
    | Opt_WarnWarningsDeprecations
    | Opt_WarnDeprecatedFlags
+   | Opt_WarnDodgyExports
    | Opt_WarnDodgyImports
    | Opt_WarnOrphans
    | Opt_WarnTabs
    | Opt_WarnUnrecognisedPragmas
    | Opt_WarnDodgyForeignImports
+   | Opt_WarnLazyUnliftedBindings
+   | Opt_WarnUnusedDoBind
+   | Opt_WarnWrongDoBind
+
 
    -- language opts
    | Opt_OverlappingInstances
@@ -197,9 +203,11 @@ data DynFlag
    | Opt_IncoherentInstances
    | Opt_MonomorphismRestriction
    | Opt_MonoPatBinds
+   | Opt_MonoLocalBinds
    | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
    | Opt_ForeignFunctionInterface
    | Opt_UnliftedFFITypes
+   | Opt_GHCForeignImportPrim
    | Opt_PArr                           -- Syntactic support for parallel arrays
    | Opt_Arrows                         -- Arrow-notation syntax
    | Opt_TemplateHaskell
@@ -218,8 +226,13 @@ data DynFlag
    | Opt_ViewPatterns
    | Opt_GADTs
    | Opt_RelaxedPolyRec
+
    | Opt_StandaloneDeriving
    | Opt_DeriveDataTypeable
+   | Opt_DeriveFunctor
+   | Opt_DeriveTraversable
+   | Opt_DeriveFoldable
+
    | Opt_TypeSynonymInstances
    | Opt_FlexibleContexts
    | Opt_FlexibleInstances
@@ -237,6 +250,7 @@ data DynFlag
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo
    | Opt_PostfixOperators
+   | Opt_TupleSections
    | Opt_PatternGuards
    | Opt_LiberalTypeSynonyms
    | Opt_Rank2Types
@@ -298,6 +312,8 @@ data DynFlag
    | Opt_PrintBindContents
    | Opt_GenManifest
    | Opt_EmbedManifest
+   | Opt_EmitExternalCore
+   | Opt_SharedImplib
 
        -- temporary flags
    | Opt_RunCPS
@@ -338,6 +354,9 @@ data DynFlags = DynFlags {
   specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function
   liberateCaseThreshold :: Maybe Int,   -- ^ Threshold for LiberateCase
 
+#ifndef OMIT_NATIVE_CODEGEN
+  targetPlatform       :: Platform,    -- ^ The platform we're compiling for. Used by the NCG.
+#endif
   stolen_x86_regs       :: Int,
   cmdlineHcIncludes     :: [String],    -- ^ @\-\#includes@
   importPaths           :: [FilePath],
@@ -583,6 +602,9 @@ defaultDynFlags =
         specConstrThreshold     = Just 200,
         specConstrCount         = Just 3,
         liberateCaseThreshold   = Just 200,
+#ifndef OMIT_NATIVE_CODEGEN
+        targetPlatform          = defaultTargetPlatform,
+#endif
         stolen_x86_regs         = 4,
         cmdlineHcIncludes       = [],
         importPaths             = ["."],
@@ -604,7 +626,7 @@ defaultDynFlags =
 
         outputFile              = Nothing,
         outputHi                = Nothing,
-        dynLibLoader            = Deployable,
+        dynLibLoader            = SystemDependent,
         dumpPrefix              = Nothing,
         dumpPrefixForce         = Nothing,
         includePaths            = [],
@@ -676,6 +698,8 @@ defaultDynFlags =
 
             Opt_DoAsmMangling,
 
+            Opt_SharedImplib,
+
             Opt_GenManifest,
             Opt_EmbedManifest,
             Opt_PrintBindContents
@@ -808,7 +832,7 @@ addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d }
 -- We used to use "-optdep-flag -optdeparg", so for legacy applications
 -- we need to strip the "-optdep" off of the arg
 deOptDep :: String -> String
-deOptDep x = case maybePrefixMatch "-optdep" x of
+deOptDep x = case stripPrefix "-optdep" x of
              Just rest -> rest
              Nothing -> x
 
@@ -832,6 +856,10 @@ data Option
               String  -- the filepath/filename portion
  | Option     String
 
+showOpt :: Option -> String
+showOpt (FileOption pre f) = pre ++ f
+showOpt (Option s)  = s
+
 -----------------------------------------------------------------------------
 -- Setting the optimisation level
 
@@ -893,7 +921,9 @@ standardWarnings
         Opt_WarnMissingFields,
         Opt_WarnMissingMethods,
         Opt_WarnDuplicateExports,
-        Opt_WarnDodgyForeignImports
+        Opt_WarnLazyUnliftedBindings,
+        Opt_WarnDodgyForeignImports,
+        Opt_WarnWrongDoBind
       ]
 
 minusWOpts :: [DynFlag]
@@ -903,6 +933,7 @@ minusWOpts
         Opt_WarnUnusedMatches,
         Opt_WarnUnusedImports,
         Opt_WarnIncompletePatterns,
+        Opt_WarnDodgyExports,
         Opt_WarnDodgyImports
       ]
 
@@ -913,7 +944,8 @@ minusWallOpts
         Opt_WarnNameShadowing,
         Opt_WarnMissingSigs,
         Opt_WarnHiShadows,
-        Opt_WarnOrphans
+        Opt_WarnOrphans,
+        Opt_WarnUnusedDoBind
       ]
 
 -- minuswRemovesOpts should be every warning option
@@ -990,8 +1022,8 @@ pprFloatOutSwitches sw = pp_not (floatOutLambdas sw) <+> text "lambdas" <> comma
     pp_not False = text "not"
 
 -- | Switches that specify the minimum amount of floating out
-gentleFloatOutSwitches :: FloatOutSwitches
-gentleFloatOutSwitches = FloatOutSwitches False False
+-- gentleFloatOutSwitches :: FloatOutSwitches
+-- gentleFloatOutSwitches = FloatOutSwitches False False
 
 -- | Switches that do not specify floating out of lambdas, just of constants
 constantsOnlyFloatOutSwitches :: FloatOutSwitches
@@ -1093,7 +1125,14 @@ getCoreToDo dflags
         -- so that overloaded functions have all their dictionary lambdas manifest
         CoreDoSpecialising,
 
-        runWhen full_laziness (CoreDoFloatOutwards gentleFloatOutSwitches),
+        runWhen full_laziness (CoreDoFloatOutwards constantsOnlyFloatOutSwitches),
+               -- Was: gentleFloatOutSwitches  
+               -- I have no idea why, but not floating constants to top level is
+               -- very bad in some cases. 
+               -- Notably: p_ident in spectral/rewrite
+               --          Changing from "gentle" to "constantsOnly" improved
+               --          rewrite's allocation by 19%, and made  0.0% difference
+               --          to any other nofib benchmark
 
         CoreDoFloatInwards,
 
@@ -1343,6 +1382,8 @@ dynamic_flags = [
          Supported
   , Flag "ddump-asm-stats"         (setDumpFlag Opt_D_dump_asm_stats)
          Supported
+  , Flag "ddump-asm-expanded"      (setDumpFlag Opt_D_dump_asm_expanded)
+         Supported
   , Flag "ddump-cpranal"           (setDumpFlag Opt_D_dump_cpranal)
          Supported
   , Flag "ddump-deriv"             (setDumpFlag Opt_D_dump_deriv)
@@ -1614,6 +1655,7 @@ useInstead flag turn_on
 fFlags :: [(String, DynFlag, Bool -> Deprecated)]
 fFlags = [
   ( "warn-dodgy-foreign-imports",       Opt_WarnDodgyForeignImports, const Supported ),
+  ( "warn-dodgy-exports",               Opt_WarnDodgyExports, const Supported ),
   ( "warn-dodgy-imports",               Opt_WarnDodgyImports, const Supported ),
   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports, const Supported ),
   ( "warn-hi-shadowing",                Opt_WarnHiShadows, const Supported ),
@@ -1637,6 +1679,10 @@ fFlags = [
   ( "warn-orphans",                     Opt_WarnOrphans, const Supported ),
   ( "warn-tabs",                        Opt_WarnTabs, const Supported ),
   ( "warn-unrecognised-pragmas",        Opt_WarnUnrecognisedPragmas, const Supported ),
+  ( "warn-lazy-unlifted-bindings",      Opt_WarnLazyUnliftedBindings,
+    const $ Deprecated "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"),
+  ( "warn-unused-do-bind",              Opt_WarnUnusedDoBind, const Supported ),
+  ( "warn-wrong-do-bind",               Opt_WarnWrongDoBind, const Supported ),
   ( "print-explicit-foralls",           Opt_PrintExplicitForalls, const Supported ),
   ( "strictness",                       Opt_Strictness, const Supported ),
   ( "static-argument-transformation",   Opt_StaticArgumentTransformation, const Supported ),
@@ -1707,6 +1753,8 @@ fFlags = [
     deprecatedForLanguage "IncoherentInstances" ),
   ( "gen-manifest",                     Opt_GenManifest, const Supported ),
   ( "embed-manifest",                   Opt_EmbedManifest, const Supported ),
+  ( "ext-core",                         Opt_EmitExternalCore, const Supported ),
+  ( "shared-implib",                    Opt_SharedImplib, const Supported ),
   ( "implicit-import-qualified",        Opt_ImplicitImportQualified, const Supported )
   ]
 
@@ -1722,6 +1770,7 @@ xFlags :: [(String, DynFlag, Bool -> Deprecated)]
 xFlags = [
   ( "CPP",                              Opt_Cpp, const Supported ),
   ( "PostfixOperators",                 Opt_PostfixOperators, const Supported ),
+  ( "TupleSections",                    Opt_TupleSections, const Supported ),
   ( "PatternGuards",                    Opt_PatternGuards, const Supported ),
   ( "UnicodeSyntax",                    Opt_UnicodeSyntax, const Supported ),
   ( "MagicHash",                        Opt_MagicHash, const Supported ),
@@ -1733,6 +1782,7 @@ xFlags = [
   ( "TransformListComp",                Opt_TransformListComp, const Supported ),
   ( "ForeignFunctionInterface",         Opt_ForeignFunctionInterface, const Supported ),
   ( "UnliftedFFITypes",                 Opt_UnliftedFFITypes, const Supported ),
+  ( "GHCForeignImportPrim",             Opt_GHCForeignImportPrim, const Supported ),
   ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, const Supported ),
   ( "Rank2Types",                       Opt_Rank2Types, const Supported ),
   ( "RankNTypes",                       Opt_RankNTypes, const Supported ),
@@ -1760,6 +1810,7 @@ xFlags = [
   ( "MonomorphismRestriction",          Opt_MonomorphismRestriction, const Supported ),
   -- On by default (which is not strictly H98):
   ( "MonoPatBinds",                     Opt_MonoPatBinds, const Supported ),
+  ( "MonoLocalBinds",                   Opt_MonoLocalBinds, const Supported ),
   ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec, const Supported ),
   ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules, const Supported ),
   ( "ImplicitParams",                   Opt_ImplicitParams, const Supported ),
@@ -1771,6 +1822,9 @@ xFlags = [
   ( "UnboxedTuples",                    Opt_UnboxedTuples, const Supported ),
   ( "StandaloneDeriving",               Opt_StandaloneDeriving, const Supported ),
   ( "DeriveDataTypeable",               Opt_DeriveDataTypeable, const Supported ),
+  ( "DeriveFunctor",                    Opt_DeriveFunctor, const Supported ),
+  ( "DeriveTraversable",                Opt_DeriveTraversable, const Supported ),
+  ( "DeriveFoldable",                   Opt_DeriveFoldable, const Supported ),
   ( "TypeSynonymInstances",             Opt_TypeSynonymInstances, const Supported ),
   ( "FlexibleContexts",                 Opt_FlexibleContexts, const Supported ),
   ( "FlexibleInstances",                Opt_FlexibleInstances, const Supported ),
@@ -1790,8 +1844,13 @@ impliedFlags
   = [ (Opt_GADTs,               Opt_RelaxedPolyRec)  -- We want type-sig variables to
                                                      --      be completely rigid for GADTs
 
+    , (Opt_TypeFamilies,        Opt_RelaxedPolyRec)  -- Trac #2944 gives a nice example
+    , (Opt_TypeFamilies,        Opt_KindSignatures)  -- Type families use kind signatures
+                                                    -- all over the place
+
     , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec)  -- Ditto for scoped type variables; see
                                                      --      Note [Scoped tyvars] in TcBinds
+    , (Opt_ImpredicativeTypes,  Opt_RankNTypes)
   ]
 
 glasgowExtsFlags :: [DynFlag]
@@ -1806,6 +1865,9 @@ glasgowExtsFlags = [
            , Opt_TypeSynonymInstances
            , Opt_StandaloneDeriving
            , Opt_DeriveDataTypeable
+           , Opt_DeriveFunctor
+           , Opt_DeriveFoldable
+           , Opt_DeriveTraversable
            , Opt_FlexibleContexts
            , Opt_FlexibleInstances
            , Opt_ConstrainedClassMethods
@@ -2017,12 +2079,15 @@ setOptLevel n dflags
 --                                      sometimes
 --    -fdicts-cheap                     always inline dictionaries
 --    -fmax-simplifier-iterations20     this is necessary sometimes
+--    -fsimplifier-phases=3             we use an additional simplifier phase
+--                                      for fusion
 --    -fno-spec-constr-threshold        run SpecConstr even for big loops
 --    -fno-spec-constr-count            SpecConstr as much as possible
 --    -finline-enough-args              hack to prevent excessive inlining
 --
 setDPHOpt :: DynFlags -> DynFlags
 setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
+                                         , simplPhases         = 3
                                          , specConstrThreshold = Nothing
                                          , specConstrCount     = Nothing
                                          })
@@ -2066,13 +2131,6 @@ setMainIs arg
   where
     (main_mod, main_fn) = splitLongestPrefix arg (== '.')
 
--- | Get the unqualified name of the function to use as the \"main\" for the main module.
--- Either returns the default name or the one configured on the command line with -main-is
-getMainFun :: DynFlags -> RdrName
-getMainFun dflags = case (mainFunIs dflags) of
-    Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn))
-    Nothing -> main_RDR_Unqual
-
 -----------------------------------------------------------------------------
 -- Paths & Libraries
 
@@ -2231,7 +2289,13 @@ machdepCCOpts _dflags
         = ( [], ["-fomit-frame-pointer", "-G0"] )
 
 #elif x86_64_TARGET_ARCH
-        = ( [], ["-fomit-frame-pointer",
+        = (
+#if darwin_TARGET_OS
+            ["-m64"],
+#else
+            [],
+#endif
+                ["-fomit-frame-pointer",
                  "-fno-asynchronous-unwind-tables",
                         -- the unwind tables are unnecessary for HC code,
                         -- and get in the way of -split-objs.  Another option
@@ -2281,7 +2345,7 @@ picCCOpts _dflags
     | otherwise
         = []
 #else
-    | opt_PIC
+    | opt_PIC || not opt_Static
         = ["-fPIC", "-U __PIC__", "-D__PIC__"]
     | otherwise
         = []
@@ -2296,21 +2360,24 @@ can_split = cSplitObjs == "YES"
 -- -----------------------------------------------------------------------------
 -- Compiler Info
 
-compilerInfo :: [(String, String)]
-compilerInfo = [("Project name",                cProjectName),
-                ("Project version",             cProjectVersion),
-                ("Booter version",              cBooterVersion),
-                ("Stage",                       cStage),
-                ("Interface file version",      cHscIfaceFileVersion),
-                ("Have interpreter",            cGhcWithInterpreter),
-                ("Object splitting",            cSplitObjs),
-                ("Have native code generator",  cGhcWithNativeCodeGen),
-                ("Support SMP",                 cGhcWithSMP),
-                ("Unregisterised",              cGhcUnregisterised),
-                ("Tables next to code",         cGhcEnableTablesNextToCode),
-                ("Win32 DLLs",                  cEnableWin32DLLs),
-                ("RTS ways",                    cGhcRTSWays),
-                ("Leading underscore",          cLeadingUnderscore),
-                ("Debug on",                    show debugIsOn)
+data Printable = String String
+               | FromDynFlags (DynFlags -> String)
+
+compilerInfo :: [(String, Printable)]
+compilerInfo = [("Project name",                String cProjectName),
+                ("Project version",             String cProjectVersion),
+                ("Booter version",              String cBooterVersion),
+                ("Stage",                       String cStage),
+                ("Have interpreter",            String cGhcWithInterpreter),
+                ("Object splitting",            String cSplitObjs),
+                ("Have native code generator",  String cGhcWithNativeCodeGen),
+                ("Support SMP",                 String cGhcWithSMP),
+                ("Unregisterised",              String cGhcUnregisterised),
+                ("Tables next to code",         String cGhcEnableTablesNextToCode),
+                ("Win32 DLLs",                  String cEnableWin32DLLs),
+                ("RTS ways",                    String cGhcRTSWays),
+                ("Leading underscore",          String cLeadingUnderscore),
+                ("Debug on",                    String (show debugIsOn)),
+                ("LibDir",                      FromDynFlags topDir)
                ]