[Haskell-cafe] Speed of Error handling with Continuations vs. Eithers

[Derek Elkins]

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 <mxcantor at 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 at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>