Attempt to fix some space leaks, general cleanup

src/Loop.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+
 --{-# LANGUAGE TupleSections #-}
 
 {- |
@@ -103,7 +105,7 @@ setupConLoop ::
     -- | Initial simulation state.
     IO world ->
     -- | Concurrent effects. Evaluating 'Nothing' exits the loop
-    (world -> Maybe (world -> world,IO (world -> Maybe world))) ->
+    (world -> Maybe (world -> world, IO (world -> Maybe world))) ->
     -- | update, called once per frame. Allows for side effects such as rendering.
     (world -> IO world) ->
     -- | SDL Event handling, once per frame. Evaluating 'Nothing' exits the loop.
@@ -134,7 +136,7 @@ doConLoop ::
     Window ->
     -- | Concurrent effects, the first function in the pair is applied
     -- immediately
-    (world -> Maybe (world->world,IO (world -> Maybe world))) ->
+    (world -> Maybe (world -> world, IO (world -> Maybe world))) ->
     -- | simulation update.
     (world -> IO world) ->
     -- | SDL Event handling.
@@ -142,32 +144,34 @@ doConLoop ::
     -- | Current simulation state.
     world ->
     IO ()
-doConLoop themvar spf window coneffs worldSideEffects eventFn startWorld = do
-    startTicks <- ticks
-    let mconeff = coneffs startWorld
-    case mconeff of
-        Nothing -> return ()
-        Just (_,acc) -> do
-            _ <- forkIO $ do
-                up <- acc
-                putMVar themvar up
-            return ()
-    let startWorld'' = maybe id fst mconeff startWorld
-    mconupdate <- tryTakeMVar themvar
-    let mstartWorld' = case mconupdate of
-            Just conupdate -> conupdate startWorld''
-            Nothing -> Just startWorld''
-    case mstartWorld' of
-        Nothing -> return ()
-        Just startWorld' -> do
-            worldAfterSimStep <- worldSideEffects startWorld'
-            glSwapWindow window
-            maybeUpdatedWorld <- pollEvents >>= foldM (applyEventIO eventFn) (Just worldAfterSimStep)
-            case maybeUpdatedWorld of
-                Just updatedWorld -> do
-                    performGC
-                    endTicks <- ticks -- it might be better to use System.Clock (monotonic)
-                    let theDelay = max 0 (spf + fromIntegral startTicks - fromIntegral endTicks)
-                    threadDelay (theDelay * 1000)
-                    doConLoop themvar spf window coneffs worldSideEffects eventFn updatedWorld
-                Nothing -> return ()
+doConLoop themvar spf window coneffs worldSideEffects eventFn !startWorld = go startWorld
+  where
+    go sw = do
+        startTicks <- ticks
+        let mconeff = coneffs sw
+        case mconeff of
+            Nothing -> return ()
+            Just (_, acc) -> do
+                _ <- forkIO $ do
+                    up <- acc
+                    putMVar themvar up
+                return ()
+        let startWorld'' = maybe id fst mconeff sw
+        mconupdate <- tryTakeMVar themvar
+        let mstartWorld' = case mconupdate of
+                Just conupdate -> conupdate startWorld''
+                Nothing -> Just startWorld''
+        case mstartWorld' of
+            Nothing -> return ()
+            Just startWorld' -> do
+                worldAfterSimStep <- worldSideEffects startWorld'
+                glSwapWindow window
+                maybeUpdatedWorld <- pollEvents >>= foldM (applyEventIO eventFn) (Just worldAfterSimStep)
+                case maybeUpdatedWorld of
+                    Just updatedWorld -> do
+                        performGC
+                        endTicks <- ticks -- it might be better to use System.Clock (monotonic)
+                        let theDelay = max 0 (spf + fromIntegral startTicks - fromIntegral endTicks)
+                        threadDelay (theDelay * 1000)
+                        go $! updatedWorld
+                    Nothing -> return ()