X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fmain%2FDynFlags.hs;h=87bf3918733684da9e44497b2ecfe6abc78af965;hb=d872133bb986dbd15959cbb14504bf9a863e3e4a;hp=396071776e8a7999d8fa349bcf194076033cdc69;hpb=ea94a66d93047a9b0cd4532645eb1e9be04888e1;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 3960717..87bf391 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -108,7 +108,6 @@ import Data.Char import Data.List import Data.Map (Map) import qualified Data.Map as Map -import Distribution.System import System.FilePath import System.IO ( stderr, hPutChar ) @@ -342,9 +341,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 @@ -807,12 +806,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 +1103,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) {- ********************************************************************** @@ -1640,7 +1628,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 +1671,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 +1738,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 +1853,7 @@ glasgowExtsFlags = [ , Opt_DeriveFunctor , Opt_DeriveFoldable , Opt_DeriveTraversable - , Opt_DeriveRepresentable + , Opt_DeriveGeneric , Opt_FlexibleContexts , Opt_FlexibleInstances , Opt_ConstrainedClassMethods @@ -1999,14 +1985,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 +2042,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 +2132,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})