Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
GHC
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Requirements
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Test cases
Artifacts
Deploy
Releases
Package Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Code review analytics
Issue analytics
Insights
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Alexander Kaznacheev
GHC
Commits
4a2127ce
Commit
4a2127ce
authored
13 years ago
by
David Terei
Committed by
Ian Lynagh
13 years ago
Browse files
Options
Downloads
Patches
Plain Diff
Move function from where clause to top level
parent
c5b92fbf
Loading
Loading
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
compiler/main/HscMain.hs
+33
-36
33 additions, 36 deletions
compiler/main/HscMain.hs
with
33 additions
and
36 deletions
compiler/main/HscMain.hs
+
33
−
36
View file @
4a2127ce
...
@@ -911,20 +911,18 @@ hscCheckSafeImports tcg_env = do
...
@@ -911,20 +911,18 @@ hscCheckSafeImports tcg_env = do
text
"Rule
\"
"
<>
ftext
n
<>
text
"
\"
ignored"
$+$
text
"Rule
\"
"
<>
ftext
n
<>
text
"
\"
ignored"
$+$
text
"User defined rules are disabled under Safe Haskell"
text
"User defined rules are disabled under Safe Haskell"
-- | Validate that safe imported modules are actually safe.
-- | Validate that safe imported modules are actually safe. For modules in the
-- For modules in the HomePackage (the package the module we
-- HomePackage (the package the module we are compiling in resides) this just
-- are compiling in resides) this just involves checking its
-- involves checking its trust type is 'Safe' or 'Trustworthy'. For modules
-- trust type is 'Safe' or 'Trustworthy'. For modules that
-- that reside in another package we also must check that the external pacakge
-- reside in another package we also must check that the
-- is trusted. See the Note [Safe Haskell Trust Check] above for more
-- external pacakge is trusted. See the Note [Safe Haskell
-- information.
-- Trust Check] above for more information.
--
--
-- The code for this is quite tricky as the whole algorithm
-- The code for this is quite tricky as the whole algorithm is done in a few
-- is done in a few distinct phases in different parts of the
-- distinct phases in different parts of the code base. See
-- code base. See RnNames.rnImportDecl for where package trust
-- RnNames.rnImportDecl for where package trust dependencies for a module are
-- dependencies for a module are collected and unioned.
-- collected and unioned. Specifically see the Note [RnNames . Tracking Trust
-- Specifically see the Note [RnNames . Tracking Trust Transitively]
-- Transitively] and the Note [RnNames . Trust Own Package].
-- and the Note [RnNames . Trust Own Package].
checkSafeImports
::
DynFlags
->
TcGblEnv
->
Hsc
TcGblEnv
checkSafeImports
::
DynFlags
->
TcGblEnv
->
Hsc
TcGblEnv
checkSafeImports
dflags
tcg_env
checkSafeImports
dflags
tcg_env
=
do
=
do
...
@@ -941,7 +939,7 @@ checkSafeImports dflags tcg_env
...
@@ -941,7 +939,7 @@ checkSafeImports dflags tcg_env
clearWarnings
clearWarnings
logWarnings
oldErrs
logWarnings
oldErrs
-- See the Note [
Safe Haskell Inference]
-- See the Note [Safe Haskell Inference]
case
(
not
$
isEmptyBag
errs
)
of
case
(
not
$
isEmptyBag
errs
)
of
-- We have errors!
-- We have errors!
...
@@ -953,7 +951,7 @@ checkSafeImports dflags tcg_env
...
@@ -953,7 +951,7 @@ checkSafeImports dflags tcg_env
-- All good matey!
-- All good matey!
False
->
do
False
->
do
when
(
packageTrustOn
dflags
)
$
checkPkgTrust
pkg_reqs
when
(
packageTrustOn
dflags
)
$
checkPkgTrust
dflags
pkg_reqs
-- add in trusted package requirements for this module
-- add in trusted package requirements for this module
let
new_trust
=
emptyImportAvails
{
imp_trust_pkgs
=
catMaybes
pkgs
}
let
new_trust
=
emptyImportAvails
{
imp_trust_pkgs
=
catMaybes
pkgs
}
return
tcg_env
{
tcg_imports
=
imp_info
`
plusImportAvails
`
new_trust
}
return
tcg_env
{
tcg_imports
=
imp_info
`
plusImportAvails
`
new_trust
}
...
@@ -986,22 +984,6 @@ checkSafeImports dflags tcg_env
...
@@ -986,22 +984,6 @@ checkSafeImports dflags tcg_env
checkSafe
(
_
,
_
,
False
)
=
return
Nothing
checkSafe
(
_
,
_
,
False
)
=
return
Nothing
checkSafe
(
m
,
l
,
True
)
=
hscCheckSafe'
dflags
m
l
checkSafe
(
m
,
l
,
True
)
=
hscCheckSafe'
dflags
m
l
-- Here we check the transitive package trust requirements are OK still.
checkPkgTrust
::
[
PackageId
]
->
Hsc
()
checkPkgTrust
pkgs
=
case
errors
of
[]
->
return
()
_
->
(
liftIO
.
throwIO
.
mkSrcErr
.
listToBag
)
errors
where
errors
=
catMaybes
$
map
go
pkgs
go
pkg
|
trusted
$
getPackageDetails
(
pkgState
dflags
)
pkg
=
Nothing
|
otherwise
=
Just
$
mkPlainErrMsg
noSrcSpan
$
text
"The package ("
<>
ppr
pkg
<>
text
") is required"
<>
text
" to be trusted but it isn't!"
-- | Check that a module is safe to import.
-- | Check that a module is safe to import.
--
--
-- We return a package id if the safe import is OK and a Nothing otherwise
-- We return a package id if the safe import is OK and a Nothing otherwise
...
@@ -1055,11 +1037,10 @@ hscCheckSafe' dflags m l = do
...
@@ -1055,11 +1037,10 @@ hscCheckSafe' dflags m l = do
<+>
text
"can't be safely imported!"
<+>
text
"can't be safely imported!"
<+>
text
"The module itself isn't safe."
<+>
text
"The module itself isn't safe."
-- | Check the package a module resides in is trusted.
-- | Check the package a module resides in is trusted. Safe compiled
-- Safe compiled modules are trusted without requiring
-- modules are trusted without requiring that their package is trusted. For
-- that their package is trusted. For trustworthy modules,
-- trustworthy modules, modules in the home package are trusted but
-- modules in the home package are trusted but otherwise
-- otherwise we check the package trust flag.
-- we check the package trust flag.
packageTrusted
::
SafeHaskellMode
->
Bool
->
Module
->
Bool
packageTrusted
::
SafeHaskellMode
->
Bool
->
Module
->
Bool
packageTrusted
_
_
_
packageTrusted
_
_
_
|
not
(
packageTrustOn
dflags
)
=
True
|
not
(
packageTrustOn
dflags
)
=
True
...
@@ -1084,6 +1065,22 @@ hscCheckSafe' dflags m l = do
...
@@ -1084,6 +1065,22 @@ hscCheckSafe' dflags m l = do
|
thisPackage
dflags
==
modulePackageId
m
=
True
|
thisPackage
dflags
==
modulePackageId
m
=
True
|
otherwise
=
False
|
otherwise
=
False
-- | Check the list of packages are trusted.
checkPkgTrust
::
DynFlags
->
[
PackageId
]
->
Hsc
()
checkPkgTrust
dflags
pkgs
=
case
errors
of
[]
->
return
()
_
->
(
liftIO
.
throwIO
.
mkSrcErr
.
listToBag
)
errors
where
errors
=
catMaybes
$
map
go
pkgs
go
pkg
|
trusted
$
getPackageDetails
(
pkgState
dflags
)
pkg
=
Nothing
|
otherwise
=
Just
$
mkPlainErrMsg
noSrcSpan
$
text
"The package ("
<>
ppr
pkg
<>
text
") is required"
<>
text
" to be trusted but it isn't!"
-- | Set module to unsafe and wipe trust information.
-- | Set module to unsafe and wipe trust information.
--
--
-- Make sure to call this method to set a module to infered unsafe,
-- Make sure to call this method to set a module to infered unsafe,
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment