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