X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=9becbb464f59174eb909817ff8f0d0706c59f569;hb=876a71215ce555d1830aacc51076595a835ad699;hp=2062ed1e1bfcacc51f2e032ae0cad3c24370dd17;hpb=982c1f494de8a691294a95aee108e765c3f592a0;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 2062ed1..9becbb4 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -29,6 +29,7 @@ module DynFlags ( GhcLink(..), isNoLink, PackageFlag(..), Option(..), + fFlags, xFlags, -- Configuration of the core-to-core and stg-to-stg phases CoreToDo(..), @@ -61,7 +62,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 +92,7 @@ import Data.List ( isPrefixOf ) import Util ( split ) #endif -import Data.Char ( isUpper ) +import Data.Char import System.IO ( hPutStrLn, stderr ) -- ----------------------------------------------------------------------------- @@ -151,6 +152,7 @@ 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 @@ -203,6 +205,7 @@ data DynFlag | Opt_DisambiguateRecordFields | Opt_RecordWildCards | Opt_RecordPuns + | Opt_ViewPatterns | Opt_GADTs | Opt_RelaxedPolyRec | Opt_StandaloneDeriving @@ -241,7 +244,6 @@ data DynFlag | Opt_OmitInterfacePragmas | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts - | Opt_IgnoreBreakpoints | Opt_DoEtaReduction | Opt_CaseMerge | Opt_UnboxStrictFields @@ -265,6 +267,7 @@ data DynFlag | Opt_HideAllPackages | Opt_PrintBindResult | Opt_Haddock + | Opt_HaddockOptions | Opt_Hpc_No_Auto | Opt_BreakOnException | Opt_BreakOnError @@ -381,14 +384,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 @@ -517,27 +522,26 @@ 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, - - -- on by default: - Opt_PrintBindResult ] - ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] - -- The default -O0 options - ++ standardWarnings, - + Opt_EmbedManifest + ] + ++ [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)) @@ -574,9 +578,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} @@ -613,6 +619,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 @@ -927,10 +935,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 = [ @@ -981,15 +992,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 ------------------------------------- @@ -1007,6 +1018,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) ----- @@ -1085,6 +1097,7 @@ 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)) @@ -1184,7 +1197,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 ), @@ -1273,6 +1285,7 @@ xFlags = [ ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields ), ( "OverloadedStrings", Opt_OverloadedStrings ), ( "GADTs", Opt_GADTs ), + ( "ViewPatterns", Opt_ViewPatterns), ( "TypeFamilies", Opt_TypeFamilies ), ( "BangPatterns", Opt_BangPatterns ), -- On by default: @@ -1443,15 +1456,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 (== '.')