X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDynFlags.hs;h=f0c95bca32dff459ba84ec0320502969277c5476;hb=4a3042fcc68554ef59966430d2c6f1b70470d222;hp=fc48857def7552faf7e8370701839d3622ee046c;hpb=d3585c0a1c3abeeaa23817454c07efe76174c081;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DynFlags.hs b/ghc/compiler/main/DynFlags.hs index fc48857..f0c95bc 100644 --- a/ghc/compiler/main/DynFlags.hs +++ b/ghc/compiler/main/DynFlags.hs @@ -41,6 +41,7 @@ module DynFlags ( -- parsing DynFlags parseDynamicFlags, + allFlags, -- misc stuff machdepCCOpts, picCCOpts, @@ -48,6 +49,8 @@ module DynFlags ( #include "HsVersions.h" +import Module ( Module, mkModule ) +import PrelNames ( mAIN ) import StaticFlags ( opt_Static, opt_PIC, WayName(..), v_Ways, v_Build_tag, v_RTS_Build_tag ) import {-# SOURCE #-} Packages (PackageState) @@ -56,13 +59,19 @@ import Config import CmdLineParser import Panic ( panic, GhcException(..) ) import Util ( notNull, splitLongestPrefix, split, normalisePath ) +import SrcLoc ( SrcSpan ) import DATA_IOREF ( readIORef ) import EXCEPTION ( throwDyn ) import Monad ( when ) +#ifdef mingw32_TARGET_OS import Data.List ( isPrefixOf ) +#endif import Maybe ( fromJust ) import Char ( isDigit, isUpper ) +import Outputable +import System.IO ( hPutStrLn, stderr ) +import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) -- ----------------------------------------------------------------------------- -- DynFlags @@ -107,6 +116,7 @@ data DynFlag | Opt_D_dump_hi | Opt_D_dump_hi_diffs | Opt_D_dump_minimal_imports + | Opt_D_faststring_stats | Opt_DoCoreLinting | Opt_DoStgLinting | Opt_DoCmmLinting @@ -144,6 +154,7 @@ data DynFlag | Opt_Generics | Opt_ImplicitPrelude | Opt_ScopedTypeVariables + | Opt_BangPatterns -- optimisation opts | Opt_Strictness @@ -163,11 +174,13 @@ data DynFlag | Opt_RecompChecking | Opt_DryRun | Opt_DoAsmMangling + | Opt_WriteIface | Opt_ExcessPrecision | Opt_ReadUserPackageConf | Opt_NoHsMain | Opt_SplitObjs | Opt_StgStats + | Opt_HideAllPackages -- keeping stuff | Opt_KeepHiDiffs @@ -177,7 +190,7 @@ data DynFlag | Opt_KeepTmpFiles deriving (Eq) - + data DynFlags = DynFlags { ghcMode :: GhcMode, ghcLink :: GhcLink, @@ -185,8 +198,6 @@ data DynFlags = DynFlags { stgToDo :: Maybe [StgToDo], -- similarly hscTarget :: HscTarget, hscOutName :: String, -- name of the output file - hscStubHOutName :: String, -- name of the .stub_h output file - hscStubCOutName :: String, -- name of the .stub_c output file extCoreName :: String, -- name of the .core output file verbosity :: Int, -- verbosity level optLevel :: Int, -- optimisation level @@ -195,7 +206,7 @@ data DynFlags = DynFlags { stolen_x86_regs :: Int, cmdlineHcIncludes :: [String], -- -#includes importPaths :: [FilePath], - mainModIs :: Maybe String, + mainModIs :: Module, mainFunIs :: Maybe String, -- ways @@ -204,13 +215,17 @@ data DynFlags = DynFlags { rtsBuildTag :: String, -- the RTS "way" -- paths etc. - outputDir :: Maybe String, - outputFile :: Maybe String, - outputHi :: Maybe String, + objectDir :: Maybe String, + hiDir :: Maybe String, + stubDir :: Maybe String, + objectSuf :: String, hcSuf :: String, - hiDir :: Maybe String, hiSuf :: String, + + outputFile :: Maybe String, + outputHi :: Maybe String, + includePaths :: [String], libraryPaths :: [String], frameworkPaths :: [String], -- used on darwin only @@ -239,7 +254,7 @@ data DynFlags = DynFlags { pgm_l :: (String,[Option]), pgm_dll :: (String,[Option]), - -- ** Package flags + -- ** Package flags extraPkgConfs :: [FilePath], -- The -package-conf flags given on the command line, in the order -- they appeared. @@ -247,11 +262,14 @@ data DynFlags = DynFlags { packageFlags :: [PackageFlag], -- The -package and -hide-package flags from the command-line - -- ** Package state + -- ** Package state pkgState :: PackageState, -- hsc dynamic flags - flags :: [DynFlag] + flags :: [DynFlag], + + -- message output + log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO () } data HscTarget @@ -292,9 +310,7 @@ data PackageFlag | IgnorePackage String defaultHscTarget -#if defined(i386_TARGET_ARCH) || defined(sparc_TARGET_ARCH) || defined(powerpc_TARGET_ARCH) | cGhcWithNativeCodeGen == "YES" = HscAsm -#endif | otherwise = HscC initDynFlags dflags = do @@ -316,8 +332,6 @@ defaultDynFlags = stgToDo = Nothing, hscTarget = defaultHscTarget, hscOutName = "", - hscStubHOutName = "", - hscStubCOutName = "", extCoreName = "", verbosity = 0, optLevel = 0, @@ -326,20 +340,23 @@ defaultDynFlags = stolen_x86_regs = 4, cmdlineHcIncludes = [], importPaths = ["."], - mainModIs = Nothing, + mainModIs = mAIN, mainFunIs = Nothing, wayNames = panic "ways", buildTag = panic "buildTag", rtsBuildTag = panic "rtsBuildTag", - outputDir = Nothing, - outputFile = Nothing, - outputHi = Nothing, + objectDir = Nothing, + hiDir = Nothing, + stubDir = Nothing, + objectSuf = phaseInputExt StopLn, hcSuf = phaseInputExt HCc, - hiDir = Nothing, hiSuf = "hi", + + outputFile = Nothing, + outputHi = Nothing, includePaths = [], libraryPaths = [], frameworkPaths = [], @@ -389,12 +406,19 @@ defaultDynFlags = -- a good thing anyway, but it seems fragile. Opt_DoAsmMangling, + Opt_WriteIface, -- and the default no-optimisation options: Opt_IgnoreInterfacePragmas, Opt_OmitInterfacePragmas - ] ++ standardWarnings + ] ++ standardWarnings, + + log_action = \severity srcSpan style msg -> + case severity of + SevInfo -> hPutStrLn stderr (show (msg style)) + SevFatal -> hPutStrLn stderr (show (msg style)) + _ -> hPutStrLn stderr ('\n':show ((mkLocMessage srcSpan msg) style)) } {- @@ -426,13 +450,16 @@ getVerbFlag dflags | verbosity dflags >= 3 = "-v" | otherwise = "" -setOutputDir f d = d{ outputDir = f} -setOutputFile f d = d{ outputFile = f} -setOutputHi f d = d{ outputHi = f} +setObjectDir f d = d{ objectDir = f} +setHiDir f d = d{ hiDir = f} +setStubDir f d = d{ stubDir = f} + setObjectSuf f d = d{ objectSuf = f} -setHcSuf f d = d{ hcSuf = f} setHiSuf f d = d{ hiSuf = f} -setHiDir f d = d{ hiDir = f} +setHcSuf f d = d{ hcSuf = f} + +setOutputFile f d = d{ outputFile = f} +setOutputHi f d = d{ outputHi = f} -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] -- Config.hs should really use Option. @@ -601,7 +628,6 @@ getCoreToDo dflags MaxSimplifierIterations max_iter ] ] - else {- opt_level >= 1 -} [ -- initial simplify: mk specialiser happy: minimum effort please @@ -741,6 +767,15 @@ getStgToDo dflags -- ----------------------------------------------------------------------------- -- DynFlags parser +allFlags :: [String] +allFlags = map ('-':) $ + [ name | (name, optkind) <- dynamic_flags, ok optkind ] ++ + map ("fno-"++) flags ++ + map ("f"++) flags + where ok (PrefixPred _ _) = False + ok _ = True + flags = map fst fFlags + dynamic_flags :: [(String, OptKind DynP)] dynamic_flags = [ ( "n" , NoArg (setDynFlag Opt_DryRun) ) @@ -790,7 +825,7 @@ dynamic_flags = [ , ( "framework" , HasArg (upd . addCmdlineFramework) ) ------- Output Redirection ------------------------------------------ - , ( "odir" , HasArg (upd . setOutputDir . Just)) + , ( "odir" , HasArg (upd . setObjectDir . Just)) , ( "o" , SepArg (upd . setOutputFile . Just)) , ( "ohi" , HasArg (upd . setOutputHi . Just )) , ( "osuf" , HasArg (upd . setObjectSuf)) @@ -798,10 +833,13 @@ dynamic_flags = [ , ( "hisuf" , HasArg (upd . setHiSuf)) , ( "hidir" , HasArg (upd . setHiDir . Just)) , ( "tmpdir" , HasArg (upd . setTmpDir)) + , ( "stubdir" , HasArg (upd . setStubDir . Just)) ------- Keeping temporary files ------------------------------------- - , ( "keep-hc-file" , AnySuffix (\_ -> setDynFlag Opt_KeepHcFiles)) - , ( "keep-s-file" , AnySuffix (\_ -> setDynFlag Opt_KeepSFiles)) + , ( "keep-hc-file" , AnySuffix (\_ -> do setDynFlag Opt_KeepHcFiles + setTarget HscC)) + , ( "keep-s-file" , AnySuffix (\_ -> do setDynFlag Opt_KeepSFiles + setTarget HscAsm)) , ( "keep-raw-s-file", AnySuffix (\_ -> setDynFlag Opt_KeepRawSFiles)) , ( "keep-tmp-files" , AnySuffix (\_ -> setDynFlag Opt_KeepTmpFiles)) @@ -819,6 +857,7 @@ dynamic_flags = [ , ( "package-name" , HasArg ignorePackage ) -- for compatibility , ( "package" , HasArg exposePackage ) , ( "hide-package" , HasArg hidePackage ) + , ( "hide-all-packages", NoArg (setDynFlag Opt_HideAllPackages) ) , ( "ignore-package" , HasArg ignorePackage ) , ( "syslib" , HasArg exposePackage ) -- for compatibility @@ -866,15 +905,16 @@ dynamic_flags = [ , ( "dsource-stats", setDumpFlag Opt_D_source_stats) , ( "dverbose-core2core", setDumpFlag Opt_D_verbose_core2core) , ( "dverbose-stg2stg", setDumpFlag Opt_D_verbose_stg2stg) - , ( "ddump-hi-diffs", setDumpFlag Opt_D_dump_hi_diffs) + , ( "ddump-hi-diffs", NoArg (setDynFlag Opt_D_dump_hi_diffs)) , ( "ddump-hi", setDumpFlag Opt_D_dump_hi) - , ( "ddump-minimal-imports", setDumpFlag Opt_D_dump_minimal_imports) + , ( "ddump-minimal-imports", NoArg (setDynFlag Opt_D_dump_minimal_imports)) , ( "ddump-vect", setDumpFlag Opt_D_dump_vect) , ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting)) , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting)) , ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting)) , ( "dshow-passes", NoArg (do unSetDynFlag Opt_RecompChecking setVerbosity "2") ) + , ( "dfaststring-stats", NoArg (setDynFlag Opt_D_faststring_stats)) ------ Machine dependant (-m) stuff --------------------------- @@ -905,6 +945,8 @@ dynamic_flags = [ ------ Compiler flags ----------------------------------------------- + , ( "fno-code", NoArg (do setTarget HscNothing + unSetDynFlag Opt_WriteIface)) , ( "fasm", AnySuffix (\_ -> setTarget HscAsm) ) , ( "fvia-c", NoArg (setTarget HscC) ) , ( "fvia-C", NoArg (setTarget HscC) ) @@ -944,6 +986,7 @@ fFlags = [ ( "th", Opt_TH ), ( "implicit-prelude", Opt_ImplicitPrelude ), ( "scoped-type-variables", Opt_ScopedTypeVariables ), + ( "bang-patterns", Opt_BangPatterns ), ( "monomorphism-restriction", Opt_MonomorphismRestriction ), ( "implicit-params", Opt_ImplicitParams ), ( "allow-overlapping-instances", Opt_AllowOverlappingInstances ), @@ -961,7 +1004,8 @@ fFlags = [ ( "case-merge", Opt_CaseMerge ), ( "unbox-strict-fields", Opt_UnboxStrictFields ), ( "excess-precision", Opt_ExcessPrecision ), - ( "asm-mangling", Opt_DoAsmMangling ) + ( "asm-mangling", Opt_DoAsmMangling ), + ( "write-iface", Opt_WriteIface ) ] glasgowExtsFlags = [ @@ -969,7 +1013,8 @@ glasgowExtsFlags = [ Opt_FFI, Opt_TH, Opt_ImplicitParams, - Opt_ScopedTypeVariables ] + Opt_ScopedTypeVariables, + Opt_BangPatterns ] isFFlag f = f `elem` (map fst fFlags) getFFlag f = fromJust (lookup f fFlags) @@ -1039,18 +1084,17 @@ setOptLevel n dflags setMainIs :: String -> DynP () setMainIs arg - | not (null main_mod) -- The arg looked like "Foo.baz" + | not (null main_fn) -- The arg looked like "Foo.baz" = upd $ \d -> d{ mainFunIs = Just main_fn, - mainModIs = Just main_mod } + mainModIs = mkModule main_mod } - | isUpper (head main_fn) -- The arg looked like "Foo" - = upd $ \d -> d{ mainModIs = Just main_fn } + | isUpper (head main_mod) -- The arg looked like "Foo" + = upd $ \d -> d{ mainModIs = mkModule main_mod } | otherwise -- The arg looked like "baz" - = upd $ \d -> d{ mainFunIs = Just main_fn } + = upd $ \d -> d{ mainFunIs = Just main_mod } where (main_mod, main_fn) = splitLongestPrefix arg (== '.') - ----------------------------------------------------------------------------- -- Paths & Libraries @@ -1222,7 +1266,22 @@ machdepCCOpts dflags = ( [], ["-fomit-frame-pointer", "-G0"] ) #elif x86_64_TARGET_ARCH - = ( [], ["-fomit-frame-pointer"] ) + = ( [], ["-fomit-frame-pointer", + "-fno-asynchronous-unwind-tables", + -- the unwind tables are unnecessary for HC code, + -- and get in the way of -split-objs. Another option + -- would be to throw them away in the mangler, but this + -- is easier. + "-fno-unit-at-a-time", + -- unit-at-a-time doesn't do us any good, and screws + -- up -split-objs by moving the split markers around. + -- It's only turned on with -O2, but put it here just + -- in case someone uses -optc-O2. + "-fno-builtin" + -- calling builtins like strlen() using the FFI can + -- cause gcc to run out of regs, so use the external + -- version. + ] ) #elif mips_TARGET_ARCH = ( ["-static"], [] ) @@ -1274,6 +1333,7 @@ picCCOpts dflags can_split :: Bool can_split = #if defined(i386_TARGET_ARCH) \ + || defined(x86_64_TARGET_ARCH) \ || defined(alpha_TARGET_ARCH) \ || defined(hppa_TARGET_ARCH) \ || defined(m68k_TARGET_ARCH) \