Add (a) CoreM monad, (b) new Annotations feature

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

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 5a1981d..df9efcb 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -91,6 +91,7 @@ import Data.IORef       ( readIORef )
 import Control.Monad    ( when )
 
 import Data.Char
+import Data.List        ( intersperse )
 import System.FilePath
 import System.IO        ( stderr, hPutChar )
 
@@ -261,6 +262,7 @@ data DynFlag
    | Opt_UnboxStrictFields
    | Opt_MethodSharing
    | Opt_DictsCheap
+   | Opt_InlineIfEnoughArgs
    | Opt_EnableRewriteRules            -- Apply rewrite rules during simplification
    | Opt_Vectorise
    | Opt_RegsGraph                      -- do graph coloring register allocation
@@ -565,7 +567,7 @@ defaultDynFlags =
 
         opt_L                   = [],
         opt_P                   = (if opt_PIC
-                                   then ["-D__PIC__"]
+                                   then ["-D__PIC__", "-U __PIC__"] -- this list is reversed
                                    else []),
         opt_F                   = [],
         opt_c                   = [],
@@ -710,7 +712,7 @@ parseDynLibLoaderMode f d =
    ("wrapped", "")      -> d{ dynLibLoader = Wrapped Nothing }
    ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing }
    ("wrapped:", flex)   -> d{ dynLibLoader = Wrapped (Just flex) }
-   (_,_)                -> error "Unknown dynlib loader"
+   _                    -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f))
 
 setDumpPrefixForce f d = d { dumpPrefixForce = f}
 
@@ -907,18 +909,44 @@ data CoreToDo           -- These are diff core-to-core passes,
   | CoreDoNothing                -- Useful when building up
   | CoreDoPasses [CoreToDo]      -- lists of these things
 
+
 data SimplifierMode             -- See comments in SimplMonad
   = SimplGently
   | SimplPhase Int [String]
 
+instance Outputable SimplifierMode where
+    ppr SimplGently       = ptext (sLit "gentle")
+    ppr (SimplPhase n ss) = int n <+> brackets (text (concat $ intersperse "," ss))
+
+
 data SimplifierSwitch
   = MaxSimplifierIterations Int
   | NoCaseOfCase
 
-data FloatOutSwitches
-  = FloatOutSw  Bool    -- True <=> float lambdas to top level
-                Bool    -- True <=> float constants to top level,
-                        --          even if they do not escape a lambda
+
+data FloatOutSwitches = FloatOutSwitches {
+        floatOutLambdas :: Bool,     -- ^ True <=> float lambdas to top level
+        floatOutConstants :: Bool    -- ^ True <=> float constants to top level,
+                                     --            even if they do not escape a lambda
+    }
+
+instance Outputable FloatOutSwitches where
+    ppr = pprFloatOutSwitches
+
+pprFloatOutSwitches :: FloatOutSwitches -> SDoc
+pprFloatOutSwitches sw = pp_not (floatOutLambdas sw) <+> text "lambdas" <> comma
+                     <+> pp_not (floatOutConstants sw) <+> text "constants"
+  where
+    pp_not True  = empty
+    pp_not False = text "not"
+
+-- | Switches that specify the minimum amount of floating out
+gentleFloatOutSwitches :: FloatOutSwitches
+gentleFloatOutSwitches = FloatOutSwitches False False
+
+-- | Switches that do not specify floating out of lambdas, just of constants
+constantsOnlyFloatOutSwitches :: FloatOutSwitches
+constantsOnlyFloatOutSwitches = FloatOutSwitches False True
 
 
 -- The core-to-core pass ordering is derived from the DynFlags:
@@ -1016,7 +1044,7 @@ getCoreToDo dflags
         -- so that overloaded functions have all their dictionary lambdas manifest
         CoreDoSpecialising,
 
-        runWhen full_laziness (CoreDoFloatOutwards (FloatOutSw False False)),
+        runWhen full_laziness (CoreDoFloatOutwards gentleFloatOutSwitches),
 
         CoreDoFloatInwards,
 
@@ -1046,8 +1074,7 @@ getCoreToDo dflags
                 ]),
 
         runWhen full_laziness
-          (CoreDoFloatOutwards (FloatOutSw False    -- Not lambdas
-                                           True)),  -- Float constants
+          (CoreDoFloatOutwards constantsOnlyFloatOutSwitches),
                 -- nofib/spectral/hartel/wang doubles in speed if you
                 -- do full laziness late in the day.  It only happens
                 -- after fusion and other stuff, so the early pass doesn't
@@ -1545,6 +1572,7 @@ fFlags = [
   ( "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 ),
   ( "asm-mangling",                     Opt_DoAsmMangling, const Supported ),
   ( "print-bind-result",                Opt_PrintBindResult, const Supported ),
@@ -1908,6 +1936,7 @@ setOptLevel n dflags
 --    -fmax-simplifier-iterations20     this is necessary sometimes
 --    -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
@@ -1916,6 +1945,7 @@ setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
                                          })
                    `dopt_set`   Opt_DictsCheap
                    `dopt_unset` Opt_MethodSharing
+                   `dopt_set`   Opt_InlineIfEnoughArgs
 
 data DPHBackend = DPHPar
                 | DPHSeq
@@ -2158,18 +2188,18 @@ picCCOpts _dflags
       --     in dynamic libraries.
 
     | opt_PIC
-        = ["-fno-common", "-D__PIC__"]
+        = ["-fno-common", "-U __PIC__","-D__PIC__"]
     | otherwise
         = ["-mdynamic-no-pic"]
 #elif mingw32_TARGET_OS
       -- no -fPIC for Windows
     | opt_PIC
-        = ["-D__PIC__"]
+        = ["-U __PIC__","-D__PIC__"]
     | otherwise
         = []
 #else
     | opt_PIC
-        = ["-fPIC", "-D__PIC__"]
+        = ["-fPIC", "-U __PIC__", "-D__PIC__"]
     | otherwise
         = []
 #endif