ghc and signal processing

Wolfgang Thaller wolfgang.thaller at gmx.net
Mon Feb 23 14:38:05 EST 2004


On 23.02.2004, at 13:32, MR K P SCHUPKE wrote:

>> b <- mapArray id a
>
> The reason it is slow is because the array type is copied every time
> a member is assigned.

The array in question is already a mutable array, and even for 
non-mutable arrays, mapArray would use mutable arrays internally.

The problem here is that mapArray's implementation isn't perfect, and 
that GHC doesn't generate perfect code for it.
I was able to get a 16% performance increase by using the following 
instead of GHC's built-in mapArray:

import Data.Array.Base
myMapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i 
e' -> m (a i e)
myMapArray f marr = case Data.Array.IO.bounds marr of
   (l,u) -> do
     marr' <- newArray_ (l,u)
     let loop i n | i == n = return ()
                  | otherwise = do
                         e <- unsafeRead marr i
                         unsafeWrite marr' i (f e)
                         loop (i+1) n
     loop 0 (rangeSize (l,u))
     return marr'

The difference is that I use an explicit loop rather than an 
intermediate list of indices ([1 .. rangeSize (l,u) - 1]) that GHC 
fails to optimize away.

> There are two solutions:
>
> 1) Use a mutable-array in the StateMonad then freeze it.

This won't help in this case (see above).

> 2) In this particular case where processing is sequential (IE you
> are only altering values based on *nearby* values, you can use streams.
> One of the nicest features of Haskell is how lists (being lazy) operate
> just like streams...
[...]
> This should be fast, and also use very little memory.

I second that. You might need to use arrays for input and output, but 
for everything in between, lists are probably a very good choice. Using 
lists this way in Haskell is probably more efficient that using an 
equivalent data structure in C.
When you use arrays, GHC often ends up using lists internally, as we 
saw above. So the luxury of using lists really shouldn't cost too much.

Cheers,

Wolfgang



More information about the Glasgow-haskell-users mailing list