Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/0f13e110c01674fe185ead1cd24e234dba2fa22e >--------------------------------------------------------------- commit 0f13e110c01674fe185ead1cd24e234dba2fa22e Author: David Terei <[email protected]> Date: Mon Apr 25 15:58:10 2011 -0700 SafeHaskell: Disable user written rewrite rules in Safe mode >--------------------------------------------------------------- compiler/main/DynFlags.hs | 6 ++---- 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 7a587da..3585915 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 24f610f..dddee58 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 _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
