Haskell Data.Vector, huge memory leak

Hi, I am trying to make a basic 2D engine with haskell and the SDL1.2 bindings (for fun, I am just learning). Ideally the world is to be procedurally generated, chunk by chunk, allowing free exploration. Right now my chunk is composed of 200*200 tiles which I represent using a type: Mat [Tile] = Vec.Vector (Vec.Vector [Tile]) and these functions: fromMat :: [[a]] -> Mat a fromMat xs = Vec.fromList [Vec.fromList xs' | xs' <- xs] (§) :: Mat a -> (Int, Int) -> a v § (r, c) = (v Vec.! r) Vec.! c I am using cyclic list of tiles in order to allow for sprite animation, and later for dynamic behaviour. Each frame of the game loop, the program reads the part of the vector relevant to the current camera position, display the corresponding tiles and return a new vector in which every of these cyclic lists has been replaced by it's tail. Here is the code responsible for this: applyTileMat :: Chunk -> SDL.Surface -> SDL.Surface -> IO Chunk applyTileMat ch src dest = let m = chLand $! ch (x,y) = chPos ch wid = Vec.length (m Vec.! 0) - 1 hei = (Vec.length m) - 1 (canW,canH) = canvasSize ch in do sequence $ [ applyTile (head (m § (i,j))) (32*(j-x), 32*(i-y)) src dest | i <- [y..(y+canH)], j <- [x..(x+canW)]] m' <-sequence $ [sequence [(return $! tail (m § (i,j))) | j <- [0..wid]] | i <- [0..hei]] --weird :P return ch { chLand = fromMat m' } the first sequence does the display part, the second one returns the new vector m'. At first I was using the following comprehension to get m' let !m' = [id $! [(tail $! (m § (i,j))) | j <- [0..wid]] | i <- [0..hei]] but doing so results in ever increasing memory usage. I think it has to do with lazy evaluation preventing the data to be properly garbage collected, but I don't really understand why. In this particular case, it doesn't really mater since I have to look at the whole vector. But I don't know how I should do if I wanted to only "update" part of my chunk each frame, thus making a new chunk with only part of the data from the previous one. I am probably not using Data.Vector the way it's intended, but it's the simplest data structure I found with O(n) random access. The whole code is there: https://github.com/eniac314/wizzard/blob/master/tiler.hs

I am probably not using Data.Vector the way it's intended, but it's the simplest data structure I found with O(n) random access.
Remember that vectors from Data.Vector are lazy arrays. Technically speaking they are arrays of pointers to lazily evaluated values. What you really want for graphics is most likely Data.Vector.Storable. A vector of that type is always fully evaluated and dense: import qualified Data.Vector as V import qualified Data.Vector.Storable as Vs import qualified Data.Vector.Unboxed as Vu import Data.Word v :: V.Vector Word64 v = V.fromList [1..1000] vs :: Vs.Vector Word64 vs = Vs.fromList [1..1000] vu :: Vu.Vector Word64 vu = Vu.fromList [1..1000] You would expect that a 1000-element array of `Word64` values takes exactly 8000 bytes of memory. This is true for `vs` and `vu`, but not for `v`, because it is a lazy array. The difference between storable and unboxed vectors is that the former has a certain address in memory that is not moved around. This is useful for example when you need to interface with OpenGL or SDL. Unboxed vectors can be faster in certain cases, but the difference is almost always negligible and would not be possible anyway if you were to interface with a non-Haskell library. Greets, Ertugrul

Ok I see the problem now, I will take a look in Data.Vector.Storable, Thank you!
participants (3)
-
Ertugrul Söylemez
-
fayong
-
Florian Gillard