git.iko.soy/text
on 48685b2 help sign in
text/Data/Text/Array.hs
268 lines 8.3 kB history raw
1{-# LANGUAGE CPP, ExistentialQuantification, MagicHash, Rank2Types,
2 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 , toList
39 ) where
41#if 0
42#define BOUNDS_CHECKING
43-- This fugly hack is brought by GHC's apparent reluctance to deal
44-- with MagicHash and UnboxedTuples when inferring types. Eek!
45#define CHECK_BOUNDS(_func_,_len_,_k_) \
46if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else
47#else
48#define CHECK_BOUNDS(_func_,_len_,_k_)
49#endif
51#if defined(__GLASGOW_HASKELL__)
52#include "MachDeps.h"
54import GHC.Base (ByteArray#, MutableByteArray#, Int(..), indexWord16Array#,
55 newByteArray#, readWord16Array#, unsafeCoerce#,
56 writeWord16Array#, (+#), (*#))
57import GHC.Prim (Int#)
58import GHC.ST (ST(..), runST)
59import GHC.Word (Word16(..))
61#elif defined(__HUGS__)
63import Control.Exception (assert)
64import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,
65 newMutableByteArray, readMutableByteArray,
66 unsafeFreezeMutableByteArray, writeMutableByteArray)
67import Foreign.Storable (Storable, sizeOf)
68import Hugs.ST (ST(..), runST)
70#else
71# error not implemented for this compiler
72#endif
74import Data.Typeable (Typeable1(..), Typeable2(..), TyCon, mkTyCon, mkTyConApp)
75import Data.Word (Word16)
76import Prelude hiding (length, read)
78#include "Typeable.h"
80-- | Immutable array type.
81data Array e = Array
82 {-# UNPACK #-} !Int -- length (in units of e, not bytes)
83#if defined(__GLASGOW_HASKELL__)
84 ByteArray#
85#elif defined(__HUGS__)
86 !ByteArray
87#endif
89INSTANCE_TYPEABLE1(Array,arrayTc,"Array")
91-- | Mutable array type, for use in the ST monad.
92data MArray s e = MArray
93 {-# UNPACK #-} !Int -- length (in units of e, not bytes)
94#if defined(__GLASGOW_HASKELL__)
95 (MutableByteArray# s)
96#elif defined(__HUGS__)
97 !(MutableByteArray s)
98#endif
100INSTANCE_TYPEABLE2(MArray,mArrayTc,"MArray")
102-- | Operations supported by all arrays.
103class IArray a where
104 -- | Return the length of an array.
105 length :: a -> Int
107instance IArray (Array e) where
108 length (Array len _ba) = len
109 {-# INLINE length #-}
111instance (Elt e, Show e) => Show (Array e) where
112 show = show . toList
114instance IArray (MArray s e) where
115 length (MArray len _ba) = len
116 {-# INLINE length #-}
118check :: IArray a => String -> a -> Int -> (a -> Int -> b) -> b
119check func ary i f
120 | i >= 0 && i < length ary = f ary i
121 | otherwise = error ("Data.Array.Flat." ++ func ++ ": index out of bounds")
122{-# INLINE check #-}
124-- | Operations supported by all elements that can be stored in
125-- arrays.
126class Elt e where
127 -- | Indicate how many bytes would be used for an array of the
128 -- given size.
129 bytesInArray :: Int -> e -> Int
130 -- | Unchecked read of an immutable array. May return garbage or
131 -- crash on an out-of-bounds access.
132 unsafeIndex :: Array e -> Int -> e
133 -- | Unchecked read of a mutable array. May return garbage or
134 -- crash on an out-of-bounds access.
135 unsafeRead :: MArray s e -> Int -> ST s e
136 -- | Unchecked write of a mutable array. May return garbage or
137 -- crash on an out-of-bounds access.
138 unsafeWrite :: MArray s e -> Int -> e -> ST s ()
140 -- | Read an immutable array. An invalid index results in a
141 -- runtime error.
142 index :: Array e -> Int -> e
143 index ary i = check "index" ary i unsafeIndex
144 {-# INLINE index #-}
146 -- | Read a mutable array. An invalid index results in a runtime
147 -- error.
148 read :: Array e -> Int -> ST s e
149 read ary i = check "read" ary i read
150 {-# INLINE read #-}
152 -- | Write a mutable array. An invalid index results in a runtime
153 -- error.
154 write :: Array e -> Int -> ST s e
155 write ary i = check "write" ary i write
156 {-# INLINE write #-}
158-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
159unsafeFreeze :: MArray s e -> ST s (Array e)
161#if defined(__GLASGOW_HASKELL__)
163wORD16_SCALE :: Int# -> Int#
164wORD16_SCALE n# = scale# *# n# where I# scale# = SIZEOF_WORD16
166-- | Create an uninitialized mutable array.
167unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)
168unsafeNew n = ST $ \s1# ->
169 case bytesInArray n (undefined :: e) of
170 len@(I# len#) ->
171#if defined(BOUNDS_CHECKING)
172 if len < 0 then error (show ("unsafeNew",len)) else
173#endif
174 case newByteArray# len# s1# of
175 (# s2#, marr# #) -> (# s2#, MArray n marr# #)
176{-# INLINE unsafeNew #-}
178unsafeFreeze (MArray len mba#) = ST $ \s# ->
179 (# s#, Array len (unsafeCoerce# mba#) #)
180{-# INLINE unsafeFreeze #-}
182-- | Create a mutable array, with its elements initialized with the
183-- given value.
184new :: forall s e. Elt e => Int -> e -> ST s (MArray s e)
186#elif defined(__HUGS__)
188unsafeIndexArray :: Storable e => Array e -> Int -> e
189unsafeIndexArray (Array off len arr) i =
190 assert (i >= 0 && i < len) $ readByteArray arr (off + i)
192unsafeReadMArray :: Storable e => MArray s e -> Int -> ST s e
193unsafeReadMArray (MArray _len marr) i =
194 assert (i >= 0 && i < len) $ readMutableByteArray marr
196unsafeWriteMArray :: Storable e => MArray s e -> Int -> e -> ST s ()
197unsafeWriteMArray (MArray len marr) i =
198 assert (i >= 0 && i < len) $ writeMutableByteArray marr
200-- | Create an uninitialized mutable array.
201unsafeNew :: (Storable e) => Int -> ST s (MArray s e)
202unsafeNew n = new undefined
203 where new :: (Storable e) => e -> ST s (MArray s e)
204 new unused = do
205 marr <- newMutableByteArray (n * sizeOf unused)
206 return (MArray n marr)
208unsafeFreeze (MArray len mba) = do
209 ba <- unsafeFreezeMutableByteArray mba
210 return (Array 0 len ba)
212-- | Create a mutable array, with its elements initialized with the
213-- given value.
214new :: (Storable e) => Int -> e -> ST s (MArray s e)
215#endif
217new len initVal = do
218 marr <- unsafeNew len
219 sequence_ [unsafeWrite marr i initVal | i <- [0..len-1]]
220 return marr
222instance Elt Word16 where
223#if defined(__GLASGOW_HASKELL__)
225 bytesInArray (I# i#) _ = I# (wORD16_SCALE i#)
226 {-# INLINE bytesInArray #-}
228 unsafeIndex (Array len ba#) i@(I# i#) =
229 CHECK_BOUNDS("unsafeIndex",len,i)
230 case indexWord16Array# ba# i# of r# -> (W16# r#)
231 {-# INLINE unsafeIndex #-}
233 unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->
234 CHECK_BOUNDS("unsafeRead",len,i)
235 case readWord16Array# mba# i# s# of
236 (# s2#, r# #) -> (# s2#, W16# r# #)
237 {-# INLINE unsafeRead #-}
239 unsafeWrite (MArray len marr#) i@(I# i#) (W16# e#) = ST $ \s1# ->
240 CHECK_BOUNDS("unsafeWrite",len,i)
241 case writeWord16Array# marr# i# e# s1# of
242 s2# -> (# s2#, () #)
243 {-# INLINE unsafeWrite #-}
245#elif defined(__HUGS__)
247 bytesInArray n w = sizeOf w * n
248 unsafeIndex = unsafeIndexArray
249 unsafeRead = unsafeReadMArray
250 unsafeWrite = unsafeWriteMArray
252#endif
254-- | Convert an immutable array to a list.
255toList :: Elt e => Array e -> [e]
256toList a = loop 0
257 where loop i | i < len = unsafeIndex a i : loop (i+1)
258 | otherwise = []
259 len = length a
261-- | An empty immutable array.
262empty :: Elt e => Array e
263empty = runST (unsafeNew 0 >>= unsafeFreeze)
265-- | Run an action in the ST monad and return an immutable array of
266-- its result.
267run :: Elt e => (forall s. ST s (MArray s e)) -> Array e
268run k = runST (k >>= unsafeFreeze)