Rewrite Applicative/Monad instances into normal-form
authorHerbert Valerio Riedel <hvr@gnu.org>
Sat, 17 Oct 2015 17:33:35 +0000 (19:33 +0200)
committerHerbert Valerio Riedel <hvr@gnu.org>
Sat, 17 Oct 2015 17:34:49 +0000 (19:34 +0200)
I.e. make sure `return` is defined in terms of `pure` rather than the
other way round.

src/Compiler/Hoopl/Fuel.hs
src/Compiler/Hoopl/Graph.hs
src/Compiler/Hoopl/Unique.hs

index da6d490..5916200 100644 (file)
@@ -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
index 80add5c..3d9831a 100644 (file)
@@ -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
index 0744f3d..5727fb4 100644 (file)
@@ -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