Start support for coloured SDoc output.
[ghc-hetmet.git] / compiler / main / DynFlags.hs
index ab755b0..9eac33c 100644 (file)
@@ -32,7 +32,7 @@ module DynFlags (
         Option(..), showOpt,
         DynLibLoader(..),
         fFlags, fLangFlags, xFlags,
-        dphPackage,
+        DPHBackend(..), dphPackageMaybe,
         wayNames,
 
         -- ** Manipulating DynFlags
@@ -101,6 +101,7 @@ import Data.Char
 import Data.List
 import Data.Map (Map)
 import qualified Data.Map as Map
+import Data.Maybe
 import System.FilePath
 import System.IO        ( stderr, hPutChar )
 
@@ -112,6 +113,7 @@ data DynFlag
 
    -- debugging flags
    = Opt_D_dump_cmm
+   | Opt_D_dump_raw_cmm
    | Opt_D_dump_cmmz
    | Opt_D_dump_cmmz_pretty
    | Opt_D_dump_cps_cmm
@@ -126,6 +128,7 @@ data DynFlag
    | Opt_D_dump_asm_stats
    | Opt_D_dump_asm_expanded
    | Opt_D_dump_llvm
+   | Opt_D_dump_core_stats
    | Opt_D_dump_cpranal
    | Opt_D_dump_deriv
    | Opt_D_dump_ds
@@ -153,8 +156,10 @@ data DynFlag
    | Opt_D_dump_rn_stats
    | Opt_D_dump_opt_cmm
    | Opt_D_dump_simpl_stats
+   | Opt_D_dump_cs_trace       -- Constraint solver in type checker
    | Opt_D_dump_tc_trace
    | Opt_D_dump_if_trace
+   | Opt_D_dump_vt_trace
    | Opt_D_dump_splices
    | Opt_D_dump_BCOs
    | Opt_D_dump_vect
@@ -181,6 +186,7 @@ data DynFlag
    | Opt_WarnHiShadows
    | Opt_WarnImplicitPrelude
    | Opt_WarnIncompletePatterns
+   | Opt_WarnIncompleteUniPatterns
    | Opt_WarnIncompletePatternsRecUpd
    | Opt_WarnMissingFields
    | Opt_WarnMissingImportList
@@ -269,6 +275,7 @@ data DynFlag
    | Opt_BuildingCabalPackage
    | Opt_SSE2
    | Opt_GhciSandbox
+   | Opt_HelpfulErrors
 
        -- temporary flags
    | Opt_RunCPS
@@ -668,7 +675,7 @@ defaultDynFlags =
         mainFunIs               = Nothing,
         ctxtStkDepth            = mAX_CONTEXT_REDUCTION_DEPTH,
 
-        dphBackend              = DPHPar,
+        dphBackend              = DPHNone,
 
         thisPackage             = mainPackageId,
 
@@ -753,12 +760,12 @@ defaultDynFlags =
 
         log_action = \severity srcSpan style msg ->
                         case severity of
-                          SevOutput -> printOutput (msg style)
-                          SevInfo   -> printErrs (msg style)
-                          SevFatal  -> printErrs (msg style)
+                          SevOutput -> printSDoc msg style
+                          SevInfo   -> printErrs msg style
+                          SevFatal  -> printErrs msg style
                           _         -> do 
                                 hPutChar stderr '\n'
-                                printErrs ((mkLocMessage srcSpan msg) style)
+                                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.
@@ -804,7 +811,14 @@ languageExtensions (Just Haskell98)
     = [Opt_ImplicitPrelude,
        Opt_MonomorphismRestriction,
        Opt_NPlusKPatterns,
-       Opt_DatatypeContexts]
+       Opt_DatatypeContexts,
+       Opt_NondecreasingIndentation
+           -- strictly speaking non-standard, but we always had this
+           -- on implicitly before the option was added in 7.1, and
+           -- turning it off breaks code, so we're keeping it on for
+           -- backwards compatibility.  Cabal uses -XHaskell98 by
+           -- default unless you specify another language.
+      ]
 
 languageExtensions (Just Haskell2010)
     = [Opt_ImplicitPrelude,
@@ -881,7 +895,8 @@ setObjectDir  f d = d{ objectDir  = Just f}
 setHiDir      f d = d{ hiDir      = Just f}
 setStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }
   -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
-  -- \#included from the .hc file when compiling with -fvia-C.
+  -- \#included from the .hc file when compiling via C (i.e. unregisterised
+  -- builds).
 setOutputDir  f = setObjectDir f . setHiDir f . setStubDir f
 setDylibInstallName  f d = d{ dylibInstallName = Just f}
 
@@ -1042,16 +1057,7 @@ parseDynamicFlags_ dflags0 args pkg_flags = do
           = runCmdLine (processArgs flag_spec args') dflags0
   when (not (null errs)) $ ghcError $ errorsToGhcException errs
 
-  -- Cannot use -fPIC with registerised -fvia-C, because the mangler
-  -- isn't up to the job.  We know that if hscTarget == HscC, then the
-  -- user has explicitly used -fvia-C, because -fasm is the default,
-  -- unless there is no NCG on this platform.  The latter case is
-  -- checked when the -fPIC flag is parsed.
-  --
   let (pic_warns, dflags2)
-        | opt_PIC && hscTarget dflags1 == HscC && cGhcUnregisterised == "NO"
-        = ([L noSrcSpan $ "Warning: -fvia-C is incompatible with -fPIC; ignoring -fvia-C"],
-                dflags1{ hscTarget = HscAsm })
 #if !(x86_64_TARGET_ARCH && linux_TARGET_OS)
         | (not opt_Static || opt_PIC) && hscTarget dflags1 == HscLlvm
         = ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and -"
@@ -1210,8 +1216,10 @@ dynamic_flags = [
   , Flag "dstg-stats"     (NoArg (setDynFlag Opt_StgStats))
 
   , Flag "ddump-cmm"               (setDumpFlag Opt_D_dump_cmm)
+  , Flag "ddump-raw-cmm"           (setDumpFlag Opt_D_dump_raw_cmm)
   , Flag "ddump-cmmz"              (setDumpFlag Opt_D_dump_cmmz)
   , Flag "ddump-cmmz-pretty"       (setDumpFlag Opt_D_dump_cmmz_pretty)
+  , Flag "ddump-core-stats"        (setDumpFlag Opt_D_dump_core_stats)
   , Flag "ddump-cps-cmm"           (setDumpFlag Opt_D_dump_cps_cmm)
   , Flag "ddump-cvt-cmm"           (setDumpFlag Opt_D_dump_cvt_cmm)
   , Flag "ddump-asm"               (setDumpFlag Opt_D_dump_asm)
@@ -1250,7 +1258,9 @@ dynamic_flags = [
   , Flag "ddump-worker-wrapper"    (setDumpFlag Opt_D_dump_worker_wrapper)
   , Flag "ddump-rn-trace"          (setDumpFlag Opt_D_dump_rn_trace)
   , Flag "ddump-if-trace"          (setDumpFlag Opt_D_dump_if_trace)
+  , Flag "ddump-cs-trace"          (setDumpFlag Opt_D_dump_cs_trace)
   , Flag "ddump-tc-trace"          (setDumpFlag Opt_D_dump_tc_trace)
+  , Flag "ddump-vt-trace"          (setDumpFlag Opt_D_dump_vt_trace)
   , Flag "ddump-splices"           (setDumpFlag Opt_D_dump_splices)
   , Flag "ddump-rn-stats"          (setDumpFlag Opt_D_dump_rn_stats)
   , Flag "ddump-opt-cmm"           (setDumpFlag Opt_D_dump_opt_cmm)
@@ -1333,14 +1343,15 @@ dynamic_flags = [
   , Flag "fdph-seq"         (NoArg (setDPHBackend DPHSeq))
   , Flag "fdph-par"         (NoArg (setDPHBackend DPHPar))
   , Flag "fdph-this"        (NoArg (setDPHBackend DPHThis))
+  , Flag "fdph-none"        (NoArg (setDPHBackend DPHNone))
 
         ------ Compiler flags -----------------------------------------------
 
   , Flag "fasm"             (NoArg (setObjTarget HscAsm))
-  , Flag "fvia-c"           (NoArg (setObjTarget HscC >>
-         (addWarn "The -fvia-c flag will be removed in a future GHC release")))
-  , Flag "fvia-C"           (NoArg (setObjTarget HscC >>
-         (addWarn "The -fvia-C flag will be removed in a future GHC release")))
+  , Flag "fvia-c"           (NoArg
+         (addWarn "The -fvia-c flag does nothing; it will be removed in a future GHC release"))
+  , Flag "fvia-C"           (NoArg
+         (addWarn "The -fvia-C flag does nothing; it will be removed in a future GHC release"))
   , Flag "fllvm"            (NoArg (setObjTarget HscLlvm))
 
   , Flag "fno-code"         (NoArg (do upd $ \d -> d{ ghcLink=NoLink }
@@ -1418,6 +1429,7 @@ fFlags = [
   ( "warn-hi-shadowing",                Opt_WarnHiShadows, nop ),
   ( "warn-implicit-prelude",            Opt_WarnImplicitPrelude, nop ),
   ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns, nop ),
+  ( "warn-incomplete-uni-patterns",     Opt_WarnIncompleteUniPatterns, nop ),
   ( "warn-incomplete-record-updates",   Opt_WarnIncompletePatternsRecUpd, nop ),
   ( "warn-missing-fields",              Opt_WarnMissingFields, nop ),
   ( "warn-missing-import-lists",        Opt_WarnMissingImportList, nop ),
@@ -1488,6 +1500,7 @@ fFlags = [
   ( "ext-core",                         Opt_EmitExternalCore, nop ),
   ( "shared-implib",                    Opt_SharedImplib, nop ),
   ( "ghci-sandbox",                     Opt_GhciSandbox, nop ),
+  ( "helpful-errors",                   Opt_HelpfulErrors, nop ),
   ( "building-cabal-package",           Opt_BuildingCabalPackage, nop ),
   ( "implicit-import-qualified",        Opt_ImplicitImportQualified, nop )
   ]
@@ -1644,7 +1657,8 @@ defaultFlags
       Opt_GenManifest,
       Opt_EmbedManifest,
       Opt_PrintBindContents,
-      Opt_GhciSandbox
+      Opt_GhciSandbox,
+      Opt_HelpfulErrors
     ]
 
     ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
@@ -1661,6 +1675,7 @@ impliedFlags
     , (Opt_ExistentialQuantification, turnOn, Opt_ExplicitForAll)
     , (Opt_PolymorphicComponents,     turnOn, Opt_ExplicitForAll)
     , (Opt_FlexibleInstances,         turnOn, Opt_TypeSynonymInstances)
+    , (Opt_FunctionalDependencies,    turnOn, Opt_MultiParamTypeClasses)
 
     , (Opt_RebindableSyntax, turnOff, Opt_ImplicitPrelude)      -- NB: turn off!
 
@@ -1678,6 +1693,8 @@ impliedFlags
        -- stuff like " 'a' not in scope ", which is a bit silly
        -- if the compiler has just filled in field 'a' of constructor 'C'
     , (Opt_RecordWildCards,     turnOn, Opt_DisambiguateRecordFields)
+    
+    , (Opt_ParallelArrays, turnOn, Opt_ParallelListComp)
   ]
 
 optLevelFlags :: [([Int], DynFlag)]
@@ -1736,6 +1753,7 @@ standardWarnings
       ]
 
 minusWOpts :: [DynFlag]
+-- Things you get with -W
 minusWOpts
     = standardWarnings ++
       [ Opt_WarnUnusedBinds,
@@ -1747,6 +1765,7 @@ minusWOpts
       ]
 
 minusWallOpts :: [DynFlag]
+-- Things you get with -Wall
 minusWallOpts
     = minusWOpts ++
       [ Opt_WarnTypeDefaults,
@@ -1754,21 +1773,21 @@ minusWallOpts
         Opt_WarnMissingSigs,
         Opt_WarnHiShadows,
         Opt_WarnOrphans,
-        Opt_WarnUnusedDoBind,
-        Opt_WarnIdentities
+        Opt_WarnUnusedDoBind
       ]
 
--- minuswRemovesOpts should be every warning option
 minuswRemovesOpts :: [DynFlag]
+-- minuswRemovesOpts should be every warning option 
 minuswRemovesOpts
     = minusWallOpts ++
-      [Opt_WarnImplicitPrelude,
+      [Opt_WarnTabs,
        Opt_WarnIncompletePatternsRecUpd,
+       Opt_WarnIncompleteUniPatterns,
        Opt_WarnMonomorphism,
        Opt_WarnUnrecognisedPragmas,
        Opt_WarnAutoOrphans,
-       Opt_WarnTabs
-      ]
+       Opt_WarnImplicitPrelude
+     ]       
 
 enableGlasgowExts :: DynP ()
 enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls
@@ -1951,8 +1970,8 @@ setTarget l = upd set
      | otherwise = dfs
 
 -- Changes the target only if we're compiling object code.  This is
--- used by -fasm and -fvia-C, which switch from one to the other, but
--- not from bytecode to object-code.  The idea is that -fasm/-fvia-C
+-- used by -fasm and -fllvm, which switch from one to the other, but
+-- not from bytecode to object-code.  The idea is that -fasm/-fllvm
 -- can be safely used in an OPTIONS_GHC pragma.
 setObjTarget :: HscTarget -> DynP ()
 setObjTarget l = upd set
@@ -1974,44 +1993,36 @@ setOptLevel n dflags
 -- -Odph is equivalent to
 --
 --    -O2                               optimise as much as possible
---    -fno-method-sharing               sharing specialisation defeats fusion
---                                      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
+--    -fsimplifier-phases=3             we use an additional simplifier phase for fusion
 --
 setDPHOpt :: DynFlags -> DynFlags
 setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
                                          , simplPhases         = 3
-                                         , specConstrThreshold = Nothing
-                                         , specConstrCount     = Nothing
                                          })
-                   `dopt_set`   Opt_DictsCheap
 
-data DPHBackend = DPHPar
-                | DPHSeq
-                | DPHThis
+-- Determines the package used by the vectoriser for the symbols of the vectorised code.
+-- 'DPHNone' indicates that no data-parallel backend library is available; hence, the
+-- vectoriser cannot be used.
+--
+data DPHBackend = DPHPar    -- "dph-par"
+                | DPHSeq    -- "dph-seq"
+                | DPHThis   -- the currently compiled package
+                | DPHNone   -- no DPH library available
         deriving(Eq, Ord, Enum, Show)
 
 setDPHBackend :: DPHBackend -> DynP ()
-setDPHBackend backend 
-  = do
-      upd $ \dflags -> dflags { dphBackend = backend }
-      mapM_ exposePackage (dph_packages backend)
-  where
-    dph_packages DPHThis = []
-    dph_packages DPHPar  = ["dph-prim-par", "dph-par"]
-    dph_packages DPHSeq  = ["dph-prim-seq", "dph-seq"]
+setDPHBackend backend = upd $ \dflags -> dflags { dphBackend = backend }
 
-dphPackage :: DynFlags -> PackageId
-dphPackage dflags = case dphBackend dflags of
-                      DPHPar  -> dphParPackageId
-                      DPHSeq  -> dphSeqPackageId
-                      DPHThis -> thisPackage dflags
+-- Query the DPH backend package to be used by the vectoriser and desugaring of DPH syntax.
+--
+dphPackageMaybe :: DynFlags -> Maybe PackageId
+dphPackageMaybe dflags 
+  = case dphBackend dflags of
+      DPHPar  -> Just dphParPackageId
+      DPHSeq  -> Just dphSeqPackageId
+      DPHThis -> Just (thisPackage dflags)
+      DPHNone -> Nothing
 
 setMainIs :: String -> DynP ()
 setMainIs arg
@@ -2267,7 +2278,7 @@ picCCOpts _dflags
 -- Splitting
 
 can_split :: Bool
-can_split = cSplitObjs == "YES"
+can_split = cSupportsSplitObjs == "YES"
 
 -- -----------------------------------------------------------------------------
 -- Compiler Info
@@ -2280,13 +2291,12 @@ compilerInfo = [("Project name",                String cProjectName),
                 ("Project version",             String cProjectVersion),
                 ("Booter version",              String cBooterVersion),
                 ("Stage",                       String cStage),
-                ("Build platform",              String cBuildPlatform),
-                ("Host platform",               String cHostPlatform),
-                ("Target platform",             String cTargetPlatform),
+                ("Build platform",              String cBuildPlatformString),
+                ("Host platform",               String cHostPlatformString),
+                ("Target platform",             String cTargetPlatformString),
                 ("Have interpreter",            String cGhcWithInterpreter),
-                ("Object splitting",            String cSplitObjs),
+                ("Object splitting supported",  String cSupportsSplitObjs),
                 ("Have native code generator",  String cGhcWithNativeCodeGen),
-                ("Have llvm code generator",    String cGhcWithLlvmCodeGen),
                 ("Support SMP",                 String cGhcWithSMP),
                 ("Unregisterised",              String cGhcUnregisterised),
                 ("Tables next to code",         String cGhcEnableTablesNextToCode),
@@ -2294,6 +2304,9 @@ compilerInfo = [("Project name",                String cProjectName),
                 ("Leading underscore",          String cLeadingUnderscore),
                 ("Debug on",                    String (show debugIsOn)),
                 ("LibDir",                      FromDynFlags topDir),
-                ("Global Package DB",           FromDynFlags systemPackageConfig)
+                ("Global Package DB",           FromDynFlags systemPackageConfig),
+                ("C compiler flags",            String (show cCcOpts)),
+                ("Gcc Linker flags",            String (show cGccLinkerOpts)),
+                ("Ld Linker flags",             String (show cLdLinkerOpts))
                ]