packages feed

loop (empty) → 0.1.0

raw patch · 8 files changed

+536/−0 lines, 8 filesdep +basedep +criteriondep +hspecsetup-changed

Dependencies added: base, criterion, hspec, loop, mtl, random, vector

Files

+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Bench.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE BangPatterns #-}++module Main (main) where++import           Control.Monad+import           Criterion.Main+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import           Data.Word+import           System.Random (randomIO)++import           Control.Loop (forLoop)+import           Control.Loop.Internal (loop, unsafeLoop, numLoop)+++main :: IO ()+main = do++  r <- randomIO++  -- Warning: -fllvm can compile away the `unsafe` loops to complete no-ops.++  defaultMain+    [ bgroup "int" [ bench "loop"                         $ nfIO $ loop                         0 (1000000 :: Int)    (\_ -> return ())+                   , bench "unsafeLoop"                   $ nfIO $ unsafeLoop                   0 (1000000 :: Int)    (\_ -> return ())+                   , bench "numLoop"                      $ nfIO $ numLoop                      0 (1000000 :: Int)    (\_ -> return ())+                   , bench "forLoop"                      $ nfIO $ forLoop                      (0 :: Int) (< 1000000) (+1) (\_ -> return ())+                   , bench "loopLocal"                    $ nfIO $ loopLocal                    0 (1000000 :: Int)    (\_ -> return ())+                   , bench "unsafeLoopLocal"              $ nfIO $ unsafeLoopLocal              0 (1000000 :: Int)    (\_ -> return ())+                   , bench "loopMonad"                    $ nfIO $ loopMonad                    0 (1000000 :: Int)    (\_ -> return ())+                   , bench "numLoopMonadIntInlinable"     $ nfIO $ numLoopMonadIntInlinable     0 (1000000 :: Int)    (\_ -> return ())+                   , bench "numLoopMonadIntInline"        $ nfIO $ numLoopMonadIntInline        0 (1000000 :: Int)    (\_ -> return ())+                   , bench "numLoopInt"                   $ nfIO $ numLoopInt                   0 (1000000 :: Int)    (\_ -> return ())+                   , bench "numLoopEndInt"                $ nfIO $ numLoopEndInt                  (1000000 :: Int)    (\_ -> return ())+                   , bench "listForM_Int"                 $ nfIO $ listForM_Int                 0 (1000000 :: Int)    (\_ -> return ())+                   , bench "vectorFromListInt"            $ nfIO $ vectorFromListInt            0 (1000000 :: Int)    (\_ -> return ())+                   , bench "vectorEnumFromToInt"          $ nfIO $ vectorEnumFromToInt          0 (1000000 :: Int)    (\_ -> return ())+                -- Allocates the vector -> linear space and slow+                -- , bench "vectorEnumFromNInt"           $ nfIO $ vectorEnumFromNInt           0 (1000000 :: Int)    (\_ -> return ())+                   , bench "uvectorFromListInt"           $ nfIO $ uvectorFromListInt           0 (1000000 :: Int)    (\_ -> return ())+                   , bench "uvectorEnumFromToInt"         $ nfIO $ uvectorEnumFromToInt         0 (1000000 :: Int)    (\_ -> return ())+                -- Allocates the vector -> linear space and slow+                -- , bench "uvectorEnumFromNInt"          $ nfIO $ uvectorEnumFromNInt          0 (1000000 :: Int)    (\_ -> return ())+                   ]++    , bgroup "w32" [ bench "loop"                          $ nfIO $ loop                        0 (1000000 :: Word32) (\_ -> return ())+                   , bench "unsafeLoop"                    $ nfIO $ unsafeLoop                  0 (1000000 :: Word32) (\_ -> return ())+                   , bench "numLoop"                       $ nfIO $ numLoop                     0 (1000000 :: Word32) (\_ -> return ())+                   , bench "forLoop"                       $ nfIO $ forLoop                     (0 :: Word32) (< 1000000) (+1) (\_ -> return ())+                   , bench "loopLocal"                     $ nfIO $ loopLocal                   0 (1000000 :: Word32) (\_ -> return ())+                   , bench "unsafeLoopLocal"               $ nfIO $ unsafeLoopLocal             0 (1000000 :: Word32) (\_ -> return ())+                   , bench "loopMonad"                     $ nfIO $ loopMonad                   0 (1000000 :: Word32) (\_ -> return ())+                   , bench "numLoopW32"                    $ nfIO $ numLoopW32                  0 (1000000 :: Word32) (\_ -> return ())+                   , bench "numLoopEndW32"                 $ nfIO $ numLoopEndW32                 (1000000 :: Word32) (\_ -> return ())+                   , bench "listForM_W32"                  $ nfIO $ listForM_W32                0 (1000000 :: Word32) (\_ -> return ())+                   , bench "vectorFromListW32"             $ nfIO $ vectorFromListW32           0 (1000000 :: Word32) (\_ -> return ())+                   , bench "vectorEnumFromToW32"           $ nfIO $ vectorEnumFromToW32         0 (1000000 :: Word32) (\_ -> return ())+                   , bench "uvectorFromListW32"            $ nfIO $ uvectorFromListW32          0 (1000000 :: Word32) (\_ -> return ())+                   , bench "uvectorEnumFromToW32"          $ nfIO $ uvectorEnumFromToW32        0 (1000000 :: Word32) (\_ -> return ())+                   ]++    -- `succ` is almost twice as slow as (+1) because it does an overflow check.+    -- This doesn't become apparent in this benchmark, only if you use it in a loop.+    , bgroup "inc" [ bench "+1"   $ whnf (+1) (r :: Int)+                   , bench "succ" $ whnf succ (r :: Int)+                   ]+    ]+++-- Same as `loop` just defined locally.+loopLocal :: (Enum e, Eq e, Monad m) => e -> e -> (e -> m ()) -> m ()+loopLocal start end f = go start+  where+    go !x | x == end  = f x+          | otherwise = f x >> go (succ x)++{-# INLINEABLE loopLocal #-}+++-- Same as `unsafeLoop` just defined locally.+unsafeLoopLocal :: (Enum e, Eq e, Monad m) => e -> e -> (e -> m ()) -> m ()+unsafeLoopLocal start end f = go start+  where+    go !x | x == end  = f x+          | otherwise = f x >> go (unsafeSucc x)+    unsafeSucc = toEnum . (+ 1) . fromEnum++{-# INLINEABLE unsafeLoopLocal #-}+++-- Same as `loop` just with the monad monomorphic.+loopMonad :: (Enum e, Eq e) => e -> e -> (e -> IO ()) -> IO ()+loopMonad start end f = go start+  where+    go !x | x == end  = f x+          | otherwise = f x >> go (succ x)++{-# INLINEABLE loopMonad #-}+++-- Same as `numLoop` just completely monomorphic, marked as INLINEABLE.+numLoopMonadIntInlinable :: Int -> Int -> (Int -> IO ()) -> IO ()+numLoopMonadIntInlinable start end f = go start+  where+    go !x | x == end  = f x+          | otherwise = f x >> go (x+1)++{-# INLINEABLE numLoopMonadIntInlinable #-}+++-- Same as `numLoop` just completely monomorphic, marked as INLINE.+numLoopMonadIntInline :: Int -> Int -> (Int -> IO ()) -> IO ()+numLoopMonadIntInline start end f = go start+  where+    go !x | x == end  = f x+          | otherwise = f x >> go (x+1)++{-# INLINE numLoopMonadIntInline #-}+++-- Same as `numLoop`, specialized to Int.+numLoopInt :: (Monad m) => Int -> Int -> (Int -> m ()) -> m ()+numLoopInt start end f = go start+  where+    go !n | n == end  = f n >> return ()+          | otherwise = f n >> go (n+1)++{-# INLINEABLE numLoopInt #-}+++-- Same as `numLoop`, specialized to Int with constant start value.+numLoopEndInt :: (Monad m) => Int -> (Int -> m ()) -> m ()+numLoopEndInt end f = go 0+  where+    go !n | n == end  = f n >> return ()+          | otherwise = f n >> go (n+1)++{-# INLINEABLE numLoopEndInt #-}+++-- Same as `numLoop`, specialized to Int32.+numLoopW32 :: (Monad m) => Word32 -> Word32 -> (Word32 -> m ()) -> m ()+numLoopW32 start end f = go start+  where+    go !n | n == end  = f n >> return ()+          | otherwise = f n >> go (n+1)++{-# INLINEABLE numLoopW32 #-}+++-- Same as `numLoop`, specialized to Int32 with constant start value.+numLoopEndW32 :: (Monad m) => Word32 -> (Word32 -> m ()) -> m ()+numLoopEndW32 end f = go 0+  where+    go !n | n == end  = f n >> return ()+          | otherwise = f n >> go (n+1)++{-# INLINEABLE numLoopEndW32 #-}+++-- Using `forM_`, specialized to Int.+listForM_Int :: (Monad m) => Int -> Int -> (Int -> m ()) -> m ()+listForM_Int start end f = forM_ [start..end] f+++-- Using `V.forM_` with `V.fromList`, specialized to Int.+vectorFromListInt :: (Monad m) => Int -> Int -> (Int -> m ()) -> m ()+vectorFromListInt start end f = V.forM_ (V.fromList [start..end]) f+++-- Using `V.forM_` with `V.enumFromTo`, specialized to Int.+vectorEnumFromToInt :: (Monad m) => Int -> Int -> (Int -> m ()) -> m ()+vectorEnumFromToInt start end f = V.forM_ (V.enumFromTo start end) f+++-- Using `V.forM_` with `V.enumFromN`, specialized to Int.+vectorEnumFromNInt :: (Monad m) => Int -> Int -> (Int -> m ()) -> m ()+vectorEnumFromNInt start end f = V.forM_ (V.enumFromN start (end - start + 1)) f+++-- Using `U.forM_` with `U.fromList`, specialized to Int.+uvectorFromListInt :: (Monad m) => Int -> Int -> (Int -> m ()) -> m ()+uvectorFromListInt start end f = U.forM_ (U.fromList [start..end]) f+++-- Using `U.forM_` with `U.enumFromTo`, specialized to Int.+uvectorEnumFromToInt :: (Monad m) => Int -> Int -> (Int -> m ()) -> m ()+uvectorEnumFromToInt start end f = U.forM_ (U.enumFromTo start end) f+++-- Using `U.forM_` with `U.enumFromN`, specialized to Int.+uvectorEnumFromNInt :: (Monad m) => Int -> Int -> (Int -> m ()) -> m ()+uvectorEnumFromNInt start end f = U.forM_ (U.enumFromN start (end - start + 1)) f+++-- Using `forM_`, specialized to Word32.+listForM_W32 :: (Monad m) => Word32 -> Word32 -> (Word32 -> m ()) -> m ()+listForM_W32 start end f = forM_ [start..end] f+++-- Using `V.forM_` with `V.fromList`, specialized to Word32.+vectorFromListW32 :: (Monad m) => Word32 -> Word32 -> (Word32 -> m ()) -> m ()+vectorFromListW32 start end f = V.forM_ (V.fromList [start..end]) f+++-- Using `V.forM_` with `V.enumFromTo`, specialized to Word32.+vectorEnumFromToW32 :: (Monad m) => Word32 -> Word32 -> (Word32 -> m ()) -> m ()+vectorEnumFromToW32 start end f = V.forM_ (V.enumFromTo start end) f+++-- Using `U.forM_` with `U.fromList`, specialized to Word32.+uvectorFromListW32 :: (Monad m) => Word32 -> Word32 -> (Word32 -> m ()) -> m ()+uvectorFromListW32 start end f = U.forM_ (U.fromList [start..end]) f+++-- Using `U.forM_` with `U.enumFromTo`, specialized to Word32.+uvectorEnumFromToW32 :: (Monad m) => Word32 -> Word32 -> (Word32 -> m ()) -> m ()+uvectorEnumFromToW32 start end f = U.forM_ (U.enumFromTo start end) f
+ bench/FoldlAndIORefAreSlow.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE BangPatterns #-}++module Main (main) where++import           Control.Monad.State.Strict+import           Criterion.Main+import           Data.List (foldl')+import           Data.IORef+import           Data.Word+++main :: IO ()+main = do++  -- Warning: -fllvm can compile away the `unsafe` loops to complete no-ops.++  defaultMain+    [ 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 "sumIntloopIORef"     $ nfIO (sumIntloopIORef                          1000000)+                           , bench "sumIntStrictState"   $ whnf (\n -> execState (sumIntStrictState n) 0) 1000000+                           , bench "foldlInt"            $ whnf (\n -> foldl' (+) 0 [0..n::Int])          1000000+                           ]+    ]++++forLoop :: (Monad m) => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()+forLoop start cond inc f = go start+  where+    go !x | cond x    = f x >> go (inc x)+          | otherwise = return ()++{-# INLINE forLoop #-}+++sumW32loopIORef :: Word32 -> IO Word32+sumW32loopIORef n = do+  ref <- newIORef 0+  forLoop (0 :: Word32) (< n) (+1) $ \i -> do+    modifyIORef' ref (+i)+  readIORef ref+++sumW32StrictState :: Word32 -> State Word32 ()+sumW32StrictState n = do+  forLoop (0 :: Word32) (< n) (+1) $ \i -> do+    x <- get+    put $! x + i+++sumIntloopIORef :: Int -> IO Int+sumIntloopIORef n = do+  ref <- newIORef 0+  forLoop (0 :: Int) (< n) (+1) $ \i -> do+    modifyIORef' ref (+i)+  readIORef ref+++sumIntStrictState :: Int -> State Int ()+sumIntStrictState n = do+  forLoop (0 :: Int) (< n) (+1) $ \i -> do+    x <- get+    put $! x + i
+ bench/TraverseW32.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE BangPatterns #-}++module Main (main) where++import           Criterion.Main+import           Data.Word++import           Control.Loop (forLoop)+import           Control.Loop.Internal (loop, unsafeLoop, numLoop)+++main :: IO ()+main = do++  -- Warning: -fllvm can compile away the `unsafe` loops to complete no-ops.++  defaultMain+    [ bgroup "traversew32" [ bench "loop"        $ nfIO $ loop        0 (maxBound :: Word32) (\_ -> return ())+                           , bench "unsafeLoop"  $ nfIO $ unsafeLoop  0 (maxBound :: Word32) (\_ -> return ())+                           , bench "numLoop"     $ nfIO $ numLoop     0 (maxBound :: Word32) (\_ -> return ())+                           , bench "forLoop"     $ nfIO $ forLoop     0 (< (maxBound :: Word32)) (+1) (\_ -> return ())+                           ]+    ]
+ loop.cabal view
@@ -0,0 +1,98 @@+name:          loop+version:       0.1.0+license:       MIT+copyright:     2014 Niklas Hambüchen <mail@nh2.me>+author:        Niklas Hambüchen <mail@nh2.me>+maintainer:    Niklas Hambüchen <mail@nh2.me>+category:      Control+build-type:    Simple+stability:     experimental+tested-with:   GHC==7.6.3+cabal-version: >= 1.8+homepage:      https://github.com/nh2/loop+bug-reports:   https://github.com/nh2/loop/issues+synopsis:      Fast loops (for when GHC can't optimize forM_)+description:+  This package provides a convenient and fast alternative to the common+  `forM_ [1..n]` idiom, which in many cases GHC cannot fuse to efficient+  code.+  .+  See https://ghc.haskell.org/trac/ghc/ticket/8763.++source-repository head+  type:      git+  location:  git://github.com/nh2/loop.git+++library+  exposed-modules:+    Control.Loop+    -- Internal+    Control.Loop.Internal+  hs-source-dirs:+    src+  build-depends:+      base                >= 4 && < 5+  ghc-options:+    -Wall -O2+++test-suite tests+  type: exitcode-stdio-1.0+  hs-source-dirs:+    test+  main-is:+    Main.hs+  build-depends:+      base                >= 4 && < 5+    , loop+    , hspec               >= 1.3.0.1+    , mtl                 >= 2.1.2+  ghc-options:+    -Wall -O2+++benchmark bench+  type: exitcode-stdio-1.0+  hs-source-dirs:+    bench+  main-is:+    Bench.hs+  build-depends:+      base                >= 4 && < 5+    , loop+    , criterion           >= 0.6.0.0+    , random              >= 1.0.1.1+    , vector              >= 0.10.9.1+  ghc-options:+    -Wall -O2+++benchmark bench-traverse-w32+  type: exitcode-stdio-1.0+  hs-source-dirs:+    bench+  main-is:+    TraverseW32.hs+  build-depends:+      base                >= 4 && < 5+    , loop+    , criterion           >= 0.6.0.0+    , vector              >= 0.10.9.1+  ghc-options:+    -Wall -O2+++benchmark bench-foldl-and-iorefs-are-slow+  type: exitcode-stdio-1.0+  hs-source-dirs:+    bench+  main-is:+    FoldlAndIORefAreSlow.hs+  build-depends:+      base                >= 4.6 && < 5+    , criterion           >= 0.6.0.0+    , mtl                 >= 2.1.2+    , vector              >= 0.10.9.1+  ghc-options:+    -Wall -O2
+ src/Control/Loop.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE BangPatterns #-}++-- | Provides a convenient and fast alternative to the common+-- @forM_ [1..n]@ idiom, which in many cases GHC cannot fuse to efficient+-- code.+--+-- Notes on fast iteration:+--+-- * For `Int`, @(+1)@ is almost twice as fast as `succ` because `succ`+--   does an overflow check.+--+-- * For `Int`, you can get around that while still using `Enum` using+--   @toEnum . (+ 1) . fromEnum@.+--+-- * However, @toEnum . (+ 1) . fromEnum@ is slower than `succ` for+--   `Word32` on 64-bit machines since `toEnum` has to check if the+--   given `Int` exceeds 32 bits.+--+-- * Using @(+1)@ from `Num` is always the fastest way, but it gives+--   no overflow checking.+--+-- * Using `forLoop` you can flexibly pick the way of increasing the value+--   that best fits your needs.+--+-- * The currently recommended replacement for @forM_ [1..n]@ is+--   @forLoop 1 (<= n) (+1)@.+module Control.Loop+  ( forLoop+  ) where+++-- | @forLoop start cond inc f@: A C-style for loop with starting value,+-- loop condition and incrementor.+forLoop :: (Monad m) => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()+forLoop start cond inc f = go start+  where+    go !x | cond x    = f x >> go (inc x)+          | otherwise = return ()++{-# INLINE forLoop #-}
+ src/Control/Loop/Internal.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE BangPatterns #-}++-- | This is for trying out loop alternatives.+--+-- Names and types are subjects to change.+module Control.Loop.Internal+  ( loop+  , unsafeLoop+  , numLoop+  ) where+++-- | @loop start end f@: Loops from @start@ to @end@ (inclusive), executing @f@+-- on each iteration. Same as @forM_ [start..end] f@.+--+-- Uses `succ` inside, which does a bounds (overflow) check.+loop :: (Enum e, Eq e, Monad m) => e -> e -> (e -> m ()) -> m ()+loop start end f = go start+  where+    go !x | x == end  = f x+          | otherwise = f x >> go (succ x)++{-# INLINE loop #-}+++-- | Like `loop`, but (sometimes) without bounds (overflow) check.+--+-- This circumvents the implementation of `succ` for the @Enum@ type+-- and uses @toEnum . (+ 1) . fromEnum@ instead, so it will break+-- on Enums that are not contiguous.+--+-- Note that some types (e.g. Word32) have bounds checks even for+-- `toEnum`.+unsafeLoop :: (Enum e, Eq e, Monad m) => e -> e -> (e -> m ()) -> m ()+unsafeLoop start end f = go start+  where+    go !x | x == end  = f x+          | otherwise = f x >> go (unsafeSucc x)+    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
@@ -0,0 +1,37 @@+{-# LANGUAGE BangPatterns #-}++import           Control.Monad.State.Strict+import           Data.IORef+import           Data.Word+import           Test.Hspec++import           Control.Loop (forLoop)+++main :: IO ()+main = hspec $ do++  describe "forLoop" $ do++    it "over all of Word32, calculating sum, IORef" $ do+      ref <- newIORef 0+      forLoop (0 :: Word32) (< maxBound) (+1) $ \i -> do+        modifyIORef' ref (+i)+      res <- readIORef ref+      res `shouldBe` 2147483649++    it "over all of Word32, calculating sum, strict State" $ do+      let res = flip execState 0 $ do+            forLoop (0 :: Word32) (< maxBound) (+1) $ \i -> do+              x <- get+              put $! x + i++      res `shouldBe` 2147483649++    it "over all of Word32, calculating sum, strict State, i unused" $ do+      let res = flip execState 0 $ do+            forLoop (0 :: Word32) (< maxBound) (+1) $ \_ -> do+              x <- get+              put $! x + 1++      res `shouldBe` (maxBound :: Word32)