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