ApplicativeDo: allow "return $ e"
authorSimon Marlow <marlowsd@gmail.com>
Sat, 18 Jun 2016 13:51:04 +0000 (14:51 +0100)
committerSimon Marlow <marlowsd@gmail.com>
Mon, 20 Jun 2016 13:50:32 +0000 (14:50 +0100)
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

compiler/rename/RnExpr.hs
docs/users_guide/glasgow_exts.rst
testsuite/tests/ado/ado004.hs
testsuite/tests/ado/ado004.stderr

index c92f69e..f8a53e0 100644 (file)
@@ -1765,19 +1765,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)
 
 {-
 ************************************************************************
index 1b24db2..d5e5f7c 100644 (file)
@@ -859,9 +859,8 @@ 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.  In particular,
-``return $ E`` is not of the form ``return E``, and will therefore
-incur a ``Monad`` constraint.
+``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
index 6ddc839..fa3c723 100644 (file)
@@ -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)
index 8f5a816..ec2ebbc 100644 (file)
@@ -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) =>