Commit 45c64c1d authored by dterei's avatar dterei
Browse files

SafeHaskell: Disable certain ghc extensions in Safe.

This patch disables the use of some GHC extensions in
Safe mode and also the use of certain flags. Some
are disabled completely while others are only allowed
on the command line and not in source PRAGMAS.

We also check that Safe imports are indeed importing
a Safe or Trustworthy module.
parent 94434054
......@@ -909,7 +909,7 @@ mk_usage_info pit hsc_env this_mod direct_imports used_names
= case lookupModuleEnv direct_imports mod of
Just ((_,_,_,safe):_xs) -> (True, safe)
Just _ -> pprPanic "mkUsage: empty direct import" empty
Nothing -> (False, safeImportsRequired dflags)
Nothing -> (False, safeImplicitImpsReq dflags)
-- Nothing case is for implicit imports like 'System.IO' when 'putStrLn'
-- is used in the source code. We require them to be safe in SafeHaskell
......
......@@ -12,8 +12,8 @@
module CmdLineParser (
processArgs, OptKind(..),
CmdLineP(..), getCmdLineState, putCmdLineState,
Flag(..),
errorsToGhcException,
Flag(..), FlagSafety(..), flagA, flagR, flagC, flagN,
errorsToGhcException, determineSafeLevel,
EwM, addErr, addWarn, getArg, liftEwM, deprecate
) where
......@@ -34,9 +34,36 @@ import Data.List
data Flag m = Flag
{ flagName :: String, -- Flag, without the leading "-"
flagSafety :: FlagSafety, -- Flag safety level (SafeHaskell)
flagOptKind :: OptKind m -- What to do if we see it
}
-- | This determines how a flag should behave when SafeHaskell
-- mode is on.
data FlagSafety
= EnablesSafe -- ^ This flag is a little bit of a hack. We give
-- the safe haskell flags (-XSafe and -XSafeLanguage)
-- this safety type so we can easily detect when safe
-- haskell mode has been enable in a module pragma
-- as this changes how the rest of the parsing should
-- happen.
| AlwaysAllowed -- ^ Flag is always allowed
| RestrictedFunction -- ^ Flag is allowed but functions in a reduced way
| CmdLineOnly -- ^ Flag is only allowed on command line, not in pragma
| NeverAllowed -- ^ Flag isn't allowed at all
deriving ( Eq, Ord )
determineSafeLevel :: Bool -> FlagSafety
determineSafeLevel False = RestrictedFunction
determineSafeLevel True = CmdLineOnly
flagA, flagR, flagC, flagN :: String -> OptKind m -> Flag m
flagA n o = Flag n AlwaysAllowed o
flagR n o = Flag n RestrictedFunction o
flagC n o = Flag n CmdLineOnly o
flagN n o = Flag n NeverAllowed o
-------------------------------
data OptKind m -- Suppose the flag is -f
= NoArg (EwM m ()) -- -f all by itself
......@@ -64,22 +91,32 @@ type Warns = Bag Warn
-- EwM (short for "errors and warnings monad") is a
-- monad transformer for m that adds an (err, warn) state
newtype EwM m a = EwM { unEwM :: Located String -- Current arg
-> FlagSafety -- arg safety level
-> FlagSafety -- global safety level
-> Errs -> Warns
-> m (Errs, Warns, a) }
instance Monad m => Monad (EwM m) where
(EwM f) >>= k = EwM (\l e w -> do { (e', w', r) <- f l e w
; unEwM (k r) l e' w' })
return v = EwM (\_ e w -> return (e, w, v))
setArg :: Located String -> EwM m a -> EwM m a
setArg l (EwM f) = EwM (\_ es ws -> f l es ws)
(EwM f) >>= k = EwM (\l s c e w -> do { (e', w', r) <- f l s c e w
; unEwM (k r) l s c e' w' })
return v = EwM (\_ _ _ e w -> return (e, w, v))
setArg :: Monad m => Located String -> FlagSafety -> EwM m () -> EwM m ()
setArg l s (EwM f) = EwM (\_ _ c es ws ->
let check | s <= c = f l s c es ws
| otherwise = err l es ws
err (L loc ('-' : arg)) es ws =
let msg = "Warning: " ++ arg ++ " is not allowed in "
++ "SafeHaskell; ignoring " ++ arg
in return (es, ws `snocBag` L loc msg, ())
err _ _ _ = error "Bad pattern match in setArg"
in check)
addErr :: Monad m => String -> EwM m ()
addErr e = EwM (\(L loc _) es ws -> return (es `snocBag` L loc e, ws, ()))
addErr e = EwM (\(L loc _) _ _ es ws -> return (es `snocBag` L loc e, ws, ()))
addWarn :: Monad m => String -> EwM m ()
addWarn msg = EwM (\(L loc _) es ws -> return (es, ws `snocBag` L loc w, ()))
addWarn msg = EwM (\(L loc _) _ _ es ws -> return (es, ws `snocBag` L loc w, ()))
where
w = "Warning: " ++ msg
......@@ -89,10 +126,10 @@ deprecate s
; addWarn (arg ++ " is deprecated: " ++ s) }
getArg :: Monad m => EwM m String
getArg = EwM (\(L _ arg) es ws -> return (es, ws, arg))
getArg = EwM (\(L _ arg) _ _ es ws -> return (es, ws, arg))
liftEwM :: Monad m => m a -> EwM m a
liftEwM action = EwM (\_ es ws -> do { r <- action; return (es, ws, r) })
liftEwM action = EwM (\_ _ _ es ws -> do { r <- action; return (es, ws, r) })
-- -----------------------------------------------------------------------------
-- A state monad for use in the command-line parser
......@@ -119,31 +156,41 @@ putCmdLineState s = CmdLineP $ \_ -> ((),s)
processArgs :: Monad m
=> [Flag m] -- cmdline parser spec
-> [Located String] -- args
-> FlagSafety -- flag clearance lvl
-> Bool
-> m (
[Located String], -- spare args
[Located String], -- errors
[Located String] -- warnings
)
processArgs spec args
= do { (errs, warns, spare) <- unEwM (process args [])
(panic "processArgs: no arg yet")
emptyBag emptyBag
; return (spare, bagToList errs, bagToList warns) }
processArgs spec args clvl0 cmdline
= let (clvl1, action) = process clvl0 args []
in do { (errs, warns, spare) <- unEwM action (panic "processArgs: no arg yet")
AlwaysAllowed clvl1 emptyBag emptyBag
; return (spare, bagToList errs, bagToList warns) }
where
-- process :: [Located String] -> [Located String] -> EwM m [Located String]
process [] spare = return (reverse spare)
-- process :: FlagSafety -> [Located String] -> [Located String] -> (FlagSafety, EwM m [Located String])
--
process clvl [] spare = (clvl, return (reverse spare))
process (locArg@(L _ ('-' : arg)) : args) spare =
process clvl (locArg@(L _ ('-' : arg)) : args) spare =
case findArg spec arg of
Just (rest, opt_kind) ->
case processOneArg opt_kind rest arg args of
Left err -> do { setArg locArg $ addErr err
; process args spare }
Right (action,rest) -> do { setArg locArg $ action
; process rest spare }
Nothing -> process args (locArg : spare)
Just (rest, opt_kind, fsafe) ->
let clvl1 = if fsafe == EnablesSafe then determineSafeLevel cmdline else clvl
in case processOneArg opt_kind rest arg args of
Left err ->
let (clvl2,b) = process clvl1 args spare
clvl3 = min clvl1 clvl2
in (clvl3, (setArg locArg fsafe $ addErr err) >> b)
Right (action,rest) ->
let (clvl2,b) = process clvl1 rest spare
clvl3 = min clvl1 clvl2
in (clvl3, (setArg locArg fsafe $ action) >> b)
Nothing -> process clvl args (locArg : spare)
process (arg : args) spare = process args (arg : spare)
process clvl (arg : args) spare = process clvl args (arg : spare)
processOneArg :: OptKind m -> String -> String -> [Located String]
......@@ -184,11 +231,12 @@ processOneArg opt_kind rest arg args
AnySuffixPred _ f -> Right (f dash_arg, args)
findArg :: [Flag m] -> String -> Maybe (String, OptKind m)
findArg :: [Flag m] -> String -> Maybe (String, OptKind m, FlagSafety)
findArg spec arg
= case [ (removeSpaces rest, optKind)
= case [ (removeSpaces rest, optKind, flagSafe)
| flag <- spec,
let optKind = flagOptKind flag,
let optKind = flagOptKind flag,
let flagSafe = flagSafety flag,
Just rest <- [stripPrefix (flagName flag) arg],
arg_ok optKind rest arg ]
of
......
......@@ -754,7 +754,7 @@ runPhase (Cpp sf) input_fn dflags0
= do
src_opts <- io $ getOptionsFromFile dflags0 input_fn
(dflags1, unhandled_flags, warns)
<- io $ parseDynamicNoPackageFlags dflags0 src_opts
<- io $ parseDynamicFilePragma dflags0 src_opts
setDynFlags dflags1
io $ checkProcessArgsResult unhandled_flags
......@@ -772,7 +772,7 @@ runPhase (Cpp sf) input_fn dflags0
-- See #2464,#3457
src_opts <- io $ getOptionsFromFile dflags0 output_fn
(dflags2, unhandled_flags, warns)
<- io $ parseDynamicNoPackageFlags dflags0 src_opts
<- io $ parseDynamicFilePragma dflags0 src_opts
io $ checkProcessArgsResult unhandled_flags
unless (dopt Opt_Pp dflags2) $ io $ handleFlagWarnings dflags2 warns
-- the HsPp pass below will emit warnings
......@@ -806,7 +806,7 @@ runPhase (HsPp sf) input_fn dflags
-- re-read pragmas now that we've parsed the file (see #3674)
src_opts <- io $ getOptionsFromFile dflags output_fn
(dflags1, unhandled_flags, warns)
<- io $ parseDynamicNoPackageFlags dflags src_opts
<- io $ parseDynamicFilePragma dflags src_opts
setDynFlags dflags1
io $ checkProcessArgsResult unhandled_flags
io $ handleFlagWarnings dflags1 warns
......
......@@ -34,7 +34,8 @@ module DynFlags (
-- ** SafeHaskell
SafeHaskellMode(..),
safeHaskellOn, safeImportsRequired,
safeHaskellOn, safeLanguageOn,
safeDirectImpsReq, safeImplicitImpsReq,
Settings(..),
ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings,
......@@ -57,8 +58,8 @@ module DynFlags (
doingTickyProfiling,
-- ** Parsing DynFlags
parseDynamicFlags,
parseDynamicNoPackageFlags,
parseDynamicFlagsCmdLine,
parseDynamicFilePragma,
allFlags,
supportedLanguagesAndExtensions,
......@@ -975,6 +976,10 @@ setLanguage l = upd f
extensionFlags = flattenExtensionFlags mLang oneoffs
}
safeLanguageOn :: DynFlags -> Bool
safeLanguageOn dflags = s == Sf_SafeLanguage || s == Sf_Safe
where s = safeHaskell dflags
-- | Test if SafeHaskell is on in some form
safeHaskellOn :: DynFlags -> Bool
safeHaskellOn dflags = safeHaskell dflags /= Sf_None
......@@ -987,10 +992,15 @@ setSafeHaskell s = upd f
safeHaskell = combineSafeFlags sf s
}
-- | Are all imports required to be safe for this SafeHaskell mode?
safeImportsRequired :: DynFlags -> Bool
safeImportsRequired dflags = m == Sf_SafeLanguage || m == Sf_Safe
where m = safeHaskell dflags
-- | Are all direct imports required to be safe for this SafeHaskell mode?
-- Direct imports are when the code explicitly imports a module
safeDirectImpsReq :: DynFlags -> Bool
safeDirectImpsReq = safeLanguageOn
-- | Are all implicit imports required to be safe for this SafeHaskell mode?
-- Implicit imports are things in the prelude. e.g System.IO when print is used.
safeImplicitImpsReq :: DynFlags -> Bool
safeImplicitImpsReq _ = False
-- | Combine two SafeHaskell modes correctly. Used for dealing with multiple flags.
-- This makes SafeHaskell very much a monoid but for now I prefer this as I don't
......@@ -1128,6 +1138,7 @@ data Option
-- transformed (e.g., "/out=")
String -- the filepath/filename portion
| Option String
deriving ( Eq )
showOpt :: Option -> String
showOpt (FileOption pre f) = pre ++ f
......@@ -1183,26 +1194,27 @@ getStgToDo dflags
-- the parsed 'DynFlags', the left-over arguments, and a list of warnings.
-- Throws a 'UsageError' if errors occurred during parsing (such as unknown
-- flags or missing arguments).
parseDynamicFlags :: Monad m =>
parseDynamicFlagsCmdLine :: Monad m =>
DynFlags -> [Located String]
-> m (DynFlags, [Located String], [Located String])
-- ^ Updated 'DynFlags', left-over arguments, and
-- list of warnings.
parseDynamicFlags dflags args = parseDynamicFlags_ dflags args True
parseDynamicFlagsCmdLine dflags args = parseDynamicFlags dflags args True
-- | Like 'parseDynamicFlags' but does not allow the package flags (-package,
-- -hide-package, -ignore-package, -hide-all-packages, -package-conf).
parseDynamicNoPackageFlags :: Monad m =>
-- | Like 'parseDynamicFlagsCmdLine' but does not allow the package flags
-- (-package, -hide-package, -ignore-package, -hide-all-packages, -package-conf).
-- Used to parse flags set in a modules pragma.
parseDynamicFilePragma :: Monad m =>
DynFlags -> [Located String]
-> m (DynFlags, [Located String], [Located String])
-- ^ Updated 'DynFlags', left-over arguments, and
-- list of warnings.
parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False
parseDynamicFilePragma dflags args = parseDynamicFlags dflags args False
parseDynamicFlags_ :: Monad m =>
parseDynamicFlags :: Monad m =>
DynFlags -> [Located String] -> Bool
-> m (DynFlags, [Located String], [Located String])
parseDynamicFlags_ dflags0 args pkg_flags = do
parseDynamicFlags dflags0 args cmdline = do
-- XXX Legacy support code
-- We used to accept things like
-- optdep-f -optdepdepend
......@@ -1216,14 +1228,116 @@ parseDynamicFlags_ dflags0 args pkg_flags = do
args' = f args
-- Note: -ignore-package (package_flags) must precede -i* (dynamic_flags)
flag_spec | pkg_flags = package_flags ++ dynamic_flags
flag_spec | cmdline = package_flags ++ dynamic_flags
| otherwise = dynamic_flags
let safeLevel = if safeLanguageOn dflags0
then determineSafeLevel cmdline else NeverAllowed
let ((leftover, errs, warns), dflags1)
= runCmdLine (processArgs flag_spec args') dflags0
= runCmdLine (processArgs flag_spec args' safeLevel cmdline) dflags0
when (not (null errs)) $ ghcError $ errorsToGhcException errs
return (dflags1, leftover, warns)
-- check for disabled flags in safe haskell
-- Hack: unfortunately flags that are completely disabled can't be stopped from being
-- enabled on the command line before a -XSafe or -XSafeLanguage flag is encountered.
-- the easiest way to fix this is to just check that they aren't enabled now. The down
-- side is that flags marked as NeverAllowed must also be checked here placing a sync
-- burden on the ghc hacker.
let sh_warns = if (safeLanguageOn dflags2)
then shFlagsDisallowed dflags2
else []
return (dflags2, leftover, sh_warns ++ warns)
-- | Extensions that can't be enabled at all when compiling in Safe mode
-- checkSafeHaskellFlags :: MonadIO m => DynFlags -> m ()
shFlagsDisallowed :: DynFlags -> [Located String]
shFlagsDisallowed dflags = concat $ map check_method bad_flags
where
check_method (flag,str) | (flag dflags) = safeFailure str
| otherwise = []
bad_flags = [(xopt Opt_GeneralizedNewtypeDeriving, "-XGeneralizedNewtypeDeriving")]
safeFailure str = [L noSrcSpan $ "Warning: " ++ str ++ " is not allowed in"
++ " SafeHaskell; ignoring " ++ str]
{-
-- ALTERNATE SAFE HASKELL CHECK METHOD
-- | Extensions that can only be enabled on the command line when compiling in
-- Safe mode
shFlagsCmdLineOnly :: Monad m => DynFlags -> DynFlags -> m ()
shFlagsCmdLineOnly oldf newf = mapM_ check_method bad_flags
where
check_method (test,str) = when test $ safeFailure str
ext_test ext = xopt ext newf && not (xopt ext oldf)
pgm_test pgm = pgm oldf == pgm newf
dyn_test dyn = dopt dyn newf && not (dopt dyn oldf)
bad_flags = [ (ext_test Opt_TemplateHaskell, "TemplateHaskell")
, (ext_test Opt_Cpp, "CPP")
, (dyn_test Opt_Pp, "F")
, (pgm_test pgm_lo, "pgmlo")
, (pgm_test pgm_lc, "pgmlc")
, (pgm_test pgm_L, "pgmL")
, (pgm_test pgm_P, "pgmP")
, (pgm_test pgm_F, "pgmF")
, (pgm_test pgm_c, "pgmc")
, (pgm_test pgm_m, "pgmm")
, (pgm_test pgm_s, "pgms")
, (pgm_test pgm_a, "pgma")
, (pgm_test pgm_l, "pgml")
, (pgm_test pgm_dll, "pgmdll")
, (pgm_test pgm_windres, "pgmwindres")
, (pgm_test opt_lo, "optlo")
, (pgm_test opt_lc, "optlc")
, (pgm_test opt_L, "optL")
, (pgm_test opt_P, "optP")
, (pgm_test opt_F, "optF")
, (pgm_test opt_c, "optc")
, (pgm_test opt_m, "optm")
, (pgm_test opt_a, "opta")
, (pgm_test opt_l, "optl OR l")
, (pgm_test opt_windres, "optlwindres")
, (pgm_test mainFunIs
&& pgm_test mainModIs, "main-is")
, (pgm_test libraryPaths, "L")
, (pgm_test dynLibLoader, "dynload")
, (pgm_test hcSuf, "hcsuf")
, (pgm_test hiSuf, "hisuf")
, (pgm_test objectSuf, "osuf")
, (pgm_test hiDir, "hidir")
, (pgm_test objectDir, "odir")
, (pgm_test stubDir, "stubdir")
, (pgm_test outputHi, "ohi")
, (pgm_test outputFile, "o")
, (pgm_test tmpDir, "tmpdir")
, (pgm_test includePaths, "I")
, (pgm_test rtsOpts, "with-rtsopts")
, (pgm_test rtsOptsEnabled, "rtsopts")
, (pgm_test dylibInstallName, "dylib-install-name")
]
-- safeFailure :: MonadIO m => String -> m ()
safeFailure :: Monad m => String -> m ()
safeFailure s = ghcError $ CmdLineError $ "Illegal extension (" ++ s
++ ") in use while compiling with Safe Haskell!"
{-
-- prefer this error but circular imports arise.
= liftIO $ throwIO $ mkSrcErr $ unitBag $ mkPlainErrMsg noSrcSpan $
text "Illegal extension (" <> text s <>
text ") in use while compiling with Safe Haskell!"
-}
-}
{- **********************************************************************
......@@ -1240,301 +1354,301 @@ allFlags = map ('-':) $
map ("f"++) flags' ++
map ("X"++) supportedExtensions
where ok (PrefixPred _ _) = False
ok _ = True
flags = [ name | (name, _, _) <- fFlags ]
flags' = [ name | (name, _, _) <- fLangFlags ]
ok _ = True
flags = [ name | (name, _, _, _) <- fFlags ]
flags' = [ name | (name, _, _, _) <- fLangFlags ]
--------------- The main flags themselves ------------------
dynamic_flags :: [Flag (CmdLineP DynFlags)]
dynamic_flags = [
Flag "n" (NoArg (addWarn "The -n flag is deprecated and no longer has any effect"))
, Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp))
, Flag "F" (NoArg (setDynFlag Opt_Pp))
, Flag "#include"
flagA "n" (NoArg (addWarn "The -n flag is deprecated and no longer has any effect"))
, flagC "cpp" (NoArg (setExtensionFlag Opt_Cpp))
, flagC "F" (NoArg (setDynFlag Opt_Pp))
, flagA "#include"
(HasArg (\s -> do { addCmdlineHCInclude s
; addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect" }))
, Flag "v" (OptIntSuffix setVerbosity)
, flagA "v" (OptIntSuffix setVerbosity)
------- Specific phases --------------------------------------------
-- need to appear before -pgmL to be parsed as LLVM flags.
, Flag "pgmlo" (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])})))
, Flag "pgmlc" (hasArg (\f -> alterSettings (\s -> s { sPgm_lc = (f,[])})))
, Flag "pgmL" (hasArg (\f -> alterSettings (\s -> s { sPgm_L = f})))
, Flag "pgmP" (hasArg setPgmP)
, Flag "pgmF" (hasArg (\f -> alterSettings (\s -> s { sPgm_F = f})))
, Flag "pgmc" (hasArg (\f -> alterSettings (\s -> s { sPgm_c = (f,[])})))
, Flag "pgmm" (HasArg (\_ -> addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release"))
, Flag "pgms" (hasArg (\f -> alterSettings (\s -> s { sPgm_s = (f,[])})))
, Flag "pgma" (hasArg (\f -> alterSettings (\s -> s { sPgm_a = (f,[])})))
, Flag "pgml" (hasArg (\f -> alterSettings (\s -> s { sPgm_l = (f,[])})))
, Flag "pgmdll" (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])})))
, Flag "pgmwindres" (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f})))
, flagC "pgmlo" (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])})))
, flagC "pgmlc" (hasArg (\f -> alterSettings (\s -> s { sPgm_lc = (f,[])})))
, flagC "pgmL" (hasArg (\f -> alterSettings (\s -> s { sPgm_L = f})))
, flagC "pgmP" (hasArg setPgmP)
, flagC "pgmF" (hasArg (\f -> alterSettings (\s -> s { sPgm_F = f})))
, flagC "pgmc" (hasArg (\f -> alterSettings (\s -> s { sPgm_c = (f,[])})))
, flagC "pgmm" (HasArg (\_ -> addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release"))
, flagC "pgms" (hasArg (\f -> alterSettings (\s -> s { sPgm_s = (f,[])})))
, flagC "pgma" (hasArg (\f -> alterSettings (\s -> s { sPgm_a = (f,[])})))
, flagC "pgml" (hasArg (\f -> alterSettings (\s -> s { sPgm_l = (f,[])})))
, flagC "pgmdll" (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])})))
, flagC "pgmwindres" (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f})))
-- need to appear before -optl/-opta to be parsed as LLVM flags.
, Flag "optlo" (hasArg (\f -> alterSettings (\s -> s { sOpt_lo = f : sOpt_lo s})))
, Flag "optlc" (hasArg (\f -> alterSettings (\s -> s { sOpt_lc = f : sOpt_lc s})))
, Flag "optL" (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s})))
, Flag "optP" (hasArg addOptP)
, Flag "optF" (hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s})))
, Flag "optc" (hasArg (\f -> alterSettings (\s -> s { sOpt_c = f : sOpt_c s})))
, Flag "optm" (hasArg (\f -> alterSettings (\s -> s { sOpt_m = f : sOpt_m s})))
, Flag "opta" (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s})))
, Flag "optl" (hasArg addOptl)
, Flag "optwindres" (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s})))
, Flag "split-objs"
, flagC "optlo" (hasArg (\f -> alterSettings (\s -> s { sOpt_lo = f : sOpt_lo s})))
, flagC "optlc" (hasArg (\f -> alterSettings (\s -> s { sOpt_lc = f : sOpt_lc s})))
, flagC "optL" (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s})))
, flagC "optP" (hasArg addOptP)
, flagC "optF" (hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s})))
, flagC "optc" (hasArg (\f -> alterSettings (\s -> s { sOpt_c = f : sOpt_c s})))
, flagC "optm" (hasArg (\f -> alterSettings (\s -> s { sOpt_m = f : sOpt_m s})))
, flagC "opta" (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s})))
, flagC "optl" (hasArg addOptl)
, flagC "optwindres" (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s})))
, flagC "split-objs"
(NoArg (if can_split
then setDynFlag Opt_SplitObjs
else addWarn "ignoring -fsplit-objs"))
-------- ghc -M -----------------------------------------------------
, Flag "dep-suffix" (hasArg addDepSuffix)
, Flag "optdep-s" (hasArgDF addDepSuffix "Use -dep-suffix instead")
, Flag "dep-makefile" (hasArg setDepMakefile)
, Flag "optdep-f" (hasArgDF setDepMakefile "Use -dep-makefile instead")
, Flag "optdep-w" (NoArg (deprecate "doesn't do anything"))
, Flag "include-pkg-deps" (noArg (setDepIncludePkgDeps True))
, Flag "optdep--include-prelude" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
, Flag "optdep--include-pkg-deps" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
, Flag "exclude-module" (hasArg addDepExcludeMod)
, Flag "optdep--exclude-module" (hasArgDF addDepExcludeMod "Use -exclude-module instead")
, Flag "optdep-x" (hasArgDF addDepExcludeMod "Use -exclude-module instead")
, flagA "dep-suffix" (hasArg addDepSuffix)
, flagA "optdep-s" (hasArgDF addDepSuffix "Use -dep-suffix instead")
, flagA "dep-makefile" (hasArg setDepMakefile)
, flagA "optdep-f" (hasArgDF setDepMakefile "Use -dep-makefile instead")
, flagA "optdep-w" (NoArg (deprecate "doesn't do anything"))
, flagA "include-pkg-deps" (noArg (setDepIncludePkgDeps True))
, flagA "optdep--include-prelude" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
, flagA "optdep--include-pkg-deps" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
, flagA "exclude-module" (hasArg addDepExcludeMod)
, flagA "optdep--exclude-module" (hasArgDF addDepExcludeMod "Use -exclude-module instead")
, flagA "optdep-x" (hasArgDF addDepExcludeMod "Use -exclude-module instead")
-------- Linking ----------------------------------------------------
, Flag "no-link" (noArg (\d -> d{ ghcLink=NoLink }))
, Flag "shared" (noArg (\d -> d{ ghcLink=LinkDynLib }))
, Flag "dynload" (hasArg parseDynLibLoaderMode)
, Flag "dylib-install-name" (hasArg setDylibInstallName)
, flagA "no-link" (noArg (\d -> d{ ghcLink=NoLink }))
, flagA "shared" (noArg (\d -> d{ ghcLink=LinkDynLib }))
, flagC "dynload" (hasArg parseDynLibLoaderMode)
, flagC "dylib-install-name" (hasArg setDylibInstallName)
------- Libraries ---------------------------------------------------
, Flag "L" (Prefix addLibraryPath)
, Flag "l" (hasArg (addOptl . ("-l" ++)))
, flagC "L" (Prefix addLibraryPath)
, flagC "l" (hasArg (addOptl . ("-l" ++)))
------- Frameworks --------------------------------------------------
-- -framework-path should really be -F ...
, Flag "framework-path" (HasArg addFrameworkPath)
, Flag "framework" (hasArg addCmdlineFramework)
, flagC "framework-path" (HasArg addFrameworkPath)
, flagC "framework" (hasArg addCmdlineFramework)
------- Output Redirection ------------------------------------------
, Flag "odir" (hasArg setObjectDir)
, Flag "o" (SepArg (upd . setOutputFile . Just))
, Flag "ohi" (hasArg (setOutputHi . Just ))
, Flag "osuf" (hasArg setObjectSuf)
, Flag "hcsuf" (hasArg setHcSuf)
, Flag "hisuf" (hasArg setHiSuf)
, Flag "hidir" (hasArg setHiDir)
, Flag "tmpdir" (hasArg setTmpDir)
, Flag "stubdir" (hasArg setStubDir)
, Flag "outputdir" (hasArg setOutputDir)
, Flag "ddump-file-prefix" (hasArg (setDumpPrefixForce . Just))
, flagC "odir" (hasArg setObjectDir)
, flagC "o" (SepArg (upd . setOutputFile . Just))
, flagC "ohi" (hasArg (setOutputHi . Just ))
, flagC "osuf" (hasArg setObjectSuf)
, flagC "hcsuf" (hasArg setHcSuf)
, flagC "hisuf" (hasArg setHiSuf)
, flagC "hidir" (hasArg setHiDir)
, flagC "tmpdir" (hasArg setTmpDir)
, flagC "stubdir" (hasArg setStubDir)
, flagC "outputdir" (hasArg setOutputDir)
, flagC "ddump-file-prefix" (hasArg (setDumpPrefixForce . Just))
------- Keeping temporary files -------------------------------------
-- These can be singular (think ghc -c) or plural (think ghc --make)