define return in terms of pure, >> as *>, mappend as <>

In preparation for deprecation, see https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid and https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return

src/compiler/GF/Compile/GeneratePMCFG.hs

@@ -201,11 +201,11 @@ instance Fail.MonadFail CnvMonad where
   fail = bug
 
 instance Applicative CnvMonad where
-  pure = return
+  pure a = CM (\gr c s -> c a s)
   (<*>) = ap
 
 instance Monad CnvMonad where
-    return a   = CM (\gr c s -> c a s)
+    return     = pure
     CM m >>= k = CM (\gr c s -> m gr (\a s -> unCM (k a) gr c s) s)
 
 instance MonadState ([ProtoFCat],[Symbol]) CnvMonad where

src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs

@@ -644,7 +644,7 @@ data TcResult a
 newtype TcM a = TcM {unTcM :: MetaStore -> [Message] -> TcResult a}
 
 instance Monad TcM where
-  return x = TcM (\ms msgs -> TcOk x ms msgs)
+  return = pure
   f >>= g  = TcM (\ms msgs -> case unTcM f ms msgs of
                                 TcOk x ms msgs -> unTcM (g x) ms msgs
                                 TcFail    msgs -> TcFail msgs)
@@ -659,7 +659,7 @@ instance Fail.MonadFail TcM where
 
 
 instance Applicative TcM where
-  pure = return
+  pure x = TcM (\ms msgs -> TcOk x ms msgs)
   (<*>) = ap
 
 instance Functor TcM where

src/compiler/GF/CompileInParallel.hs

@@ -238,12 +238,12 @@ runCO (CO m) = do (o,x) <- m
 instance Functor m => Functor (CollectOutput m) where
    fmap f (CO m) = CO (fmap (fmap f) m)
 
-instance (Functor m,Monad m) => Applicative (CollectOutput m) where 
-  pure = return
+instance (Functor m,Monad m) => Applicative (CollectOutput m) where
+  pure x = CO (return (return (),x))
   (<*>) = ap
 
 instance Monad m => Monad (CollectOutput m) where
-  return x = CO (return (return (),x))
+  return     = pure
   CO m >>= f = CO $ do (o1,x) <- m
                        let CO m2 = f x
                        (o2,y) <- m2

src/compiler/GF/Data/BacktrackM.hs

@@ -64,11 +64,11 @@ finalStates :: BacktrackM s () -> s -> [s]
 finalStates bm = map fst . runBM bm
 
 instance Applicative (BacktrackM s) where
-    pure = return
+    pure a = BM (\c s b -> c a s b)
     (<*>) = ap
 
 instance Monad (BacktrackM s) where
-    return a   = BM (\c s b -> c a s b)
+    return     = pure
     BM m >>= k = BM (\c s b -> m (\a s b -> unBM (k a) c s b) s b)
         where unBM (BM m) = m
 

src/compiler/GF/Data/ErrM.hs

@@ -34,7 +34,7 @@ fromErr :: a -> Err a -> a
 fromErr a = err (const a) id
 
 instance Monad Err where
-  return      = Ok
+  return      = pure
   Ok a  >>= f = f a
   Bad s >>= f = Bad s
 
@@ -54,7 +54,7 @@ instance Functor Err where
   fmap f (Bad s) = Bad s
 
 instance Applicative Err where
-  pure = return
+  pure = Ok
   (<*>) = ap
 
 -- | added by KJ

src/compiler/GF/Grammar/Lexer.x

@@ -283,11 +283,11 @@ instance Functor P where
   fmap = liftA
 
 instance Applicative P where
-  pure = return
+  pure a = a `seq` (P $ \s -> POk s a)
   (<*>) = ap
 
 instance Monad P where
-  return a    = a `seq` (P $ \s -> POk s a)
+  return      = pure
   (P m) >>= k = P $ \ s -> case m s of
                              POk s a          -> unP (k a) s
                              PFailed posn err -> PFailed posn err

src/compiler/GF/Infra/CheckM.hs

@@ -48,7 +48,7 @@ newtype Check a
 instance Functor Check where fmap = liftM
 
 instance Monad Check where
-  return x = Check $ \{-ctxt-} ws -> (ws,Success x)
+  return   = pure
   f >>= g  = Check $ \{-ctxt-} ws ->
                case unCheck f {-ctxt-} ws of
                  (ws,Success x) -> unCheck (g x) {-ctxt-} ws
@@ -58,7 +58,7 @@ instance Fail.MonadFail Check where
   fail = raise
 
 instance Applicative Check where
-  pure = return
+  pure x = Check $ \{-ctxt-} ws -> (ws,Success x)
   (<*>) = ap
 
 instance ErrorMonad Check where

src/compiler/GF/Infra/SIO.hs

@@ -52,11 +52,11 @@ newtype SIO a = SIO {unS::PutStr->IO a}
 instance Functor SIO where fmap = liftM
 
 instance Applicative SIO where
-  pure = return
+  pure x = SIO (const (pure x))
   (<*>) = ap
 
 instance Monad SIO where
-  return x = SIO (const (return x))
+  return         = pure
   SIO m1 >>= xm2 = SIO $ \ h -> m1 h >>= \ x -> unS (xm2 x) h
 
 instance Fail.MonadFail SIO where

src/runtime/haskell/Data/Binary/Builder.hs

@@ -114,7 +114,7 @@ instance Semigroup Builder where
 instance Monoid Builder where
     mempty  = empty
     {-# INLINE mempty #-}
-    mappend = append
+    mappend = (<>)
     {-# INLINE mappend #-}
 
 ------------------------------------------------------------------------

src/runtime/haskell/Data/Binary/Get.hs

@@ -127,11 +127,11 @@ instance Functor Get where
     {-# INLINE fmap #-}
 
 instance Applicative Get where
-    pure  = return
+    pure a = Get (\s -> (a, s))
     (<*>) = ap
 
 instance Monad Get where
-    return a  = Get (\s -> (a, s))
+    return = pure
     {-# INLINE return #-}
 
     m >>= k   = Get (\s -> case unGet m s of

src/runtime/haskell/Data/Binary/Put.hs

@@ -77,15 +77,20 @@ instance Functor PutM where
         {-# INLINE fmap #-}
 
 instance Applicative PutM where
-        pure    = return
+        pure a  = Put $ PairS a mempty
         m <*> k = Put $
             let PairS f w  = unPut m
                 PairS x w' = unPut k
             in PairS (f x) (w `mappend` w')
+        m *> k  = Put $
+            let PairS _ w  = unPut m
+                PairS b w' = unPut k
+            in PairS b (w `mappend` w')
+        {-# INLINE (*>) #-}
 
 -- Standard Writer monad, with aggressive inlining
 instance Monad PutM where
-    return a = Put $ PairS a mempty
+    return = pure
     {-# INLINE return #-}
 
     m >>= k  = Put $
@@ -94,10 +99,7 @@ instance Monad PutM where
         in PairS b (w `mappend` w')
     {-# INLINE (>>=) #-}
 
-    m >> k  = Put $
-        let PairS _ w  = unPut m
-            PairS b w' = unPut k
-        in PairS b (w `mappend` w')
+    (>>) = (*>)
     {-# INLINE (>>) #-}
 
 tell :: Builder -> Put

src/runtime/haskell/PGF/TypeCheck.hs

@@ -94,11 +94,11 @@ class Selector s where
   select        :: CId -> Scope -> Maybe Int -> TcM s (Expr,TType)
 
 instance Applicative (TcM s) where
-  pure = return
+  pure x = TcM (\abstr k h -> k x)
   (<*>) = ap
 
 instance Monad (TcM s) where
-  return x = TcM (\abstr k h -> k x)
+  return   = pure
   f >>= g  = TcM (\abstr k h -> unTcM f abstr (\x -> unTcM (g x) abstr k h) h)
 
 instance Selector s => Alternative (TcM s) where