Inline throwIf* and clear (fixes #180)

Before:

Case                     Allocated  GCs
pollEvent 1                  1,600    0
pollEvent 10                 1,728    0
pollEvent 100                1,728    0
pollEvent 1000               1,728    0
pollEvent 10000              1,728    0
pollEvent + clear 1          2,864    0
pollEvent + clear 10         6,448    0
pollEvent + clear 100       35,968    0
pollEvent + clear 1000     331,168    0
pollEvent + clear 10000  3,283,336    6

After:

Case                     Allocated  GCs
pollEvent 1                  1,496    0
pollEvent 10                 1,624    0
pollEvent 100                1,624    0
pollEvent 1000               1,624    0
pollEvent 10000              1,624    0
pollEvent + clear 1          2,072    0
pollEvent + clear 10         2,704    0
pollEvent + clear 100        2,704    0
pollEvent + clear 1000       2,704    0
pollEvent + clear 10000      2,872    0

Author: chrisdone

bench/Space.hs

@@ -25,6 +25,20 @@ main =
                                "Allocated >2KB! Allocations should be constant."
                         else Nothing)
           | i <- [1, 10, 100, 1000, 10000]
+          ]
+        sequence_
+          [ validateAction
+            ("pollEvent + clear " ++ show i)
+            pollEventClearTest
+            i
+            (\weight ->
+               if weightGCs weight > 0
+                 then Just "Non-zero number of garbage collections!"
+                 else if weightAllocatedBytes weight > 3000
+                        then Just
+                               "Allocated >3KB! Allocations should be constant."
+                        else Nothing)
+          | i <- [1, 10, 100, 1000, 10000]
           ])
 
 -- | Test that merely polling does not allocate or engage the GC.
@@ -38,3 +52,18 @@ pollEventTest iters = do
         _ <- pollEvent
         go (i - 1)
   go iters
+
+-- | Test that merely polling and clearing the screen does not
+-- allocate or engage the GC.
+pollEventClearTest :: Int -> IO ()
+pollEventClearTest iters = do
+  initializeAll
+  window <- createWindow "pollEventClearTest" defaultWindow
+  renderer <- createRenderer window (-1) defaultRenderer
+  let go :: Int -> IO ()
+      go 0 = pure ()
+      go i = do
+        _ <- pollEvent
+        clear renderer
+        go (i - 1)
+  go iters

src/SDL/Internal/Exception.hs

@@ -33,31 +33,39 @@ getError = liftIO $ do
   cstr <- Raw.getError
   Text.decodeUtf8 <$> BS.packCString cstr
 
+{-# INLINE throwIf #-}
 throwIf :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m a
 throwIf f caller funName m = do
   a <- m
   liftIO $ when (f a) $
     (SDLCallFailed caller funName <$> getError) >>= throwIO
   return a
 
+{-# INLINE throwIf_ #-}
 throwIf_ :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m ()
 throwIf_ f caller funName m = throwIf f caller funName m >> return ()
 
+{-# INLINE throwIfNeg #-}
 throwIfNeg :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m a
 throwIfNeg = throwIf (< 0)
 
+{-# INLINE throwIfNeg_ #-}
 throwIfNeg_ :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m ()
 throwIfNeg_ = throwIf_ (< 0)
 
+{-# INLINE throwIfNull #-}
 throwIfNull :: (MonadIO m) => Text -> Text -> m (Ptr a) -> m (Ptr a)
 throwIfNull = throwIf (== nullPtr)
 
+{-# INLINE throwIf0 #-}
 throwIf0 :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m a
 throwIf0 = throwIf (== 0)
 
+{-# INLINE throwIfNot0 #-}
 throwIfNot0 :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m a
 throwIfNot0 = throwIf (/= 0)
 
+{-# INLINE throwIfNot0_ #-}
 throwIfNot0_ :: (Eq a, MonadIO m, Num a) => Text -> Text -> m a -> m ()
 throwIfNot0_ = throwIf_ (/= 0)
 

src/SDL/Video/Renderer.hs

@@ -651,6 +651,7 @@ clear :: (Functor m, MonadIO m) => Renderer -> m ()
 clear (Renderer r) =
   throwIfNeg_ "SDL.Video.clear" "SDL_RenderClear" $
   Raw.renderClear r
+{-# INLINE clear #-}
 
 -- | Get or set the drawing scale for rendering on the current target.
 --