Commit edb8dc5c authored by Austin Seipp's avatar Austin Seipp

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

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

This reverts commit b199536b.
parent fc8c5e7a
......@@ -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
--
......
......@@ -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
......
......@@ -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
-- %************************************************************************
-- %* *
......
......@@ -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)
......
......@@ -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
......
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
main = let (x :: String) = "hello" in putStrLn x
{-# 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
<no location info>: Warning:
-O conflicts with --interactive; -O ignored.
[1 of 1] Compiling Main ( T10052-input.hs, interpreted )
test('T10052', normal, run_command,
['$MAKE -s --no-print-directory T10052'])
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