X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverFlags.hs;h=6d24d5374613a1428a797710723d1b9bc9e52311;hb=e195ea859d2d4227c478a3b5e1e9ac20b086b0c7;hp=f159b391766dccd9b461af122b8a8bda8038927f;hpb=d255dfff87648bcd4dd1d87faa8d835d358c70a2;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index f159b39..6d24d53 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -7,14 +7,18 @@ ----------------------------------------------------------------------------- module DriverFlags ( - processArgs, OptKind(..), static_flags, dynamic_flags, + processDynamicFlags, + processStaticFlags, + addCmdlineHCInclude, buildStaticHscOpts, - machdepCCOpts + machdepCCOpts, + + processArgs, OptKind(..), -- for DriverMkDepend only ) where #include "HsVersions.h" -#include "../includes/config.h" +#include "../includes/ghcconfig.h" import MkIface ( showIface ) import DriverState @@ -25,9 +29,10 @@ import CmdLineOpts import Config import Util import Panic +import FastString ( mkFastString ) import EXCEPTION -import DATA_IOREF ( readIORef, writeIORef ) +import DATA_IOREF ( IORef, readIORef, writeIORef ) import System ( exitWith, ExitCode(..) ) import IO @@ -57,6 +62,9 @@ import Char ----------------------------------------------------------------------------- -- Process command-line +processStaticFlags :: [String] -> IO [String] +processStaticFlags opts = processArgs static_flags opts [] + data OptKind = NoArg (IO ()) -- flag with no argument | HasArg (String -> IO ()) -- flag has an argument (maybe prefix) @@ -201,8 +209,11 @@ static_flags = , ( "smp" , NoArg (addNoDups v_Ways WaySMP) ) , ( "debug" , NoArg (addNoDups v_Ways WayDebug) ) , ( "ndp" , NoArg (addNoDups v_Ways WayNDP) ) + , ( "threaded" , NoArg (addNoDups v_Ways WayThreaded) ) -- ToDo: user ways + ------ RTS ways ----------------------------------------------------- + ------ Debugging ---------------------------------------------------- , ( "dppr-noprags", PassFlag (add v_Opt_C) ) , ( "dppr-debug", PassFlag (add v_Opt_C) ) @@ -251,12 +262,10 @@ static_flags = then do writeIORef v_Split_object_files True add v_Opt_C "-fglobalise-toplev-names" else hPutStrLn stderr - "warning: don't know how to split \ - \object files on this architecture" + "warning: don't know how to split object files on this architecture" ) ) ------- Include/Import Paths ---------------------------------------- - , ( "i" , OptPrefix (addToDirList v_Import_paths) ) , ( "I" , Prefix (addToDirList v_Include_paths) ) ------- Libraries --------------------------------------------------- @@ -269,23 +278,16 @@ static_flags = , ( "framework-path" , HasArg (addToDirList v_Framework_paths) ) , ( "framework" , HasArg (add v_Cmdline_frameworks) ) #endif - ------- Packages ---------------------------------------------------- - , ( "package-name" , HasArg (\s -> add v_Opt_C ("-inpackage="++s)) ) - - , ( "package-conf" , HasArg (readPackageConf) ) - , ( "package" , HasArg (addPackage) ) - , ( "syslib" , HasArg (addPackage) ) -- for compatibility w/ old vsns - ------- Specific phases -------------------------------------------- , ( "pgmL" , HasArg setPgmL ) , ( "pgmP" , HasArg setPgmP ) - , ( "pgmP" , HasArg setPgmP ) , ( "pgmF" , HasArg setPgmF ) , ( "pgmc" , HasArg setPgmc ) , ( "pgmm" , HasArg setPgmm ) , ( "pgms" , HasArg setPgms ) , ( "pgma" , HasArg setPgma ) , ( "pgml" , HasArg setPgml ) + , ( "pgmdll" , HasArg setPgmDLL ) #ifdef ILX , ( "pgmI" , HasArg setPgmI ) , ( "pgmi" , HasArg setPgmi ) @@ -338,14 +340,26 @@ dynamic_flags = [ , ( "opti", HasArg (addOpt_i) ) #endif + ------- Packages ---------------------------------------------------- + , ( "package-conf" , HasArg extraPkgConf_ ) + , ( "no-user-package-conf", NoArg noUserPkgConf_ ) + , ( "package-name" , HasArg ignorePackage ) -- for compatibility + , ( "package" , HasArg exposePackage ) + , ( "hide-package" , HasArg hidePackage ) + , ( "ignore-package" , HasArg ignorePackage ) + , ( "syslib" , HasArg exposePackage ) -- for compatibility + ------ HsCpp opts --------------------------------------------------- , ( "D", AnySuffix addOpt_P ) , ( "U", AnySuffix addOpt_P ) + ------- Paths & stuff ----------------------------------------------- + , ( "i" , OptPrefix addImportPath ) + ------ Debugging ---------------------------------------------------- , ( "dstg-stats", NoArg (writeIORef v_StgStats True) ) - , ( "ddump-absC", NoArg (setDynFlag Opt_D_dump_absC) ) + , ( "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) ) @@ -355,7 +369,6 @@ dynamic_flags = [ , ( "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-realC", NoArg (setDynFlag Opt_D_dump_realC) ) , ( "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) ) @@ -374,7 +387,7 @@ dynamic_flags = [ , ( "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-stix", NoArg (setDynFlag Opt_D_dump_stix) ) + , ( "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) ) @@ -386,6 +399,7 @@ dynamic_flags = [ , ( "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) ) ------ Machine dependant (-m) stuff --------------------------- @@ -423,11 +437,6 @@ dynamic_flags = [ , ( "fglasgow-exts", NoArg (mapM_ setDynFlag glasgowExtsFlags) ) , ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) ) - -- "active negatives" - , ( "fno-implicit-prelude", NoArg (setDynFlag Opt_NoImplicitPrelude) ) - , ( "fno-monomorphism-restriction", - NoArg (setDynFlag Opt_NoMonomorphismRestriction) ) - -- the rest of the -f* and -fno-* flags , ( "fno-", PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) ) , ( "f", PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag f)) ) @@ -439,6 +448,7 @@ fFlags = [ ( "warn-duplicate-exports", Opt_WarnDuplicateExports ), ( "warn-hi-shadowing", Opt_WarnHiShadows ), ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns ), + ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd ), ( "warn-missing-fields", Opt_WarnMissingFields ), ( "warn-missing-methods", Opt_WarnMissingMethods ), ( "warn-missing-signatures", Opt_WarnMissingSigs ), @@ -450,17 +460,22 @@ fFlags = [ ( "warn-unused-imports", Opt_WarnUnusedImports ), ( "warn-unused-matches", Opt_WarnUnusedMatches ), ( "warn-deprecations", Opt_WarnDeprecations ), + ( "warn-orphans", Opt_WarnOrphans ), ( "fi", Opt_FFI ), -- support `-ffi'... ( "ffi", Opt_FFI ), -- ...and also `-fffi' ( "arrows", Opt_Arrows ), -- arrow syntax ( "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 ), ( "allow-undecidable-instances", Opt_AllowUndecidableInstances ), ( "allow-incoherent-instances", Opt_AllowIncoherentInstances ), ( "generics", Opt_Generics ), ( "strictness", Opt_Strictness ), + ( "full-laziness", Opt_FullLaziness ), ( "cse", Opt_CSE ), ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas ), ( "omit-interface-pragmas", Opt_OmitInterfacePragmas ), @@ -471,11 +486,82 @@ 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) +-- ----------------------------------------------------------------------------- +-- Parsing the dynamic flags. + +-- we use a temporary global variable, for convenience + +GLOBAL_VAR(v_DynFlags, defaultDynFlags, DynFlags) + +processDynamicFlags :: [String] -> DynFlags -> IO (DynFlags,[String]) +processDynamicFlags args dflags = do + writeIORef v_DynFlags dflags + spare <- processArgs dynamic_flags args [] + dflags <- readIORef v_DynFlags + return (dflags,spare) + +updDynFlags :: (DynFlags -> DynFlags) -> IO () +updDynFlags f = do dfs <- readIORef v_DynFlags + writeIORef v_DynFlags (f dfs) + +setDynFlag, unSetDynFlag :: DynFlag -> IO () +setDynFlag f = updDynFlags (\dfs -> dopt_set dfs f) +unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f) + +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}) +addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s}) +addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s}) +addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s}) +#ifdef ILX +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 + +setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 }) +setVerbosity n + | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n }) + | otherwise = throwDyn (UsageError "can't parse verbosity flag (-v)") + +addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s}) + +extraPkgConf_ p = updDynFlags (\s -> s{ extraPkgConfs = p : extraPkgConfs s }) +noUserPkgConf_ = updDynFlags (\s -> s{ readUserPkgConf = False }) + +exposePackage p = + updDynFlags (\s -> s{ packageFlags = ExposePackage p : packageFlags s }) +hidePackage p = + updDynFlags (\s -> s{ packageFlags = HidePackage p : packageFlags s }) +ignorePackage p = + updDynFlags (\s -> s{ packageFlags = IgnorePackage p : packageFlags s }) + +-- -i on its own deletes the import paths +addImportPath "" = updDynFlags (\s -> s{importPaths = []}) +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 } + _ -> dfs) + +setOptLevel :: Int -> IO () +setOptLevel n + = do dflags <- readIORef v_DynFlags + if hscLang dflags == HscInterpreted && n > 0 + then putStr "warning: -O conflicts with --interactive; -O ignored.\n" + else writeIORef v_DynFlags (updOptLevel n dflags) + ----------------------------------------------------------------------------- -- convert sizes like "3.5M" into integers @@ -543,9 +629,9 @@ setMainIs arg -- , registerised HC compilations -- ) -machdepCCOpts +machdepCCOpts dflags | prefixMatch "alpha" cTARGETPLATFORM - = return ( ["-static", "-w", "-mieee" + = return ( ["-w", "-mieee" #ifdef HAVE_THREADED_RTS_SUPPORT , "-D_REENTRANT" #endif @@ -557,7 +643,7 @@ machdepCCOpts | prefixMatch "hppa" cTARGETPLATFORM -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi! -- (very nice, but too bad the HP /usr/include files don't agree.) - = return ( ["-static", "-D_HPUX_SOURCE"], [] ) + = return ( ["-D_HPUX_SOURCE"], [] ) | prefixMatch "m68k" cTARGETPLATFORM -- -fno-defer-pop : for the .hc files, we want all the pushing/ @@ -576,7 +662,7 @@ machdepCCOpts -- -- -fomit-frame-pointer : *must* in .hc files; because we're stealing -- the fp (%ebp) for our register maps. - = do n_regs <- dynFlag stolen_x86_regs + = do let n_regs = stolen_x86_regs dflags sta <- readIORef v_Static return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" -- , if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" @@ -618,38 +704,26 @@ machdepCCOpts -- for "normal" programs, but it doesn't support register variable -- declarations. -- -mdynamic-no-pic: - -- As we don't support haskell code in shared libraries anyway, - -- we might as well turn of PIC code generation and save space and time. - -- This is completely optional. - = return ( ["-no-cpp-precomp","-mdynamic-no-pic"], [] ) - - | prefixMatch "powerpc" cTARGETPLATFORM || prefixMatch "rs6000" cTARGETPLATFORM - = return ( ["-static"], ["-finhibit-size-directive"] ) - + -- Turn off PIC code generation to save space and time. + -- -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 ( [], [] ) ----------------------------------------------------------------------------- -- local utils -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}) -addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s}) -addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s}) -addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s}) -#ifdef ILX -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 - -setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 }) -setVerbosity n - | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n }) - | otherwise = throwDyn (UsageError "can't parse verbosity flag (-v)") - -addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s}) - -- ----------------------------------------------------------------------------- -- Version and usage messages