Revert "compiler: make sure we reject -O + HscInterpreted" (again)

Apparently my machine likes this commit, but Harbormaster does not?

This reverts commit b199536b.

compiler/main/DynFlags.hs

@@ -52,7 +52,6 @@ module DynFlags (
         dynFlagDependencies,
         tablesNextToCode, mkTablesNextToCode,
         SigOf, getSigOf,
-        checkOptLevel,
 
         Way(..), mkBuildTag, wayRTSOnly, addWay', updateWays,
         wayGeneralFlags, wayUnsetGeneralFlags,
@@ -3838,14 +3837,13 @@ setObjTarget l = updM set
      | otherwise = return dflags
 
 setOptLevel :: Int -> DynFlags -> DynP DynFlags
-setOptLevel n dflags = return (updOptLevel n dflags)
-
-checkOptLevel :: Int -> DynFlags -> Either String DynFlags
-checkOptLevel n dflags
+setOptLevel n dflags
    | hscTarget dflags == HscInterpreted && n > 0
-     = Left "-O conflicts with --interactive; -O ignored."
+        = do addWarn "-O conflicts with --interactive; -O ignored."
+             return dflags
    | otherwise
-     = Right dflags
+        = return (updOptLevel n dflags)
+
 
 -- -Odph is equivalent to
 --

compiler/main/ErrUtils.hs

@@ -29,7 +29,7 @@ module ErrUtils (
         --  * Messages during compilation
         putMsg, printInfoForUser, printOutputForUser,
         logInfo, logOutput,
-        errorMsg, warningMsg,
+        errorMsg,
         fatalErrorMsg, fatalErrorMsg', fatalErrorMsg'',
         compilationProgressMsg,
         showPass,
@@ -351,10 +351,6 @@ errorMsg :: DynFlags -> MsgDoc -> IO ()
 errorMsg dflags msg
    = log_action dflags dflags SevError noSrcSpan (defaultErrStyle dflags) msg
 
-warningMsg :: DynFlags -> MsgDoc -> IO ()
-warningMsg dflags msg
-   = log_action dflags dflags SevWarning noSrcSpan (defaultErrStyle dflags) msg
-
 fatalErrorMsg :: DynFlags -> MsgDoc -> IO ()
 fatalErrorMsg dflags msg = fatalErrorMsg' (log_action dflags) dflags msg
 

compiler/main/GHC.hs

@@ -570,19 +570,17 @@ checkBrokenTablesNextToCode' dflags
 --
 setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageKey]
 setSessionDynFlags dflags = do
-  dflags' <- checkNewDynFlags dflags
-  (dflags'', preload) <- liftIO $ initPackages dflags'
-  modifySession $ \h -> h{ hsc_dflags = dflags''
-                         , hsc_IC = (hsc_IC h){ ic_dflags = dflags'' } }
+  (dflags', preload) <- liftIO $ initPackages dflags
+  modifySession $ \h -> h{ hsc_dflags = dflags'
+                         , hsc_IC = (hsc_IC h){ ic_dflags = dflags' } }
   invalidateModSummaryCache
   return preload
 
 -- | Sets the program 'DynFlags'.
 setProgramDynFlags :: GhcMonad m => DynFlags -> m [PackageKey]
 setProgramDynFlags dflags = do
-  dflags' <- checkNewDynFlags dflags
-  (dflags'', preload) <- liftIO $ initPackages dflags'
-  modifySession $ \h -> h{ hsc_dflags = dflags'' }
+  (dflags', preload) <- liftIO $ initPackages dflags
+  modifySession $ \h -> h{ hsc_dflags = dflags' }
   invalidateModSummaryCache
   return preload
 
@@ -621,8 +619,7 @@ getProgramDynFlags = getSessionDynFlags
 -- 'pkgState' into the interactive @DynFlags@.
 setInteractiveDynFlags :: GhcMonad m => DynFlags -> m ()
 setInteractiveDynFlags dflags = do
-  dflags' <- checkNewDynFlags dflags
-  modifySession $ \h -> h{ hsc_IC = (hsc_IC h) { ic_dflags = dflags' }}
+  modifySession $ \h -> h{ hsc_IC = (hsc_IC h) { ic_dflags = dflags }}
 
 -- | Get the 'DynFlags' used to evaluate interactive expressions.
 getInteractiveDynFlags :: GhcMonad m => m DynFlags
@@ -634,32 +631,6 @@ parseDynamicFlags :: MonadIO m =>
                   -> m (DynFlags, [Located String], [Located String])
 parseDynamicFlags = parseDynamicFlagsCmdLine
 
-{- Note [GHCi and -O]
-~~~~~~~~~~~~~~~~~~~~~
-When using optimization, the compiler can introduce several things
-(such as unboxed tuples) into the intermediate code, which GHCi later
-chokes on since the bytecode interpreter can't handle this (and while
-this is arguably a bug these aren't handled, there are no plans to fix
-it.)
-
-While the driver pipeline always checks for this particular erroneous
-combination when parsing flags, we also need to check when we update
-the flags; this is because API clients may parse flags but update the
-DynFlags afterwords, before finally running code inside a session (see
-T10052 and #10052).
--}
-
--- | Checks the set of new DynFlags for possibly erroneous option
--- combinations when invoking 'setSessionDynFlags' and friends, and if
--- found, returns a fixed copy (if possible).
-checkNewDynFlags :: MonadIO m => DynFlags -> m DynFlags
-checkNewDynFlags dflags
-  -- See Note [GHCi and -O]
-  | Left e <- checkOptLevel (optLevel dflags) dflags
-    = do liftIO $ warningMsg dflags (text e)
-         return (dflags { optLevel = 0 })
-  | otherwise
-    = return dflags
 
 -- %************************************************************************
 -- %*                                                                      *

compiler/simplCore/FloatOut.hs

@@ -257,32 +257,6 @@ floatBody lvl arg       -- Used rec rhss, and case-alternative rhss
     (fsa, floats', install heres arg') }}
 
 -----------------
-
-{- Note [Floating past breakpoints]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Notes from Peter Wortmann (re: #10052)
-
-"This case clearly means we're trying to float past a breakpoint..."
-
-Further:
-
-"Breakpoints as they currently exist are the only Tikish that is not
-scoped, counting, and not splittable.
-
-This means that we can't:
-  - Simply float code out of it, because the payload must still be covered (scoped)
-  - Copy the tick, because it would change entry counts (here: duplicate breakpoints)"
-
-While this seems like an odd case, it can apparently occur in real
-life: through the combination of optimizations + GHCi usage. For an
-example, see #10052 as mentioned above. So not only does the
-interpreter not like some compiler-generated things (like unboxed
-tuples), the compiler doesn't like interpreter-introduced things!
-
-Also see Note [GHCi and -O] in GHC.hs.
--}
-
 floatExpr :: LevelledExpr
           -> (FloatStats, FloatBinds, CoreExpr)
 floatExpr (Var v)   = (zeroStats, emptyFloats, Var v)
@@ -318,7 +292,6 @@ floatExpr (Tick tickish expr)
     in
     (fs, annotated_defns, Tick tickish expr') }
 
-  -- Note [Floating past breakpoints]
   | otherwise
   = pprPanic "floatExpr tick" (ppr tickish)
 

testsuite/.gitignore

@@ -717,7 +717,6 @@ mk/ghcconfig*_inplace_bin_ghc-stage2.exe.mk
 /tests/ghc-api/T8628
 /tests/ghc-api/T8639_api
 /tests/ghc-api/T9595
-/tests/ghc-api/T10052/T10052
 /tests/ghc-api/apirecomp001/myghc
 /tests/ghc-api/dynCompileExpr/dynCompileExpr
 /tests/ghc-api/ghcApi

testsuite/tests/ghc-api/T10052/Makefile

-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
-
-clean:
-	rm -f *.o *.hi
-
-T10052: clean
-	'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc T10052
-	./T10052 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" -XScopedTypeVariables -O
-
-.PHONY: clean T10052

testsuite/tests/ghc-api/T10052/T10052-input.hs

-main = let (x :: String) = "hello" in putStrLn x

testsuite/tests/ghc-api/T10052/T10052.hs

-{-# LANGUAGE RecordWildCards #-}
-{-# OPTIONS_GHC -Wall #-}
-module Main where
-
-import System.Environment
-import GHC
-
-main :: IO ()
-main = do
-    flags <- getArgs
-    runGhc' flags $ do
-      setTargets [Target (TargetFile "T10052-input.hs" Nothing) True Nothing]
-      _success <- load LoadAllTargets
-      return ()
-
-runGhc' :: [String] -> Ghc a -> IO a
-runGhc' args act = do
-    let libdir = head args
-        flags  = tail args
-    (dynFlags, _warns) <- parseStaticFlags (map noLoc flags)
-    runGhc (Just libdir) $ do
-      dflags0 <- getSessionDynFlags
-      (dflags1, _leftover, _warns) <- parseDynamicFlags dflags0 dynFlags
-      let dflags2 = dflags1 {
-              hscTarget = HscInterpreted
-            , ghcLink   = LinkInMemory
-            , verbosity = 1
-            }
-      _newPkgs <- setSessionDynFlags dflags2
-      act

testsuite/tests/ghc-api/T10052/T10052.stderr

-
-<no location info>: Warning:
-    -O conflicts with --interactive; -O ignored.

testsuite/tests/ghc-api/T10052/T10052.stdout

-[1 of 1] Compiling Main             ( T10052-input.hs, interpreted )

testsuite/tests/ghc-api/T10052/all.T

-test('T10052', normal, run_command,
-               ['$MAKE -s --no-print-directory T10052'])