Add a WARNING pragma

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

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index ed2fdc0..ad327bd 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -23,6 +23,7 @@ module DynFlags (
         Option(..),
         DynLibLoader(..),
         fFlags, xFlags,
+        DPHBackend(..),
 
         -- Configuration of the core-to-core and stg-to-stg phases
         CoreToDo(..),
@@ -82,7 +83,7 @@ import Control.Monad    ( when )
 
 import Data.Char
 import System.FilePath
-import System.IO        ( hPutStrLn, stderr )
+import System.IO        ( stderr, hPutChar )
 
 -- -----------------------------------------------------------------------------
 -- DynFlags
@@ -168,11 +169,12 @@ data DynFlag
    | Opt_WarnUnusedBinds
    | Opt_WarnUnusedImports
    | Opt_WarnUnusedMatches
-   | Opt_WarnDeprecations
+   | Opt_WarnWarningsDeprecations
    | Opt_WarnDeprecatedFlags
    | Opt_WarnDodgyImports
    | Opt_WarnOrphans
    | Opt_WarnTabs
+   | Opt_WarnDodgyForeignImports
 
    -- language opts
    | Opt_OverlappingInstances
@@ -220,6 +222,7 @@ data DynFlag
    | Opt_TransformListComp
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo
+   | Opt_PostfixOperators
    | Opt_PatternGuards
    | Opt_LiberalTypeSynonyms
    | Opt_Rank2Types
@@ -274,6 +277,7 @@ data DynFlag
    | Opt_EmbedManifest
    | Opt_RunCPSZ
    | Opt_ConvertToZipCfgAndBack
+   | Opt_AutoLinkPackages
 
    -- keeping stuff
    | Opt_KeepHiDiffs
@@ -310,6 +314,8 @@ data DynFlags = DynFlags {
   mainFunIs             :: Maybe String,
   ctxtStkDepth          :: Int,         -- Typechecker context stack depth
 
+  dphBackend            :: DPHBackend,
+
   thisPackage           :: PackageId,
 
   -- ways
@@ -501,6 +507,8 @@ defaultDynFlags =
         mainFunIs               = Nothing,
         ctxtStkDepth            = mAX_CONTEXT_REDUCTION_DEPTH,
 
+        dphBackend              = DPHPar,
+
         thisPackage             = mainPackageId,
 
         objectDir               = Nothing,
@@ -563,6 +571,7 @@ defaultDynFlags =
         -- end of initSysTools values
         haddockOptions = Nothing,
         flags = [
+            Opt_AutoLinkPackages,
             Opt_ReadUserPackageConf,
 
             Opt_MonoPatBinds,   -- Experimentally, I'm making this non-standard
@@ -586,9 +595,14 @@ defaultDynFlags =
 
         log_action = \severity srcSpan style msg ->
                         case severity of
-                          SevInfo  -> hPutStrLn stderr (show (msg style))
-                          SevFatal -> hPutStrLn stderr (show (msg style))
-                          _        -> hPutStrLn stderr ('\n':show ((mkLocMessage srcSpan msg) style))
+                          SevInfo  -> printErrs (msg style)
+                          SevFatal -> printErrs (msg style)
+                          _        -> do 
+                                hPutChar stderr '\n'
+                                printErrs ((mkLocMessage srcSpan msg) style)
+                     -- careful (#2302): printErrs prints in UTF-8, whereas
+                     -- converting to string first and using hPutStr would
+                     -- just emit the low 8 bits of each unicode char.
       }
 
 {-
@@ -742,12 +756,13 @@ optLevelFlags
 
 standardWarnings :: [DynFlag]
 standardWarnings
-    = [ Opt_WarnDeprecations,
+    = [ Opt_WarnWarningsDeprecations,
         Opt_WarnDeprecatedFlags,
         Opt_WarnOverlappingPatterns,
         Opt_WarnMissingFields,
         Opt_WarnMissingMethods,
-        Opt_WarnDuplicateExports
+        Opt_WarnDuplicateExports,
+        Opt_WarnDodgyForeignImports
       ]
 
 minusWOpts :: [DynFlag]
@@ -807,7 +822,7 @@ data CoreToDo           -- These are diff core-to-core passes,
   | CoreCSE
   | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
                                                 -- matching this string
-  | CoreDoVectorisation
+  | CoreDoVectorisation DPHBackend
   | CoreDoNothing                -- Useful when building up
   | CoreDoPasses [CoreToDo]      -- lists of these things
 
@@ -848,8 +863,7 @@ getCoreToDo dflags
     spec_constr   = dopt Opt_SpecConstr dflags
     liberate_case = dopt Opt_LiberateCase dflags
     rule_check    = ruleCheck dflags
-    vectorisation = dopt Opt_Vectorise dflags
-    -- static_args   = dopt Opt_StaticArgumentTransformation dflags
+    static_args   = dopt Opt_StaticArgumentTransformation dflags
 
     maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
 
@@ -861,6 +875,11 @@ getCoreToDo dflags
             maybe_rule_check phase
           ]
 
+    vectorisation
+      = runWhen (dopt Opt_Vectorise dflags)
+        $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphBackend dflags) ]
+
+
                 -- By default, we have 2 phases before phase 0.
 
                 -- Want to run with inline phase 2 after the specialiser to give
@@ -895,7 +914,7 @@ getCoreToDo dflags
 
     core_todo =
      if opt_level == 0 then
-       [runWhen vectorisation (CoreDoPasses [ simpl_gently, CoreDoVectorisation ]),
+       [vectorisation,
         simpl_phase 0 ["final"] max_iter]
      else {- opt_level >= 1 -} [
 
@@ -903,15 +922,14 @@ getCoreToDo dflags
     -- may expose extra opportunities to float things outwards. However, to fix
     -- up the output of the transformation we need at do at least one simplify
     -- after this before anything else
-            -- runWhen static_args CoreDoStaticArgs,
-            -- XXX disabled, see #2321
-
-        -- initial simplify: mk specialiser happy: minimum effort please
-        simpl_gently,
+        runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]),
 
         -- We run vectorisation here for now, but we might also try to run
         -- it later
-        runWhen vectorisation (CoreDoPasses [ CoreDoVectorisation, simpl_gently ]),
+        vectorisation,
+
+        -- initial simplify: mk specialiser happy: minimum effort please
+        simpl_gently,
 
         -- Specialisation is best done before full laziness
         -- so that overloaded functions have all their dictionary lambdas manifest
@@ -1097,6 +1115,7 @@ dynamic_flags = [
   , Flag "keep-tmp-files"   (NoArg (setDynFlag Opt_KeepTmpFiles)) Supported
 
         ------- Miscellaneous ----------------------------------------------
+  , Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages)) Supported
   , Flag "no-hs-main"     (NoArg (setDynFlag Opt_NoHsMain)) Supported
   , Flag "main-is"        (SepArg setMainIs ) Supported
   , Flag "haddock"        (NoArg (setDynFlag Opt_Haddock)) Supported
@@ -1324,6 +1343,15 @@ dynamic_flags = [
          (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
          Supported
 
+        ------ DPH flags ----------------------------------------------------
+
+  , Flag "fdph-seq"
+         (NoArg (upd (setDPHBackend DPHSeq)))
+         Supported
+  , Flag "fdph-par"
+         (NoArg (upd (setDPHBackend DPHPar)))
+         Supported
+
         ------ Compiler flags -----------------------------------------------
 
   , Flag "fasm"             (NoArg (setObjTarget HscAsm)) Supported
@@ -1361,6 +1389,7 @@ deprecatedForLanguage lang turnOn =
 
 fFlags :: [(String, DynFlag, Bool -> Deprecated)]
 fFlags = [
+  ( "warn-dodgy-foreign-imports",       Opt_WarnDodgyForeignImports, const Supported ),
   ( "warn-dodgy-imports",               Opt_WarnDodgyImports, const Supported ),
   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports, const Supported ),
   ( "warn-hi-shadowing",                Opt_WarnHiShadows, const Supported ),
@@ -1378,7 +1407,7 @@ fFlags = [
   ( "warn-unused-binds",                Opt_WarnUnusedBinds, const Supported ),
   ( "warn-unused-imports",              Opt_WarnUnusedImports, const Supported ),
   ( "warn-unused-matches",              Opt_WarnUnusedMatches, const Supported ),
-  ( "warn-deprecations",                Opt_WarnDeprecations, const Supported ),
+  ( "warn-warnings-deprecations",       Opt_WarnWarningsDeprecations, const Supported ),
   ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, const Supported ),
   ( "warn-orphans",                     Opt_WarnOrphans, const Supported ),
   ( "warn-tabs",                        Opt_WarnTabs, const Supported ),
@@ -1460,6 +1489,7 @@ languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ]
 xFlags :: [(String, DynFlag, Bool -> Deprecated)]
 xFlags = [
   ( "CPP",                              Opt_Cpp, const Supported ),
+  ( "PostfixOperators",                 Opt_PostfixOperators, const Supported ),
   ( "PatternGuards",                    Opt_PatternGuards, const Supported ),
   ( "UnicodeSyntax",                    Opt_UnicodeSyntax, const Supported ),
   ( "MagicHash",                        Opt_MagicHash, const Supported ),
@@ -1547,6 +1577,7 @@ glasgowExtsFlags = [
            , Opt_PolymorphicComponents
            , Opt_ExistentialQuantification
            , Opt_UnicodeSyntax
+           , Opt_PostfixOperators
            , Opt_PatternGuards
            , Opt_LiberalTypeSynonyms
            , Opt_RankNTypes
@@ -1712,6 +1743,11 @@ setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
                    `dopt_set`   Opt_DictsCheap
                    `dopt_unset` Opt_MethodSharing
 
+data DPHBackend = DPHPar
+                | DPHSeq
+
+setDPHBackend :: DPHBackend -> DynFlags -> DynFlags
+setDPHBackend backend dflags = dflags { dphBackend = backend }
 
 
 setMainIs :: String -> DynP ()
@@ -1873,7 +1909,6 @@ machdepCCOpts _dflags
                sta = opt_Static
            in
                     ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
---                    , if "mingw32" `isSuffixOf` cTARGETPLATFORM then "-mno-cygwin" else ""
                       ],
                       [ "-fno-defer-pop",
                         "-fomit-frame-pointer",