Merge branch 'master' of http://darcs.haskell.org/ghc into ghc-generics
[ghc-hetmet.git] / compiler / main / DynFlags.hs
index 3960717..d80d2a6 100644 (file)
@@ -108,7 +108,8 @@ import Data.Char
 import Data.List
 import Data.Map (Map)
 import qualified Data.Map as Map
-import Distribution.System
+import Data.Set (Set)
+import qualified Data.Set as Set
 import System.FilePath
 import System.IO        ( stderr, hPutChar )
 
@@ -123,6 +124,21 @@ data DynFlag
    | Opt_D_dump_raw_cmm
    | Opt_D_dump_cmmz
    | Opt_D_dump_cmmz_pretty
+   -- All of the cmmz subflags (there are a lot!)  Automatically
+   -- enabled if you run -ddump-cmmz
+   | Opt_D_dump_cmmz_cbe
+   | Opt_D_dump_cmmz_proc
+   | Opt_D_dump_cmmz_spills
+   | Opt_D_dump_cmmz_rewrite
+   | Opt_D_dump_cmmz_dead
+   | Opt_D_dump_cmmz_stub
+   | Opt_D_dump_cmmz_sp
+   | Opt_D_dump_cmmz_procmap
+   | Opt_D_dump_cmmz_split
+   | Opt_D_dump_cmmz_lower
+   | Opt_D_dump_cmmz_info
+   | Opt_D_dump_cmmz_cafs
+   -- end cmmz subflags
    | Opt_D_dump_cps_cmm
    | Opt_D_dump_cvt_cmm
    | Opt_D_dump_asm
@@ -342,9 +358,9 @@ data ExtensionFlag
    | Opt_DeriveFunctor
    | Opt_DeriveTraversable
    | Opt_DeriveFoldable
-   | Opt_DeriveRepresentable            -- Allow deriving Representable0/1
-   | Opt_DefaultSignatures              -- Allow extra signatures for defmeths
-   | Opt_Generics                       -- Generic deriving mechanism
+   | Opt_DeriveGeneric            -- Allow deriving Generic/1
+   | Opt_DefaultSignatures        -- Allow extra signatures for defmeths
+   | Opt_Generics                 -- Old generic classes, now deprecated
 
    | Opt_TypeSynonymInstances
    | Opt_FlexibleContexts
@@ -482,6 +498,11 @@ data DynFlags = DynFlags {
   filesToClean          :: IORef [FilePath],
   dirsToClean           :: IORef (Map FilePath FilePath),
 
+  -- Names of files which were generated from -ddump-to-file; used to
+  -- track which ones we need to truncate because it's our first run
+  -- through
+  generatedDumps        :: IORef (Set FilePath),
+
   -- hsc dynamic flags
   flags                 :: [DynFlag],
   -- Don't change this without updating extensionFlags:
@@ -718,12 +739,14 @@ initDynFlags dflags = do
  ways <- readIORef v_Ways
  refFilesToClean <- newIORef []
  refDirsToClean <- newIORef Map.empty
+ refGeneratedDumps <- newIORef Set.empty
  return dflags{
         ways            = ways,
         buildTag        = mkBuildTag (filter (not . wayRTSOnly) ways),
         rtsBuildTag     = mkBuildTag ways,
         filesToClean    = refFilesToClean,
-        dirsToClean     = refDirsToClean
+        dirsToClean     = refDirsToClean,
+        generatedDumps   = refGeneratedDumps
         }
 
 -- | The normal 'DynFlags'. Note that they is not suitable for use in this form
@@ -799,6 +822,7 @@ defaultDynFlags mySettings =
         -- end of ghc -M values
         filesToClean   = panic "defaultDynFlags: No filesToClean",
         dirsToClean    = panic "defaultDynFlags: No dirsToClean",
+        generatedDumps = panic "defaultDynFlags: No generatedDumps",
         haddockOptions = Nothing,
         flags = defaultFlags,
         language = Nothing,
@@ -807,12 +831,12 @@ defaultDynFlags mySettings =
 
         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.
@@ -1104,18 +1128,7 @@ parseDynamicFlags_ dflags0 args pkg_flags = do
           = runCmdLine (processArgs flag_spec args') dflags0
   when (not (null errs)) $ ghcError $ errorsToGhcException errs
 
-  let (pic_warns, dflags2)
-        | not (cTargetArch == X86_64 && (cTargetOS == Linux || cTargetOS == OSX)) &&
-          (not opt_Static || opt_PIC) &&
-          hscTarget dflags1 == HscLlvm
-        = ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and "
-                       ++ "-dynamic on this platform;\n"
-                       ++ "         using "
-                       ++ showHscTargetFlag defaultObjectTarget ++ " instead"],
-                dflags1{ hscTarget = defaultObjectTarget })
-        | otherwise = ([], dflags1)
-
-  return (dflags2, leftover, pic_warns ++ warns)
+  return (dflags1, leftover, warns)
 
 
 {- **********************************************************************
@@ -1199,8 +1212,8 @@ dynamic_flags = [
   , Flag "dylib-install-name" (hasArg setDylibInstallName)
 
         ------- Libraries ---------------------------------------------------
-  , Flag "L"   (Prefix    addLibraryPath)
-  , Flag "l"   (AnySuffix (upd . addOptl))
+  , Flag "L"   (Prefix addLibraryPath)
+  , Flag "l"   (hasArg (addOptl . ("-l" ++)))
 
         ------- Frameworks --------------------------------------------------
         -- -framework-path should really be -F ...
@@ -1268,6 +1281,18 @@ dynamic_flags = [
   , 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-cmmz-cbe"          (setDumpFlag Opt_D_dump_cmmz_cbe)
+  , Flag "ddump-cmmz-spills"       (setDumpFlag Opt_D_dump_cmmz_spills)
+  , Flag "ddump-cmmz-proc"         (setDumpFlag Opt_D_dump_cmmz_proc)
+  , Flag "ddump-cmmz-rewrite"      (setDumpFlag Opt_D_dump_cmmz_rewrite)
+  , Flag "ddump-cmmz-dead"         (setDumpFlag Opt_D_dump_cmmz_dead)
+  , Flag "ddump-cmmz-stub"         (setDumpFlag Opt_D_dump_cmmz_stub)
+  , Flag "ddump-cmmz-sp"           (setDumpFlag Opt_D_dump_cmmz_sp)
+  , Flag "ddump-cmmz-procmap"      (setDumpFlag Opt_D_dump_cmmz_procmap)
+  , Flag "ddump-cmmz-split"        (setDumpFlag Opt_D_dump_cmmz_split)
+  , Flag "ddump-cmmz-lower"        (setDumpFlag Opt_D_dump_cmmz_lower)
+  , Flag "ddump-cmmz-info"         (setDumpFlag Opt_D_dump_cmmz_info)
+  , Flag "ddump-cmmz-cafs"         (setDumpFlag Opt_D_dump_cmmz_cafs)
   , 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)
@@ -1640,7 +1665,8 @@ xFlags = [
   ( "ParallelArrays",                   Opt_ParallelArrays, nop ),
   ( "TemplateHaskell",                  Opt_TemplateHaskell, checkTemplateHaskellOk ),
   ( "QuasiQuotes",                      Opt_QuasiQuotes, nop ),
-  ( "Generics",                         Opt_Generics, nop ),
+  ( "Generics",                         Opt_Generics,
+    \ _ -> deprecate "it does nothing; look into -XDefaultSignatures and -XDeriveGeneric for generic programming support." ),
   ( "ImplicitPrelude",                  Opt_ImplicitPrelude, nop ),
   ( "RecordWildCards",                  Opt_RecordWildCards, nop ),
   ( "NamedFieldPuns",                   Opt_RecordPuns, nop ),
@@ -1682,7 +1708,7 @@ xFlags = [
   ( "DeriveFunctor",                    Opt_DeriveFunctor, nop ),
   ( "DeriveTraversable",                Opt_DeriveTraversable, nop ),
   ( "DeriveFoldable",                   Opt_DeriveFoldable, nop ),
-  ( "DeriveRepresentable",              Opt_DeriveRepresentable, nop ),
+  ( "DeriveGeneric",                    Opt_DeriveGeneric, nop ),
   ( "DefaultSignatures",                Opt_DefaultSignatures, nop ),
   ( "TypeSynonymInstances",             Opt_TypeSynonymInstances, nop ),
   ( "FlexibleContexts",                 Opt_FlexibleContexts, nop ),
@@ -1749,9 +1775,6 @@ impliedFlags
     , (Opt_RecordWildCards,     turnOn, Opt_DisambiguateRecordFields)
     
     , (Opt_ParallelArrays, turnOn, Opt_ParallelListComp)
-    -- The new behavior of the XGenerics flag is just to turn on these two flags
-    , (Opt_Generics, turnOn, Opt_DefaultSignatures)
-    , (Opt_Generics, turnOn, Opt_DeriveRepresentable)
   ]
 
 optLevelFlags :: [([Int], DynFlag)]
@@ -1867,7 +1890,7 @@ glasgowExtsFlags = [
            , Opt_DeriveFunctor
            , Opt_DeriveFoldable
            , Opt_DeriveTraversable
-           , Opt_DeriveRepresentable
+           , Opt_DeriveGeneric
            , Opt_FlexibleContexts
            , Opt_FlexibleInstances
            , Opt_ConstrainedClassMethods
@@ -1999,14 +2022,13 @@ forceRecompile :: DynP ()
 -- recompiled which probably isn't what you want
 forceRecompile = do { dfs <- liftEwM getCmdLineState
                    ; when (force_recomp dfs) (setDynFlag Opt_ForceRecomp) }
-       where
+        where
          force_recomp dfs = isOneShot (ghcMode dfs)
 
 setVerboseCore2Core :: DynP ()
 setVerboseCore2Core = do forceRecompile
                          setDynFlag Opt_D_verbose_core2core 
                          upd (\dfs -> dfs { shouldDumpSimplPhase = Nothing })
-                        
 
 setDumpSimplPhases :: String -> DynP ()
 setDumpSimplPhases s = do forceRecompile
@@ -2057,21 +2079,28 @@ setObjTarget l = updM set
        = case l of
          HscC
           | cGhcUnregisterised /= "YES" ->
-             do addWarn ("Compiler not unregisterised, so ignoring " ++
-                         showHscTargetFlag l)
+             do addWarn ("Compiler not unregisterised, so ignoring " ++ flag)
                 return dflags
          HscAsm
           | cGhcWithNativeCodeGen /= "YES" ->
              do addWarn ("Compiler has no native codegen, so ignoring " ++
-                         showHscTargetFlag l)
+                         flag)
                 return dflags
          HscLlvm
           | cGhcUnregisterised == "YES" ->
-             do addWarn ("Compiler unregisterised, so ignoring " ++
-                         showHscTargetFlag l)
+             do addWarn ("Compiler unregisterised, so ignoring " ++ flag)
+                return dflags
+          | not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) &&
+            (not opt_Static || opt_PIC)
+            ->
+             do addWarn ("Ignoring " ++ flag ++ " as it is incompatible with -fPIC and -dynamic on this platform")
                 return dflags
          _ -> return $ dflags { hscTarget = l }
      | otherwise = return dflags
+     where platform = targetPlatform dflags
+           arch = platformArch platform
+           os   = platformOS   platform
+           flag = showHscTargetFlag l
 
 setOptLevel :: Int -> DynFlags -> DynP DynFlags
 setOptLevel n dflags
@@ -2140,7 +2169,6 @@ addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> D
 addImportPath "" = upd (\s -> s{importPaths = []})
 addImportPath p  = upd (\s -> s{importPaths = importPaths s ++ splitPathList p})
 
-
 addLibraryPath p =
   upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p})