git.iko.soy/text
on 1c19252 help sign in
text/Data/Text/Array.hs
347 lines 11 kB history raw
1{-# LANGUAGE BangPatterns, CPP, ExistentialQuantification, MagicHash,
2 Rank2Types, ScopedTypeVariables, UnboxedTuples #-}
3{-# OPTIONS_GHC -fno-warn-unused-matches #-}
4-- |
5-- Module : Data.Text.Array
6-- Copyright : (c) Bryan O'Sullivan 2009
7--
8-- License : BSD-style
9-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,
10-- duncan@haskell.org
11-- Stability : experimental
12-- Portability : portable
13--
14-- Packed, unboxed, heap-resident arrays. Suitable for performance
15-- critical use, both in terms of large data quantities and high
16-- speed.
17--
18-- This module is intended to be imported @qualified@, to avoid name
19-- clashes with "Prelude" functions, e.g.
20--
21-- > import qualified Data.Text.Array as A
22--
23-- The names in this module resemble those in the 'Data.Array' family
24-- of modules, but are shorter due to the assumption of qualifid
25-- naming.
26module Data.Text.Array
27 (
28 -- * Types
29 IArray(..)
30 , Elt(..)
31 , Array
32 , MArray
34 -- * Functions
35 , empty
36 , new
37 , unsafeNew
38 , unsafeFreeze
39 , run
40 , run2
41 , toList
42 , copy
43 , unsafeCopy
44 ) where
46#if 0
47#define BOUNDS_CHECKING
48-- This fugly hack is brought by GHC's apparent reluctance to deal
49-- with MagicHash and UnboxedTuples when inferring types. Eek!
50#define CHECK_BOUNDS(_func_,_len_,_k_) \
51if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else
52#else
53#define CHECK_BOUNDS(_func_,_len_,_k_)
54#endif
56#if defined(__GLASGOW_HASKELL__)
57#include "MachDeps.h"
59import GHC.Base (ByteArray#, MutableByteArray#, Int(..), indexIntArray#,
60 indexWord16Array#, newByteArray#, readIntArray#,
61 readWord16Array#, unsafeCoerce#, writeIntArray#,
62 writeWord16Array#, (+#), (*#))
63import GHC.Prim (Int#)
64import GHC.ST (ST(..), runST)
65import GHC.Word (Word16(..))
67#elif defined(__HUGS__)
69import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,
70 newMutableByteArray, readMutableByteArray,
71 unsafeFreezeMutableByteArray, writeMutableByteArray)
72import Foreign.Storable (Storable, sizeOf)
73import Hugs.ST (ST(..), runST)
75#else
76# error not implemented for this compiler
77#endif
79import Control.Exception (assert)
80import Data.Typeable (Typeable1(..), Typeable2(..), TyCon, mkTyCon, mkTyConApp)
81import Data.Word (Word16)
82import Prelude hiding (length, read)
84#include "Typeable.h"
86-- | Immutable array type.
87data Array e = Array
88 {-# UNPACK #-} !Int -- length (in units of e, not bytes)
89#if defined(__GLASGOW_HASKELL__)
90 ByteArray#
91#elif defined(__HUGS__)
92 !ByteArray
93#endif
95INSTANCE_TYPEABLE1(Array,arrayTc,"Array")
97-- | Mutable array type, for use in the ST monad.
98data MArray s e = MArray
99 {-# UNPACK #-} !Int -- length (in units of e, not bytes)
100#if defined(__GLASGOW_HASKELL__)
101 (MutableByteArray# s)
102#elif defined(__HUGS__)
103 !(MutableByteArray s)
104#endif
106INSTANCE_TYPEABLE2(MArray,mArrayTc,"MArray")
108-- | Operations supported by all arrays.
109class IArray a where
110 -- | Return the length of an array.
111 length :: a -> Int
113instance IArray (Array e) where
114 length (Array len _ba) = len
115 {-# INLINE length #-}
117instance (Elt e, Show e) => Show (Array e) where
118 show = show . toList
120instance IArray (MArray s e) where
121 length (MArray len _ba) = len
122 {-# INLINE length #-}
124check :: IArray a => String -> a -> Int -> (a -> Int -> b) -> b
125check func ary i f
126 | i >= 0 && i < length ary = f ary i
127 | otherwise = error ("Data.Array.Flat." ++ func ++ ": index out of bounds")
128{-# INLINE check #-}
130-- | Operations supported by all elements that can be stored in
131-- arrays.
132class Elt e where
133 -- | Indicate how many bytes would be used for an array of the
134 -- given size.
135 bytesInArray :: Int -> e -> Int
136 -- | Unchecked read of an immutable array. May return garbage or
137 -- crash on an out-of-bounds access.
138 unsafeIndex :: Array e -> Int -> e
139 -- | Unchecked read of a mutable array. May return garbage or
140 -- crash on an out-of-bounds access.
141 unsafeRead :: MArray s e -> Int -> ST s e
142 -- | Unchecked write of a mutable array. May return garbage or
143 -- crash on an out-of-bounds access.
144 unsafeWrite :: MArray s e -> Int -> e -> ST s ()
146 -- | Read an immutable array. An invalid index results in a
147 -- runtime error.
148 index :: Array e -> Int -> e
149 index ary i = check "index" ary i unsafeIndex
150 {-# INLINE index #-}
152 -- | Read a mutable array. An invalid index results in a runtime
153 -- error.
154 read :: Array e -> Int -> ST s e
155 read ary i = check "read" ary i read
156 {-# INLINE read #-}
158 -- | Write a mutable array. An invalid index results in a runtime
159 -- error.
160 write :: Array e -> Int -> ST s e
161 write ary i = check "write" ary i write
162 {-# INLINE write #-}
164-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
165unsafeFreeze :: MArray s e -> ST s (Array e)
167#if defined(__GLASGOW_HASKELL__)
169iNT_SCALE :: Int# -> Int#
170iNT_SCALE n# = scale# *# n# where I# scale# = SIZEOF_INT
172wORD16_SCALE :: Int# -> Int#
173wORD16_SCALE n# = scale# *# n# where I# scale# = SIZEOF_WORD16
175-- | Create an uninitialized mutable array.
176unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)
177unsafeNew n = assert (n >= 0) . ST $ \s1# ->
178 case bytesInArray n (undefined :: e) of
179 len@(I# len#) ->
180#if defined(BOUNDS_CHECKING)
181 if len < 0 then error (show ("unsafeNew",len)) else
182#endif
183 case newByteArray# len# s1# of
184 (# s2#, marr# #) -> (# s2#, MArray n marr# #)
185{-# INLINE unsafeNew #-}
187unsafeFreeze (MArray len mba#) = ST $ \s# ->
188 (# s#, Array len (unsafeCoerce# mba#) #)
189{-# INLINE unsafeFreeze #-}
191-- | Create a mutable array, with its elements initialized with the
192-- given value.
193new :: forall s e. Elt e => Int -> e -> ST s (MArray s e)
195#elif defined(__HUGS__)
197unsafeIndexArray :: Storable e => Array e -> Int -> e
198unsafeIndexArray (Array off len arr) i =
199 assert (i >= 0 && i < len) $ readByteArray arr (off + i)
201unsafeReadMArray :: Storable e => MArray s e -> Int -> ST s e
202unsafeReadMArray (MArray _len marr) i =
203 assert (i >= 0 && i < len) $ readMutableByteArray marr
205unsafeWriteMArray :: Storable e => MArray s e -> Int -> e -> ST s ()
206unsafeWriteMArray (MArray len marr) i =
207 assert (i >= 0 && i < len) $ writeMutableByteArray marr
209-- | Create an uninitialized mutable array.
210unsafeNew :: (Storable e) => Int -> ST s (MArray s e)
211unsafeNew n = new undefined
212 where new :: (Storable e) => e -> ST s (MArray s e)
213 new unused = do
214 marr <- newMutableByteArray (n * sizeOf unused)
215 return (MArray n marr)
217unsafeFreeze (MArray len mba) = do
218 ba <- unsafeFreezeMutableByteArray mba
219 return (Array 0 len ba)
221-- | Create a mutable array, with its elements initialized with the
222-- given value.
223new :: (Storable e) => Int -> e -> ST s (MArray s e)
224#endif
226new len initVal = do
227 marr <- unsafeNew len
228 sequence_ [unsafeWrite marr i initVal | i <- [0..len-1]]
229 return marr
231instance Elt Int where
232#if defined(__GLASGOW_HASKELL__)
234 bytesInArray (I# i#) _ = I# (iNT_SCALE i#)
235 {-# INLINE bytesInArray #-}
237 unsafeIndex (Array len ba#) i@(I# i#) =
238 CHECK_BOUNDS("unsafeIndex",len,i)
239 case indexIntArray# ba# i# of r# -> (I# r#)
240 {-# INLINE unsafeIndex #-}
242 unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->
243 CHECK_BOUNDS("unsafeRead",len,i)
244 case readIntArray# mba# i# s# of
245 (# s2#, r# #) -> (# s2#, I# r# #)
246 {-# INLINE unsafeRead #-}
248 unsafeWrite (MArray len marr#) i@(I# i#) (I# e#) = ST $ \s1# ->
249 CHECK_BOUNDS("unsafeWrite",len,i)
250 case writeIntArray# marr# i# e# s1# of
251 s2# -> (# s2#, () #)
252 {-# INLINE unsafeWrite #-}
254#elif defined(__HUGS__)
256 bytesInArray n w = sizeOf w * n
257 unsafeIndex = unsafeIndexArray
258 unsafeRead = unsafeReadMArray
259 unsafeWrite = unsafeWriteMArray
261#endif
263instance Elt Word16 where
264#if defined(__GLASGOW_HASKELL__)
266 bytesInArray (I# i#) _ = I# (wORD16_SCALE i#)
267 {-# INLINE bytesInArray #-}
269 unsafeIndex (Array len ba#) i@(I# i#) =
270 CHECK_BOUNDS("unsafeIndex",len,i)
271 case indexWord16Array# ba# i# of r# -> (W16# r#)
272 {-# INLINE unsafeIndex #-}
274 unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->
275 CHECK_BOUNDS("unsafeRead",len,i)
276 case readWord16Array# mba# i# s# of
277 (# s2#, r# #) -> (# s2#, W16# r# #)
278 {-# INLINE unsafeRead #-}
280 unsafeWrite (MArray len marr#) i@(I# i#) (W16# e#) = ST $ \s1# ->
281 CHECK_BOUNDS("unsafeWrite",len,i)
282 case writeWord16Array# marr# i# e# s1# of
283 s2# -> (# s2#, () #)
284 {-# INLINE unsafeWrite #-}
286#elif defined(__HUGS__)
288 bytesInArray n w = sizeOf w * n
289 unsafeIndex = unsafeIndexArray
290 unsafeRead = unsafeReadMArray
291 unsafeWrite = unsafeWriteMArray
293#endif
295-- | Convert an immutable array to a list.
296toList :: Elt e => Array e -> [e]
297toList a = loop 0
298 where loop i | i < len = unsafeIndex a i : loop (i+1)
299 | otherwise = []
300 len = length a
302-- | An empty immutable array.
303empty :: Elt e => Array e
304empty = runST (unsafeNew 0 >>= unsafeFreeze)
306-- | Run an action in the ST monad and return an immutable array of
307-- its result.
308run :: Elt e => (forall s. ST s (MArray s e)) -> Array e
309run k = runST (k >>= unsafeFreeze)
311-- | Run an action in the ST monad and return an immutable array of
312-- its result paired with whatever else the action returns.
313run2 :: Elt e => (forall s. ST s (MArray s e, a)) -> (Array e, a)
314run2 k = runST (do
315 (marr,b) <- k
316 arr <- unsafeFreeze marr
317 return (arr,b))
319-- | Copy an array in its entirety. The destination array must be at
320-- least as big as the source.
321copy :: Elt e => MArray s e -- ^ source array
322 -> MArray s e -- ^ destination array
323 -> ST s ()
324copy src dest
325 | length dest >= length src = copy_loop 0
326 | otherwise = fail "Data.Text.Array.copy: array too small"
327 where
328 len = length src
329 copy_loop i
330 | i >= len = return ()
331 | otherwise = do unsafeRead src i >>= unsafeWrite dest i
332 copy_loop (i+1)
333{-# INLINE copy #-}
335-- | Unsafely copy the elements of an array.
336unsafeCopy :: Elt e =>
337 MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
338unsafeCopy src sidx dest didx count =
339 assert (sidx + count <= length src) .
340 assert (didx + count <= length dest) $
341 copy_loop sidx didx 0
342 where
343 copy_loop !i !j !c
344 | c >= count = return ()
345 | otherwise = do unsafeRead src i >>= unsafeWrite dest j
346 copy_loop (i+1) (j+1) (c+1)
347{-# INLINE unsafeCopy #-}