Function definition in GHCi

This patch allows define and re-define functions in ghci. `let` is not
required anymore (but can be used).

Idea: If ghci input string can be parsed as statement then run it as
statement else run it as declaration.

Reviewers: mpickering, bgamari, austin

Reviewed By: mpickering, bgamari, austin

Subscribers: hvr, mpickering, dterei, thomie

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

GHC Trac Issues: #7253

10 files changed, 123 insertions, 39 deletions

diff --git a/docs/users_guide/7.12.1-notes.rst b/docs/users_guide/7.12.1-notes.rst
index f3c0ed43a6..67e2b0f28a 100644
--- a/docs/users_guide/7.12.1-notes.rst
+++ b/docs/users_guide/7.12.1-notes.rst
@@ -164,6 +164,8 @@ GHCi
 
 -  ``ghci -e`` now behaves like ``ghc -e`` (#9360).
 
+-  Added support for top-level function declarations (#7253).
+
 Template Haskell
 ~~~~~~~~~~~~~~~~
 
diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst
index 0cb3a713e2..beb946ee2d 100644
--- a/docs/users_guide/ghci.rst
+++ b/docs/users_guide/ghci.rst
@@ -462,12 +462,11 @@ with the ``let`` form, the expression isn't evaluated immediately:
 Note that ``let`` bindings do not automatically print the value bound,
 unlike monadic bindings.
 
-You can also use ``let``-statements to define functions at the
-prompt:
+You can also define functions at the prompt:
 
 ::
 
-    Prelude> let add a b = a + b
+    Prelude> add a b = a + b
     Prelude> add 1 2
     3
     Prelude>
@@ -479,7 +478,7 @@ instead of layout:
 
 ::
 
-    Prelude> let f op n [] = n ; f op n (h:t) = h `op` f op n t
+    Prelude> f op n [] = n ; f op n (h:t) = h `op` f op n t
     Prelude> f (+) 0 [1..3]
     6
     Prelude>
@@ -491,8 +490,8 @@ own):
 ::
 
     Prelude> :{
-    Prelude| let g op n [] = n
-    Prelude|     g op n (h:t) = h `op` g op n t
+    Prelude| g op n [] = n
+    Prelude| g op n (h:t) = h `op` g op n t
     Prelude| :}
     Prelude> g (*) 1 [1..3]
     6
@@ -877,7 +876,7 @@ arguments, e.g.:
 
 ::
 
-    Prelude> let main = System.Environment.getArgs >>= print
+    Prelude> main = System.Environment.getArgs >>= print
     Prelude> :main foo bar
     ["foo","bar"]
 
@@ -897,8 +896,8 @@ flag or the ``:run`` command:
 
 ::
 
-    Prelude> let foo = putStrLn "foo" >> System.Environment.getArgs >>= print
-    Prelude> let bar = putStrLn "bar" >> System.Environment.getArgs >>= print
+    Prelude> foo = putStrLn "foo" >> System.Environment.getArgs >>= print
+    Prelude> bar = putStrLn "bar" >> System.Environment.getArgs >>= print
     Prelude> :set -main-is foo
     Prelude> :main foo "bar baz"
     foo
@@ -2318,7 +2317,7 @@ commonly used commands.
 
     ::
 
-        Prelude> let main = System.Environment.getArgs >>= print
+        Prelude> main = System.Environment.getArgs >>= print
         Prelude> :main foo bar
         ["foo","bar"]
 
@@ -2338,8 +2337,8 @@ commonly used commands.
 
     ::
 
-        Prelude> let foo = putStrLn "foo" >> System.Environment.getArgs >>= print
-        Prelude> let bar = putStrLn "bar" >> System.Environment.getArgs >>= print
+        Prelude> foo = putStrLn "foo" >> System.Environment.getArgs >>= print
+        Prelude> bar = putStrLn "bar" >> System.Environment.getArgs >>= print
         Prelude> :set -main-is foo
         Prelude> :main foo "bar baz"
         foo
diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
index 7dd005b99e..6d068be485 100644
--- a/ghc/GhciMonad.hs
+++ b/ghc/GhciMonad.hs
@@ -19,7 +19,7 @@ module GhciMonad (
         TickArray,
         getDynFlags,
 
-        runStmt, runDecls, resume, timeIt, recordBreak, revertCAFs,
+        isStmt, runStmt, runDecls, resume, timeIt, recordBreak, revertCAFs,
 
         printForUser, printForUserPartWay, prettyLocations,
         initInterpBuffering, turnOffBuffering, flushInterpBuffers,
@@ -50,6 +50,10 @@ 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
@@ -262,6 +266,19 @@ 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 8f861eecac..e5c4e11dea 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -897,22 +897,6 @@ enqueueCommands cmds = do
   cmds `deepseq` return ()
   modifyGHCiState $ \st -> st{ cmdqueue = cmds ++ cmdqueue st }
 
--- | If we one of these strings prefixes a command, then we treat it as a decl
--- rather than a stmt. NB that the appropriate decl prefixes depends on the
--- flag settings (Trac #9915)
-declPrefixes :: DynFlags -> [String]
-declPrefixes dflags = keywords ++ concat opt_keywords
-  where
-    keywords = [ "class ", "instance "
-               , "data ", "newtype ", "type "
-               , "default ", "default("
-               ]
-
-    opt_keywords = [ ["foreign "  | xopt Opt_ForeignFunctionInterface dflags]
-                   , ["deriving " | xopt Opt_StandaloneDeriving dflags]
-                   , ["pattern "  | xopt Opt_PatternSynonyms dflags]
-                   ]
-
 -- | 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)
@@ -927,10 +911,11 @@ runStmt stmt step
  = do addImportToContext stmt; return (Just (GHC.ExecComplete (Right []) 0))
 
  | otherwise
- = do dflags <- getDynFlags
-      if any (stmt `looks_like`) (declPrefixes dflags)
-        then run_decl
-        else run_stmt
+ = do
+     parse_res <- GhciMonad.isStmt stmt
+     if parse_res
+       then run_stmt
+       else run_decl
   where
     run_decl =
         do _ <- liftIO $ tryIO $ hFlushAll stdin
diff --git a/testsuite/tests/ghci/should_run/T7253.script b/testsuite/tests/ghci/should_run/T7253.script
new file mode 100644
index 0000000000..0ab8337bae
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T7253.script
@@ -0,0 +1,69 @@
+:{
+add :: Int -> Int -> Int
+add a b = a + b
+:}
+add 2 3
+
+-- override
+add = sum
+add [1,2,3]
+
+:{
+a 0 = 0
+a x = 1 + b x
+b x = 2 + a (x -  1)
+:}
+b 2
+
+-- do not show warning twice
+{-# foo #-}
+
+:{
+{-# WARNING Foo "Just a warning" #-}
+data Foo = Foo String
+:}
+
+:seti -XStandaloneDeriving
+deriving instance Show Foo
+
+-- ^ Just a 'foo' function.
+foo = Foo "Some foo"
+show foo
+
+import Data.Char
+
+:seti -XDefaultSignatures
+:{
+class HasString a where
+  update :: a -> (String -> String) -> a
+
+  upcase :: a -> a
+  upcase x = update x (fmap toUpper)
+
+  content :: a -> String
+  default content :: Show a => a -> String
+  content = show
+:}
+
+:{
+instance HasString Foo where
+  update (Foo s) f = Foo (f s)
+  content (Foo s) = s
+:}
+
+upcase foo
+
+{-# RULES "map/map" forall f g xs. map f (map g xs) = map (f.g) xs #-}
+{-# ANN foo (Just "Hello") #-}
+{-# NOVECTORISE foo #-}
+
+:seti -XRoleAnnotations
+:{
+type role T1 _ phantom
+data T1 a b = MkT1 b
+:}
+
+:{
+type role T2 _ nominal
+data T2 a b = MkT2 a
+:}
diff --git a/testsuite/tests/ghci/should_run/T7253.stderr b/testsuite/tests/ghci/should_run/T7253.stderr
new file mode 100644
index 0000000000..a96d27803f
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T7253.stderr
@@ -0,0 +1,7 @@
+
+<interactive>:19:1: warning: Unrecognised pragma
+
+<interactive>:62:1:
+    Role mismatch on variable b:
+      Annotation says phantom but role representational is required
+    while checking a role annotation for ‘T1’
diff --git a/testsuite/tests/ghci/should_run/T7253.stdout b/testsuite/tests/ghci/should_run/T7253.stdout
new file mode 100644
index 0000000000..2d29a0f28d
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T7253.stdout
@@ -0,0 +1,5 @@
+5
+6
+5
+"Foo \"Some foo\""
+Foo "SOME FOO"
diff --git a/testsuite/tests/ghci/should_run/T9915.stderr b/testsuite/tests/ghci/should_run/T9915.stderr
deleted file mode 100644
index 95f5758517..0000000000
--- a/testsuite/tests/ghci/should_run/T9915.stderr
+++ /dev/null
@@ -1,5 +0,0 @@
-
-<interactive>:2:9: error:
-    parse error on input ‘=’
-    Perhaps you need a 'let' in a 'do' block?
-    e.g. 'let x = 5' instead of 'x = 5'
diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T
index bcb15380fb..68c74072f6 100644
--- a/testsuite/tests/ghci/should_run/all.T
+++ b/testsuite/tests/ghci/should_run/all.T
@@ -21,3 +21,4 @@ test('T8377',      just_ghci, compile_and_run, [''])
 test('T9914',      just_ghci, ghci_script, ['T9914.script'])
 test('T9915',      just_ghci, ghci_script, ['T9915.script'])
 test('T10145',     just_ghci, ghci_script, ['T10145.script'])
+test('T7253',      just_ghci, ghci_script, ['T7253.script'])
diff --git a/testsuite/tests/safeHaskell/ghci/p14.stderr b/testsuite/tests/safeHaskell/ghci/p14.stderr
index b015016622..65baafe716 100644
--- a/testsuite/tests/safeHaskell/ghci/p14.stderr
+++ b/testsuite/tests/safeHaskell/ghci/p14.stderr
@@ -1,2 +1,6 @@
 
-<interactive>:9:1: parse error on input ‘{-# RULES’
+<interactive>:9:25: error:
+    No instance for (Num a) arising from a use of ‘f’
+    Possible fix: add (Num a) to the context of the RULE "id/Int"
+    In the expression: f
+    When checking the transformation rule "id/Int"