[commit: packages/hoopl] master: Rewrite Applicative/Monad instances into normal-form (20fad2e)

[git at git.haskell.org]

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

On branch  : master
Link       : http://git.haskell.org/packages/hoopl.git/commitdiff/20fad2ed91cd78ed8b9bd92aae1ecfdfb8350d2f

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

commit 20fad2ed91cd78ed8b9bd92aae1ecfdfb8350d2f
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Sat Oct 17 19:33:35 2015 +0200

    Rewrite Applicative/Monad instances into normal-form
    
    I.e. make sure `return` is defined in terms of `pure` rather than the
    other way round.


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

20fad2ed91cd78ed8b9bd92aae1ecfdfb8350d2f
 src/Compiler/Hoopl/Fuel.hs   | 8 ++++----
 src/Compiler/Hoopl/Graph.hs  | 4 ++--
 src/Compiler/Hoopl/Unique.hs | 8 ++++----
 3 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/src/Compiler/Hoopl/Fuel.hs b/src/Compiler/Hoopl/Fuel.hs
index da6d490..5916200 100644
--- a/src/Compiler/Hoopl/Fuel.hs
+++ b/src/Compiler/Hoopl/Fuel.hs
@@ -64,11 +64,11 @@ instance Monad m => Functor (CheckingFuelMonad m) where
   fmap  = liftM
 
 instance Monad m => Applicative (CheckingFuelMonad m) where
-  pure  = return
+  pure a = FM (\f -> return (a, f))
   (<*>) = ap
 
 instance Monad m => Monad (CheckingFuelMonad m) where
-  return a = FM (\f -> return (a, f))
+  return = pure
   fm >>= k = FM (\f -> do { (a, f') <- unFM fm f; unFM (k a) f' })
 
 instance CheckpointMonad m => CheckpointMonad (CheckingFuelMonad m) where
@@ -96,11 +96,11 @@ instance Monad m => Functor (InfiniteFuelMonad m) where
   fmap  = liftM
 
 instance Monad m => Applicative (InfiniteFuelMonad m) where
-  pure  = return
+  pure a = IFM $ return a
   (<*>) = ap
 
 instance Monad m => Monad (InfiniteFuelMonad m) where
-  return a = IFM $ return a
+  return = pure
   m >>= k  = IFM $ do { a <- unIFM m; unIFM (k a) }
 
 instance UniqueMonad m => UniqueMonad (InfiniteFuelMonad m) where
diff --git a/src/Compiler/Hoopl/Graph.hs b/src/Compiler/Hoopl/Graph.hs
index 80add5c..3d9831a 100644
--- a/src/Compiler/Hoopl/Graph.hs
+++ b/src/Compiler/Hoopl/Graph.hs
@@ -358,11 +358,11 @@ instance Functor VM where
   fmap  = liftM
 
 instance Applicative VM where
-  pure  = return
+  pure a = VM $ \visited -> (a, visited)
   (<*>) = ap
 
 instance Monad VM where
-  return a = VM $ \visited -> (a, visited)
+  return = pure
   m >>= k  = VM $ \visited -> let (a, v') = unVM m visited in unVM (k a) v'
 
 marked :: Label -> VM Bool
diff --git a/src/Compiler/Hoopl/Unique.hs b/src/Compiler/Hoopl/Unique.hs
index 0744f3d..5727fb4 100644
--- a/src/Compiler/Hoopl/Unique.hs
+++ b/src/Compiler/Hoopl/Unique.hs
@@ -123,11 +123,11 @@ instance Functor SimpleUniqueMonad where
   fmap = liftM
 
 instance Applicative SimpleUniqueMonad where
-  pure  = return
+  pure a = SUM $ \us -> (a, us)
   (<*>) = ap
 
 instance Monad SimpleUniqueMonad where
-  return a = SUM $ \us -> (a, us)
+  return = pure
   m >>= k  = SUM $ \us -> let (a, us') = unSUM m us in
                               unSUM (k a) us'
 
@@ -152,11 +152,11 @@ instance Monad m => Functor (UniqueMonadT m) where
   fmap  = liftM
 
 instance Monad m => Applicative (UniqueMonadT m) where
-  pure  = return
+  pure a = UMT $ \us -> return (a, us)
   (<*>) = ap
 
 instance Monad m => Monad (UniqueMonadT m) where
-  return a = UMT $ \us -> return (a, us)
+  return = pure
   m >>= k  = UMT $ \us -> do { (a, us') <- unUMT m us; unUMT (k a) us' }
 
 instance Monad m => UniqueMonad (UniqueMonadT m) where