Skip to content
Snippets Groups Projects
Commit 25675493 authored by meooow's avatar meooow Committed by Lei Zhu
Browse files

Optimize newGenArray a little

* Use unsafeNewArray_ instead of newAray_. We know we will fill the
  array, and newArray_ wastefully initializes it beforehand.
* Avoid safeIndexing the range when writing the elements. range
  generates the elements in the required order, so we can simply use an
  Int counter.
parent 650fe165
No related branches found
No related tags found
1 merge request!24Optimize newGenArray a little
Pipeline #86339 skipped
......@@ -921,10 +921,17 @@ newListArray (l,u) es = do
-- | Constructs a mutable array using a generator function.
-- It invokes the generator function in ascending order of the indices.
newGenArray :: (MArray a e m, Ix i) => (i,i) -> (i -> m e) -> m (a i e)
newGenArray (l,u) f = do
marr <- newArray_ (l,u)
let n = safeRangeSize (l,u)
sequence_ [ f i >>= unsafeWrite marr (safeIndex (l,u) n i) | i <- range (l,u)]
newGenArray bnds f = do
let n = safeRangeSize bnds
marr <- unsafeNewArray_ bnds
let g ix k i
| i == n = return ()
| otherwise = do
x <- f ix
unsafeWrite marr i x
k (i+1)
foldr g (\ !_i -> return ()) (range bnds) 0
-- The bang above is important for GHC for unbox the Int.
return marr
{-# INLINE readArray #-}
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment