X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=d5f5edd070e13e621d9690b667b70f479e9448a9;hb=0560e796f1d813582e066a5f2bec2684c71df44d;hp=25bb530f84aeecb459ff4a854e7bd718d4ffe23c;hpb=cac2aca1e1874e936f3ef15ca2a81a32c7863750;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 25bb530..d5f5edd 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1,3 +1,4 @@ + {-# OPTIONS -fno-warn-missing-fields #-} ----------------------------------------------------------------------------- -- @@ -16,7 +17,7 @@ module DynFlags ( -- Dynamic flags DynFlag(..), DynFlags(..), - HscTarget(..), + HscTarget(..), isObjectTarget, GhcMode(..), isOneShot, GhcLink(..), isNoLink, PackageFlag(..), @@ -84,10 +85,6 @@ import Util ( split ) import Data.Char ( isUpper ) import System.IO ( hPutStrLn, stderr ) -#ifdef GHCI -import Breakpoints ( BkptHandler ) -import Module ( ModuleName ) -#endif -- ----------------------------------------------------------------------------- -- DynFlags @@ -133,6 +130,7 @@ data DynFlag | Opt_D_dump_hi | Opt_D_dump_hi_diffs | Opt_D_dump_minimal_imports + | Opt_D_dump_mod_cycles | Opt_D_faststring_stats | Opt_DoCoreLinting | Opt_DoStgLinting @@ -150,6 +148,7 @@ data DynFlag | Opt_WarnOverlappingPatterns | Opt_WarnSimplePatterns | Opt_WarnTypeDefaults + | Opt_WarnMonomorphism | Opt_WarnUnusedBinds | Opt_WarnUnusedImports | Opt_WarnUnusedMatches @@ -206,9 +205,6 @@ data DynFlag | Opt_SplitObjs | Opt_StgStats | Opt_HideAllPackages -#if defined(GHCI) && defined(DEBUGGER) - | Opt_Debugging -#endif | Opt_PrintBindResult | Opt_Haddock | Opt_Hpc_No_Auto @@ -319,11 +315,6 @@ data DynFlags = DynFlags { -- message output log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO () - -#ifdef GHCI - -- breakpoint handling - ,bkptHandler :: Maybe (BkptHandler Module) -#endif } data HscTarget @@ -334,24 +325,35 @@ data HscTarget | HscNothing deriving (Eq, Show) +-- | will this target result in an object file on the disk? +isObjectTarget :: HscTarget -> Bool +isObjectTarget HscC = True +isObjectTarget HscAsm = True +isObjectTarget _ = False + +-- | The 'GhcMode' tells us whether we're doing multi-module +-- compilation (controlled via the "GHC" API) or one-shot +-- (single-module) compilation. This makes a difference primarily to +-- the "Finder": in one-shot mode we look for interface files for +-- imported modules, but in multi-module mode we look for source files +-- in order to check whether they need to be recompiled. data GhcMode - = BatchCompile -- | @ghc --make Main@ - | Interactive -- | @ghc --interactive@ - | OneShot -- | @ghc -c Foo.hs@ - | JustTypecheck -- | Development environemnts, refactorer, etc. - | MkDepend + = CompManager -- ^ --make, GHCi, etc. + | OneShot -- ^ ghc -c Foo.hs + | MkDepend -- ^ ghc -M, see Finder for why we need this deriving Eq isOneShot :: GhcMode -> Bool isOneShot OneShot = True isOneShot _other = False +-- | What kind of linking to do. data GhcLink -- What to do in the link step, if there is one - = -- Only relevant for modes - -- DoMake and StopBefore StopLn - NoLink -- Don't link at all - | StaticLink -- Ordinary linker [the default] + = NoLink -- Don't link at all + | LinkBinary -- Link object code into a binary + | LinkInMemory -- Use the in-memory dynamic linker | MkDLL -- Make a DLL + deriving Eq isNoLink :: GhcLink -> Bool isNoLink NoLink = True @@ -380,8 +382,8 @@ initDynFlags dflags = do defaultDynFlags = DynFlags { - ghcMode = OneShot, - ghcLink = StaticLink, + ghcMode = CompManager, + ghcLink = LinkBinary, coreToDo = Nothing, stgToDo = Nothing, hscTarget = defaultHscTarget, @@ -433,9 +435,6 @@ defaultDynFlags = packageFlags = [], pkgDatabase = Nothing, pkgState = panic "no package state yet: call GHC.setSessionDynFlags", -#ifdef GHCI - bkptHandler = Nothing, -#endif flags = [ Opt_ReadUserPackageConf, @@ -585,6 +584,7 @@ standardWarnings Opt_WarnOverlappingPatterns, Opt_WarnMissingFields, Opt_WarnMissingMethods, + Opt_WarnMonomorphism, Opt_WarnDuplicateExports ] @@ -954,6 +954,7 @@ dynamic_flags = [ , ( "ddump-minimal-imports", setDumpFlag Opt_D_dump_minimal_imports) , ( "ddump-vect", setDumpFlag Opt_D_dump_vect) , ( "ddump-hpc", setDumpFlag Opt_D_dump_hpc) + , ( "ddump-mod-cycles", setDumpFlag Opt_D_dump_mod_cycles) , ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting)) , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting)) @@ -993,10 +994,13 @@ dynamic_flags = [ ------ Compiler flags ----------------------------------------------- + , ( "fasm", AnySuffix (\_ -> setObjTarget HscAsm) ) + , ( "fvia-c", NoArg (setObjTarget HscC) ) + , ( "fvia-C", NoArg (setObjTarget HscC) ) + , ( "fno-code", NoArg (setTarget HscNothing)) - , ( "fasm", AnySuffix (\_ -> setTarget HscAsm) ) - , ( "fvia-c", NoArg (setTarget HscC) ) - , ( "fvia-C", NoArg (setTarget HscC) ) + , ( "fbyte-code", NoArg (setTarget HscInterpreted) ) + , ( "fobject-code", NoArg (setTarget defaultHscTarget) ) , ( "fglasgow-exts", NoArg (mapM_ setDynFlag glasgowExtsFlags) ) , ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) ) @@ -1021,6 +1025,7 @@ fFlags = [ ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns ), ( "warn-simple-patterns", Opt_WarnSimplePatterns ), ( "warn-type-defaults", Opt_WarnTypeDefaults ), + ( "warn-monomorphism-restriction", Opt_WarnMonomorphism ), ( "warn-unused-binds", Opt_WarnUnusedBinds ), ( "warn-unused-imports", Opt_WarnUnusedImports ), ( "warn-unused-matches", Opt_WarnUnusedMatches ), @@ -1062,9 +1067,6 @@ fFlags = [ ( "excess-precision", Opt_ExcessPrecision ), ( "asm-mangling", Opt_DoAsmMangling ), ( "print-bind-result", Opt_PrintBindResult ), -#if defined(GHCI) && defined(DEBUGGER) - ( "debugging", Opt_Debugging), -#endif ( "force-recomp", Opt_ForceRecomp ), ( "hpc-no-auto", Opt_Hpc_No_Auto ) ] @@ -1131,12 +1133,23 @@ setPackageName p where pid = stringToPackageId p --- we can only switch between HscC, and HscAsmm with dynamic flags --- (-fvia-C, -fasm, -filx respectively). -setTarget l = upd (\dfs -> case hscTarget dfs of - HscC -> dfs{ hscTarget = l } - HscAsm -> dfs{ hscTarget = l } - _ -> dfs) +-- If we're linking a binary, then only targets that produce object +-- code are allowed (requests for other target types are ignored). +setTarget l = upd set + where + set dfs + | ghcLink dfs /= LinkBinary || isObjectTarget l = dfs{ hscTarget = l } + | otherwise = dfs + +-- Changes the target only if we're compiling object code. This is +-- used by -fasm and -fvia-C, which switch from one to the other, but +-- not from bytecode to object-code. The idea is that -fasm/-fvia-C +-- can be safely used in an OPTIONS_GHC pragma. +setObjTarget l = upd set + where + set dfs + | isObjectTarget (hscTarget dfs) = dfs { hscTarget = l } + | otherwise = dfs setOptLevel :: Int -> DynFlags -> DynFlags setOptLevel n dflags