Commit 091944e3 authored by Austin Seipp's avatar Austin Seipp

compiler: make sure we reject -O + HscInterpreted

When using GHCi, we explicitly reject optimization, because the
compilers optimization passes can introduce unboxed tuples, which the
interpreter is not able to handle. But this goes the other way too: using
GHCi on optimized code may cause the optimizer to float out breakpoints
that the interpreter introduces. This manifests itself in weird ways,
particularly if you as an API client use custom DynFlags to introduce
optimization in combination with HscInterpreted.

It turns out we weren't checking for consistent DynFlag settings when
doing `setSessionDynFlags`, as #10052 showed. While the main driver
handled it in `DynFlags` via `parseDynamicFlags`, we didn't check this
elsewhere.

This does a little refactoring to split out some of the common code, and
immunizes the various `DynFlags` utilities in the `GHC` module from this
particular bug. We should probably be checking other general invariants
too.

This fixes #10052, and adds some notes about the behavior in `GHC` and
`FloatOut`

As a bonus, expose `warningMsg` from `ErrUtils` as a helper since it
didn't exist (somehow).
Signed-off-by: default avatarAustin Seipp <austin@well-typed.com>

Reviewed By: edsko

Differential Revision: https://phabricator.haskell.org/D727

GHC Trac Issues: #10052
parent b2b69b2a
......@@ -52,6 +52,7 @@ module DynFlags (
dynFlagDependencies,
tablesNextToCode, mkTablesNextToCode,
SigOf, getSigOf,
checkOptLevel,
Way(..), mkBuildTag, wayRTSOnly, addWay', updateWays,
wayGeneralFlags, wayUnsetGeneralFlags,
......@@ -3837,13 +3838,14 @@ setObjTarget l = updM set
| otherwise = return dflags
setOptLevel :: Int -> DynFlags -> DynP DynFlags
setOptLevel n dflags
setOptLevel n dflags = return (updOptLevel n dflags)
checkOptLevel :: Int -> DynFlags -> Either String DynFlags
checkOptLevel n dflags
| hscTarget dflags == HscInterpreted && n > 0
= do addWarn "-O conflicts with --interactive; -O ignored."
return dflags
= Left "-O conflicts with --interactive; -O ignored."
| otherwise
= return (updOptLevel n dflags)
= Right dflags
-- -Odph is equivalent to
--
......
......@@ -29,7 +29,7 @@ module ErrUtils (
-- * Messages during compilation
putMsg, printInfoForUser, printOutputForUser,
logInfo, logOutput,
errorMsg,
errorMsg, warningMsg,
fatalErrorMsg, fatalErrorMsg', fatalErrorMsg'',
compilationProgressMsg,
showPass,
......@@ -351,6 +351,10 @@ 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,17 +570,19 @@ checkBrokenTablesNextToCode' dflags
--
setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageKey]
setSessionDynFlags dflags = do
(dflags', preload) <- liftIO $ initPackages dflags
modifySession $ \h -> h{ hsc_dflags = dflags'
, hsc_IC = (hsc_IC h){ ic_dflags = dflags' } }
dflags' <- checkNewDynFlags 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', preload) <- liftIO $ initPackages dflags
modifySession $ \h -> h{ hsc_dflags = dflags' }
dflags' <- checkNewDynFlags dflags
(dflags'', preload) <- liftIO $ initPackages dflags'
modifySession $ \h -> h{ hsc_dflags = dflags'' }
invalidateModSummaryCache
return preload
......@@ -619,7 +621,8 @@ getProgramDynFlags = getSessionDynFlags
-- 'pkgState' into the interactive @DynFlags@.
setInteractiveDynFlags :: GhcMonad m => DynFlags -> m ()
setInteractiveDynFlags dflags = do
modifySession $ \h -> h{ hsc_IC = (hsc_IC h) { ic_dflags = dflags }}
dflags' <- checkNewDynFlags 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
......@@ -631,6 +634,32 @@ 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,6 +257,32 @@ 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)
......@@ -292,6 +318,7 @@ floatExpr (Tick tickish expr)
in
(fs, annotated_defns, Tick tickish expr') }
-- Note [Floating past breakpoints]
| otherwise
= pprPanic "floatExpr tick" (ppr tickish)
......
......@@ -717,6 +717,7 @@ 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'])
<no location info>: Warning:
<no location info>: warning:
-O conflicts with --interactive; -O ignored.
<no location info>: warning:
-O conflicts with --interactive; -O ignored.
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