Add isImport, isDecl, and isStmt functions to GHC API

Reviewers: austin, thomie, bgamari

Reviewed By: thomie, bgamari

Subscribers: mpickering, thomie

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

GHC Trac Issues: #9015

2 files changed, 12 insertions, 40 deletions

diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
index 6d068be485..7dd005b99e 100644
--- a/ghc/GhciMonad.hs
+++ b/ghc/GhciMonad.hs
@@ -19,7 +19,7 @@ module GhciMonad (
         TickArray,
         getDynFlags,
 
-        isStmt, runStmt, runDecls, resume, timeIt, recordBreak, revertCAFs,
+        runStmt, runDecls, resume, timeIt, recordBreak, revertCAFs,
 
         printForUser, printForUserPartWay, prettyLocations,
         initInterpBuffering, turnOffBuffering, flushInterpBuffers,
@@ -50,10 +50,6 @@ import System.IO
 import Control.Monad
 import GHC.Exts
 
-import qualified Lexer (ParseResult(..), unP, mkPState)
-import qualified Parser (parseStmt)
-import StringBuffer (stringToStringBuffer)
-
 import System.Console.Haskeline (CompletionFunc, InputT)
 import qualified System.Console.Haskeline as Haskeline
 import Control.Monad.Trans.Class
@@ -266,19 +262,6 @@ printForUserPartWay doc = do
   dflags <- getDynFlags
   liftIO $ Outputable.printForUserPartWay dflags stdout (pprUserLength dflags) unqual doc
 
-isStmt :: String -> GHCi Bool
-isStmt stmt = do
-  st <- getGHCiState
-  dflags <- GHC.getInteractiveDynFlags
-
-  let buf = stringToStringBuffer stmt
-      loc = mkRealSrcLoc (fsLit "<interactive>") (line_number st) 1
-      parser = Parser.parseStmt
-
-  case Lexer.unP parser (Lexer.mkPState dflags buf loc) of
-    Lexer.POk _ _ -> return True
-    Lexer.PFailed _ _ -> return False
-
 -- | Run a single Haskell expression
 runStmt :: String -> GHC.SingleStep -> GHCi (Maybe GHC.ExecResult)
 runStmt expr step = do
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 772b39b9bc..f7b3603b6a 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, TupleSections,
-             RecordWildCards #-}
+             RecordWildCards, MultiWayIf #-}
 {-# OPTIONS -fno-cse #-}
 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
 
@@ -900,23 +900,17 @@ 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
- -- empty; this should be impossible anyways since we filtered out
- -- whitespace-only input in runOneCommand's noSpace
- | null (filter (not.isSpace) stmt)
- = return Nothing
-
- -- import
- | stmt `looks_like` "import "
- = do addImportToContext stmt; return (Just (GHC.ExecComplete (Right []) 0))
-
- | otherwise
- = do
-     parse_res <- GhciMonad.isStmt stmt
-     if parse_res
-       then run_stmt
-       else run_decl
+runStmt stmt step = do
+  dflags <- GHC.getInteractiveDynFlags
+  if | GHC.isStmt dflags stmt   -> run_stmt
+     | GHC.isImport dflags stmt -> run_imports
+     | otherwise                -> run_decl
+
   where
+    run_imports = do
+      addImportToContext stmt
+      return (Just (GHC.ExecComplete (Right []) 0))
+
     run_decl =
         do _ <- liftIO $ tryIO $ hFlushAll stdin
            m_result <- GhciMonad.runDecls stmt
@@ -938,11 +932,6 @@ runStmt stmt step
                Nothing     -> return Nothing
                Just result -> Just <$> afterRunStmt (const True) result
 
-    s `looks_like` prefix = prefix `isPrefixOf` dropWhile isSpace s
-       -- Ignore leading spaces (see Trac #9914), so that
-       --    ghci>   data T = T
-       -- (note leading spaces) works properly
-
 -- | Clean up the GHCi environment after a statement has run
 afterRunStmt :: (SrcSpan -> Bool) -> GHC.ExecResult -> GHCi GHC.ExecResult
 afterRunStmt step_here run_result = do