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 ...@@ -909,7 +909,7 @@ mk_usage_info pit hsc_env this_mod direct_imports used_names
= case lookupModuleEnv direct_imports mod of = case lookupModuleEnv direct_imports mod of
Just ((_,_,_,safe):_xs) -> (True, safe) Just ((_,_,_,safe):_xs) -> (True, safe)
Just _ -> pprPanic "mkUsage: empty direct import" empty 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' -- 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 -- is used in the source code. We require them to be safe in SafeHaskell
......
...@@ -12,8 +12,8 @@ ...@@ -12,8 +12,8 @@
module CmdLineParser ( module CmdLineParser (
processArgs, OptKind(..), processArgs, OptKind(..),
CmdLineP(..), getCmdLineState, putCmdLineState, CmdLineP(..), getCmdLineState, putCmdLineState,
Flag(..), Flag(..), FlagSafety(..), flagA, flagR, flagC, flagN,
errorsToGhcException, errorsToGhcException, determineSafeLevel,
EwM, addErr, addWarn, getArg, liftEwM, deprecate EwM, addErr, addWarn, getArg, liftEwM, deprecate
) where ) where
...@@ -34,9 +34,36 @@ import Data.List ...@@ -34,9 +34,36 @@ import Data.List
data Flag m = Flag data Flag m = Flag
{ flagName :: String, -- Flag, without the leading "-" { flagName :: String, -- Flag, without the leading "-"
flagSafety :: FlagSafety, -- Flag safety level (SafeHaskell)
flagOptKind :: OptKind m -- What to do if we see it 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 data OptKind m -- Suppose the flag is -f
= NoArg (EwM m ()) -- -f all by itself = NoArg (EwM m ()) -- -f all by itself
...@@ -64,22 +91,32 @@ type Warns = Bag Warn ...@@ -64,22 +91,32 @@ type Warns = Bag Warn
-- EwM (short for "errors and warnings monad") is a -- EwM (short for "errors and warnings monad") is a
-- monad transformer for m that adds an (err, warn) state -- monad transformer for m that adds an (err, warn) state
newtype EwM m a = EwM { unEwM :: Located String -- Current arg newtype EwM m a = EwM { unEwM :: Located String -- Current arg
-> FlagSafety -- arg safety level
-> FlagSafety -- global safety level
-> Errs -> Warns -> Errs -> Warns
-> m (Errs, Warns, a) } -> m (Errs, Warns, a) }
instance Monad m => Monad (EwM m) where instance Monad m => Monad (EwM m) where
(EwM f) >>= k = EwM (\l e w -> do { (e', w', r) <- f l e w (EwM f) >>= k = EwM (\l s c e w -> do { (e', w', r) <- f l s c e w
; unEwM (k r) l e' w' }) ; unEwM (k r) l s c e' w' })
return v = EwM (\_ e w -> return (e, w, v)) return v = EwM (\_ _ _ e w -> return (e, w, v))
setArg :: Located String -> EwM m a -> EwM m a setArg :: Monad m => Located String -> FlagSafety -> EwM m () -> EwM m ()
setArg l (EwM f) = EwM (\_ es ws -> f l es ws) 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 :: 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 :: 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 where
w = "Warning: " ++ msg w = "Warning: " ++ msg
...@@ -89,10 +126,10 @@ deprecate s ...@@ -89,10 +126,10 @@ deprecate s
; addWarn (arg ++ " is deprecated: " ++ s) } ; addWarn (arg ++ " is deprecated: " ++ s) }
getArg :: Monad m => EwM m String 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 :: 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 -- A state monad for use in the command-line parser
...@@ -119,31 +156,41 @@ putCmdLineState s = CmdLineP $ \_ -> ((),s) ...@@ -119,31 +156,41 @@ putCmdLineState s = CmdLineP $ \_ -> ((),s)
processArgs :: Monad m processArgs :: Monad m
=> [Flag m] -- cmdline parser spec => [Flag m] -- cmdline parser spec
-> [Located String] -- args -> [Located String] -- args
-> FlagSafety -- flag clearance lvl
-> Bool
-> m ( -> m (
[Located String], -- spare args [Located String], -- spare args
[Located String], -- errors [Located String], -- errors
[Located String] -- warnings [Located String] -- warnings
) )
processArgs spec args processArgs spec args clvl0 cmdline
= do { (errs, warns, spare) <- unEwM (process args []) = let (clvl1, action) = process clvl0 args []
(panic "processArgs: no arg yet") in do { (errs, warns, spare) <- unEwM action (panic "processArgs: no arg yet")
emptyBag emptyBag AlwaysAllowed clvl1 emptyBag emptyBag
; return (spare, bagToList errs, bagToList warns) } ; return (spare, bagToList errs, bagToList warns) }
where where
-- process :: [Located String] -> [Located String] -> EwM m [Located String] -- process :: FlagSafety -> [Located String] -> [Located String] -> (FlagSafety, EwM m [Located String])
process [] spare = return (reverse spare) --
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 case findArg spec arg of
Just (rest, opt_kind) -> Just (rest, opt_kind, fsafe) ->
case processOneArg opt_kind rest arg args of let clvl1 = if fsafe == EnablesSafe then determineSafeLevel cmdline else clvl
Left err -> do { setArg locArg $ addErr err in case processOneArg opt_kind rest arg args of
; process args spare } Left err ->
Right (action,rest) -> do { setArg locArg $ action let (clvl2,b) = process clvl1 args spare
; process rest spare } clvl3 = min clvl1 clvl2
Nothing -> process args (locArg : spare) 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] processOneArg :: OptKind m -> String -> String -> [Located String]
...@@ -184,11 +231,12 @@ processOneArg opt_kind rest arg args ...@@ -184,11 +231,12 @@ processOneArg opt_kind rest arg args
AnySuffixPred _ f -> Right (f dash_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 findArg spec arg
= case [ (removeSpaces rest, optKind) = case [ (removeSpaces rest, optKind, flagSafe)
| flag <- spec, | flag <- spec,
let optKind = flagOptKind flag, let optKind = flagOptKind flag,
let flagSafe = flagSafety flag,
Just rest <- [stripPrefix (flagName flag) arg], Just rest <- [stripPrefix (flagName flag) arg],
arg_ok optKind rest arg ] arg_ok optKind rest arg ]
of of
......
...@@ -754,7 +754,7 @@ runPhase (Cpp sf) input_fn dflags0 ...@@ -754,7 +754,7 @@ runPhase (Cpp sf) input_fn dflags0
= do = do
src_opts <- io $ getOptionsFromFile dflags0 input_fn src_opts <- io $ getOptionsFromFile dflags0 input_fn
(dflags1, unhandled_flags, warns) (dflags1, unhandled_flags, warns)
<- io $ parseDynamicNoPackageFlags dflags0 src_opts <- io $ parseDynamicFilePragma dflags0 src_opts
setDynFlags dflags1 setDynFlags dflags1
io $ checkProcessArgsResult unhandled_flags io $ checkProcessArgsResult unhandled_flags
...@@ -772,7 +772,7 @@ runPhase (Cpp sf) input_fn dflags0 ...@@ -772,7 +772,7 @@ runPhase (Cpp sf) input_fn dflags0
-- See #2464,#3457 -- See #2464,#3457
src_opts <- io $ getOptionsFromFile dflags0 output_fn src_opts <- io $ getOptionsFromFile dflags0 output_fn
(dflags2, unhandled_flags, warns) (dflags2, unhandled_flags, warns)
<- io $ parseDynamicNoPackageFlags dflags0 src_opts <- io $ parseDynamicFilePragma dflags0 src_opts
io $ checkProcessArgsResult unhandled_flags io $ checkProcessArgsResult unhandled_flags
unless (dopt Opt_Pp dflags2) $ io $ handleFlagWarnings dflags2 warns unless (dopt Opt_Pp dflags2) $ io $ handleFlagWarnings dflags2 warns
-- the HsPp pass below will emit warnings -- the HsPp pass below will emit warnings
...@@ -806,7 +806,7 @@ runPhase (HsPp sf) input_fn dflags ...@@ -806,7 +806,7 @@ runPhase (HsPp sf) input_fn dflags
-- re-read pragmas now that we've parsed the file (see #3674) -- re-read pragmas now that we've parsed the file (see #3674)
src_opts <- io $ getOptionsFromFile dflags output_fn src_opts <- io $ getOptionsFromFile dflags output_fn
(dflags1, unhandled_flags, warns) (dflags1, unhandled_flags, warns)
<- io $ parseDynamicNoPackageFlags dflags src_opts <- io $ parseDynamicFilePragma dflags src_opts
setDynFlags dflags1 setDynFlags dflags1
io $ checkProcessArgsResult unhandled_flags io $ checkProcessArgsResult unhandled_flags
io $ handleFlagWarnings dflags1 warns io $ handleFlagWarnings dflags1 warns
......
This diff is collapsed.
...@@ -460,6 +460,11 @@ setSessionDynFlags dflags = do ...@@ -460,6 +460,11 @@ setSessionDynFlags dflags = do
return preload return preload
parseDynamicFlags :: Monad m =>
DynFlags -> [Located String]
-> m (DynFlags, [Located String], [Located String])
parseDynamicFlags = parseDynamicFlagsCmdLine
-- %************************************************************************ -- %************************************************************************
-- %* * -- %* *
......
...@@ -1408,7 +1408,7 @@ preprocessFile hsc_env src_fn mb_phase (Just (buf, _time)) ...@@ -1408,7 +1408,7 @@ preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
let local_opts = getOptions dflags buf src_fn let local_opts = getOptions dflags buf src_fn
(dflags', leftovers, warns) (dflags', leftovers, warns)
<- parseDynamicNoPackageFlags dflags local_opts <- parseDynamicFilePragma dflags local_opts
checkProcessArgsResult leftovers checkProcessArgsResult leftovers
handleFlagWarnings dflags' warns handleFlagWarnings dflags' warns
......
...@@ -105,9 +105,9 @@ mkPrelImports this_mod implicit_prelude import_decls ...@@ -105,9 +105,9 @@ mkPrelImports this_mod implicit_prelude import_decls
preludeImportDecl preludeImportDecl
= L loc $ = L loc $
ImportDecl (L loc pRELUDE_NAME) ImportDecl (L loc pRELUDE_NAME)
Nothing {- no specific package -} Nothing {- No specific package -}
False {- Not a boot interface -} False {- Not a boot interface -}
False {- Not a safe interface -} False {- Not a safe import -}
False {- Not qualified -} False {- Not qualified -}
Nothing {- No "as" -} Nothing {- No "as" -}
Nothing {- No import list -} Nothing {- No import list -}
......
...@@ -86,7 +86,8 @@ import Panic ...@@ -86,7 +86,8 @@ import Panic
#endif #endif
import Id ( Id ) import Id ( Id )
import Module ( emptyModuleEnv, ModLocation(..), Module ) import Module
import Packages
import RdrName import RdrName
import HsSyn import HsSyn
import CoreSyn import CoreSyn
...@@ -770,12 +771,109 @@ batchMsg hsc_env mb_mod_index recomp mod_summary ...@@ -770,12 +771,109 @@ batchMsg hsc_env mb_mod_index recomp mod_summary
-------------------------------------------------------------- --------------------------------------------------------------
hscFileFrontEnd :: ModSummary -> Hsc TcGblEnv hscFileFrontEnd :: ModSummary -> Hsc TcGblEnv
hscFileFrontEnd mod_summary = hscFileFrontEnd mod_summary = do
do rdr_module <- hscParse' mod_summary rdr_module <- hscParse' mod_summary
hsc_env <- getHscEnv hsc_env <- getHscEnv
{-# SCC "Typecheck-Rename" #-} {-# SCC "Typecheck-Rename" #-}
ioMsgMaybe $ tcg_env <- ioMsgMaybe $
tcRnModule hsc_env (ms_hsc_src mod_summary) False rdr_module tcRnModule hsc_env (ms_hsc_src mod_summary) False rdr_module
dflags <- getDynFlags
tcg_env' <- checkSafeImports dflags hsc_env tcg_env
return tcg_env'
--------------------------------------------------------------
-- SafeHaskell
--------------------------------------------------------------
-- | Validate that safe imported modules are actually safe.
-- For modules in the HomePackage (the package the module we
-- are compiling in resides) this just involves checking its
-- trust type is 'Safe' or 'Trustworthy'. For modules that
-- reside in another package we also must check that the
-- external pacakge is trusted.
checkSafeImports :: DynFlags -> HscEnv -> TcGblEnv -> Hsc TcGblEnv
checkSafeImports dflags hsc_env tcg_env
| not (safeHaskellOn dflags)
= return tcg_env
| otherwise
= do
imps <- mapM condense imports'
mapM_ checkSafe imps
return tcg_env
where
imp_info = tcg_imports tcg_env -- ImportAvails
imports = imp_mods imp_info -- ImportedMods
imports' = moduleEnvToList imports -- (Module, [ImportedModsVal])
condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, IsSafeImport)
condense (_, []) = panic "HscMain.condense: Pattern match failure!"
condense (m, x:xs) = do (_,_,l,s) <- foldlM cond' x xs
return (m, l, s)
-- ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport)
cond' :: ImportedModsVal -> ImportedModsVal -> Hsc ImportedModsVal
cond' v1@(m1,_,l1,s1) (_,_,_,s2)
| s1 /= s2
= liftIO $ throwIO $ mkSrcErr $ unitBag $ mkPlainErrMsg l1
(text "Module" <+> ppr m1 <+> (text $ "is imported"
++ " both as a safe and unsafe import!"))
| otherwise
= return v1
lookup' :: Module -> Hsc (Maybe ModIface)
lookup' m = do
hsc_eps <- liftIO $ hscEPS hsc_env
let pkgIfaceT = eps_PIT hsc_eps
homePkgT = hsc_HPT hsc_env
iface = lookupIfaceByModule dflags homePkgT pkgIfaceT m
return iface
-- | Check the package a module resides in is trusted.
-- Modules in the home package are trusted but otherwise
-- we check the packages trust flag.
packageTrusted :: Module -> Bool
packageTrusted m
| thisPackage dflags == modulePackageId m = True
| otherwise = trusted $ getPackageDetails (pkgState dflags)
(modulePackageId m)
-- Is a module a Safe importable? Return Nothing if True, or a String
-- if it isn't containing the reason it isn't
isModSafe :: Module -> SrcSpan -> Hsc (Maybe SDoc)
isModSafe m l = do
iface <- lookup' m
case iface of
-- can't load iface to check trust!
Nothing -> liftIO $ throwIO $ mkSrcErr $ unitBag $ mkPlainErrMsg l
$ text "Can't load the interface file for" <+> ppr m <>
text ", to check that it can be safely imported"
-- got iface, check trust
Just iface' -> do
let trust = getSafeMode $ mi_trust iface'
-- check module is trusted
safeM = trust `elem` [Sf_Safe, Sf_Trustworthy,
Sf_TrustworthyWithSafeLanguage]
-- check package is trusted
safeP = packageTrusted m
if safeM && safeP
then return Nothing
else return $ Just $ if safeM
then text "The package (" <> ppr (modulePackageId m) <>
text ") the module resides in isn't trusted."
else text "The module itself isn't safe."
checkSafe :: (Module, SrcSpan, IsSafeImport) -> Hsc ()
checkSafe (_, _, False) = return ()
checkSafe (m, l, True ) = do
module_safe <- isModSafe m l
case module_safe of
Nothing -> return ()
Just s -> liftIO $ throwIO $ mkSrcErr $ unitBag $ mkPlainErrMsg l
$ text "Safe import of" <+> ppr m <+> text "can't be met!"
<+> s
-------------------------------------------------------------- --------------------------------------------------------------
-- Simplifiers -- Simplifiers
......
...@@ -15,7 +15,7 @@ module HscTypes ( ...@@ -15,7 +15,7 @@ module HscTypes (
-- * Information about modules -- * Information about modules
ModDetails(..), emptyModDetails, ModDetails(..), emptyModDetails,
ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC, ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
ImportedMods, ImportedMods, ImportedModsVal,
ModSummary(..), ms_mod_name, showModMsg, isBootSummary, ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
msHsFilePath, msHiFilePath, msObjFilePath, msHsFilePath, msHiFilePath, msObjFilePath,
...@@ -718,7 +718,9 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv, ...@@ -718,7 +718,9 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv,
} }
-- | Records the modules directly imported by a module for extracting e.g. usage information -- | Records the modules directly imported by a module for extracting e.g. usage information
type ImportedMods = ModuleEnv [(ModuleName, Bool, SrcSpan, IsSafeImport)] type ImportedMods = ModuleEnv [ImportedModsVal]
type ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport)
-- TODO: we are not actually using the codomain of this type at all, so it can be -- TODO: we are not actually using the codomain of this type at all, so it can be
-- replaced with ModuleEnv () -- replaced with ModuleEnv ()
......
...@@ -50,7 +50,7 @@ parseStaticFlags args = do ...@@ -50,7 +50,7 @@ parseStaticFlags args = do
ready <- readIORef v_opt_C_ready ready <- readIORef v_opt_C_ready
when ready $ ghcError (ProgramError "Too late for parseStaticFlags: call it before newSession") when ready $ ghcError (ProgramError "Too late for parseStaticFlags: call it before newSession")
(leftover, errs, warns1) <- processArgs static_flags args (leftover, errs, warns1) <- processArgs static_flags args CmdLineOnly True
when (not (null errs)) $ ghcError $ errorsToGhcException errs when (not (null errs)) $ ghcError $ errorsToGhcException errs
-- deal with the way flags: the way (eg. prof) gives rise to -- deal with the way flags: the way (eg. prof) gives rise to
...@@ -62,7 +62,8 @@ parseStaticFlags args = do ...@@ -62,7 +62,8 @@ parseStaticFlags args = do
let unreg_flags | cGhcUnregisterised == "YES" = unregFlags let unreg_flags | cGhcUnregisterised == "YES" = unregFlags
| otherwise = [] | otherwise = []
(more_leftover, errs, warns2) <- processArgs static_flags (unreg_flags ++ way_flags') (more_leftover, errs, warns2) <-
processArgs static_flags (unreg_flags ++ way_flags') CmdLineOnly True
-- see sanity code in staticOpts -- see sanity code in staticOpts
writeIORef v_opt_C_ready True writeIORef v_opt_C_ready True
...@@ -103,65 +104,65 @@ static_flags :: [Flag IO] ...@@ -103,65 +104,65 @@ static_flags :: [Flag IO]
static_flags = [ static_flags = [
------- GHCi ------------------------------------------------------- ------- GHCi -------------------------------------------------------
Flag "ignore-dot-ghci" (PassFlag addOpt) flagC "ignore-dot-ghci" (PassFlag addOpt)
, Flag "read-dot-ghci" (NoArg (removeOpt "-ignore-dot-ghci")) , flagC "read-dot-ghci" (NoArg (removeOpt "-ignore-dot-ghci"))
------- ways -------------------------------------------------------- ------- ways --------------------------------------------------------
, Flag "prof" (NoArg (addWay WayProf)) , flagC "prof" (NoArg (addWay WayProf))
, Flag "eventlog" (NoArg (addWay WayEventLog)) , flagC "eventlog" (NoArg (addWay WayEventLog))
, Flag "parallel" (NoArg (addWay WayPar)) , flagC "parallel" (NoArg (addWay WayPar))
, Flag "gransim" (NoArg (addWay WayGran)) , flagC "gransim" (NoArg (addWay WayGran))
, Flag "smp" (NoArg (addWay WayThreaded >> deprecate "Use -threaded instead")) , flagC "smp" (NoArg (addWay WayThreaded >> deprecate "Use -threaded instead"))
, Flag "debug" (NoArg (addWay WayDebug)) , flagC "debug" (NoArg (addWay WayDebug))
, Flag "ndp" (NoArg (addWay WayNDP)) , flagC "ndp" (NoArg (addWay WayNDP))
, Flag "threaded" (NoArg (addWay WayThreaded)) , flagC "threaded" (NoArg (addWay WayThreaded))
, Flag "ticky" (PassFlag (\f -> do addOpt f; addWay WayDebug)) , flagC "ticky" (PassFlag (\f -> do addOpt f; addWay WayDebug))
-- -ticky enables ticky-ticky code generation, and also implies -debug which -- -ticky enables ticky-ticky code generation, and also implies -debug which
-- is required to get the RTS ticky support. -- is required to get the RTS ticky support.
------ Debugging ---------------------------------------------------- ------ Debugging ----------------------------------------------------
, Flag "dppr-debug" (PassFlag addOpt) , flagC "dppr-debug" (PassFlag addOpt)
, Flag "dppr-cols" (AnySuffix addOpt) , flagC "dppr-cols" (AnySuffix addOpt)
, Flag "dppr-user-length" (AnySuffix addOpt) , flagC "dppr-user-length" (AnySuffix addOpt)
, Flag "dppr-case-as-let" (PassFlag addOpt) , flagC "dppr-case-as-let" (PassFlag addOpt)
, Flag "dsuppress-all" (PassFlag addOpt) , flagC "dsuppress-all" (PassFlag addOpt)
, Flag "dsuppress-uniques" (PassFlag addOpt) , flagC "dsuppress-uniques" (PassFlag addOpt)
, Flag "dsuppress-coercions" (PassFlag addOpt) , flagC "dsuppress-coercions" (PassFlag addOpt)
, Flag "dsuppress-module-prefixes" (PassFlag addOpt) , flagC "dsuppress-module-prefixes" (PassFlag addOpt)
, Flag "dsuppress-type-applications" (PassFlag addOpt) , flagC "dsuppress-type-applications" (PassFlag addOpt)
, Flag "dsuppress-idinfo" (PassFlag addOpt) , flagC "dsuppress-idinfo" (PassFlag addOpt)
, Flag "dsuppress-type-signatures" (PassFlag addOpt) , flagC "dsuppress-type-signatures" (PassFlag addOpt)
, Flag "dopt-fuel" (AnySuffix addOpt) , flagC "dopt-fuel" (AnySuffix addOpt)
, Flag "dtrace-level" (AnySuffix addOpt) , flagC "dtrace-level" (AnySuffix addOpt)
, Flag "dno-debug-output" (PassFlag addOpt) , flagC "dno-debug-output" (PassFlag addOpt)
, Flag "dstub-dead-values" (PassFlag addOpt) , flagC "dstub-dead-values" (PassFlag addOpt)
-- rest of the debugging flags are dynamic -- rest of the debugging flags are dynamic
----- Linker -------------------------------------------------------- ----- Linker --------------------------------------------------------
, Flag "static" (PassFlag addOpt) , flagC "static" (PassFlag addOpt)
, Flag "dynamic" (NoArg (removeOpt "-static" >> addWay WayDyn)) , flagC "dynamic" (NoArg (removeOpt "-static" >> addWay WayDyn))
-- ignored for compat w/ gcc: -- ignored for compat w/ gcc:
, Flag "rdynamic" (NoArg (return ())) , flagC "rdynamic" (NoArg (return ()))
----- RTS opts ------------------------------------------------------ ----- RTS opts ------------------------------------------------------