Float constants to top-level even in first full laziness pass

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

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index b5cfb23..47cc3fe 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -35,6 +35,7 @@ module DynFlags (
         updOptLevel,
         setTmpDir,
         setPackageName,
+        doingTickyProfiling,
 
         -- ** Parsing DynFlags
         parseDynamicFlags,
@@ -63,6 +64,9 @@ module DynFlags (
 
 #include "HsVersions.h"
 
+#ifndef OMIT_NATIVE_CODEGEN
+import Platform
+#endif
 import Module
 import PackageConfig
 import PrelNames        ( mAIN, main_RDR_Unqual )
@@ -219,6 +223,7 @@ data DynFlag
    | Opt_RelaxedPolyRec
    | Opt_StandaloneDeriving
    | Opt_DeriveDataTypeable
+   | Opt_DeriveFunctor
    | Opt_TypeSynonymInstances
    | Opt_FlexibleContexts
    | Opt_FlexibleInstances
@@ -337,6 +342,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],
@@ -517,6 +525,11 @@ isNoLink :: GhcLink -> Bool
 isNoLink NoLink = True
 isNoLink _      = False
 
+-- Is it worth evaluating this Bool and caching it in the DynFlags value
+-- during initDynFlags?
+doingTickyProfiling :: DynFlags -> Bool
+doingTickyProfiling dflags = WayTicky `elem` wayNames dflags
+
 data PackageFlag
   = ExposePackage  String
   | HidePackage    String
@@ -577,6 +590,9 @@ defaultDynFlags =
         specConstrThreshold     = Just 200,
         specConstrCount         = Just 3,
         liberateCaseThreshold   = Just 200,
+#ifndef OMIT_NATIVE_CODEGEN
+        targetPlatform          = defaultTargetPlatform,
+#endif
         stolen_x86_regs         = 4,
         cmdlineHcIncludes       = [],
         importPaths             = ["."],
@@ -984,8 +1000,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
@@ -1087,7 +1103,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,
 
@@ -1765,6 +1788,7 @@ xFlags = [
   ( "UnboxedTuples",                    Opt_UnboxedTuples, const Supported ),
   ( "StandaloneDeriving",               Opt_StandaloneDeriving, const Supported ),
   ( "DeriveDataTypeable",               Opt_DeriveDataTypeable, const Supported ),
+  ( "DeriveFunctor",                    Opt_DeriveFunctor, const Supported ),
   ( "TypeSynonymInstances",             Opt_TypeSynonymInstances, const Supported ),
   ( "FlexibleContexts",                 Opt_FlexibleContexts, const Supported ),
   ( "FlexibleInstances",                Opt_FlexibleInstances, const Supported ),
@@ -1784,8 +1808,11 @@ 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_ScopedTypeVariables, Opt_RelaxedPolyRec)  -- Ditto for scoped type variables; see
                                                      --      Note [Scoped tyvars] in TcBinds
+    , (Opt_ImpredicativeTypes,  Opt_RankNTypes)
   ]
 
 glasgowExtsFlags :: [DynFlag]
@@ -1800,6 +1827,7 @@ glasgowExtsFlags = [
            , Opt_TypeSynonymInstances
            , Opt_StandaloneDeriving
            , Opt_DeriveDataTypeable
+           , Opt_DeriveFunctor
            , Opt_FlexibleContexts
            , Opt_FlexibleInstances
            , Opt_ConstrainedClassMethods
@@ -1813,7 +1841,6 @@ glasgowExtsFlags = [
            , Opt_PatternGuards
            , Opt_LiberalTypeSynonyms
            , Opt_RankNTypes
-           , Opt_ImpredicativeTypes
            , Opt_TypeOperators
            , Opt_RecursiveDo
            , Opt_ParallelListComp