Commit 029e24e0 authored by dterei's avatar dterei

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.
parent d19f2a37
......@@ -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))
......
......@@ -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" ),
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment