Commit a34ee615 authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan

Refactor GHCi UI to fix #11606, #12091, #15721, #16096

Instead of parsing and executing a statement or declaration directly we
now parse them first and then execute in a separate step. This gives us
the flexibility to inspect the parsed declaration before execution.
Using this we now inspect parsed declarations, and if it's a single
declaration of form `x = y` we execute it as `let x = y` instead, fixing
a ton of problems caused by poor declaration support in GHCi.

To avoid any users of the modules I left `execStmt` and `runDecls`
unchanged and added `execStmt'` and `runDecls'` which work on parsed
statements/declarations.
parent 448f0e7d
......@@ -149,8 +149,7 @@ deSugar hsc_env
keep_alive <- readIORef keep_var
; let (rules_for_locals, rules_for_imps) = partition isLocalRule all_rules
final_prs = addExportFlagsAndRules target export_set keep_alive
mod rules_for_locals
(fromOL all_prs)
rules_for_locals (fromOL all_prs)
final_pgm = combineEvBinds ds_ev_binds final_prs
-- Notice that we put the whole lot in a big Rec, even the foreign binds
......@@ -284,9 +283,9 @@ deSugarExpr hsc_env tc_expr = do {
-}
addExportFlagsAndRules
:: HscTarget -> NameSet -> NameSet -> Module -> [CoreRule]
:: HscTarget -> NameSet -> NameSet -> [CoreRule]
-> [(Id, t)] -> [(Id, t)]
addExportFlagsAndRules target exports keep_alive mod rules prs
addExportFlagsAndRules target exports keep_alive rules prs
= mapFst add_one prs
where
add_one bndr = add_rules name (add_export name bndr)
......@@ -319,20 +318,10 @@ addExportFlagsAndRules target exports keep_alive mod rules prs
-- simplification), and retain them all in the TypeEnv so they are
-- available from the command line.
--
-- Most of the time, this can be accomplished by use of
-- targetRetainsAllBindings, which returns True if the target is
-- HscInteractive. However, there are cases when one can use GHCi with
-- a target other than HscInteractive (e.g., with the -fobject-code
-- flag enabled, as in #12091). In such scenarios,
-- targetRetainsAllBindings can return False, so we must fall back on
-- isInteractiveModule to be doubly sure we export entities defined in
-- a GHCi session.
--
-- isExternalName separates the user-defined top-level names from those
-- introduced by the type checker.
is_exported :: Name -> Bool
is_exported | targetRetainsAllBindings target
|| isInteractiveModule mod = isExternalName
is_exported | targetRetainsAllBindings target = isExternalName
| otherwise = (`elemNameSet` exports)
{-
......
......@@ -96,11 +96,11 @@ module GHC (
-- * Interactive evaluation
-- ** Executing statements
execStmt, ExecOptions(..), execOptions, ExecResult(..),
execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..),
resumeExec,
-- ** Adding new declarations
runDecls, runDeclsWithLocation,
runDecls, runDeclsWithLocation, runParsedDecls,
-- ** Get/set the current context
parseImportDecl,
......
......@@ -63,8 +63,8 @@ module HscMain
, hscGetModuleInterface
, hscRnImportDecls
, hscTcRnLookupRdrName
, hscStmt, hscStmtWithLocation, hscParsedStmt
, hscDecls, hscDeclsWithLocation
, hscStmt, hscParseStmtWithLocation, hscStmtWithLocation, hscParsedStmt
, hscDecls, hscParseDeclsWithLocation, hscDeclsWithLocation, hscParsedDecls
, hscTcExpr, TcRnExprMode(..), hscImport, hscKcType
, hscParseExpr
, hscCompileCoreExpr
......@@ -1602,17 +1602,27 @@ hscDecls :: HscEnv
-> IO ([TyThing], InteractiveContext)
hscDecls hsc_env str = hscDeclsWithLocation hsc_env str "<interactive>" 1
hscParseDeclsWithLocation :: HscEnv -> String -> Int -> String -> IO [LHsDecl GhcPs]
hscParseDeclsWithLocation hsc_env source line_num str = do
L _ (HsModule{ hsmodDecls = decls }) <-
runInteractiveHsc hsc_env $
hscParseThingWithLocation source line_num parseModule str
return decls
-- | Compile a decls
hscDeclsWithLocation :: HscEnv
-> String -- ^ The statement
-> String -- ^ The source
-> Int -- ^ Starting line
-> IO ([TyThing], InteractiveContext)
hscDeclsWithLocation hsc_env0 str source linenumber =
runInteractiveHsc hsc_env0 $ do
hscDeclsWithLocation hsc_env str source linenumber = do
L _ (HsModule{ hsmodDecls = decls }) <-
runInteractiveHsc hsc_env $
hscParseThingWithLocation source linenumber parseModule str
hscParsedDecls hsc_env decls
hscParsedDecls :: HscEnv -> [LHsDecl GhcPs] -> IO ([TyThing], InteractiveContext)
hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
{- Rename and typecheck it -}
hsc_env <- getHscEnv
tc_gblenv <- ioMsgMaybe $ tcRnDeclsi hsc_env decls
......
......@@ -23,7 +23,7 @@ module HscTypes (
needsTemplateHaskellOrQQ, mgBootModules,
-- * Hsc monad
Hsc(..), runHsc, runInteractiveHsc,
Hsc(..), runHsc, mkInteractiveHscEnv, runInteractiveHsc,
-- * Information about modules
ModDetails(..), emptyModDetails,
......@@ -253,13 +253,15 @@ runHsc hsc_env (Hsc hsc) = do
printOrThrowWarnings (hsc_dflags hsc_env) w
return a
mkInteractiveHscEnv :: HscEnv -> HscEnv
mkInteractiveHscEnv hsc_env = hsc_env{ hsc_dflags = interactive_dflags }
where
interactive_dflags = ic_dflags (hsc_IC hsc_env)
runInteractiveHsc :: HscEnv -> Hsc a -> IO a
-- A variant of runHsc that switches in the DynFlags from the
-- InteractiveContext before running the Hsc computation.
runInteractiveHsc hsc_env
= runHsc (hsc_env { hsc_dflags = interactive_dflags })
where
interactive_dflags = ic_dflags (hsc_IC hsc_env)
runInteractiveHsc hsc_env = runHsc (mkInteractiveHscEnv hsc_env)
-- -----------------------------------------------------------------------------
-- Source Errors
......
......@@ -11,8 +11,8 @@
module InteractiveEval (
Resume(..), History(..),
execStmt, ExecOptions(..), execOptions, ExecResult(..), resumeExec,
runDecls, runDeclsWithLocation,
execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..), resumeExec,
runDecls, runDeclsWithLocation, runParsedDecls,
isStmt, hasImport, isImport, isDecl,
parseImportDecl, SingleStep(..),
abandon, abandonAll,
......@@ -165,23 +165,40 @@ execStmt
=> String -- ^ a statement (bind or expression)
-> ExecOptions
-> m ExecResult
execStmt stmt ExecOptions{..} = do
execStmt input exec_opts@ExecOptions{..} = do
hsc_env <- getSession
mb_stmt <-
liftIO $
runInteractiveHsc hsc_env $
hscParseStmtWithLocation execSourceFile execLineNumber input
case mb_stmt of
-- empty statement / comment
Nothing -> return (ExecComplete (Right []) 0)
Just stmt -> execStmt' stmt input exec_opts
-- | Like `execStmt`, but takes a parsed statement as argument. Useful when
-- doing preprocessing on the AST before execution, e.g. in GHCi (see
-- GHCi.UI.runStmt).
execStmt' :: GhcMonad m => GhciLStmt GhcPs -> String -> ExecOptions -> m ExecResult
execStmt' stmt stmt_text ExecOptions{..} = do
hsc_env <- getSession
-- Turn off -fwarn-unused-local-binds when running a statement, to hide
-- warnings about the implicit bindings we introduce.
-- (This is basically `mkInteractiveHscEnv hsc_env`, except we unset
-- -wwarn-unused-local-binds)
let ic = hsc_IC hsc_env -- use the interactive dflags
idflags' = ic_dflags ic `wopt_unset` Opt_WarnUnusedLocalBinds
hsc_env' = hsc_env{ hsc_IC = ic{ ic_dflags = idflags' } }
hsc_env' = mkInteractiveHscEnv (hsc_env{ hsc_IC = ic{ ic_dflags = idflags' } })
-- compile to value (IO [HValue]), don't run
r <- liftIO $ hscStmtWithLocation hsc_env' stmt
execSourceFile execLineNumber
r <- liftIO $ hscParsedStmt hsc_env' stmt
case r of
-- empty statement / comment
Nothing -> return (ExecComplete (Right []) 0)
Nothing ->
-- empty statement / comment
return (ExecComplete (Right []) 0)
Just (ids, hval, fix_env) -> do
updateFixityEnv fix_env
......@@ -195,20 +212,27 @@ execStmt stmt ExecOptions{..} = do
size = ghciHistSize idflags'
handleRunStatus execSingleStep stmt bindings ids
handleRunStatus execSingleStep stmt_text bindings ids
status (emptyHistory size)
runDecls :: GhcMonad m => String -> m [Name]
runDecls = runDeclsWithLocation "<interactive>" 1
-- | Run some declarations and return any user-visible names that were brought
-- into scope.
runDeclsWithLocation :: GhcMonad m => String -> Int -> String -> m [Name]
runDeclsWithLocation source linenumber expr =
do
runDeclsWithLocation source line_num input = do
hsc_env <- getSession
decls <- liftIO (hscParseDeclsWithLocation hsc_env source line_num input)
runParsedDecls decls
-- | Like `runDeclsWithLocation`, but takes parsed declarations as argument.
-- Useful when doing preprocessing on the AST before execution, e.g. in GHCi
-- (see GHCi.UI.runStmt).
runParsedDecls :: GhcMonad m => [LHsDecl GhcPs] -> m [Name]
runParsedDecls decls = do
hsc_env <- getSession
(tyThings, ic) <- liftIO $ hscDeclsWithLocation hsc_env expr source linenumber
(tyThings, ic) <- liftIO (hscParsedDecls hsc_env decls)
setSession $ hsc_env { hsc_IC = ic }
hsc_env <- getSession
......
......@@ -31,8 +31,8 @@ module GHCi.UI (
#include "HsVersions.h"
-- GHCi
import qualified GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls )
import GHCi.UI.Monad hiding ( args, runStmt, runDecls )
import qualified GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls' )
import GHCi.UI.Monad hiding ( args, runStmt )
import GHCi.UI.Tags
import GHCi.UI.Info
import Debugger
......@@ -50,10 +50,11 @@ import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..),
TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc,
GetDocsFailure(..),
getModuleGraph, handleSourceError )
import HscMain (hscParseDeclsWithLocation, hscParseStmtWithLocation)
import HsImpExp
import HsSyn
import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC,
setInteractivePrintName, hsc_dflags, msObjFilePath )
setInteractivePrintName, hsc_dflags, msObjFilePath, runInteractiveHsc )
import Module
import Name
import Packages ( trusted, getPackageDetails, getInstalledPackageDetails,
......@@ -82,6 +83,7 @@ import NameSet
import Panic hiding ( showException )
import Util
import qualified GHC.LanguageExtensions as LangExt
import Bag (unitBag)
-- Haskell Libraries
import System.Console.Haskeline as Haskeline
......@@ -1088,51 +1090,94 @@ enqueueCommands cmds = do
-- | Entry point to execute some haskell code from user.
-- The return value True indicates success, as in `runOneCommand`.
runStmt :: String -> SingleStep -> GHCi (Maybe GHC.ExecResult)
runStmt stmt step = do
runStmt input step = do
dflags <- GHC.getInteractiveDynFlags
-- In GHCi, we disable `-fdefer-type-errors`, as well as `-fdefer-type-holes`
-- and `-fdefer-out-of-scope-variables` for **naked expressions**. The
-- declarations and statements are not affected.
-- See Note [Deferred type errors in GHCi] in typecheck/TcRnDriver.hs
if | GHC.isStmt dflags stmt -> run_stmt
| GHC.isImport dflags stmt -> run_import
st <- getGHCiState
let source = progname st
let line = line_number st
if | GHC.isStmt dflags input -> do
hsc_env <- GHC.getSession
mb_stmt <- liftIO (runInteractiveHsc hsc_env (hscParseStmtWithLocation source line input))
case mb_stmt of
Nothing ->
-- empty statement / comment
return (Just exec_complete)
Just stmt ->
run_stmt stmt
| GHC.isImport dflags input -> run_import
-- Every import declaration should be handled by `run_import`. As GHCi
-- in general only accepts one command at a time, we simply throw an
-- exception when the input contains multiple commands of which at least
-- one is an import command (see #10663).
| GHC.hasImport dflags stmt -> throwGhcException
| GHC.hasImport dflags input -> throwGhcException
(CmdLineError "error: expecting a single import declaration")
-- Otherwise assume a declaration (or a list of declarations)
-- Note: `GHC.isDecl` returns False on input like
-- `data Infix a b = a :@: b; infixl 4 :@:`
-- and should therefore not be used here.
| otherwise -> run_decl
| otherwise -> do
hsc_env <- GHC.getSession
decls <- liftIO (hscParseDeclsWithLocation hsc_env source line input)
run_decls decls
where
exec_complete = GHC.ExecComplete (Right []) 0
run_import = do
addImportToContext stmt
return (Just (GHC.ExecComplete (Right []) 0))
addImportToContext input
return (Just exec_complete)
run_decl =
do _ <- liftIO $ tryIO $ hFlushAll stdin
m_result <- GhciMonad.runDecls stmt
case m_result of
Nothing -> return Nothing
Just result ->
Just <$> afterRunStmt (const True)
(GHC.ExecComplete (Right result) 0)
run_stmt =
do -- In the new IO library, read handles buffer data even if the Handle
-- is set to NoBuffering. This causes problems for GHCi where there
-- are really two stdin Handles. So we flush any bufferred data in
-- GHCi's stdin Handle here (only relevant if stdin is attached to
-- a file, otherwise the read buffer can't be flushed).
_ <- liftIO $ tryIO $ hFlushAll stdin
m_result <- GhciMonad.runStmt stmt step
run_stmt :: GhciLStmt GhcPs -> GHCi (Maybe GHC.ExecResult)
run_stmt stmt = do
m_result <- GhciMonad.runStmt stmt input step
case m_result of
Nothing -> return Nothing
Just result -> Just <$> afterRunStmt (const True) result
-- `x = y` (a declaration) should be treated as `let x = y` (a statement).
-- The reason is because GHCi wasn't designed to support `x = y`, but then
-- b98ff3 (#7253) added support for it, except it did not do a good job and
-- caused problems like:
--
-- - not adding the binders defined this way in the necessary places caused
-- `x = y` to not work in some cases (#12091).
-- - some GHCi command crashed after `x = y` (#15721)
-- - warning generation did not work for `x = y` (#11606)
-- - because `x = y` is a declaration (instead of a statement) differences
-- in generated code caused confusion (#16089)
--
-- Instead of dealing with all these problems individually here we fix this
-- mess by just treating `x = y` as `let x = y`.
run_decls :: [LHsDecl GhcPs] -> GHCi (Maybe GHC.ExecResult)
-- Only turn `FunBind` and `VarBind` into statements, other bindings
-- (e.g. `PatBind`) need to stay as decls.
run_decls [L l (ValD _ bind@FunBind{})] = run_stmt (mk_stmt l bind)
run_decls [L l (ValD _ bind@VarBind{})] = run_stmt (mk_stmt l bind)
-- Note that any `x = y` declarations below will be run as declarations
-- instead of statements (e.g. `...; x = y; ...`)
run_decls decls = do
-- In the new IO library, read handles buffer data even if the Handle
-- is set to NoBuffering. This causes problems for GHCi where there
-- are really two stdin Handles. So we flush any bufferred data in
-- GHCi's stdin Handle here (only relevant if stdin is attached to
-- a file, otherwise the read buffer can't be flushed).
_ <- liftIO $ tryIO $ hFlushAll stdin
m_result <- GhciMonad.runDecls' decls
forM m_result $ \result ->
afterRunStmt (const True) (GHC.ExecComplete (Right result) 0)
mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
mk_stmt loc bind =
let l = L loc
in l (LetStmt noExt (l (HsValBinds noExt (ValBinds noExt (unitBag (l bind)) []))))
-- | Clean up the GHCi environment after a statement has run
afterRunStmt :: (SrcSpan -> Bool) -> GHC.ExecResult -> GHCi GHC.ExecResult
afterRunStmt step_here run_result = do
......
......@@ -20,7 +20,7 @@ module GHCi.UI.Monad (
TickArray,
getDynFlags,
runStmt, runDecls, resume, timeIt, recordBreak, revertCAFs,
runStmt, runDecls, runDecls', resume, timeIt, recordBreak, revertCAFs,
printForUserNeverQualify, printForUserModInfo,
printForUser, printForUserPartWay, prettyLocations,
......@@ -46,7 +46,7 @@ import SrcLoc
import Module
import GHCi
import GHCi.RemoteTypes
import HsSyn (ImportDecl, GhcPs)
import HsSyn (ImportDecl, GhcPs, GhciLStmt, LHsDecl)
import Util
import Exception
......@@ -338,8 +338,8 @@ printForUserPartWay doc = do
liftIO $ Outputable.printForUserPartWay dflags stdout (pprUserLength dflags) unqual doc
-- | Run a single Haskell expression
runStmt :: String -> GHC.SingleStep -> GHCi (Maybe GHC.ExecResult)
runStmt expr step = do
runStmt :: GhciLStmt GhcPs -> String -> GHC.SingleStep -> GHCi (Maybe GHC.ExecResult)
runStmt stmt stmt_text step = do
st <- getGHCiState
GHC.handleSourceError (\e -> do GHC.printException e; return Nothing) $ do
let opts = GHC.execOptions
......@@ -348,7 +348,7 @@ runStmt expr step = do
, GHC.execSingleStep = step
, GHC.execWrap = \fhv -> EvalApp (EvalThis (evalWrapper st))
(EvalThis fhv) }
Just <$> GHC.execStmt expr opts
Just <$> GHC.execStmt' stmt stmt_text opts
runDecls :: String -> GHCi (Maybe [GHC.Name])
runDecls decls = do
......@@ -362,6 +362,18 @@ runDecls decls = do
r <- GHC.runDeclsWithLocation (progname st) (line_number st) decls
return (Just r)
runDecls' :: [LHsDecl GhcPs] -> GHCi (Maybe [GHC.Name])
runDecls' decls = do
st <- getGHCiState
reifyGHCi $ \x ->
withProgName (progname st) $
withArgs (args st) $
reflectGHCi x $
GHC.handleSourceError
(\e -> do GHC.printException e;
return Nothing)
(Just <$> GHC.runParsedDecls decls)
resume :: (SrcSpan -> Bool) -> GHC.SingleStep -> GHCi GHC.ExecResult
resume canLogSpan step = do
st <- getGHCiState
......
:set -Wall
x = 1 :: Int
x = 1 :: Int
x <- return (1 :: Int)
let x = 1 :: Int
<interactive>:3:1: warning: [-Wname-shadowing (in -Wall)]
This binding for ‘x’ shadows the existing binding
defined at <interactive>:2:1
<interactive>:4:1: warning: [-Wname-shadowing (in -Wall)]
This binding for ‘x’ shadows the existing binding
defined at <interactive>:3:1
<interactive>:5:5: warning: [-Wname-shadowing (in -Wall)]
This binding for ‘x’ shadows the existing binding
defined at <interactive>:4:1
x = [0 .. 100000] :: [Int]
:sprint x
x `seq` True
:sprint x
......@@ -262,7 +262,7 @@ test('T12091', [extra_run_opts('-fobject-code')], ghci_script,
['T12091.script'])
test('T12523', normal, ghci_script, ['T12523.script'])
test('T12024', normal, ghci_script, ['T12024.script'])
test('T12158', expect_broken(12158), ghci_script, ['T12158.script'])
test('T12158', normal, ghci_script, ['T12158.script'])
test('T12447', normal, ghci_script, ['T12447.script'])
test('T10249', normal, ghci_script, ['T10249.script'])
test('T12550', normal, ghci_script, ['T12550.script'])
......@@ -293,3 +293,5 @@ test('T15827', normal, ghci_script, ['T15827.script'])
test('T15898', normal, ghci_script, ['T15898.script'])
test('T15941', normal, ghci_script, ['T15941.script'])
test('T16030', normal, ghci_script, ['T16030.script'])
test('T11606', normal, ghci_script, ['T11606.script'])
test('T16089', normal, ghci_script, ['T16089.script'])
x :: () = _
x :: () = ()
y :: () = ()
class Foo a
:set -ddump-ds -dsuppress-uniques
-- These two should desugar to same Core
let x = [1..] :: [Int]
x = [1..] :: [Int]
==================== Desugared ====================
letrec {
x :: [GHC.Types.Int]
[LclId]
x = let {
$dEnum :: GHC.Enum.Enum GHC.Types.Int
[LclId]
$dEnum = GHC.Enum.$fEnumInt } in
letrec {
x :: [GHC.Types.Int]
[LclId]
x = GHC.Enum.enumFrom
@ GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in
x; } in
GHC.Base.returnIO
@ [()]
(GHC.Types.:
@ ()
(GHC.Prim.unsafeCoerce#
@ 'GHC.Types.LiftedRep
@ 'GHC.Types.LiftedRep
@ [GHC.Types.Int]
@ ()
x)
(GHC.Types.[] @ ()))
==================== Desugared ====================
letrec {
x :: [GHC.Types.Int]
[LclId]
x = let {
$dEnum :: GHC.Enum.Enum GHC.Types.Int
[LclId]
$dEnum = GHC.Enum.$fEnumInt } in
letrec {
x :: [GHC.Types.Int]
[LclId]
x = GHC.Enum.enumFrom
@ GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in
x; } in
GHC.Base.returnIO
@ [()]
(GHC.Types.:
@ ()
(GHC.Prim.unsafeCoerce#
@ 'GHC.Types.LiftedRep
@ 'GHC.Types.LiftedRep
@ [GHC.Types.Int]
@ ()
x)
(GHC.Types.[] @ ()))
......@@ -56,3 +56,5 @@ test('T15633b',
extra_hc_opts("-package-db tc-plugin-ghci/pkg.plugins01/local.package.conf")
],
ghci_script, ['T15633b.script'])
test('T16096', just_ghci, ghci_script, ['T16096.script'])
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