X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=97cbfc8be335c9e52c05b0146615fc5246e3a772;hb=f3399c446c7507d46d6cc550aa2fe7027dbc1b5b;hp=c6e7dcbe7e91220e1f82870ef95e740821282e22;hpb=d5036717526fdd27f6a1c770fd19a6090af60254;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c6e7dcb..97cbfc8 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1,5 +1,12 @@ {-# OPTIONS -fno-warn-missing-fields #-} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + ----------------------------------------------------------------------------- -- -- Dynamic flags @@ -13,13 +20,6 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module DynFlags ( -- Dynamic flags DynFlag(..), @@ -29,6 +29,8 @@ module DynFlags ( GhcLink(..), isNoLink, PackageFlag(..), Option(..), + DynLibLoader(..), + fFlags, xFlags, -- Configuration of the core-to-core and stg-to-stg phases CoreToDo(..), @@ -61,7 +63,7 @@ module DynFlags ( #include "HsVersions.h" -import Module ( Module, mkModuleName, mkModule, ModLocation ) +import Module import PackageConfig import PrelNames ( mAIN ) #ifdef i386_TARGET_ARCH @@ -91,7 +93,8 @@ import Data.List ( isPrefixOf ) import Util ( split ) #endif -import Data.Char ( isUpper ) +import Data.Char +import System.FilePath import System.IO ( hPutStrLn, stderr ) -- ----------------------------------------------------------------------------- @@ -125,6 +128,7 @@ data DynFlag | Opt_D_dump_rn | Opt_D_dump_simpl | Opt_D_dump_simpl_iterations + | Opt_D_dump_simpl_phases | Opt_D_dump_spec | Opt_D_dump_prep | Opt_D_dump_stg @@ -151,11 +155,13 @@ data DynFlag | Opt_D_dump_hi_diffs | Opt_D_dump_minimal_imports | Opt_D_dump_mod_cycles + | Opt_D_dump_view_pattern_commoning | Opt_D_faststring_stats | Opt_DumpToFile -- ^ Append dump output to files instead of stdout. | Opt_DoCoreLinting | Opt_DoStgLinting | Opt_DoCmmLinting + | Opt_DoAsmLinting | Opt_WarnIsError -- -Werror; makes warnings fatal | Opt_WarnDuplicateExports @@ -191,6 +197,7 @@ data DynFlag | Opt_PArr -- Syntactic support for parallel arrays | Opt_Arrows -- Arrow-notation syntax | Opt_TemplateHaskell + | Opt_QuasiQuotes | Opt_ImplicitParams | Opt_Generics | Opt_ImplicitPrelude @@ -202,6 +209,7 @@ data DynFlag | Opt_DisambiguateRecordFields | Opt_RecordWildCards | Opt_RecordPuns + | Opt_ViewPatterns | Opt_GADTs | Opt_RelaxedPolyRec | Opt_StandaloneDeriving @@ -220,12 +228,14 @@ data DynFlag | Opt_KindSignatures | Opt_PatternSignatures | Opt_ParallelListComp + | Opt_TransformListComp | Opt_GeneralizedNewtypeDeriving | Opt_RecursiveDo | Opt_PatternGuards - | Opt_PartiallyAppliedClosedTypeSynonyms + | Opt_LiberalTypeSynonyms | Opt_Rank2Types | Opt_RankNTypes + | Opt_ImpredicativeTypes | Opt_TypeOperators | Opt_PrintExplicitForalls @@ -240,7 +250,6 @@ data DynFlag | Opt_OmitInterfacePragmas | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts - | Opt_IgnoreBreakpoints | Opt_DoEtaReduction | Opt_CaseMerge | Opt_UnboxStrictFields @@ -264,10 +273,12 @@ data DynFlag | Opt_HideAllPackages | Opt_PrintBindResult | Opt_Haddock + | Opt_HaddockOptions | Opt_Hpc_No_Auto | Opt_BreakOnException | Opt_BreakOnError | Opt_PrintEvldWithShow + | Opt_PrintBindContents | Opt_GenManifest | Opt_EmbedManifest | Opt_RunCPSZ @@ -292,10 +303,12 @@ data DynFlags = DynFlags { extCoreName :: String, -- name of the .core output file verbosity :: Int, -- verbosity level optLevel :: Int, -- optimisation level + simplPhases :: Int, -- number of simplifier phases maxSimplIterations :: Int, -- max simplifier iterations ruleCheck :: Maybe String, - specThreshold :: Int, -- Threshold for function specialisation + specConstrThreshold :: Maybe Int, -- Threshold for SpecConstr + liberateCaseThreshold :: Maybe Int, -- Threshold for LiberateCase stolen_x86_regs :: Int, cmdlineHcIncludes :: [String], -- -#includes @@ -322,6 +335,7 @@ data DynFlags = DynFlags { outputFile :: Maybe String, outputHi :: Maybe String, + dynLibLoader :: DynLibLoader, -- | This is set by DriverPipeline.runPipeline based on where -- its output is going. @@ -380,14 +394,16 @@ data DynFlags = DynFlags { -- Package state -- NB. do not modify this field, it is calculated by -- Packages.initPackages and Packages.updatePackages. - pkgDatabase :: Maybe (UniqFM InstalledPackageInfo), + pkgDatabase :: Maybe (UniqFM PackageConfig), pkgState :: PackageState, -- hsc dynamic flags flags :: [DynFlag], -- message output - log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO () + log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (), + + haddockOptions :: Maybe String } data HscTarget @@ -426,7 +442,7 @@ data GhcLink -- What to do in the link step, if there is one | LinkBinary -- Link object code into a binary | LinkInMemory -- Use the in-memory dynamic linker | LinkDynLib -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) - deriving Eq + deriving (Eq, Show) isNoLink :: GhcLink -> Bool isNoLink NoLink = True @@ -446,6 +462,12 @@ defaultObjectTarget | cGhcWithNativeCodeGen == "YES" = HscAsm | otherwise = HscC +data DynLibLoader + = Deployable + | Wrapped (Maybe String) + | SystemDependent + deriving Eq + initDynFlags dflags = do -- someday these will be dynamic flags ways <- readIORef v_Ways @@ -468,9 +490,11 @@ defaultDynFlags = extCoreName = "", verbosity = 0, optLevel = 0, + simplPhases = 2, maxSimplIterations = 4, ruleCheck = Nothing, - specThreshold = 200, + specConstrThreshold = Just 200, + liberateCaseThreshold = Just 200, stolen_x86_regs = 4, cmdlineHcIncludes = [], importPaths = ["."], @@ -490,6 +514,7 @@ defaultDynFlags = outputFile = Nothing, outputHi = Nothing, + dynLibLoader = Deployable, dumpPrefix = Nothing, dumpPrefixForce = Nothing, includePaths = [], @@ -516,27 +541,27 @@ defaultDynFlags = packageFlags = [], pkgDatabase = Nothing, pkgState = panic "no package state yet: call GHC.setSessionDynFlags", - flags = [ - Opt_ReadUserPackageConf, - - Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard - -- behaviour the default, to see if anyone notices - -- SLPJ July 06 + haddockOptions = Nothing, + flags = [ + Opt_ReadUserPackageConf, - Opt_ImplicitPrelude, - Opt_MonomorphismRestriction, + Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard + -- behaviour the default, to see if anyone notices + -- SLPJ July 06 + + Opt_ImplicitPrelude, + Opt_MonomorphismRestriction, + + Opt_DoAsmMangling, - Opt_DoAsmMangling, - Opt_GenManifest, Opt_EmbedManifest, + Opt_PrintBindContents + ] + ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] + -- The default -O0 options + ++ standardWarnings, - -- on by default: - Opt_PrintBindResult ] - ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] - -- The default -O0 options - ++ standardWarnings, - log_action = \severity srcSpan style msg -> case severity of SevInfo -> hPutStrLn stderr (show (msg style)) @@ -573,9 +598,11 @@ getVerbFlag dflags | verbosity dflags >= 3 = "-v" | otherwise = "" -setObjectDir f d = d{ objectDir = f} -setHiDir f d = d{ hiDir = f} -setStubDir f d = d{ stubDir = f} +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. setObjectSuf f d = d{ objectSuf = f} setHiSuf f d = d{ hiSuf = f} @@ -584,6 +611,15 @@ setHcSuf f d = d{ hcSuf = f} setOutputFile f d = d{ outputFile = f} setOutputHi f d = d{ outputHi = f} +parseDynLibLoaderMode f d = + case splitAt 8 f of + ("deploy", "") -> d{ dynLibLoader = Deployable } + ("sysdep", "") -> d{ dynLibLoader = SystemDependent } + ("wrapped", "") -> d{ dynLibLoader = Wrapped Nothing } + ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing } + ("wrapped:", flex) -> d{ dynLibLoader = Wrapped (Just flex) } + (_,_) -> error "Unknown dynlib loader" + setDumpPrefixForce f d = d { dumpPrefixForce = f} -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] @@ -612,6 +648,8 @@ addOptwindres f d = d{ opt_windres = f : opt_windres d} addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d} +addHaddockOpts f d = d{ haddockOptions = Just f} + -- ----------------------------------------------------------------------------- -- Command-line options @@ -756,12 +794,17 @@ runWhen :: Bool -> CoreToDo -> CoreToDo runWhen True do_this = do_this runWhen False do_this = CoreDoNothing +runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo +runMaybe (Just x) f = f x +runMaybe Nothing _ = CoreDoNothing + getCoreToDo :: DynFlags -> [CoreToDo] getCoreToDo dflags | Just todo <- coreToDo dflags = todo -- set explicitly by user | otherwise = core_todo where opt_level = optLevel dflags + phases = simplPhases dflags max_iter = maxSimplIterations dflags strictness = dopt Opt_Strictness dflags full_laziness = dopt Opt_FullLaziness dflags @@ -771,17 +814,32 @@ getCoreToDo dflags rule_check = ruleCheck dflags vectorisation = dopt Opt_Vectorise dflags - core_todo = - if opt_level == 0 then - [ - CoreDoSimplify (SimplPhase 0) [ - MaxSimplifierIterations max_iter - ] - ] - else {- opt_level >= 1 -} [ + maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase) + + simpl_phase phase iter = CoreDoPasses + [ CoreDoSimplify (SimplPhase phase) [ + MaxSimplifierIterations iter + ], + maybe_rule_check phase + ] + + -- By default, we have 2 phases before phase 0. + + -- Want to run with inline phase 2 after the specialiser to give + -- maximum chance for fusion to work before we inline build/augment + -- in phase 1. This made a difference in 'ansi' where an + -- overloaded function wasn't inlined till too late. + + -- Need phase 1 so that build/augment get + -- inlined. I found that spectral/hartel/genfft lost some useful + -- strictness in the function sumcode' if augment is not inlined + -- before strictness analysis runs + simpl_phases = CoreDoPasses [ simpl_phase phase max_iter + | phase <- [phases, phases-1 .. 1] ] + -- initial simplify: mk specialiser happy: minimum effort please - CoreDoSimplify SimplGently [ + simpl_gently = CoreDoSimplify SimplGently [ -- Simplify "gently" -- Don't inline anything till full laziness has bitten -- In particular, inlining wrappers inhibits floating @@ -795,16 +853,19 @@ getCoreToDo dflags NoCaseOfCase, -- Don't do case-of-case transformations. -- This makes full laziness work better MaxSimplifierIterations max_iter - ], + ] + core_todo = + if opt_level == 0 then + [simpl_phase 0 max_iter] + else {- opt_level >= 1 -} [ + + -- initial simplify: mk specialiser happy: minimum effort please + simpl_gently, -- We run vectorisation here for now, but we might also try to run -- it later - runWhen vectorisation (CoreDoPasses [ - CoreDoVectorisation, - CoreDoSimplify SimplGently - [NoCaseOfCase, - MaxSimplifierIterations max_iter]]), + runWhen vectorisation (CoreDoPasses [ CoreDoVectorisation, simpl_gently ]), -- Specialisation is best done before full laziness -- so that overloaded functions have all their dictionary lambdas manifest @@ -814,29 +875,11 @@ getCoreToDo dflags CoreDoFloatInwards, - CoreDoSimplify (SimplPhase 2) [ - -- Want to run with inline phase 2 after the specialiser to give - -- maximum chance for fusion to work before we inline build/augment - -- in phase 1. This made a difference in 'ansi' where an - -- overloaded function wasn't inlined till too late. - MaxSimplifierIterations max_iter - ], - case rule_check of { Just pat -> CoreDoRuleCheck 2 pat; Nothing -> CoreDoNothing }, + simpl_phases, - CoreDoSimplify (SimplPhase 1) [ - -- Need inline-phase2 here so that build/augment get - -- inlined. I found that spectral/hartel/genfft lost some useful - -- strictness in the function sumcode' if augment is not inlined - -- before strictness analysis runs - MaxSimplifierIterations max_iter - ], - case rule_check of { Just pat -> CoreDoRuleCheck 1 pat; Nothing -> CoreDoNothing }, - - CoreDoSimplify (SimplPhase 0) [ -- Phase 0: allow all Ids to be inlined now -- This gets foldr inlined before strictness analysis - MaxSimplifierIterations 3 -- At least 3 iterations because otherwise we land up with -- huge dead expressions because of an infelicity in the -- simpifier. @@ -844,9 +887,8 @@ getCoreToDo dflags -- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs -- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs -- Don't stop now! + simpl_phase 0 (max max_iter 3), - ], - case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing }, #ifdef OLD_STRICTNESS CoreDoOldStrictness, @@ -855,9 +897,8 @@ getCoreToDo dflags CoreDoStrictness, CoreDoWorkerWrapper, CoreDoGlomBinds, - CoreDoSimplify (SimplPhase 0) [ - MaxSimplifierIterations max_iter - ]]), + simpl_phase 0 max_iter + ]), runWhen full_laziness (CoreDoFloatOutwards (FloatOutSw False -- Not lambdas @@ -876,24 +917,23 @@ getCoreToDo dflags CoreDoFloatInwards, - case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing }, + maybe_rule_check 0, -- Case-liberation for -O2. This should be after -- strictness analysis and the simplification which follows it. runWhen liberate_case (CoreDoPasses [ CoreLiberateCase, - CoreDoSimplify (SimplPhase 0) [ - MaxSimplifierIterations max_iter - ] ]), -- Run the simplifier after LiberateCase to vastly + simpl_phase 0 max_iter + ]), -- Run the simplifier after LiberateCase to vastly -- reduce the possiblility of shadowing -- Reason: see Note [Shadowing] in SpecConstr.lhs runWhen spec_constr CoreDoSpecConstr, + maybe_rule_check 0, + -- Final clean-up simplification: - CoreDoSimplify (SimplPhase 0) [ - MaxSimplifierIterations max_iter - ] + simpl_phase 0 max_iter ] -- ----------------------------------------------------------------------------- @@ -926,10 +966,13 @@ allFlags :: [String] allFlags = map ('-':) $ [ name | (name, optkind) <- dynamic_flags, ok optkind ] ++ map ("fno-"++) flags ++ - map ("f"++) flags + map ("f"++) flags ++ + map ("X"++) xs ++ + map ("XNo"++) xs where ok (PrefixPred _ _) = False ok _ = True flags = map fst fFlags + xs = map fst xFlags dynamic_flags :: [(String, OptKind DynP)] dynamic_flags = [ @@ -969,6 +1012,7 @@ dynamic_flags = [ , ( "c" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) , ( "no-link" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep. , ( "shared" , NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } )) + , ( "dynload" , HasArg (upd . parseDynLibLoaderMode)) ------- Libraries --------------------------------------------------- , ( "L" , Prefix addLibraryPath ) @@ -980,15 +1024,15 @@ dynamic_flags = [ , ( "framework" , HasArg (upd . addCmdlineFramework) ) ------- Output Redirection ------------------------------------------ - , ( "odir" , HasArg (upd . setObjectDir . Just)) + , ( "odir" , HasArg (upd . setObjectDir)) , ( "o" , SepArg (upd . setOutputFile . Just)) , ( "ohi" , HasArg (upd . setOutputHi . Just )) , ( "osuf" , HasArg (upd . setObjectSuf)) , ( "hcsuf" , HasArg (upd . setHcSuf)) , ( "hisuf" , HasArg (upd . setHiSuf)) - , ( "hidir" , HasArg (upd . setHiDir . Just)) + , ( "hidir" , HasArg (upd . setHiDir)) , ( "tmpdir" , HasArg (upd . setTmpDir)) - , ( "stubdir" , HasArg (upd . setStubDir . Just)) + , ( "stubdir" , HasArg (upd . setStubDir)) , ( "ddump-file-prefix", HasArg (upd . setDumpPrefixForce . Just)) ------- Keeping temporary files ------------------------------------- @@ -1006,6 +1050,7 @@ dynamic_flags = [ , ( "no-hs-main" , NoArg (setDynFlag Opt_NoHsMain)) , ( "main-is" , SepArg setMainIs ) , ( "haddock" , NoArg (setDynFlag Opt_Haddock) ) + , ( "haddock-opts" , HasArg (upd . addHaddockOpts)) , ( "hpcdir" , SepArg setOptHpcDir ) ------- recompilation checker (DEPRECATED, use -fforce-recomp) ----- @@ -1059,6 +1104,7 @@ dynamic_flags = [ , ( "ddump-rn", setDumpFlag Opt_D_dump_rn) , ( "ddump-simpl", setDumpFlag Opt_D_dump_simpl) , ( "ddump-simpl-iterations", setDumpFlag Opt_D_dump_simpl_iterations) + , ( "ddump-simpl-phases", setDumpFlag Opt_D_dump_simpl_phases) , ( "ddump-spec", setDumpFlag Opt_D_dump_spec) , ( "ddump-prep", setDumpFlag Opt_D_dump_prep) , ( "ddump-stg", setDumpFlag Opt_D_dump_stg) @@ -1084,11 +1130,13 @@ dynamic_flags = [ , ( "ddump-vect", setDumpFlag Opt_D_dump_vect) , ( "ddump-hpc", setDumpFlag Opt_D_dump_hpc) , ( "ddump-mod-cycles", setDumpFlag Opt_D_dump_mod_cycles) + , ( "ddump-view-pattern-commoning", setDumpFlag Opt_D_dump_view_pattern_commoning) , ( "ddump-to-file", setDumpFlag Opt_DumpToFile) , ( "ddump-hi-diffs", NoArg (setDynFlag Opt_D_dump_hi_diffs)) , ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting)) , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting)) , ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting)) + , ( "dasm-lint", NoArg (setDynFlag Opt_DoAsmLinting)) , ( "dshow-passes", NoArg (do setDynFlag Opt_ForceRecomp setVerbosity (Just 2)) ) , ( "dfaststring-stats", NoArg (setDynFlag Opt_D_faststring_stats)) @@ -1113,14 +1161,21 @@ dynamic_flags = [ , ( "O" , OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1)))) -- If the number is missing, use 1 + , ( "fsimplifier-phases", IntSuffix (\n -> + upd (\dfs -> dfs{ simplPhases = n })) ) , ( "fmax-simplifier-iterations", IntSuffix (\n -> upd (\dfs -> dfs{ maxSimplIterations = n })) ) - -- liberate-case-threshold is an old flag for '-fspec-threshold' - , ( "fspec-threshold", IntSuffix (\n -> upd (\dfs -> dfs{ specThreshold = n }))) - , ( "fliberate-case-threshold", IntSuffix (\n -> upd (\dfs -> dfs{ specThreshold = n }))) + , ( "fspec-constr-threshold", IntSuffix (\n -> + upd (\dfs -> dfs{ specConstrThreshold = Just n }))) + , ( "fno-spec-constr-threshold", NoArg ( + upd (\dfs -> dfs{ specConstrThreshold = Nothing }))) + , ( "fliberate-case-threshold", IntSuffix (\n -> + upd (\dfs -> dfs{ liberateCaseThreshold = Just n }))) + , ( "fno-liberate-case-threshold", NoArg ( + upd (\dfs -> dfs{ liberateCaseThreshold = Nothing }))) - , ( "frule-check", SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s }))) + , ( "frule-check", SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s }))) , ( "fcontext-stack" , IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n }) ------ Compiler flags ----------------------------------------------- @@ -1182,7 +1237,6 @@ fFlags = [ ( "omit-interface-pragmas", Opt_OmitInterfacePragmas ), ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion ), ( "ignore-asserts", Opt_IgnoreAsserts ), - ( "ignore-breakpoints", Opt_IgnoreBreakpoints), ( "do-eta-reduction", Opt_DoEtaReduction ), ( "case-merge", Opt_CaseMerge ), ( "unbox-strict-fields", Opt_UnboxStrictFields ), @@ -1196,6 +1250,7 @@ fFlags = [ ( "break-on-exception", Opt_BreakOnException ), ( "break-on-error", Opt_BreakOnError ), ( "print-evld-with-show", Opt_PrintEvldWithShow ), + ( "print-bind-contents", Opt_PrintBindContents ), ( "run-cps", Opt_RunCPSZ ), ( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack), ( "vectorise", Opt_Vectorise ), @@ -1253,17 +1308,19 @@ xFlags = [ ( "PatternSignatures", Opt_PatternSignatures ), ( "EmptyDataDecls", Opt_EmptyDataDecls ), ( "ParallelListComp", Opt_ParallelListComp ), + ( "TransformListComp", Opt_TransformListComp ), ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface ), ( "UnliftedFFITypes", Opt_UnliftedFFITypes ), - ( "PartiallyAppliedClosedTypeSynonyms", - Opt_PartiallyAppliedClosedTypeSynonyms ), + ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms ), ( "Rank2Types", Opt_Rank2Types ), ( "RankNTypes", Opt_RankNTypes ), + ( "ImpredicativeTypes", Opt_ImpredicativeTypes ), ( "TypeOperators", Opt_TypeOperators ), ( "RecursiveDo", Opt_RecursiveDo ), ( "Arrows", Opt_Arrows ), ( "PArr", Opt_PArr ), ( "TemplateHaskell", Opt_TemplateHaskell ), + ( "QuasiQuotes", Opt_QuasiQuotes ), ( "Generics", Opt_Generics ), -- On by default: ( "ImplicitPrelude", Opt_ImplicitPrelude ), @@ -1272,6 +1329,7 @@ xFlags = [ ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields ), ( "OverloadedStrings", Opt_OverloadedStrings ), ( "GADTs", Opt_GADTs ), + ( "ViewPatterns", Opt_ViewPatterns), ( "TypeFamilies", Opt_TypeFamilies ), ( "BangPatterns", Opt_BangPatterns ), -- On by default: @@ -1299,16 +1357,19 @@ xFlags = [ impliedFlags :: [(DynFlag, [DynFlag])] impliedFlags = [ - ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to be completely rigid for GADTs + ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to + -- be completely rigid for GADTs + , ( Opt_ScopedTypeVariables, [Opt_RelaxedPolyRec] ) -- Ditto for scoped type variables; see + -- Note [Scoped tyvars] in TcBinds ] glasgowExtsFlags = [ Opt_PrintExplicitForalls , Opt_ForeignFunctionInterface , Opt_UnliftedFFITypes - , Opt_GADTs - , Opt_ImplicitParams - , Opt_ScopedTypeVariables + , Opt_GADTs + , Opt_ImplicitParams + , Opt_ScopedTypeVariables , Opt_UnboxedTuples , Opt_TypeSynonymInstances , Opt_StandaloneDeriving @@ -1318,13 +1379,14 @@ glasgowExtsFlags = [ , Opt_ConstrainedClassMethods , Opt_MultiParamTypeClasses , Opt_FunctionalDependencies - , Opt_MagicHash + , Opt_MagicHash , Opt_PolymorphicComponents , Opt_ExistentialQuantification , Opt_UnicodeSyntax , Opt_PatternGuards - , Opt_PartiallyAppliedClosedTypeSynonyms + , Opt_LiberalTypeSynonyms , Opt_RankNTypes + , Opt_ImpredicativeTypes , Opt_TypeOperators , Opt_RecursiveDo , Opt_ParallelListComp @@ -1332,7 +1394,7 @@ glasgowExtsFlags = [ , Opt_KindSignatures , Opt_PatternSignatures , Opt_GeneralizedNewtypeDeriving - , Opt_TypeFamilies ] + , Opt_TypeFamilies ] ------------------ isFlag :: [(String,a)] -> String -> Bool @@ -1442,15 +1504,16 @@ setOptLevel n dflags setMainIs :: String -> DynP () setMainIs arg - | not (null main_fn) -- The arg looked like "Foo.baz" + | not (null main_fn) && isLower (head main_fn) + -- The arg looked like "Foo.Bar.baz" = upd $ \d -> d{ mainFunIs = Just main_fn, - mainModIs = mkModule mainPackageId (mkModuleName main_mod) } + mainModIs = mkModule mainPackageId (mkModuleName main_mod) } - | isUpper (head main_mod) -- The arg looked like "Foo" - = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName main_mod) } + | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar" + = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName arg) } | otherwise -- The arg looked like "baz" - = upd $ \d -> d{ mainFunIs = Just main_mod } + = upd $ \d -> d{ mainFunIs = Just arg } where (main_mod, main_fn) = splitLongestPrefix arg (== '.') @@ -1532,32 +1595,28 @@ setTmpDir :: FilePath -> DynFlags -> DynFlags setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir } where #if !defined(mingw32_HOST_OS) - canonicalise p = normalisePath p + canonicalise p = normalise p #else - -- Canonicalisation of temp path under win32 is a bit more - -- involved: (a) strip trailing slash, - -- (b) normalise slashes - -- (c) just in case, if there is a prefix /cygdrive/x/, change to x: - -- - canonicalise path = normalisePath (xltCygdrive (removeTrailingSlash path)) - - -- if we're operating under cygwin, and TMP/TEMP is of - -- the form "/cygdrive/drive/path", translate this to - -- "drive:/path" (as GHC isn't a cygwin app and doesn't - -- understand /cygdrive paths.) - xltCygdrive path - | "/cygdrive/" `isPrefixOf` path = - case drop (length "/cygdrive/") path of - drive:xs@('/':_) -> drive:':':xs - _ -> path - | otherwise = path - - -- strip the trailing backslash (awful, but we only do this once). - removeTrailingSlash path = - case last path of - '/' -> init path - '\\' -> init path - _ -> path + -- Canonicalisation of temp path under win32 is a bit more + -- involved: (a) strip trailing slash, + -- (b) normalise slashes + -- (c) just in case, if there is a prefix /cygdrive/x/, change to x: + canonicalise path = removeTrailingSlash $ normalise $ xltCygdrive path + + -- if we're operating under cygwin, and TMP/TEMP is of + -- the form "/cygdrive/drive/path", translate this to + -- "drive:/path" (as GHC isn't a cygwin app and doesn't + -- understand /cygdrive paths.) + cygdrivePrefix = [pathSeparator] ++ "/cygdrive/" ++ [pathSeparator] + xltCygdrive path = case maybePrefixMatch cygdrivePrefix path of + Just (drive:sep:xs) + | isPathSeparator sep -> drive:':':pathSeparator:xs + _ -> path + + -- strip the trailing backslash (awful, but we only do this once). + removeTrailingSlash path + | isPathSeparator (last path) = init path + | otherwise = path #endif -----------------------------------------------------------------------------