X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverFlags.hs;h=f0f60f769427736731d9b29843edc579148fa0ab;hb=ff9ab413f6ea513f1aea29c987805d022b72109a;hp=0f53bd41001ae1359e82f7eac2eb0657b5cbbb61;hpb=1f3a9ff8e19636fcb5bf477922012bc67fd52b02;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 0f53bd4..f0f60f7 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -13,12 +13,12 @@ module DriverFlags ( addCmdlineHCInclude, buildStaticHscOpts, machdepCCOpts, + picCCOpts, processArgs, OptKind(..), -- for DriverMkDepend only ) where #include "HsVersions.h" -#include "../includes/ghcconfig.h" import MkIface ( showIface ) import DriverState @@ -177,29 +177,24 @@ static_flags = ------- primary modes ------------------------------------------------ , ( "M" , PassFlag (setMode DoMkDependHS)) - , ( "E" , PassFlag (setMode (StopBefore Hsc))) + , ( "E" , PassFlag (setMode (StopBefore anyHsc))) , ( "C" , PassFlag (\f -> do setMode (StopBefore HCc) f - setLang HscC)) + setTarget HscC)) , ( "S" , PassFlag (setMode (StopBefore As))) - , ( "c" , PassFlag (setMode (StopBefore Ln))) , ( "-make" , PassFlag (setMode DoMake)) , ( "-interactive" , PassFlag (setMode DoInteractive)) - , ( "-mk-dll" , PassFlag (setMode DoMkDLL)) + , ( "-mk-dll" , NoArg (writeIORef v_GhcLink MkDLL)) , ( "e" , HasArg (\s -> setMode (DoEval s) "-e")) -- -fno-code says to stop after Hsc but don't generate any code. , ( "fno-code" , PassFlag (\f -> do setMode (StopBefore HCc) f - setLang HscNothing - writeIORef v_Recomp False)) + setTarget HscNothing + setRecompFlag False)) ------- GHCi ------------------------------------------------------- , ( "ignore-dot-ghci", NoArg (writeIORef v_Read_DotGHCi False) ) , ( "read-dot-ghci" , NoArg (writeIORef v_Read_DotGHCi True) ) - ------- recompilation checker -------------------------------------- - , ( "recomp" , NoArg (writeIORef v_Recomp True) ) - , ( "no-recomp" , NoArg (writeIORef v_Recomp False) ) - ------- ways -------------------------------------------------------- , ( "prof" , NoArg (addNoDups v_Ways WayProf) ) , ( "unreg" , NoArg (addNoDups v_Ways WayUnreg) ) @@ -241,8 +236,8 @@ static_flags = , ( "odir" , HasArg (writeIORef v_Output_dir . Just) ) , ( "o" , SepArg (writeIORef v_Output_file . Just) ) , ( "osuf" , HasArg (writeIORef v_Object_suf) ) - , ( "hcsuf" , HasArg (writeIORef v_HC_suf . Just) ) - , ( "hisuf" , HasArg (writeIORef v_Hi_suf) ) + , ( "hcsuf" , HasArg (writeIORef v_HC_suf ) ) + , ( "hisuf" , HasArg (writeIORef v_Hi_suf ) ) , ( "hidir" , HasArg (writeIORef v_Hi_dir . Just) ) , ( "buildtag" , HasArg (writeIORef v_Build_tag) ) , ( "tmpdir" , HasArg setTmpDir) @@ -298,7 +293,8 @@ static_flags = , ( "optdll" , HasArg (add v_Opt_dll) ) ----- Linker -------------------------------------------------------- - , ( "no-link" , NoArg (writeIORef v_NoLink True) ) + , ( "c" , NoArg (writeIORef v_GhcLink NoLink) ) + , ( "no-link" , NoArg (writeIORef v_GhcLink NoLink) ) -- Deprecated , ( "static" , NoArg (writeIORef v_Static True) ) , ( "dynamic" , NoArg (writeIORef v_Static False) ) , ( "rdynamic" , NoArg (return ()) ) -- ignored for compat w/ gcc @@ -340,6 +336,10 @@ dynamic_flags = [ , ( "opti", HasArg (addOpt_i) ) #endif + ------- recompilation checker -------------------------------------- + , ( "recomp" , NoArg (setRecompFlag True) ) + , ( "no-recomp" , NoArg (setRecompFlag False) ) + ------- Packages ---------------------------------------------------- , ( "package-conf" , HasArg extraPkgConf_ ) , ( "no-user-package-conf", NoArg noUserPkgConf_ ) @@ -359,47 +359,47 @@ dynamic_flags = [ ------ Debugging ---------------------------------------------------- , ( "dstg-stats", NoArg (writeIORef v_StgStats True) ) - , ( "ddump-cmm", NoArg (setDynFlag Opt_D_dump_cmm) ) - , ( "ddump-asm", NoArg (setDynFlag Opt_D_dump_asm) ) - , ( "ddump-cpranal", NoArg (setDynFlag Opt_D_dump_cpranal) ) - , ( "ddump-deriv", NoArg (setDynFlag Opt_D_dump_deriv) ) - , ( "ddump-ds", NoArg (setDynFlag Opt_D_dump_ds) ) - , ( "ddump-flatC", NoArg (setDynFlag Opt_D_dump_flatC) ) - , ( "ddump-foreign", NoArg (setDynFlag Opt_D_dump_foreign) ) - , ( "ddump-inlinings", NoArg (setDynFlag Opt_D_dump_inlinings) ) - , ( "ddump-occur-anal", NoArg (setDynFlag Opt_D_dump_occur_anal) ) - , ( "ddump-parsed", NoArg (setDynFlag Opt_D_dump_parsed) ) - , ( "ddump-rn", NoArg (setDynFlag Opt_D_dump_rn) ) - , ( "ddump-simpl", NoArg (setDynFlag Opt_D_dump_simpl) ) - , ( "ddump-simpl-iterations", NoArg (setDynFlag Opt_D_dump_simpl_iterations) ) - , ( "ddump-spec", NoArg (setDynFlag Opt_D_dump_spec) ) - , ( "ddump-prep", NoArg (setDynFlag Opt_D_dump_prep) ) - , ( "ddump-stg", NoArg (setDynFlag Opt_D_dump_stg) ) - , ( "ddump-stranal", NoArg (setDynFlag Opt_D_dump_stranal) ) - , ( "ddump-tc", NoArg (setDynFlag Opt_D_dump_tc) ) - , ( "ddump-types", NoArg (setDynFlag Opt_D_dump_types) ) - , ( "ddump-rules", NoArg (setDynFlag Opt_D_dump_rules) ) - , ( "ddump-cse", NoArg (setDynFlag Opt_D_dump_cse) ) - , ( "ddump-worker-wrapper", NoArg (setDynFlag Opt_D_dump_worker_wrapper) ) - , ( "dshow-passes", NoArg (setVerbosity "2") ) - , ( "ddump-rn-trace", NoArg (setDynFlag Opt_D_dump_rn_trace) ) - , ( "ddump-if-trace", NoArg (setDynFlag Opt_D_dump_if_trace) ) - , ( "ddump-tc-trace", NoArg (setDynFlag Opt_D_dump_tc_trace) ) - , ( "ddump-splices", NoArg (setDynFlag Opt_D_dump_splices) ) - , ( "ddump-rn-stats", NoArg (setDynFlag Opt_D_dump_rn_stats) ) - , ( "ddump-opt-cmm", NoArg (setDynFlag Opt_D_dump_opt_cmm) ) - , ( "ddump-simpl-stats", NoArg (setDynFlag Opt_D_dump_simpl_stats) ) - , ( "ddump-bcos", NoArg (setDynFlag Opt_D_dump_BCOs) ) - , ( "dsource-stats", NoArg (setDynFlag Opt_D_source_stats) ) - , ( "dverbose-core2core", NoArg (setDynFlag Opt_D_verbose_core2core) ) - , ( "dverbose-stg2stg", NoArg (setDynFlag Opt_D_verbose_stg2stg) ) - , ( "ddump-hi-diffs", NoArg (setDynFlag Opt_D_dump_hi_diffs) ) - , ( "ddump-hi", NoArg (setDynFlag Opt_D_dump_hi) ) - , ( "ddump-minimal-imports", NoArg (setDynFlag Opt_D_dump_minimal_imports) ) - , ( "ddump-vect", NoArg (setDynFlag Opt_D_dump_vect) ) - , ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting) ) - , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting) ) - , ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting) ) + , ( "ddump-cmm", setDumpFlag Opt_D_dump_cmm) + , ( "ddump-asm", setDumpFlag Opt_D_dump_asm) + , ( "ddump-cpranal", setDumpFlag Opt_D_dump_cpranal) + , ( "ddump-deriv", setDumpFlag Opt_D_dump_deriv) + , ( "ddump-ds", setDumpFlag Opt_D_dump_ds) + , ( "ddump-flatC", setDumpFlag Opt_D_dump_flatC) + , ( "ddump-foreign", setDumpFlag Opt_D_dump_foreign) + , ( "ddump-inlinings", setDumpFlag Opt_D_dump_inlinings) + , ( "ddump-occur-anal", setDumpFlag Opt_D_dump_occur_anal) + , ( "ddump-parsed", setDumpFlag Opt_D_dump_parsed) + , ( "ddump-rn", setDumpFlag Opt_D_dump_rn) + , ( "ddump-simpl", setDumpFlag Opt_D_dump_simpl) + , ( "ddump-simpl-iterations", setDumpFlag Opt_D_dump_simpl_iterations) + , ( "ddump-spec", setDumpFlag Opt_D_dump_spec) + , ( "ddump-prep", setDumpFlag Opt_D_dump_prep) + , ( "ddump-stg", setDumpFlag Opt_D_dump_stg) + , ( "ddump-stranal", setDumpFlag Opt_D_dump_stranal) + , ( "ddump-tc", setDumpFlag Opt_D_dump_tc) + , ( "ddump-types", setDumpFlag Opt_D_dump_types) + , ( "ddump-rules", setDumpFlag Opt_D_dump_rules) + , ( "ddump-cse", setDumpFlag Opt_D_dump_cse) + , ( "ddump-worker-wrapper", setDumpFlag Opt_D_dump_worker_wrapper) + , ( "ddump-rn-trace", NoArg (setDynFlag Opt_D_dump_rn_trace)) + , ( "ddump-if-trace", NoArg (setDynFlag Opt_D_dump_if_trace)) + , ( "ddump-tc-trace", setDumpFlag Opt_D_dump_tc_trace) + , ( "ddump-splices", setDumpFlag Opt_D_dump_splices) + , ( "ddump-rn-stats", NoArg (setDynFlag Opt_D_dump_rn_stats)) + , ( "ddump-opt-cmm", setDumpFlag Opt_D_dump_opt_cmm) + , ( "ddump-simpl-stats", setDumpFlag Opt_D_dump_simpl_stats) + , ( "ddump-bcos", setDumpFlag Opt_D_dump_BCOs) + , ( "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", setDumpFlag Opt_D_dump_hi) + , ( "ddump-minimal-imports", setDumpFlag 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 (setRecompFlag False >> setVerbosity "2") ) ------ Machine dependant (-m) stuff --------------------------- @@ -429,10 +429,10 @@ dynamic_flags = [ ------ Compiler flags ----------------------------------------------- - , ( "fasm", AnySuffix (\_ -> setLang HscAsm) ) - , ( "fvia-c", NoArg (setLang HscC) ) - , ( "fvia-C", NoArg (setLang HscC) ) - , ( "filx", NoArg (setLang HscILX) ) + , ( "fasm", AnySuffix (\_ -> setTarget HscAsm) ) + , ( "fvia-c", NoArg (setTarget HscC) ) + , ( "fvia-C", NoArg (setTarget HscC) ) + , ( "filx", NoArg (setTarget HscILX) ) , ( "fglasgow-exts", NoArg (mapM_ setDynFlag glasgowExtsFlags) ) , ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) ) @@ -467,6 +467,7 @@ fFlags = [ ( "parr", Opt_PArr ), ( "th", Opt_TH ), ( "implicit-prelude", Opt_ImplicitPrelude ), + ( "scoped-type-variables", Opt_ScopedTypeVariables ), ( "monomorphism-restriction", Opt_MonomorphismRestriction ), ( "implicit-params", Opt_ImplicitParams ), ( "allow-overlapping-instances", Opt_AllowOverlappingInstances ), @@ -485,7 +486,7 @@ fFlags = [ ( "unbox-strict-fields", Opt_UnboxStrictFields ) ] -glasgowExtsFlags = [ Opt_GlasgowExts, Opt_FFI, Opt_TH, Opt_ImplicitParams ] +glasgowExtsFlags = [ Opt_GlasgowExts, Opt_FFI, Opt_TH, Opt_ImplicitParams, Opt_ScopedTypeVariables ] isFFlag f = f `elem` (map fst fFlags) getFFlag f = fromJust (lookup f fFlags) @@ -512,6 +513,12 @@ setDynFlag, unSetDynFlag :: DynFlag -> IO () setDynFlag f = updDynFlags (\dfs -> dopt_set dfs f) unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f) +setDumpFlag :: DynFlag -> OptKind +setDumpFlag dump_flag + = NoArg (setRecompFlag False >> setDynFlag dump_flag) + -- Whenver we -ddump, switch off the recompilation checker, + -- else you don't see the dump! + addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s}) addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s}) addOpt_F a = updDynFlags (\s -> s{opt_F = a : opt_F s}) @@ -523,6 +530,9 @@ addOpt_I a = updDynFlags (\s -> s{opt_I = a : opt_I s}) addOpt_i a = updDynFlags (\s -> s{opt_i = a : opt_i s}) #endif +setRecompFlag :: Bool -> IO () +setRecompFlag recomp = updDynFlags (\dfs -> dfs{ recompFlag = recomp }) + setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 }) setVerbosity n | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n }) @@ -542,20 +552,22 @@ ignorePackage p = -- -i on its own deletes the import paths addImportPath "" = updDynFlags (\s -> s{importPaths = []}) -addImportPath p = updDynFlags (\s -> s{importPaths = p : importPaths s}) +addImportPath p = do + paths <- splitPathList p + updDynFlags (\s -> s{importPaths = importPaths s ++ paths}) -- we can only switch between HscC, HscAsmm, and HscILX with dynamic flags -- (-fvia-C, -fasm, -filx respectively). -setLang l = updDynFlags (\dfs -> case hscLang dfs of - HscC -> dfs{ hscLang = l } - HscAsm -> dfs{ hscLang = l } - HscILX -> dfs{ hscLang = l } +setTarget l = updDynFlags (\dfs -> case hscTarget dfs of + HscC -> dfs{ hscTarget = l } + HscAsm -> dfs{ hscTarget = l } + HscILX -> dfs{ hscTarget = l } _ -> dfs) setOptLevel :: Int -> IO () setOptLevel n = do dflags <- readIORef v_DynFlags - if hscLang dflags == HscInterpreted && n > 0 + if hscTarget dflags == HscInterpreted && n > 0 then putStr "warning: -O conflicts with --interactive; -O ignored.\n" else writeIORef v_DynFlags (updOptLevel n dflags) @@ -627,7 +639,7 @@ setMainIs arg -- ) machdepCCOpts dflags - | prefixMatch "alpha" cTARGETPLATFORM +#if alpha_TARGET_ARCH = return ( ["-w", "-mieee" #ifdef HAVE_THREADED_RTS_SUPPORT , "-D_REENTRANT" @@ -637,12 +649,12 @@ machdepCCOpts dflags -- register used for global register variable", we simply -- disable all warnings altogether using the -w flag. Oh well. - | prefixMatch "hppa" cTARGETPLATFORM +#elif hppa_TARGET_ARCH -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi! -- (very nice, but too bad the HP /usr/include files don't agree.) = return ( ["-D_HPUX_SOURCE"], [] ) - | prefixMatch "m68k" cTARGETPLATFORM +#elif m68k_TARGET_ARCH -- -fno-defer-pop : for the .hc files, we want all the pushing/ -- popping of args to routines to be explicit; if we let things -- be deferred 'til after an STGJUMP, imminent death is certain! @@ -654,7 +666,7 @@ machdepCCOpts dflags -- as on iX86, where we *do* steal the frame pointer [%ebp].) = return ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] ) - | prefixMatch "i386" cTARGETPLATFORM +#elif i386_TARGET_ARCH -- -fno-defer-pop : basically the same game as for m68k -- -- -fomit-frame-pointer : *must* in .hc files; because we're stealing @@ -680,43 +692,54 @@ machdepCCOpts dflags "-DSTOLEN_X86_REGS="++show n_regs ] ) - | prefixMatch "ia64" cTARGETPLATFORM +#elif ia64_TARGET_ARCH = return ( [], ["-fomit-frame-pointer", "-G0"] ) - | prefixMatch "x86_64" cTARGETPLATFORM +#elif x86_64_TARGET_ARCH = return ( [], ["-fomit-frame-pointer"] ) - | prefixMatch "mips" cTARGETPLATFORM +#elif mips_TARGET_ARCH = return ( ["-static"], [] ) - | prefixMatch "sparc" cTARGETPLATFORM +#elif sparc_TARGET_ARCH = return ( [], ["-w"] ) -- For now, to suppress the gcc warning "call-clobbered -- register used for global register variable", we simply -- disable all warnings altogether using the -w flag. Oh well. - | prefixMatch "powerpc-apple-darwin" cTARGETPLATFORM +#elif powerpc_apple_darwin_TARGET -- -no-cpp-precomp: -- Disable Apple's precompiling preprocessor. It's a great thing -- for "normal" programs, but it doesn't support register variable -- declarations. + = return ( [], ["-no-cpp-precomp"] ) +#else + = return ( [], [] ) +#endif + +picCCOpts dflags +#if darwin_TARGET_OS + -- Apple prefers to do things the other way round. + -- PIC is on by default. -- -mdynamic-no-pic: - -- Turn off PIC code generation to save space and time. + -- Turn off PIC code generation. -- -fno-common: -- Don't generate "common" symbols - these are unwanted -- in dynamic libraries. - = if opt_PIC - then return ( ["-no-cpp-precomp", "-fno-common"], - ["-fno-common"] ) - else return ( ["-no-cpp-precomp", "-mdynamic-no-pic"], - ["-mdynamic-no-pic"] ) - - | prefixMatch "powerpc" cTARGETPLATFORM && opt_PIC - = return ( ["-fPIC"], ["-fPIC"] ) - - | otherwise - = return ( [], [] ) + | opt_PIC + = return ["-fno-common"] + | otherwise + = return ["-mdynamic-no-pic"] +#elif mingw32_TARGET_OS + -- no -fPIC for Windows + = return [] +#else + | opt_PIC + = return ["-fPIC"] + | otherwise + = return [] +#endif ----------------------------------------------------------------------------- -- local utils @@ -733,8 +756,8 @@ showGhcUsage = do (ghc_usage_path,ghci_usage_path) <- getUsageMsgPaths mode <- readIORef v_GhcMode let usage_path - | mode == DoInteractive = ghci_usage_path - | otherwise = ghc_usage_path + | DoInteractive <- mode = ghci_usage_path + | otherwise = ghc_usage_path usage <- readFile usage_path dump usage exitWith ExitSuccess