Skip to content

GitLab

Commit f8279ea9 authored by dterei's avatar dterei
Browse files
Options

SafeHaskell: Add Safe & Trustworthy pragmas

parent 745e073e
Hide whitespace changes
Inline Side-by-side
Showing with 235 additions and 80 deletions
compiler/iface/BinIface.hs
View file @ f8279ea9
......@@ -390,7 +390,8 @@ instance Binary ModIface where
mi_rules = rules,
mi_orphan_hash = orphan_hash,
mi_vect_info = vect_info,
mi_hpc = hpc_info }) = do
mi_hpc = hpc_info,
mi_trust = trust }) = do
put_ bh mod
put_ bh is_boot
put_ bh iface_hash
......@@ -411,6 +412,7 @@ instance Binary ModIface where
put_ bh orphan_hash
put_ bh vect_info
put_ bh hpc_info
put_ bh trust
get bh = do
mod_name <- get bh
......@@ -433,6 +435,7 @@ instance Binary ModIface where
orphan_hash <- get bh
vect_info <- get bh
hpc_info <- get bh
trust <- get bh
return (ModIface {
mi_module = mod_name,
mi_boot = is_boot,
......@@ -455,6 +458,7 @@ instance Binary ModIface where
mi_orphan_hash = orphan_hash,
mi_vect_info = vect_info,
mi_hpc = hpc_info,
mi_trust = trust,
-- And build the cached values
mi_warn_fn = mkIfaceWarnCache warns,
mi_fix_fn = mkIfaceFixCache fixities,
......@@ -1522,4 +1526,7 @@ instance Binary IfaceVectInfo where
a5 <- get bh
return (IfaceVectInfo a1 a2 a3 a4 a5)
instance Binary IfaceTrustInfo where
put_ bh iftrust = putByte bh $ trustInfoToNum iftrust
get bh = getByte bh >>= (return . numToTrustInfo)
compiler/iface/LoadIface.lhs
View file @ f8279ea9
......@@ -666,7 +666,9 @@ pprModIface iface
, vcat (map ppr (mi_fam_insts iface))
, vcat (map ppr (mi_rules iface))
, pprVectInfo (mi_vect_info iface)
, pprVectInfo (mi_vect_info iface)
, ppr (mi_warns iface)
, pprTrustInfo (mi_trust iface)
]
where
pp_boot | mi_boot iface = ptext (sLit "[boot]")
......@@ -743,6 +745,9 @@ pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars
, ptext (sLit "scalar tycons:") <+> hsep (map ppr scalarTyCons)
]
pprTrustInfo :: IfaceTrustInfo -> SDoc
pprTrustInfo trust = ptext (sLit "trusted:") <+> ppr trust
instance Outputable Warnings where
ppr = pprWarns
......
compiler/iface/MkIface.lhs
View file @ f8279ea9
......@@ -106,24 +106,24 @@ import System.FilePath
%************************************************************************
%* *
%* *
\subsection{Completing an interface}
%* *
%* *
%************************************************************************
\begin{code}
mkIface :: HscEnv
-> Maybe Fingerprint -- The old fingerprint, if we have it
-> ModDetails -- The trimmed, tidied interface
-> ModGuts -- Usages, deprecations, etc
-> IO (Messages,
-> Maybe Fingerprint -- The old fingerprint, if we have it
-> ModDetails -- The trimmed, tidied interface
-> ModGuts -- Usages, deprecations, etc
-> IO (Messages,
Maybe (ModIface, -- The new one
Bool)) -- True <=> there was an old Iface, and the
Bool)) -- True <=> there was an old Iface, and the
-- new one is identical, so no need
-- to write it
mkIface hsc_env maybe_old_fingerprint mod_details
ModGuts{ mg_module = this_mod,
ModGuts{ mg_module = this_mod,
mg_boot = is_boot,
mg_used_names = used_names,
mg_deps = deps,
......@@ -232,6 +232,7 @@ mkIface_ hsc_env maybe_old_fingerprint
; iface_insts = map instanceToIfaceInst insts
; iface_fam_insts = map famInstToIfaceFamInst fam_insts
; iface_vect_info = flattenVectInfo vect_info
; trust_info = (setSafeMode . safeHaskell . hsc_dflags) hsc_env
; intermediate_iface = ModIface {
mi_module = this_mod,
......@@ -264,6 +265,7 @@ mkIface_ hsc_env maybe_old_fingerprint
mi_decls = deliberatelyOmitted "decls",
mi_hash_fn = deliberatelyOmitted "hash_fn",
mi_hpc = isHpcUsed hpc_info,
mi_trust = trust_info,
-- And build the cached values
mi_warn_fn = mkIfaceWarnCache warns,
......@@ -1029,53 +1031,50 @@ checkOldIface :: HscEnv
-> IO (RecompileRequired, Maybe ModIface)
checkOldIface hsc_env mod_summary source_unchanged maybe_iface
= do { showPass (hsc_dflags hsc_env)
("Checking old interface for " ++
showSDoc (ppr (ms_mod mod_summary))) ;
; initIfaceCheck hsc_env $
check_old_iface hsc_env mod_summary source_unchanged maybe_iface
}
= do showPass (hsc_dflags hsc_env) $
"Checking old interface for " ++ (showSDoc $ ppr $ ms_mod mod_summary)
initIfaceCheck hsc_env $
check_old_iface hsc_env mod_summary source_unchanged maybe_iface
check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
-> IfG (Bool, Maybe ModIface)
check_old_iface hsc_env mod_summary source_unchanged maybe_iface
= do -- CHECK WHETHER THE SOURCE HAS CHANGED
{ when (not source_unchanged)
(traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
-- If the source has changed and we're in interactive mode, avoid reading
-- an interface; just return the one we might have been supplied with.
; let dflags = hsc_dflags hsc_env
; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
return (outOfDate, maybe_iface)
else
case maybe_iface of {
Just old_iface -> do -- Use the one we already have
{ traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
; return (recomp, Just old_iface) }
; Nothing -> do
-- Try and read the old interface for the current module
-- from the .hi file left from the last time we compiled it
{ let iface_path = msHiFilePath mod_summary
; read_result <- readIface (ms_mod mod_summary) iface_path False
; case read_result of {
Failed err -> do -- Old interface file not found, or garbled; give up
{ traceIf (text "FYI: cannot read old interface file:"
$$ nest 4 err)
; return (outOfDate, Nothing) }
; Succeeded iface -> do
-- We have got the old iface; check its versions
{ traceIf (text "Read the interface file" <+> text iface_path)
; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
; return (recomp, Just iface)
}}}}}
check_old_iface hsc_env mod_summary src_unchanged maybe_iface
= let src_changed = not src_unchanged
dflags = hsc_dflags hsc_env
getIface =
case maybe_iface of
Just _ -> do
traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
return maybe_iface
Nothing -> do
let iface_path = msHiFilePath mod_summary
read_result <- readIface (ms_mod mod_summary) iface_path False
case read_result of
Failed err -> do
traceIf (text "FYI: cannont read old interface file:" $$ nest 4 err)
return Nothing
Succeeded iface -> do
traceIf (text "Read the interface file" <+> text iface_path)
return $ Just iface
in do
when src_changed
(traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
-- If the source has changed and we're in interactive mode, avoid reading
-- an interface; just return the one we might have been supplied with.
if not (isObjectTarget $ hscTarget dflags) && src_changed
then return (outOfDate, maybe_iface)
else do
-- Try and read the old interface for the current module
-- from the .hi file left from the last time we compiled it
maybe_iface' <- getIface
case maybe_iface' of
Nothing -> return (outOfDate, maybe_iface')
Just iface -> do
-- We have got the old iface; check its versions
recomp <- checkVersions hsc_env src_unchanged mod_summary iface
return recomp
\end{code}
@recompileRequired@ is called from the HscMain. It checks whether
......@@ -1089,41 +1088,50 @@ upToDate, outOfDate :: Bool
upToDate = False -- Recompile not required
outOfDate = True -- Recompile required
-- | Check the safe haskell flags haven't changed
-- (e.g different flag on command line now)
checkSafeHaskell :: HscEnv -> ModIface -> Bool
checkSafeHaskell hsc_env iface
= (getSafeMode $ mi_trust iface) /= (safeHaskell $ hsc_dflags hsc_env)
checkVersions :: HscEnv
-> Bool -- True <=> source unchanged
-> ModSummary
-> ModIface -- Old interface
-> IfG RecompileRequired
-> IfG (RecompileRequired, Maybe ModIface)
checkVersions hsc_env source_unchanged mod_summary iface
| not source_unchanged
= return outOfDate
= return (outOfDate, Just iface)
| otherwise
= do { traceHiDiffs (text "Considering whether compilation is required for" <+>
ppr (mi_module iface) <> colon)
= do { traceHiDiffs (text "Considering whether compilation is required for" <+>
ppr (mi_module iface) <> colon)
; recomp <- checkDependencies hsc_env mod_summary iface
; if recomp then return outOfDate else do {
; if recomp then return (outOfDate, Just iface) else do {
; if trust_dif then return (outOfDate, Nothing) else do {
-- Source code unchanged and no errors yet... carry on
-- Source code unchanged and no errors yet... carry on
--
-- First put the dependent-module info, read from the old
-- interface, into the envt, so that when we look for
-- interfaces we look for the right one (.hi or .hi-boot)
--
-- It's just temporary because either the usage check will succeed
-- (in which case we are done with this module) or it'll fail (in which
-- case we'll compile the module from scratch anyhow).
--
-- We do this regardless of compilation mode, although in --make mode
-- all the dependent modules should be in the HPT already, so it's
-- quite redundant
updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
; let this_pkg = thisPackage (hsc_dflags hsc_env)
; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
}}
-- First put the dependent-module info, read from the old
-- interface, into the envt, so that when we look for
-- interfaces we look for the right one (.hi or .hi-boot)
--
-- It's just temporary because either the usage check will succeed
-- (in which case we are done with this module) or it'll fail (in which
-- case we'll compile the module from scratch anyhow).
--
-- We do this regardless of compilation mode, although in --make mode
-- all the dependent modules should be in the HPT already, so it's
-- quite redundant
updateEps_ $ \eps -> eps { eps_is_boot = mod_deps }
; let this_pkg = thisPackage (hsc_dflags hsc_env)
; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
; return (recomp, Just iface)
}}}
where
-- This is a bit of a hack really
trust_dif = checkSafeHaskell hsc_env iface
-- This is a bit of a hack really
mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
mod_deps = mkModDeps (dep_mods (mi_deps iface))
......
compiler/main/DynFlags.hs
View file @ f8279ea9
......@@ -31,6 +31,7 @@ module DynFlags (
fFlags, fLangFlags, xFlags,
DPHBackend(..), dphPackageMaybe,
wayNames,
SafeHaskellMode(..),
Settings(..),
ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings,
......@@ -319,6 +320,24 @@ data DynFlag
data Language = Haskell98 | Haskell2010
-- | The various SafeHaskell modes
data SafeHaskellMode
= Sf_None
| Sf_SafeImports
| Sf_SafeLanguage
| Sf_Trustworthy
| Sf_TrustworthyWithSafeLanguage
| Sf_Safe
deriving (Eq)
instance Show SafeHaskellMode where
show Sf_None = "None"
show Sf_SafeImports = "SafeImports"
show Sf_SafeLanguage = "SafeLanguage"
show Sf_Trustworthy = "Trustworthy"
show Sf_TrustworthyWithSafeLanguage = "Trustworthy + SafeLanguage"
show Sf_Safe = "Safe"
data ExtensionFlag
= Opt_Cpp
| Opt_OverlappingInstances
......@@ -511,6 +530,8 @@ data DynFlags = DynFlags {
flags :: [DynFlag],
-- Don't change this without updating extensionFlags:
language :: Maybe Language,
-- | Safe Haskell mode
safeHaskell :: SafeHaskellMode,
-- Don't change this without updating extensionFlags:
extensions :: [OnOff ExtensionFlag],
-- extensionFlags should always be equal to
......@@ -831,6 +852,7 @@ defaultDynFlags mySettings =
haddockOptions = Nothing,
flags = defaultFlags,
language = Nothing,
safeHaskell = Sf_None,
extensions = [],
extensionFlags = flattenExtensionFlags Nothing [],
......@@ -949,6 +971,47 @@ setLanguage l = upd f
extensionFlags = flattenExtensionFlags mLang oneoffs
}
-- | Set a 'SafeHaskell' flag
setSafeHaskell :: SafeHaskellMode -> DynP ()
setSafeHaskell s = upd f
where f dfs = let sf = safeHaskell dfs
in dfs {
safeHaskell = combineSafeFlags sf s
}
-- | 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
-- want to export this functionality from the module but do want to export the
-- type constructors.
combineSafeFlags :: SafeHaskellMode -> SafeHaskellMode -> SafeHaskellMode
combineSafeFlags a b =
case (a,b) of
(Sf_None, sf) -> sf
(sf, Sf_None) -> sf
(Sf_SafeImports, sf) -> sf
(sf, Sf_SafeImports) -> sf
(Sf_SafeLanguage, Sf_Safe) -> err
(Sf_Safe, Sf_SafeLanguage) -> err
(Sf_SafeLanguage, Sf_Trustworthy) -> Sf_TrustworthyWithSafeLanguage
(Sf_Trustworthy, Sf_SafeLanguage) -> Sf_TrustworthyWithSafeLanguage
(Sf_TrustworthyWithSafeLanguage, Sf_Trustworthy) -> Sf_TrustworthyWithSafeLanguage
(Sf_TrustworthyWithSafeLanguage, Sf_SafeLanguage) -> Sf_TrustworthyWithSafeLanguage
(Sf_Trustworthy, Sf_TrustworthyWithSafeLanguage) -> Sf_TrustworthyWithSafeLanguage
(Sf_SafeLanguage, Sf_TrustworthyWithSafeLanguage) -> Sf_TrustworthyWithSafeLanguage
(Sf_Trustworthy, Sf_Safe) -> err
(Sf_Safe, Sf_Trustworthy) -> err
(a,b) | a == b -> a
| otherwise -> err
where err = ghcError (CmdLineError $ "Incompatible SafeHaskell flags! ("
++ show a ++ "," ++ show b ++ ")")
-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
getOpts :: DynFlags -- ^ 'DynFlags' to retrieve the options from
-> (DynFlags -> [a]) -- ^ Relevant record accessor: one of the @opt_*@ accessors
......@@ -1467,6 +1530,7 @@ dynamic_flags = [
++ map (mkFlag turnOn "X" setExtensionFlag ) xFlags
++ map (mkFlag turnOff "XNo" unSetExtensionFlag) xFlags
++ map (mkFlag turnOn "X" setLanguage) languageFlags
++ map (mkFlag turnOn "X" setSafeHaskell) safeHaskellFlags
package_flags :: [Flag (CmdLineP DynFlags)]
package_flags = [
......@@ -1645,11 +1709,15 @@ fLangFlags = [
supportedLanguages :: [String]
supportedLanguages = [ name | (name, _, _) <- languageFlags ]
supportedLanguageOverlays :: [String]
supportedLanguageOverlays = [ name | (name, _, _) <- safeHaskellFlags ]
supportedExtensions :: [String]
supportedExtensions = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
supportedLanguagesAndExtensions :: [String]
supportedLanguagesAndExtensions = supportedLanguages ++ supportedExtensions
supportedLanguagesAndExtensions =
supportedLanguages ++ supportedLanguageOverlays ++ supportedExtensions
-- | These -X<blah> flags cannot be reversed with -XNo<blah>
languageFlags :: [FlagSpec Language]
......@@ -1658,6 +1726,13 @@ languageFlags = [
( "Haskell2010", Haskell2010, nop )
]
-- | These -X<blah> flags cannot be reversed with -XNo<blah>
-- They are used to place hard requirements on what GHC Haskell language
-- features can be used.
safeHaskellFlags :: [FlagSpec SafeHaskellMode]
safeHaskellFlags = map mkF [Sf_SafeImports, Sf_SafeLanguage, Sf_Trustworthy, Sf_Safe]
where mkF flag = (show flag, flag, nop)
-- | These -X<blah> flags can all be reversed with -XNo<blah>
xFlags :: [FlagSpec ExtensionFlag]
xFlags = [
......
compiler/main/HscTypes.lhs
View file @ f8279ea9
......@@ -91,6 +91,10 @@ module HscTypes (
VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
noIfaceVectInfo,
-- * Safe Haskell information
IfaceTrustInfo, getSafeMode, setSafeMode, noIfaceTrustInfo,
trustInfoToNum, numToTrustInfo,
-- * Compilation errors and warnings
SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
throwOneError, handleSourceError,
......@@ -127,7 +131,7 @@ import DataCon ( DataCon, dataConImplicitIds, dataConWrapId )
import PrelNames ( gHC_PRIM )
import Packages hiding ( Version(..) )
import DynFlags ( DynFlags(..), isOneShot, HscTarget (..), dopt,
DynFlag(..) )
DynFlag(..), SafeHaskellMode(..) )
import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase )
import BasicTypes ( IPName, defaultFixity, WarningTxt(..) )
import OptimizationFuel ( OptFuelState )
......@@ -154,6 +158,7 @@ import Data.IORef
import Data.Array ( Array, array )
import Data.List
import Data.Map (Map)
import Data.Word
import Control.Monad ( mplus, guard, liftM, when )
import Exception
......@@ -680,8 +685,10 @@ data ModIface
-- isn't in decls. It's useful to know that when
-- seeing if we are up to date wrt. the old interface.
-- The 'OccName' is the parent of the name, if it has one.
mi_hpc :: !AnyHpcUsage
mi_hpc :: !AnyHpcUsage,
-- ^ True if this program uses Hpc at any point in the program.
mi_trust :: !IfaceTrustInfo
-- ^ Safe Haskell Trust information for this module.
}
-- | The 'ModDetails' is essentially a cache for information in the 'ModIface'
......@@ -852,7 +859,8 @@ emptyModIface mod
mi_warn_fn = emptyIfaceWarnCache,
mi_fix_fn = emptyIfaceFixCache,
mi_hash_fn = emptyIfaceHashCache,
mi_hpc = False
mi_hpc = False,
mi_trust = noIfaceTrustInfo
}
\end{code}
......@@ -1792,6 +1800,58 @@ noIfaceVectInfo :: IfaceVectInfo
noIfaceVectInfo = IfaceVectInfo [] [] [] [] []
\end{code}
%************************************************************************
%* *
\subsection{Safe Haskell Support}
%* *
%************************************************************************
This stuff here is related to supporting the Safe Haskell extension,
primarily about storing under what trust type a module has been compiled.
\begin{code}
-- | Safe Haskell information for 'ModIface'
-- Simply a wrapper around SafeHaskellMode to sepperate iface and flags
newtype IfaceTrustInfo = TrustInfo SafeHaskellMode
getSafeMode :: IfaceTrustInfo -> SafeHaskellMode
getSafeMode (TrustInfo x) = x
setSafeMode :: SafeHaskellMode -> IfaceTrustInfo
setSafeMode = TrustInfo
noIfaceTrustInfo :: IfaceTrustInfo
noIfaceTrustInfo = setSafeMode Sf_None
trustInfoToNum :: IfaceTrustInfo -> Word8
trustInfoToNum it
= case getSafeMode it of
Sf_None -> 0
Sf_SafeImports -> 1
Sf_SafeLanguage -> 2
Sf_Trustworthy -> 3
Sf_TrustworthyWithSafeLanguage -> 4
Sf_Safe -> 5
numToTrustInfo :: Word8 -> IfaceTrustInfo
numToTrustInfo 0 = setSafeMode Sf_None
numToTrustInfo 1 = setSafeMode Sf_SafeImports
numToTrustInfo 2 = setSafeMode Sf_SafeLanguage
numToTrustInfo 3 = setSafeMode Sf_Trustworthy
numToTrustInfo 4 = setSafeMode Sf_TrustworthyWithSafeLanguage
numToTrustInfo 5 = setSafeMode Sf_Safe
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_SafeLanguage) = ptext $ sLit "safe-language"
ppr (TrustInfo Sf_Trustworthy) = ptext $ sLit "trustworthy"
ppr (TrustInfo Sf_TrustworthyWithSafeLanguage)
= ptext $ sLit "trustworthy + safe-language"
ppr (TrustInfo Sf_Safe) = ptext $ sLit "safe"
\end{code}
%************************************************************************
%* *
\subsection{Linkable stuff}
......
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