[commit: ghc] master: SafeHaskell: Fix problem with forced recompilation and disable TH (029e24e)
David Terei
davidterei at gmail.com
Sat Jun 18 10:02:29 CEST 2011
Repository : ssh://darcs.haskell.org//srv/darcs/ghc
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/029e24e0cbfe89ea061e1901612daa09f0e832db
>---------------------------------------------------------------
commit 029e24e0cbfe89ea061e1901612daa09f0e832db
Author: David Terei <davidterei at gmail.com>
Date: Mon Apr 25 15:57:17 2011 -0700
SafeHaskell: Fix problem with forced recompilation and disable TH
Problem with -fforce-recomp not picking up changed Safe flags correctly
fixed. Also now disable Template Haskell completely.
>---------------------------------------------------------------
compiler/iface/MkIface.lhs | 55 ++++++++++++++++++++++---------------------
compiler/main/DynFlags.hs | 34 ++++++++++++++++-----------
2 files changed, 48 insertions(+), 41 deletions(-)
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index ccfa710..a2d3eb1 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1098,8 +1098,8 @@ 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
+safeHsChanged :: HscEnv -> ModIface -> Bool
+safeHsChanged hsc_env iface
= (getSafeMode $ mi_trust iface) /= (safeHaskell $ hsc_dflags hsc_env)
checkVersions :: HscEnv
@@ -1109,36 +1109,37 @@ checkVersions :: HscEnv
-> IfG (RecompileRequired, Maybe ModIface)
checkVersions hsc_env source_unchanged mod_summary iface
| not source_unchanged
- = return (outOfDate, Just iface)
+ = let iface' = if safeHsChanged hsc_env iface then Nothing else Just iface
+ in return (outOfDate, iface')
+
| otherwise
- = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
+ = 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, Just iface) else do {
- ; if trust_dif then return (outOfDate, Nothing) else do {
-
- -- 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)
- ; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
- ; return (recomp, Just iface)
+ ; recomp <- checkDependencies hsc_env mod_summary iface
+ ; 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
+ --
+ -- 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 }
+ ; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
+ ; return (recomp, Just iface)
}}}
where
- trust_dif = checkSafeHaskell hsc_env iface
+ this_pkg = thisPackage (hsc_dflags hsc_env)
+ trust_dif = safeHsChanged hsc_env iface
-- This is a bit of a hack really
mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
mod_deps = mkModDeps (dep_mods (mi_deps iface))
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 665b44a..7a587da 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1243,23 +1243,29 @@ parseDynamicFlags dflags0 args cmdline = do
-- the easiest way to fix this is to just check that they aren't enabled now. The down
-- side is that flags marked as NeverAllowed must also be checked here placing a sync
-- burden on the ghc hacker.
- let sh_warns = if (safeLanguageOn dflags2)
- then shFlagsDisallowed dflags2
- else []
+ let (dflags2, sh_warns) = if (safeLanguageOn dflags1)
+ then shFlagsDisallowed dflags1
+ else (dflags1, [])
return (dflags2, leftover, sh_warns ++ warns)
-- | Extensions that can't be enabled at all when compiling in Safe mode
-- checkSafeHaskellFlags :: MonadIO m => DynFlags -> m ()
-shFlagsDisallowed :: DynFlags -> [Located String]
-shFlagsDisallowed dflags = concat $ map check_method bad_flags
+shFlagsDisallowed :: DynFlags -> (DynFlags, [Located String])
+shFlagsDisallowed dflags = foldl check_method (dflags, []) bad_flags
where
- check_method (flag,str) | (flag dflags) = safeFailure str
- | otherwise = []
-
- bad_flags = [(xopt Opt_GeneralizedNewtypeDeriving, "-XGeneralizedNewtypeDeriving")]
-
- safeFailure str = [L noSrcSpan $ "Warning: " ++ str ++ " is not allowed in"
+ check_method (df, warns) (test,str,fix)
+ | test df = (fix df, warns ++ safeFailure str)
+ | otherwise = (df, warns)
+
+ 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)]
+
+ safeFailure str = [L noSrcSpan $ "Warning2: " ++ str ++ " is not allowed in"
++ " SafeHaskell; ignoring " ++ str]
{-
@@ -1772,8 +1778,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", AlwaysAllowed, Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ),
- ( "enable-rewrite-rules", AlwaysAllowed, Opt_EnableRewriteRules, nop ),
+ ( "rewrite-rules", NeverAllowed, Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ),
+ ( "enable-rewrite-rules", NeverAllowed, 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 ),
@@ -1798,7 +1804,7 @@ fFlags = [
-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
fLangFlags :: [FlagSpec ExtensionFlag]
fLangFlags = [
- ( "th", CmdLineOnly, Opt_TemplateHaskell,
+ ( "th", NeverAllowed, Opt_TemplateHaskell,
deprecatedForExtension "TemplateHaskell" >> checkTemplateHaskellOk ),
( "fi", RestrictedFunction, Opt_ForeignFunctionInterface,
deprecatedForExtension "ForeignFunctionInterface" ),
More information about the Cvs-ghc
mailing list