[commit: packages/containers] changelog-foldtree, cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-184-generic, revert-408-bugfix_394: canonicalise Monad instances (318bca7)

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:38:31 UTC 2017


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

On branches: changelog-foldtree,cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-184-generic,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/318bca71efa8eecf0e67c1da97eb2fca73da182e

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

commit 318bca71efa8eecf0e67c1da97eb2fca73da182e
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Wed Nov 25 08:25:42 2015 +0100

    canonicalise Monad instances


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

318bca71efa8eecf0e67c1da97eb2fca73da182e
 Data/Graph.hs    | 2 +-
 Data/Sequence.hs | 7 ++++---
 Data/Tree.hs     | 2 +-
 3 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/Data/Graph.hs b/Data/Graph.hs
index c02b3e3..71d82c8 100644
--- a/Data/Graph.hs
+++ b/Data/Graph.hs
@@ -295,7 +295,7 @@ chop (Node v ts : us)
 newtype SetM s a = SetM { runSetM :: STArray s Vertex Bool -> ST s a }
 
 instance Monad (SetM s) where
-    return x     = SetM $ const (return x)
+    return = pure
     {-# INLINE return #-}
     SetM v >>= f = SetM $ \s -> do { x <- v s; runSetM (f x) s }
     {-# INLINE (>>=) #-}
diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index c06931b..8fc2baf 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -267,7 +267,7 @@ instance NFData a => NFData (Seq a) where
     rnf (Seq xs) = rnf xs
 
 instance Monad Seq where
-    return = singleton
+    return = pure
     xs >>= f = foldl' add empty xs
       where add ys x = ys >< f x
     (>>) = (*>)
@@ -861,12 +861,13 @@ instance Functor (State s) where
 instance Monad (State s) where
     {-# INLINE return #-}
     {-# INLINE (>>=) #-}
-    return x = State $ \ s -> (s, x)
+    return = pure
     m >>= k = State $ \ s -> case runState m s of
         (s', x) -> runState (k x) s'
 
 instance Applicative (State s) where
-    pure = return
+    {-# INLINE pure #-}
+    pure x = State $ \ s -> (s, x)
     (<*>) = ap
 
 execState :: State s a -> s -> a
diff --git a/Data/Tree.hs b/Data/Tree.hs
index abc9902..c1b9d34 100644
--- a/Data/Tree.hs
+++ b/Data/Tree.hs
@@ -92,7 +92,7 @@ instance Applicative Tree where
         Node (f x) (map (f <$>) txs ++ map (<*> tx) tfs)
 
 instance Monad Tree where
-    return x = Node x []
+    return = pure
     Node x ts >>= f = Node x' (ts' ++ map (>>= f) ts)
       where Node x' ts' = f x
 



More information about the ghc-commits mailing list