-----------------------------------------------------------------------------
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
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
-----------------------------------------------------------------------------
-- 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)
, ( "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) )
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 ---------------------------------------------------
, ( "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 )
, ( "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) )
, ( "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) )
, ( "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) )
, ( "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<blah>) stuff ---------------------------
, ( "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)) )
( "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 ),
( "arrows", Opt_Arrows ), -- arrow syntax
( "parr", Opt_PArr ),
( "th", Opt_TH ),
+ ( "implicit-prelude", Opt_ImplicitPrelude ),
+ ( "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 ),
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<n>)")
+
+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 = updDynFlags (\s -> s{importPaths = p : importPaths s})
+
+-- 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
-- , registerised HC compilations
-- )
-machdepCCOpts
+machdepCCOpts dflags
| prefixMatch "alpha" cTARGETPLATFORM
- = return ( ["-static", "-w", "-mieee"
+ = return ( ["-w", "-mieee"
#ifdef HAVE_THREADED_RTS_SUPPORT
, "-D_REENTRANT"
#endif
| 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/
--
-- -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 ""
-- 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<n>)")
-
-addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s})
-
-- -----------------------------------------------------------------------------
-- Version and usage messages