Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
0f13e110
Commit
0f13e110
authored
Apr 25, 2011
by
dterei
Browse files
SafeHaskell: Disable user written rewrite rules in Safe mode
parent
029e24e0
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/main/DynFlags.hs
View file @
0f13e110
...
...
@@ -1260,8 +1260,6 @@ shFlagsDisallowed dflags = foldl check_method (dflags, []) bad_flags
bad_flags
=
[(
xopt
Opt_GeneralizedNewtypeDeriving
,
"-XGeneralizedNewtypeDeriving"
,
flip
xopt_unset
Opt_GeneralizedNewtypeDeriving
),
(
dopt
Opt_EnableRewriteRules
,
"-enable-rewrite-rules"
,
flip
dopt_unset
Opt_EnableRewriteRules
),
(
xopt
Opt_TemplateHaskell
,
"-XTemplateHaskell"
,
flip
xopt_unset
Opt_TemplateHaskell
)]
...
...
@@ -1778,8 +1776,8 @@ fFlags = [
(
"print-bind-result"
,
AlwaysAllowed
,
Opt_PrintBindResult
,
nop
),
(
"force-recomp"
,
AlwaysAllowed
,
Opt_ForceRecomp
,
nop
),
(
"hpc-no-auto"
,
AlwaysAllowed
,
Opt_Hpc_No_Auto
,
nop
),
(
"rewrite-rules"
,
Never
Allowed
,
Opt_EnableRewriteRules
,
useInstead
"enable-rewrite-rules"
),
(
"enable-rewrite-rules"
,
Never
Allowed
,
Opt_EnableRewriteRules
,
nop
),
(
"rewrite-rules"
,
Always
Allowed
,
Opt_EnableRewriteRules
,
useInstead
"enable-rewrite-rules"
),
(
"enable-rewrite-rules"
,
Always
Allowed
,
Opt_EnableRewriteRules
,
nop
),
(
"break-on-exception"
,
AlwaysAllowed
,
Opt_BreakOnException
,
nop
),
(
"break-on-error"
,
AlwaysAllowed
,
Opt_BreakOnError
,
nop
),
(
"print-evld-with-show"
,
AlwaysAllowed
,
Opt_PrintEvldWithShow
,
nop
),
...
...
compiler/main/HscMain.lhs
View file @
0f13e110
...
...
@@ -778,8 +778,27 @@ hscFileFrontEnd mod_summary = do
tcg_env <- ioMsgMaybe $
tcRnModule hsc_env (ms_hsc_src mod_summary) False rdr_module
dflags <- getDynFlags
tcg_env' <- checkSafeImports dflags hsc_env tcg_env
return tcg_env'
-- XXX: See Note [SafeHaskell API]
if safeHaskellOn dflags
then do
tcg_env1 <- checkSafeImports dflags hsc_env tcg_env
if safeLanguageOn dflags
then do
-- we also nuke user written RULES.
logWarnings $ warns (tcg_rules tcg_env1)
return tcg_env1 { tcg_rules = [] }
else
return tcg_env1
else
return tcg_env
where
warns rules = listToBag $ map warnRules rules
warnRules (L loc (HsRule n _ _ _ _ _ _)) =
mkPlainWarnMsg loc $
text "Rule \"" <> ftext n <> text "\" ignored" $+$
text "User defined rules are disabled under SafeHaskell"
--------------------------------------------------------------
-- SafeHaskell
...
...
@@ -791,12 +810,14 @@ hscFileFrontEnd mod_summary = do
-- trust type is 'Safe' or 'Trustworthy'. For modules that
-- reside in another package we also must check that the
-- external pacakge is trusted.
--
-- Note [SafeHaskell API]
-- ~~~~~~~~~~~~~~~~~~~~~~
-- XXX: We only call this in hscFileFrontend and don't expose
-- it to the GHC API. External users of GHC can't properly use
-- the GHC API and SafeHaskell.
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
...
...
Write
Preview
Supports
Markdown
0%
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!
Cancel
Please
register
or
sign in
to comment