testingwip/t20021

4 files changed, 14 insertions, 20 deletions

diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index 6f1120d860..f6b4fc4bfe 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -2098,7 +2098,10 @@ rebuildCall env info@(ArgInfo { ai_fun = fun, ai_args = rev_args
     -- so try rewrite rules; see Note [RULEs apply to simplified arguments]
     -- See also Note [Rules for recursive functions]
     do { cur_mod <- getSimplCurMod
-       ; mb_match <- tryRules env cur_mod rules fun (reverse rev_args) cont
+       ; mb_match <-
+          if sm_rules (seMode env)
+             then tryRules env cur_mod rules fun (reverse rev_args) cont
+             else return Nothing
        ; case mb_match of
              Just (env', rhs, cont') -> simplExprF env' rhs cont'
              Nothing                 -> rebuildCall env info' cont }
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index d4f816384b..59b5b5ea56 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -90,6 +90,7 @@ import GHC.Iface.Make          ( mkFullIface )
 import GHC.Runtime.Loader      ( initializePlugins )
 
 
+import GHC.Types.Basic       ( SuccessFlag(..) )
 import GHC.Types.Error       ( singleMessage, getMessages )
 import GHC.Types.Name.Env
 import GHC.Types.Target
@@ -119,7 +120,6 @@ import Data.Version
 import Data.Either      ( partitionEithers )
 
 import Data.Time        ( getCurrentTime )
-import GHC.Types.Basic
 
 -- ---------------------------------------------------------------------------
 -- Pre-process
@@ -236,7 +236,6 @@ compileOne' m_tc_result mHscMessage
          HscUpToDate iface old_linkable -> do
            massert ( isJust old_linkable || isNoLink (ghcLink dflags) )
            -- See Note [ModDetails and --make mode]
-           --refresh_iface <- refreshBinary (hsc_NC hsc_env) iface
            details <- initModDetails plugin_hsc_env summary iface
            return $! HomeModInfo iface details old_linkable
          HscRecompNeeded mb_old_hash -> do
@@ -331,7 +330,6 @@ compileOnePostTc hsc_env summary tc_result warnings mb_old_hash = do
         return $ Just linkable
       | otherwise -> return Nothing
   -- See Note [ModDetails and --make mode]
-  --refresh_iface <- refreshBinary (hsc_NC hsc_env) iface
   details <- initModDetails hsc_env summary iface
   return $! HomeModInfo iface details mLinkable
 
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index 5158eb2800..da40b1a768 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -29,7 +29,7 @@ module GHC.Iface.Binary (
         putSymbolTable,
         BinSymbolTable(..),
         BinDictionary(..)
-    ,refreshBinary) where
+        ) where
 
 import GHC.Prelude
 
@@ -178,13 +178,6 @@ getWithUserData name_cache bh = do
     -- Read the interface file
     get bh
 
-refreshBinary :: Binary a => NameCache -> a -> IO a
-refreshBinary name_cache a = do
-  bh <- openBinMem 1024
-  putWithUserData QuietBinIFace bh a
-  resetBinOffset bh
-  getWithUserData name_cache bh
-
 -- | Write an interface file
 writeBinIface :: Profile -> TraceBinIFace -> FilePath -> ModIface -> IO ()
 writeBinIface profile traceBinIface hi_path mod_iface = do
diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs
index ae1d140c28..db717f7c98 100644
--- a/compiler/GHC/Types/Id.hs
+++ b/compiler/GHC/Types/Id.hs
@@ -725,18 +725,18 @@ idUnfolding id = unfoldingInfo (idInfo id)
 -- See Note []
 idUnfoldingChecked :: Module -> Bool -> Id -> Unfolding
 -- Do not expose the unfolding of an imported ID
-idUnfoldingChecked cur_mod ignore id =
+idUnfoldingChecked _cur_mod ignore id =
   let unf =
             idUnfolding id
   in
       if ignore && (not $ isCompulsoryUnfolding unf)
-                && not (isDataConWrapId id) -- Data Con wrappers don't obey IgnorePragmas
-                && not (isDataConWorkId id) -- Evald unfolding info but nothing concrete
-                && not (isClassOpId id) -- newtype class-op id have unfoldings
-                && not (isFCallId id) -- These ones don't have an unfolding anyway
-                && if (isLocalId id /= nameIsLocalOrFrom cur_mod (idName id)) && not (isInteractiveModule cur_mod)
-                    then pprPanic "unf" (ppr (idDetails id) $$ ppr id $$ ppr (isCompulsoryUnfolding unf) $$ ppr (isLocalId id) $$ ppr (nameIsLocalOrFrom cur_mod (idName id)) $$ ppr (isExternalName (idName id)) $$ ppr (nameModule_maybe (idName id)))
-                    else not (nameIsLocalOrFrom cur_mod (idName id))
+                -- && not (isDataConWrapId id) -- Data Con wrappers don't obey IgnorePragmas
+                -- && not (isDataConWorkId id) -- Evald unfolding info but nothing concrete
+                -- && not (isClassOpId id) -- newtype class-op id have unfoldings
+                -- && not (isFCallId id) -- These ones don't have an unfolding anyway
+                -- && if (isLocalId id /= nameIsLocalOrFrom cur_mod (idName id)) && not (isInteractiveModule cur_mod)
+                --    then pprPanic "unf" (ppr (idDetails id) $$ ppr id $$ ppr (isCompulsoryUnfolding unf) $$ ppr (isLocalId id) $$ ppr (nameIsLocalOrFrom cur_mod (idName id)) $$ ppr (isExternalName (idName id)) $$ ppr (nameModule_maybe (idName id)))
+                --    else not (nameIsLocalOrFrom cur_mod (idName id))
           then NoUnfolding
           else unf