X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDynFlags.hs;h=9d279d688ef0b4f8a5e41ada7006467df55a2395;hb=5d3051c66796dcf884b052f9e4afc3ed19b9f514;hp=b3131017a55216a47f355d3cf5f128c11d2b712e;hpb=f2ec1d281959ef7cddf648b542517b9e3e6d2f0c;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DynFlags.hs b/ghc/compiler/main/DynFlags.hs index b313101..9d279d6 100644 --- a/ghc/compiler/main/DynFlags.hs +++ b/ghc/compiler/main/DynFlags.hs @@ -48,6 +48,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,6 +58,7 @@ import Config import CmdLineParser import Panic ( panic, GhcException(..) ) import Util ( notNull, splitLongestPrefix, split, normalisePath ) +import SrcLoc ( SrcSpan ) import DATA_IOREF ( readIORef ) import EXCEPTION ( throwDyn ) @@ -66,6 +69,9 @@ import Data.List ( isPrefixOf ) import Maybe ( fromJust ) import Char ( isDigit, isUpper ) import Outputable +import System.IO ( hPutStrLn, stderr ) +import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) + -- ----------------------------------------------------------------------------- -- DynFlags @@ -146,6 +152,7 @@ data DynFlag | Opt_Generics | Opt_ImplicitPrelude | Opt_ScopedTypeVariables + | Opt_BangPatterns -- optimisation opts | Opt_Strictness @@ -180,7 +187,7 @@ data DynFlag | Opt_KeepTmpFiles deriving (Eq) - + data DynFlags = DynFlags { ghcMode :: GhcMode, ghcLink :: GhcLink, @@ -188,8 +195,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 @@ -198,7 +203,7 @@ data DynFlags = DynFlags { stolen_x86_regs :: Int, cmdlineHcIncludes :: [String], -- -#includes importPaths :: [FilePath], - mainModIs :: Maybe String, + mainModIs :: Module, mainFunIs :: Maybe String, -- ways @@ -207,13 +212,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 @@ -254,7 +263,10 @@ data DynFlags = DynFlags { pkgState :: PackageState, -- hsc dynamic flags - flags :: [DynFlag] + flags :: [DynFlag], + + -- message output + log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO () } data HscTarget @@ -317,8 +329,6 @@ defaultDynFlags = stgToDo = Nothing, hscTarget = defaultHscTarget, hscOutName = "", - hscStubHOutName = "", - hscStubCOutName = "", extCoreName = "", verbosity = 0, optLevel = 0, @@ -327,20 +337,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 = [], @@ -395,7 +408,13 @@ defaultDynFlags = 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)) } {- @@ -427,13 +446,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. @@ -602,7 +624,6 @@ getCoreToDo dflags MaxSimplifierIterations max_iter ] ] - else {- opt_level >= 1 -} [ -- initial simplify: mk specialiser happy: minimum effort please @@ -791,7 +812,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)) @@ -799,6 +820,7 @@ 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)) @@ -870,7 +892,7 @@ dynamic_flags = [ , ( "dverbose-stg2stg", setDumpFlag Opt_D_verbose_stg2stg) , ( "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)) @@ -907,6 +929,7 @@ dynamic_flags = [ ------ Compiler flags ----------------------------------------------- + , ( "fno-code", NoArg (setTarget HscNothing)) , ( "fasm", AnySuffix (\_ -> setTarget HscAsm) ) , ( "fvia-c", NoArg (setTarget HscC) ) , ( "fvia-C", NoArg (setTarget HscC) ) @@ -946,6 +969,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 ), @@ -971,7 +995,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) @@ -1043,10 +1068,10 @@ setMainIs :: String -> DynP () setMainIs arg | 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_mod) -- The arg looked like "Foo" - = upd $ \d -> d{ mainModIs = Just main_mod } + = upd $ \d -> d{ mainModIs = mkModule main_mod } | otherwise -- The arg looked like "baz" = upd $ \d -> d{ mainFunIs = Just main_mod } @@ -1224,11 +1249,16 @@ machdepCCOpts dflags #elif x86_64_TARGET_ARCH = ( [], ["-fomit-frame-pointer", - "-fno-asynchronous-unwind-tables" + "-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. ] ) #elif mips_TARGET_ARCH