Commit 18d2dab6 authored by dterei's avatar dterei

Setup new Safe Haskell interface

parent e6dfe150
......@@ -39,7 +39,7 @@ module DynFlags (
-- ** Safe Haskell
SafeHaskellMode(..),
safeHaskellOn, safeLanguageOn,
safeImportsOn, safeLanguageOn,
safeDirectImpsReq, safeImplicitImpsReq,
packageTrustOn,
......@@ -343,16 +343,18 @@ data Language = Haskell98 | Haskell2010
-- | The various Safe Haskell modes
data SafeHaskellMode
= Sf_None
| Sf_SafeImports
| Sf_Unsafe
| Sf_Trustworthy
| Sf_Safe
| Sf_SafeInfered
deriving (Eq)
instance Outputable SafeHaskellMode where
ppr Sf_None = ptext $ sLit "None"
ppr Sf_SafeImports = ptext $ sLit "SafeImports"
ppr Sf_None = ptext $ sLit "None"
ppr Sf_Unsafe = ptext $ sLit "Unsafe"
ppr Sf_Trustworthy = ptext $ sLit "Trustworthy"
ppr Sf_Safe = ptext $ sLit "Safe"
ppr Sf_Safe = ptext $ sLit "Safe"
ppr Sf_SafeInfered = ptext $ sLit "Safe-Infered"
data ExtensionFlag
= Opt_Cpp
......@@ -880,7 +882,7 @@ defaultDynFlags mySettings =
flags = defaultFlags,
warningFlags = standardWarnings,
language = Nothing,
safeHaskell = Sf_None,
safeHaskell = Sf_SafeInfered,
thOnLoc = noSrcSpan,
newDerivOnLoc = noSrcSpan,
extensions = [],
......@@ -1027,9 +1029,11 @@ packageTrustOn = dopt Opt_PackageTrust
safeLanguageOn :: DynFlags -> Bool
safeLanguageOn dflags = safeHaskell dflags == Sf_Safe
-- | Test if Safe Haskell is on in some form
safeHaskellOn :: DynFlags -> Bool
safeHaskellOn dflags = safeHaskell dflags /= Sf_None
-- | Test if Safe Imports are on in some form
safeImportsOn :: DynFlags -> Bool
safeImportsOn dflags = safeHaskell dflags == Sf_Unsafe ||
safeHaskell dflags == Sf_Trustworthy ||
safeHaskell dflags == Sf_Safe
-- | Set a 'Safe Haskell' flag
setSafeHaskell :: SafeHaskellMode -> DynP ()
......@@ -1059,11 +1063,8 @@ combineSafeFlags a b =
(Sf_None, sf) -> return sf
(sf, Sf_None) -> return sf
(Sf_SafeImports, sf) -> return sf
(sf, Sf_SafeImports) -> return sf
(Sf_Trustworthy, Sf_Safe) -> err
(Sf_Safe, Sf_Trustworthy) -> err
(Sf_SafeInfered, sf) -> return sf
(sf, Sf_SafeInfered) -> return sf
(a,b) | a == b -> return a
| otherwise -> err
......@@ -1829,9 +1830,8 @@ languageFlags = [
-- They are used to place hard requirements on what GHC Haskell language
-- features can be used.
safeHaskellFlags :: [FlagSpec SafeHaskellMode]
safeHaskellFlags = [mkF Sf_SafeImports, mkF Sf_Trustworthy, mkF' Sf_Safe]
safeHaskellFlags = [mkF Sf_Unsafe, mkF Sf_Trustworthy, mkF Sf_Safe]
where mkF flag = (showPpr flag, flag, nop)
mkF' flag = (showPpr flag, flag, nop)
-- | These -X<blah> flags can all be reversed with -XNo<blah>
xFlags :: [FlagSpec ExtensionFlag]
......
......@@ -808,7 +808,7 @@ hscFileFrontEnd mod_summary = do
tcRnModule hsc_env (ms_hsc_src mod_summary) False rdr_module
dflags <- getDynFlags
-- XXX: See Note [Safe Haskell API]
if safeHaskellOn dflags
if safeImportsOn dflags
then do
tcg_env1 <- checkSafeImports dflags hsc_env tcg_env
if safeLanguageOn dflags
......
......@@ -1990,23 +1990,26 @@ noIfaceTrustInfo = setSafeMode Sf_None
trustInfoToNum :: IfaceTrustInfo -> Word8
trustInfoToNum it
= case getSafeMode it of
Sf_None -> 0
Sf_SafeImports -> 1
Sf_None -> 0
Sf_Unsafe -> 1
Sf_Trustworthy -> 2
Sf_Safe -> 3
Sf_Safe -> 3
Sf_SafeInfered -> 4
numToTrustInfo :: Word8 -> IfaceTrustInfo
numToTrustInfo 0 = setSafeMode Sf_None
numToTrustInfo 1 = setSafeMode Sf_SafeImports
numToTrustInfo 1 = setSafeMode Sf_Unsafe
numToTrustInfo 2 = setSafeMode Sf_Trustworthy
numToTrustInfo 3 = setSafeMode Sf_Safe
numToTrustInfo 4 = setSafeMode Sf_SafeInfered
numToTrustInfo n = error $ "numToTrustInfo: bad input number! (" ++ show n ++ ")"
instance Outputable IfaceTrustInfo where
ppr (TrustInfo Sf_None) = ptext $ sLit "none"
ppr (TrustInfo Sf_SafeImports) = ptext $ sLit "safe-imports"
ppr (TrustInfo Sf_Unsafe) = ptext $ sLit "unsafe"
ppr (TrustInfo Sf_Trustworthy) = ptext $ sLit "trustworthy"
ppr (TrustInfo Sf_Safe) = ptext $ sLit "safe"
ppr (TrustInfo Sf_SafeInfered) = ptext $ sLit "safe-infered"
\end{code}
%************************************************************************
......
......@@ -1888,7 +1888,7 @@ mkPState flags buf loc =
.|. alternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags
.|. relaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags
.|. nondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags
.|. safeHaskellBit `setBitIf` safeHaskellOn flags
.|. safeHaskellBit `setBitIf` safeImportsOn flags
.|. traditionalRecordSyntaxBit `setBitIf` xopt Opt_TraditionalRecordSyntax flags
--
setBitIf :: Int -> Bool -> Int
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment