You did it wrong. All you did was Church encode the Either type.
Your bind is still doing a case-analysis. All you have to do is use
ContT r (Either e). The bind implementation for ContT is completely
independent of the underlying monad. It doesn't even require the m in
ContT r m to be a functor, let alone a monad. Therefore the ContT
bind doesn't do any case-analysis because it doesn't know anything
about the underlying monad. One way to look at what is happening is
to compare it to Andrzej Filiniski's work in "Representing Monads" and
"Representing Layered Monads".
On Mon, May 10, 2010 at 4:38 AM, Max Cantor <mxcan...@gmail.com> wrote:
> Based on some discussions in #haskell, it seemed to be a consensus that using
> a modified continuation monad for Error handling instead of Eithers would be
> a significant optimization since it would eliminate a lot of conditional
> branching (everytime >>= is called in the Either monad, there is a
> conditional.
>
> I implemented a ErrCPS monad which does exactly that, but the speed has been
> disappointing. It runs almost exactly 3x slower than a drop in replacement
> using the MonadError instance of Either from mtl.
>
> mkEMA and midError are basically toy functions but I dont know why Either is
> so much faster. I've experimented with putting some seq's in the bindErrCPS
> and even {-# INLINE (>>=) #-} in the Monad instance, but to no avail.
>
> I've copy/pasted the code below, any suggestions on optimization, or if this
> is simply a bad idea would be much appreciated. Strangely, compiling with
> -O2 seems to have no effect on the speed:
>
>
> -Max
>
>
>> {-# LANGUAGE MultiParamTypeClasses #-}
>> {-# LANGUAGE FlexibleInstances #-}
>> {-# LANGUAGE FlexibleContexts #-}
>> {-# LANGUAGE Rank2Types #-}
>> module Main where
>>
>> import Control.Applicative
>> import Control.Monad.Error -- hiding (foldM)
>> import Control.Monad.Trans
>> import Control.Monad hiding (foldM)
>> import System.Random
>> import Control.Monad.Identity (runIdentity, Identity)
>> import Control.Monad.Reader.Class
>> import Data.Time.LocalTime as Time -- for benchmarking
>> import Data.Time.Calendar (Day)
>> import Data.Time.LocalTime (getZonedTime)
>
>
>> midError :: MonadError String m => Double -> Double -> m Double
>> midError a b = if (b < 1) then throwError "check val"
>> else let r = (a + b) / 2 in r `seq` (return r)
>> mkEMA l = foldM midError 1 l
>
>
>> newtype ErrCPS e m a = ErrCPS { runErrCPS :: forall r . (e -> m r) -- error
>> handler
>> -> (a -> m r) -- success handler
>> -> m r }
>>
>
>
>> {-# INLINE retErrCPS #-}
>> retErrCPS :: a -> ErrCPS e m a
>> retErrCPS x = ErrCPS $ \_ good -> good x
>>
>> {-# INLINE bindErrCPS #-}
>> bindErrCPS :: ErrCPS e m b -> (b -> ErrCPS e m a) -> ErrCPS e m a
>> bindErrCPS m f = ErrCPS $ \err good -> runErrCPS m err $ \x -> runErrCPS (f
>> x) err good
>>
>> instance Monad m => Monad (ErrCPS e m) where
>> return = retErrCPS
>> (>>=) = bindErrCPS
>
>
>
>> main :: IO ()
>> main = do
>> let n = 500000
>> runEither e b g = either b g e
>> runTest f s = do
>> sg <- newStdGen
>> let l = take n $ randomRs (2, 50000) sg
>> mapM_ (\e -> e `seq` return ()) l
>> stopwatch $ f (mkEMA l)
>> (putStr . show)
>> (putStr . (s ++) . show)
>>
>> forever $ do runTest runEither "either: "
>> runTest runErrCPS "errCPS: "
>
>
>
>
>
> ErrCPS based code seems to run almost exactly 3x slower than the
> Either based code:
> errCPS: 37453.226 Action ran in: 30 msec
> either: 26803.055 Action ran in: 11 msec
> errCPS: 15840.626 Action ran in: 34 msec
> either: 32556.881 Action ran in: 10 msec
> errCPS: 38933.121 Action ran in: 30 msec
> either: 35370.820 Action ran in: 11 msec
> ...
>
>
>
>
>
>>
>> instance (Error e, Monad m) => MonadError e (ErrCPS e m) where
>> throwError = errCPS
>> catchError m f = ErrCPS $ \err good -> runErrCPS m (\e -> runErrCPS (f e)
>> err good) good
>>
>>
>> -- * MTL stuff
>> instance MonadTrans (ErrCPS e ) where lift m = ErrCPS $ \_ good -> m >>= good
>> instance (MonadIO m) => MonadIO (ErrCPS e m ) where liftIO = lift . liftIO
>>
>
> Random utility stuff
>
>> stopwatch :: IO () -> IO ()
>> stopwatch act = do
>> t1 <- getFastTimeOfDay
>> act
>> t2 <- getFastTimeOfDay
>> putStrLn $ " Action ran in: " ++ show (t2 - t1) ++ " msec"
>> type FastTimeOfDay = Int
>>
>> -- | Return the current trading day. This should respect the
>> -- fact that the Trading Day ranges from
>> -- SingTime 6am (UTC -02:00) to SST 5:59 am (UTC -1:59).
>> getTradingDay :: IO Day
>> getTradingDay = error "getTradingDay undefined"
>>
>> getFastTimeOfDay :: IO FastTimeOfDay
>> getFastTimeOfDay = getZonedTime >>=
>> (return . fastFromTimeOfDay . Time.localTimeOfDay .
>> Time.zonedTimeToLocalTime)
>>
>> timeOfDayFromFast :: FastTimeOfDay -> Time.TimeOfDay
>> timeOfDayFromFast fast = Time.TimeOfDay
>> { Time.todHour = fromIntegral (fast `div` (3600 * 1000))
>> , Time.todMin = fromIntegral (fast `div` (60 * 1000)) `mod` 60
>> , Time.todSec = fromRational $ (fromIntegral fast) / 1000
>> }
>>
>> fastFromTimeOfDay :: Time.TimeOfDay -> FastTimeOfDay
>> fastFromTimeOfDay t = fromIntegral $
>> ((Time.todHour t) * 3600000) +
>> ((Time.todMin t) * 60000) +
>> (round $ 1000 * Time.todSec t)
>>
>
>
>
>
>> instance (Monad m) => Functor (ErrCPS e m) where
>> fmap f m = ErrCPS $ \err good -> runErrCPS m err (good . f)
>>
>> instance (Monad m) => Applicative (ErrCPS e m) where
>> pure = return
>> f <*> a = do f' <- f
>> a' <- a
>> return $ f' a'
>>
>> errCPS :: forall e m a . e -> ErrCPS e m a
>> errCPS e = ErrCPS $ \err _ -> err e
>>
>>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
