[commit: ghc] ghc-8.0: ApplicativeDo: allow "return $ e" (10b69f6)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/10b69f6871bb243a1fd0259edfd74538839044f9/ghc

>---------------------------------------------------------------

commit 10b69f6871bb243a1fd0259edfd74538839044f9
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Sat Jun 18 14:51:04 2016 +0100

    ApplicativeDo: allow "return $ e"
    
    Summary:
    There's a precedent for special-casing $, as we already have special
    typing rules for it.
    
    Test Plan: validate; new test cases
    
    Reviewers: ezyang, austin, niteria, bgamari, simonpj, erikd
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2345
    
    GHC Trac Issues: #11835
    
    (cherry picked from commit 0ba34b6bac988228948c65ae11d9e08afe82c878)


>---------------------------------------------------------------

10b69f6871bb243a1fd0259edfd74538839044f9
 compiler/rename/RnExpr.hs         | 22 +++++++++++++---------
 docs/users_guide/glasgow_exts.rst |  4 ++++
 testsuite/tests/ado/ado004.hs     | 12 ++++++++++++
 testsuite/tests/ado/ado004.stderr |  6 ++++++
 4 files changed, 35 insertions(+), 9 deletions(-)

diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index 1ca677a..5d97332 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -1779,19 +1779,23 @@ needJoin [L loc (LastStmt e _ t)]
  | Just arg <- isReturnApp e = (False, [L loc (LastStmt arg True t)])
 needJoin stmts = (True, stmts)
 
--- | @Just e@, if the expression is @return e@, otherwise @Nothing@
+-- | @Just e@, if the expression is @return e@ or @return $ e@,
+-- otherwise @Nothing@
 isReturnApp :: LHsExpr Name -> Maybe (LHsExpr Name)
 isReturnApp (L _ (HsPar expr)) = isReturnApp expr
-isReturnApp (L _ (HsApp f arg))
-  | is_return f = Just arg
-  | otherwise = Nothing
+isReturnApp (L _ e) = case e of
+  OpApp l op _ r | is_return l, is_dollar op -> Just r
+  HsApp f arg    | is_return f               -> Just arg
+  _otherwise -> Nothing
  where
-  is_return (L _ (HsPar e)) = is_return e
-  is_return (L _ (HsAppType e _)) = is_return e
-  is_return (L _ (HsVar (L _ r))) = r == returnMName || r == pureAName
+  is_var f (L _ (HsPar e)) = is_var f e
+  is_var f (L _ (HsAppType e _)) = is_var f e
+  is_var f (L _ (HsVar (L _ r))) = f r
        -- TODO: I don't know how to get this right for rebindable syntax
-  is_return _ = False
-isReturnApp _ = Nothing
+  is_var _ _ = False
+
+  is_return = is_var (\n -> n == returnMName || n == pureAName)
+  is_dollar = is_var (`hasKey` dollarIdKey)
 
 {-
 ************************************************************************
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index cbecda7..fd4f947 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -939,6 +939,10 @@ then the expression will only require ``Applicative``. Otherwise, the expression
 will require ``Monad``. The block may return a pure expression ``E`` depending
 upon the results ``p1...pn`` with either ``return`` or ``pure``.
 
+Note: the final statement really must be of the form ``return E`` or
+``pure E``, otherwise you get a ``Monad`` constraint.  Using ``$`` as
+in ``return $ E`` or ``pure $ E`` is also acceptable.
+
 When the statements of a ``do`` expression have dependencies between
 them, and ``ApplicativeDo`` cannot infer an ``Applicative`` type, it
 uses a heuristic algorithm to try to use ``<*>`` as much as possible.
diff --git a/testsuite/tests/ado/ado004.hs b/testsuite/tests/ado/ado004.hs
index 6ddc839..fa3c723 100644
--- a/testsuite/tests/ado/ado004.hs
+++ b/testsuite/tests/ado/ado004.hs
@@ -9,6 +9,13 @@ test1 f = do
   y <- f 4
   return (x + y)
 
+-- The same using $
+test1a :: Applicative f => (Int -> f Int) -> f Int
+test1a f = do
+  x <- f 3
+  y <- f 4
+  return $ x + y
+
 -- Test we can also infer the Applicative version of the type
 test2 f = do
   x <- f 3
@@ -20,6 +27,11 @@ test2a f = do
   x <- f 3
   return (x + 1)
 
+-- The same using $
+test2c f = do
+  x <- f 3
+  return $ x + 1
+
 -- Test for just one statement
 test2b f = do
   return (f 3)
diff --git a/testsuite/tests/ado/ado004.stderr b/testsuite/tests/ado/ado004.stderr
index 8f5a816..ec2ebbc 100644
--- a/testsuite/tests/ado/ado004.stderr
+++ b/testsuite/tests/ado/ado004.stderr
@@ -1,6 +1,8 @@
 TYPE SIGNATURES
   test1 ::
     forall (f :: * -> *). Applicative f => (Int -> f Int) -> f Int
+  test1a ::
+    forall (f :: * -> *). Applicative f => (Int -> f Int) -> f Int
   test2 ::
     forall t b (f :: * -> *).
     (Num b, Num t, Applicative f) =>
@@ -11,6 +13,10 @@ TYPE SIGNATURES
     (t -> f b) -> f b
   test2b ::
     forall (m :: * -> *) a t. (Num t, Monad m) => (t -> a) -> m a
+  test2c ::
+    forall t b (f :: * -> *).
+    (Num b, Num t, Functor f) =>
+    (t -> f b) -> f b
   test3 ::
     forall a t (m :: * -> *) t1.
     (Num t1, Monad m) =>