Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
f8279ea9
Commit
f8279ea9
authored
Apr 25, 2011
by
dterei
Browse files
SafeHaskell: Add Safe & Trustworthy pragmas
parent
745e073e
Changes
5
Hide whitespace changes
Inline
Side-by-side
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 s
ou
rc
e
_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)
e
lse
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 Fa
lse
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}
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment