[GHC] #13648: ApplicativeDo selects "GHC.Base.Monad.return" when actions are used without patterns.

[GHC]

#13648: ApplicativeDo selects "GHC.Base.Monad.return" when actions are used without
patterns.
-------------------------------------+-------------------------------------
        Reporter:  AaronFriel        |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Compiler          |              Version:  8.2.1-rc1
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
 Type of failure:  GHC rejects       |  Unknown/Multiple
  valid program                      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------
Description changed by AaronFriel:

@@ -61,1 +61,2 @@
-            (\() () -> ())
+            (\ r1 r2 ->
+               case r1 of { () -> case r2 of { () -> () } })
@@ -65,2 +66,2 @@
- testCase1' m1 m2 = (fmap (\() () -> () ) (m1 >> (return ()))) <*> (m2 >>
- (return ()))
+ testCase1'' m1 m2 = (fmap (\() () -> () ) (m1 >> (GHC.Base.Monad.return
+ ()))) <*> (m2 >> (GHC.Base.Monad.return ()))
@@ -81,3 +82,8 @@
- This isn't a _complete_ fix, as this would still induce an unnecessary use
- of the local `fmap`, but it would reduce the desugaring bug in `testCase1`
- to only that local `fmap`.
+ This isn't a _complete_ fix, as this would still leave the unnecessary
+ pattern matches in the use of `fmap`. The resulting desugaring would be:
+
+
+ {{{#!hs
+ testCase1''' m1 m2 = (fmap (\() () -> () ) (m1 *> (pure ()))) <*> (m2 *>
+ (pure ()))
+ }}}

New description:

 GHC 8.0.2 and 8.2.1-rc1 (rc2 not checked) have a bug where -XApplicativeDo
 causes "GHC.Base.Monad.return" to be used instead of the locally available
 "return", and a spurious "return ()" shows up. This desugaring is not
 adhering to the -XRebindableSyntax spec (see: #12490).

 Example:

 {{{#!hs
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE RebindableSyntax  #-}
 -- Bug vanishes if this next line is removed:
 {-# LANGUAGE ApplicativeDo  #-}

 module Main where

 import Prelude (String, print)

 class MyFunctor f where
     fmap :: (a -> b) -> f a -> f b

 class MyApplicative f where
     pure :: a -> f a
     (<*>) :: f (a -> b) -> f a -> f b

 class MyMonad m where
     return :: a -> m a
     (>>) :: m a -> m b -> m b
     (>>=) :: m a -> (a -> m b) -> m b
     fail :: String -> m a
     join :: m (m a) -> m a

 testCase1 m1 m2 = do
     m1
     m2
     return ()

 testCase2 m1 m2 = do
     _ <- m1
     _ <- m2
     return ()

 main = print "42"
 }}}

 {{{
 :t testCase1
 testCase1
   :: (MyFunctor f, MyApplicative f, MyMonad f, Monad f) =>
      f a2 -> f a1 -> f ()

 :t testCase2
   :: testCase2 :: (MyFunctor f, MyApplicative f) => f t -> f a -> f ()
 }}}

 The desugaring for testCase1 shows the issue:

 {{{#!hs
 testCase1' m1 m2 =
       (<*>)
         (fmap
            (\ r1 r2 ->
               case r1 of { () -> case r2 of { () -> () } })
            (m1 >> (GHC.Base.Monad.return ())))
         (m2 >> (GHC.Base.Monad.return ()))
 -- or:
 testCase1'' m1 m2 = (fmap (\() () -> () ) (m1 >> (GHC.Base.Monad.return
 ()))) <*> (m2 >> (GHC.Base.Monad.return ()))
 }}}

 I would be able to work on this if someone pointed me in the right
 direction. It looks like it would be in `compiler/rename/RnEnv` and
 `compiler/rename/RnExpr`, as with #12490?

 As a proposed fix, I would want to implement a limited-scope fix before
 the 8.2.1 release which would not address the thornier issue of #10892.
 The patch would:

 1. Replace `GHC.Base.Monad.return` with local `pure`, removing the `Monad`
 constraint.
 2. Replace `>>` with `*>`, removing the `MyMonad` constraint.

 This isn't a _complete_ fix, as this would still leave the unnecessary
 pattern matches in the use of `fmap`. The resulting desugaring would be:


 {{{#!hs
 testCase1''' m1 m2 = (fmap (\() () -> () ) (m1 *> (pure ()))) <*> (m2 *>
 (pure ()))
 }}}

--

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13648#comment:1>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler