Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/029e24e0cbfe89ea061e1901612daa09f0e832db >--------------------------------------------------------------- commit 029e24e0cbfe89ea061e1901612daa09f0e832db Author: David Terei <[email protected]> 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" ), _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
