mtl-c 0 → 0.1

raw patch · 4 files changed

+51/−23 lines, 4 files

Files

• Control/Monad/Reader/CPS.hs +12/−4
• Control/Monad/State/CPS.hs +22/−11
• Control/Monad/Writer/CPS.hs +15/−6
• mtl-c.cabal +2/−2

@@ -1,15 +1,21 @@ {-# LANGUAGE Trustworthy, Rank2Types, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
-module Control.Monad.Reader.CPS where
+module Control.Monad.Reader.CPS (ReaderT(..)
+    , runReaderT
+    , mapReaderT
+    , Reader
+    , runReader
+    , module Control.Monad.Reader.Class) where
 import Control.Monad.Reader.Class
 import Control.Applicative
 import Control.Monad.Identity
 import Control.Monad.Trans
+import Unsafe.Coerce
 
 newtype ReaderT r m a = ReaderT { unReaderT :: forall b. r -> (a -> m b) -> m b }
 
 runReaderT :: Monad m => ReaderT r m a -> r -> m a
 runReaderT m r = unReaderT m r return
-{-# INLINE runReaderT #-}
+{-# INLINABLE runReaderT #-}
 
 mapReaderT :: (Monad m, Monad n) => (m a -> n b) -> ReaderT r m a -> ReaderT r n b
 mapReaderT t m = ReaderT $ \r c -> t (unReaderT m r return) >>= c
@@ -29,6 +35,8 @@     {-# INLINABLE return #-}
     m >>= k = ReaderT $ \r c -> unReaderT m r (\a -> unReaderT (k a) r c)
     {-# INLINABLE (>>=) #-}
+    m >> n = ReaderT $ \r c -> unReaderT m r (\_ -> unReaderT n r c)
+    {-# INLINABLE (>>) #-}
 
 instance MonadReader r (ReaderT r m) where
     ask = ReaderT $ \r c -> c r
@@ -45,5 +53,5 @@ type Reader r = ReaderT r Identity
 
 runReader :: Reader r a -> r -> a
-runReader m r = runIdentity (runReaderT m r)
-{-# INLINABLE runReader #-}
+runReader = asTypeOf unsafeCoerce ((runIdentity .) .) runReaderT
+{-# INLINE runReader #-}

@@ -1,5 +1,14 @@-{-# LANGUAGE Trustworthy, Rank2Types, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
-module Control.Monad.State.CPS where
+{-# LANGUAGE Trustworthy, Rank2Types, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, BangPatterns #-}
+module Control.Monad.State.CPS (StateT(..)
+    , runStateT
+    , evalStateT
+    , execStateT
+    , mapStateT
+    , State
+    , runState
+    , evalState
+    , execState
+    , module Control.Monad.State.Class) where
 import Control.Monad.State.Class
 import Control.Applicative
 import Control.Monad.Identity
@@ -30,13 +39,15 @@ instance Applicative (StateT s m) where
     pure x = StateT $ \s c -> c x s
     {-# INLINABLE pure #-}
-    mf <*> ma = StateT $ \s c -> unStateT mf s (\f s' -> unStateT ma s' (c . f))
+    mf <*> ma = StateT $ \s c -> unStateT mf s $ \f s' -> unStateT ma s' (c . f)
     {-# INLINABLE (<*>) #-}
 
 instance Monad (StateT s m) where
     return x = StateT $ \s c -> c x s
-    {-# INLINABLE return #-}
-    m >>= k = StateT $ \s c -> unStateT m s (\a s' -> unStateT (k a) s' c)
+    m >>= k = StateT $ \s c -> unStateT m s $ \a s' -> unStateT (k a) s' c
+    {-# INLINABLE (>>=) #-}
+    m >> n = StateT $ \s c -> unStateT m s $ \_ s' -> unStateT n s' c
+    {-# INLINABLE (>>) #-}
 
 instance MonadState s (StateT s m) where
     get = StateT $ \s c -> c s s
@@ -53,13 +64,13 @@ type State s = StateT s Identity
 
 runState :: State s a -> s -> (a, s)
-runState = (unsafeCoerce `asTypeOf` (runIdentity.)) . runStateT
-{-# INLINABLE runState #-}
+runState = asTypeOf unsafeCoerce ((runIdentity .) .) runStateT
+{-# INLINE runState #-}
 
 evalState :: State s a -> s -> a
-evalState = (unsafeCoerce `asTypeOf` (runIdentity.)) . evalStateT
-{-# INLINABLE evalState #-}
+evalState = asTypeOf unsafeCoerce ((runIdentity .) .) evalStateT
+{-# INLINE evalState #-}
 
 execState :: State s a -> s -> s
-execState = (unsafeCoerce `asTypeOf` (runIdentity.)) . execStateT
-{-# INLINABLE execState #-}
+execState = asTypeOf unsafeCoerce ((runIdentity .) .) execStateT
+{-# INLINE execState #-}

@@ -1,5 +1,12 @@-{-# LANGUAGE Trustworthy, Rank2Types, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
-module Control.Monad.Writer.CPS where
+{-# LANGUAGE Trustworthy, Rank2Types, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, BangPatterns #-}
+module Control.Monad.Writer.CPS (WriterT(..)
+    , runWriterT
+    , execWriterT
+    , mapWriterT
+    , Writer
+    , runWriter
+    , execWriter
+    , module Control.Monad.Writer.Class)where
 
 import Control.Monad.Writer.Class
 import Control.Applicative
@@ -28,14 +35,16 @@ instance Monoid w => Applicative (WriterT w m) where
     pure x = WriterT $ \c -> c x mempty
     {-# INLINABLE pure #-}
-    mf <*> ma = WriterT $ \c -> unWriterT mf $ \f w -> unWriterT ma $ \a w' -> c (f a) (mappend w w')
+    mf <*> ma = WriterT $ \c -> unWriterT mf $ \f !w -> unWriterT ma $ \a !w' -> c (f a) $! mappend w w'
     {-# INLINABLE (<*>) #-}
 
 instance Monoid w => Monad (WriterT w m) where
     return x = WriterT $ \c -> c x mempty
     {-# INLINABLE return #-}
-    m >>= k = WriterT $ \c -> unWriterT m $ \a w -> unWriterT (k a) $ \b w' -> c b (mappend w w')
+    m >>= k = WriterT $ \c -> unWriterT m $ \a !w -> unWriterT (k a) $ \b !w' -> c b $! mappend w w'
     {-# INLINABLE (>>=) #-}
+    m >> n = WriterT $ \c -> unWriterT m $ \_ !w -> unWriterT n $ \b !w' -> c b $! mappend w w'
+    {-# INLINABLE (>>) #-}
 
 instance Monoid w => MonadWriter w (WriterT w m) where
     writer (a, w) = WriterT $ \c -> c a w
@@ -55,8 +64,8 @@ 
 runWriter :: Writer w a -> (a, w)
 runWriter = (unsafeCoerce `asTypeOf` (runIdentity.)) runWriterT
-{-# INLINABLE runWriter #-}
+{-# INLINE runWriter #-}
 
 execWriter :: Writer w a -> w
 execWriter = (unsafeCoerce `asTypeOf` (runIdentity.)) execWriterT
-{-# INLINABLE execWriter #-}
+{-# INLINE execWriter #-}

@@ -1,6 +1,6 @@ name:                mtl-c
-version:             0
-synopsis:            Monad transformers using continuation passing style
+version:             0.1
+synopsis:            Very strict CPS'd transformers
 description:         Monad transformers in CPS
 homepage:            https://github.com/fumieval/mtl-c
 license:             BSD3