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
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