Faster break and span for Prelude

Boris Lykah lykahb at gmail.com
Tue Dec 27 20:41:33 CET 2011


Hello everyone,

I noticed that Prelude break and span Core uses boxed tuples which is
quite expensive. Since functions from Prelude are used everywhere,
many programs will benefit from their optimization. Please see my
implementation which uses internal worker function and unboxed tuples.
In the best case it could perform more than twice faster than Prelude
functions.

import Criterion.Main

newspan :: (a -> Bool) -> [a] -> ([a], [a])
newspan p xs = go xs where
  go xs@[] = (xs, xs)
  go xs@(x:xs')
         | p x       = case go xs' of (ys, zs) -> (x:ys,zs)
         | otherwise = ([], xs)

newbreak :: (a -> Bool) -> [a] -> ([a], [a])
newbreak p xs = go xs where
  go xs@[] = (xs, xs)
  go xs@(x:xs')
         | p x       = ([], xs)
         | otherwise = case go xs' of (ys, zs) -> (x:ys,zs)

versus f1 f2 pred arg = [ bench "new"     $ whnf (f1 pred) arg
                        , bench "prelude" $ whnf (f2 pred) arg
                        ]

variousLists f1 f2 pred = [ bgroup "fullMatch"   $ versus f1 f2 pred
      (replicate 1000 1 :: [Int])
                          , bgroup "failOnFirst" $ versus f1 f2 (not .
pred) (replicate 1000 1 :: [Int])
                          , bgroup "emptyList"   $ versus f1 f2 pred
      ([]::[Int])
                          ]

main = defaultMain [ bgroup "span"  $ variousLists newspan  span  (==1)
                   , bgroup "break" $ variousLists newbreak break (/=1)
                   ]


-- 
Regards,
Boris



More information about the Libraries mailing list