diff options
| author | David Terei <davidterei@gmail.com> | 2011-04-25 15:58:10 -0700 |
|---|---|---|
| committer | David Terei <davidterei@gmail.com> | 2011-06-17 18:39:28 -0700 |
| commit | 0f13e110c01674fe185ead1cd24e234dba2fa22e (patch) | |
| tree | 8de25e4935f1f5d2a418ab72d48c5ad5f8fd2410 /compiler/main | |
| parent | 029e24e0cbfe89ea061e1901612daa09f0e832db (diff) | |
| download | haskell-0f13e110c01674fe185ead1cd24e234dba2fa22e.tar.gz | |
SafeHaskell: Disable user written rewrite rules in Safe mode
Diffstat (limited to 'compiler/main')
| -rw-r--r-- | compiler/main/DynFlags.hs | 6 | ||||
| -rw-r--r-- | compiler/main/HscMain.lhs | 33 |
2 files changed, 29 insertions, 10 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 7a587dac0a..35859158db 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -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", NeverAllowed, Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ), - ( "enable-rewrite-rules", NeverAllowed, Opt_EnableRewriteRules, nop ), + ( "rewrite-rules", AlwaysAllowed, Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ), + ( "enable-rewrite-rules", AlwaysAllowed, 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 ), diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index 24f610f836..dddee58ec9 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -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 |