loop 0.1.0 → 0.2.0
raw patch · 8 files changed
+155/−19 lines, 8 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
- Control.Loop.Internal: numLoop :: (Num a, Eq a, Monad m) => a -> a -> (a -> m ()) -> m ()
+ Control.Loop: forLoopFold :: a -> (a -> Bool) -> (a -> a) -> acc -> (acc -> a -> acc) -> acc
+ Control.Loop: numLoop :: (Num a, Eq a, Monad m) => a -> a -> (a -> m ()) -> m ()
+ Control.Loop: numLoopFold :: (Num a, Eq a) => a -> a -> acc -> (acc -> a -> acc) -> acc
Files
- bench/Bench.hs +2/−2
- bench/BenchFolds.hs +50/−0
- bench/FoldlAndIORefAreSlow.hs +3/−0
- bench/TraverseW32.hs +2/−2
- loop.cabal +16/−1
- src/Control/Loop.hs +48/−0
- src/Control/Loop/Internal.hs +0/−13
- test/Main.hs +34/−1
bench/Bench.hs view
@@ -9,8 +9,8 @@ import Data.Word import System.Random (randomIO) -import Control.Loop (forLoop)-import Control.Loop.Internal (loop, unsafeLoop, numLoop)+import Control.Loop (forLoop, numLoop)+import Control.Loop.Internal (loop, unsafeLoop) main :: IO ()
+ bench/BenchFolds.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE BangPatterns #-}++module Main (main) where++import Control.Monad.State.Strict+import Criterion.Main++import Control.Loop (forLoop, forLoopFold, numLoopFold)+++main :: IO ()+main = do++ defaultMain+ [ bgroup "pure" [ bench "sumFold" $ whnf sumFold 1000000+ , bench "sumFoldTooStrict" $ whnf sumFoldTooStrict 1000000+ , bench "numSumFold" $ whnf numSumFold 1000000+ ]+ , bgroup "monadic" [ bench "sumFoldMonadic" $ whnf sumFoldMonadic 1000000+ ]+ ]+++-- This is too strict if you want to write something like this;+-- forLoopFold 0 (<4) (+1) (error "default should not be evaluated") (\acc x -> x)+-- Namely it evaluates acc0 even if it is never used.+-- See http://neilmitchell.blogspot.co.uk/2013/08/destroying-performance-with-strictness.html+forLoopFoldTooStrict :: a -> (a -> Bool) -> (a -> a) -> acc -> (acc -> a -> acc) -> acc+forLoopFoldTooStrict start cond inc acc0 f = go acc0 start+ where+ go !acc !x | cond x = go (f acc x) (inc x)+ | otherwise = acc++{-# INLINE forLoopFoldTooStrict #-}+++sumFold :: Int -> Int+sumFold n = forLoopFold 0 (< n) (+1) 0 (+)++sumFoldTooStrict :: Int -> Int+sumFoldTooStrict n = forLoopFoldTooStrict 0 (< n) (+1) 0 (+)++sumFoldMonadic :: Int -> Int+sumFoldMonadic n = flip execState 0 $ do+ forLoop 0 (< n) (+1) $ \i -> do+ x <- get+ put $! x + i++numSumFold :: Int -> Int+numSumFold n = numLoopFold 0 (n - 1) 0 (+) -- numLoopFold is inclusive
bench/FoldlAndIORefAreSlow.hs view
@@ -6,6 +6,7 @@ import Criterion.Main import Data.List (foldl') import Data.IORef+import qualified Data.Vector as V import Data.Word @@ -18,9 +19,11 @@ [ bgroup "sum32" [ bench "sumW32loopIORef" $ nfIO (sumW32loopIORef 1000000) , bench "sumW32StrictState" $ whnf (\n -> execState (sumW32StrictState n) 0) 1000000 , bench "foldlW32" $ whnf (\n -> foldl' (+) 0 [0..n::Word32]) 1000000+ , bench "V.foldlW32" $ whnf (\n -> V.foldl' (+) 0 (V.enumFromTo 0 (n::Word32))) 1000000 , bench "sumIntloopIORef" $ nfIO (sumIntloopIORef 1000000) , bench "sumIntStrictState" $ whnf (\n -> execState (sumIntStrictState n) 0) 1000000 , bench "foldlInt" $ whnf (\n -> foldl' (+) 0 [0..n::Int]) 1000000+ , bench "V.foldlInt" $ whnf (\n -> V.foldl' (+) 0 (V.enumFromTo 0 (n::Int))) 1000000 ] ]
bench/TraverseW32.hs view
@@ -5,8 +5,8 @@ import Criterion.Main import Data.Word -import Control.Loop (forLoop)-import Control.Loop.Internal (loop, unsafeLoop, numLoop)+import Control.Loop (forLoop, numLoop)+import Control.Loop.Internal (loop, unsafeLoop) main :: IO ()
loop.cabal view
@@ -1,5 +1,5 @@ name: loop-version: 0.1.0+version: 0.2.0 license: MIT copyright: 2014 Niklas Hambüchen <mail@nh2.me> author: Niklas Hambüchen <mail@nh2.me>@@ -64,6 +64,21 @@ , criterion >= 0.6.0.0 , random >= 1.0.1.1 , vector >= 0.10.9.1+ ghc-options:+ -Wall -O2+++benchmark bench-folds+ type: exitcode-stdio-1.0+ hs-source-dirs:+ bench+ main-is:+ BenchFolds.hs+ build-depends:+ base >= 4 && < 5+ , loop+ , criterion >= 0.6.0.0+ , mtl >= 2.1.2 ghc-options: -Wall -O2
src/Control/Loop.hs view
@@ -26,6 +26,9 @@ -- @forLoop 1 (<= n) (+1)@. module Control.Loop ( forLoop+ , forLoopFold+ , numLoop+ , numLoopFold ) where @@ -38,3 +41,48 @@ | otherwise = return () {-# INLINE forLoop #-}+++-- | @forLoopFold start cond inc acc0 f@: A pure fold using a for loop+-- instead of a list for performance.+--+-- Care is taken that @acc0@ not be strictly evaluated if unless done so by @f@.+forLoopFold :: a -> (a -> Bool) -> (a -> a) -> acc -> (acc -> a -> acc) -> acc+forLoopFold start cond inc acc0 f = go acc0 start+ where+ -- Not using !acc, see:+ -- http://neilmitchell.blogspot.co.uk/2013/08/destroying-performance-with-strictness.html+ go acc !x | cond x = let acc' = f acc x+ in acc' `seq` go acc' (inc x)+ | otherwise = acc++{-# INLINE forLoopFold #-}+++-- | @numLoop start end f@: Loops over a contiguous numerical range, including+-- @end@.+--+-- It uses @(+ 1)@ so for most integer types it has no bounds (overflow) check.+numLoop :: (Num a, Eq a, Monad m) => a -> a -> (a -> m ()) -> m ()+numLoop start end f = go start+ where+ go !x | x == end = f x+ | otherwise = f x >> go (x+1)++{-# INLINE numLoop #-}+++-- | @numLoopFold start end acc0 f@: A pure fold over a contiguous numerical+-- range, including @end@.+--+-- It uses @(+ 1)@ so for most integer types it has no bounds (overflow) check.+--+-- Care is taken that @acc0@ not be strictly evaluated if unless done so by @f@.+numLoopFold :: (Num a, Eq a) => a -> a -> acc -> (acc -> a -> acc) -> acc+numLoopFold start end acc0 f = go acc0 start+ where+ go acc !x | x == end = f acc x+ | otherwise = let acc' = f acc x+ in acc' `seq` go acc' (x+1)++{-# INLINE numLoopFold #-}
src/Control/Loop/Internal.hs view
@@ -6,7 +6,6 @@ module Control.Loop.Internal ( loop , unsafeLoop- , numLoop ) where @@ -39,15 +38,3 @@ unsafeSucc = toEnum . (+ 1) . fromEnum {-# INLINE unsafeLoop #-}----- | Like `loop`, but using `Num` instead.------ It uses @(+ 1)@ so for most integer types it has no bounds (overflow) check.-numLoop :: (Num a, Eq a, Monad m) => a -> a -> (a -> m ()) -> m ()-numLoop start end f = go start- where- go !x | x == end = f x- | otherwise = f x >> go (x+1)--{-# INLINE numLoop #-}
test/Main.hs view
@@ -5,7 +5,7 @@ import Data.Word import Test.Hspec -import Control.Loop (forLoop)+import Control.Loop (forLoop, numLoop, numLoopFold) main :: IO ()@@ -13,6 +13,22 @@ describe "forLoop" $ do + it "sum [1..10], strict State" $ do+ let res = flip execState 0 $ do+ forLoop (1 :: Int) (<= 10) (+1) $ \i -> do+ x <- get+ put $! x + i++ res `shouldBe` sum [1..10]++ it "sum [-10..10], strict State" $ do+ let res = flip execState 0 $ do+ forLoop (-10 :: Int) (<= 10) (+1) $ \i -> do+ x <- get+ put $! x + i++ res `shouldBe` sum [-10..10]+ it "over all of Word32, calculating sum, IORef" $ do ref <- newIORef 0 forLoop (0 :: Word32) (< maxBound) (+1) $ \i -> do@@ -35,3 +51,20 @@ put $! x + 1 res `shouldBe` (maxBound :: Word32)+++ describe "numLoop" $ do++ it "is inclusive" $ do+ let res = flip execState 0 $ do+ numLoop (0 :: Int) 10 $ \i -> do+ x <- get+ put $! x + i++ res `shouldBe` 55+++ describe "numLoopFold" $ do++ it "is inclusive" $ do+ numLoopFold (0 :: Int) 10 0 (+) `shouldBe` 55