@@ -1,5 +1,4 @@
1−{-# LANGUAGE BangPatterns, CPP, ExistentialQuantification, MagicHash,
2− Rank2Types, ScopedTypeVariables, UnboxedTuples #-}
1+{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples #-}
32{-# OPTIONS_GHC -fno-warn-unused-matches #-}
43-- |
54-- Module : Data.Text.Array
@@ -27,20 +26,20 @@ module Data.Text.Array
2726 (
2827 -- * Types
2928 IArray(..)
30− , Elt(..)
3129 , Array
3230 , MArray
3331
3432 -- * Functions
33+ , copy
3534 , empty
36− , new
37− , unsafeNew
38− , unsafeFreeze
3935 , run
4036 , run2
4137 , toList
42− , copy
4338 , unsafeCopy
39+ , unsafeFreeze
40+ , unsafeIndex
41+ , unsafeNew
42+ , unsafeWrite
4443 ) where
4544
4645#if 0
@@ -53,125 +52,48 @@ if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ "
5352#define CHECK_BOUNDS(_func_,_len_,_k_)
5453#endif
5554
56−#if defined(__GLASGOW_HASKELL__)
5755#include "MachDeps.h"
5856
57+import Control.Exception (assert)
58+import Data.Text.UnsafeShift (shiftL)
5959import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
6060 indexWord16Array#, newByteArray#,
6161 readWord16Array#, unsafeCoerce#,
62− writeWord16Array#, (*#))
63−import GHC.Prim (Int#)
62+ writeWord16Array#)
6463import GHC.ST (ST(..), runST)
6564import GHC.Word (Word16(..))
66−
67−#elif defined(__HUGS__)
68−
69−import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,
70− newMutableByteArray, readMutableByteArray,
71− unsafeFreezeMutableByteArray, writeMutableByteArray)
72−import Foreign.Storable (Storable, sizeOf)
73−import Hugs.ST (ST(..), runST)
74−
75−#else
76−# error not implemented for this compiler
77−#endif
78−
79−import Control.Exception (assert)
80−import Data.Typeable (Typeable1(..), Typeable2(..), TyCon, mkTyCon, mkTyConApp)
8165import Prelude hiding (length, read)
8266
83−#include "Typeable.h"
84−
8567-- | Immutable array type.
86−data Array e = Array
87− {-# UNPACK #-} !Int -- length (in units of e, not bytes)
88−#if defined(__GLASGOW_HASKELL__)
68+data Array = Array
69+ {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
8970 ByteArray#
90−#elif defined(__HUGS__)
91− !ByteArray
92−#endif
93−
94−INSTANCE_TYPEABLE1(Array,arrayTc,"Array")
9571
9672-- | Mutable array type, for use in the ST monad.
97−data MArray s e = MArray
98− {-# UNPACK #-} !Int -- length (in units of e, not bytes)
99−#if defined(__GLASGOW_HASKELL__)
73+data MArray s = MArray
74+ {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
10075 (MutableByteArray# s)
101−#elif defined(__HUGS__)
102− !(MutableByteArray s)
103−#endif
104−
105−INSTANCE_TYPEABLE2(MArray,mArrayTc,"MArray")
10676
10777-- | Operations supported by all arrays.
10878class IArray a where
10979 -- | Return the length of an array.
11080 length :: a -> Int
11181
112−instance IArray (Array e) where
82+instance IArray Array where
11383 length (Array len _ba) = len
11484 {-# INLINE length #-}
11585
116−instance (Elt e, Show e) => Show (Array e) where
117− show = show . toList
118−
119−instance IArray (MArray s e) where
86+instance IArray (MArray s) where
12087 length (MArray len _ba) = len
12188 {-# INLINE length #-}
12289
123−check :: IArray a => String -> a -> Int -> (a -> Int -> b) -> b
124−check func ary i f
125− | i >= 0 && i < length ary = f ary i
126− | otherwise = error ("Data.Array.Flat." ++ func ++ ": index out of bounds")
127−{-# INLINE check #-}
128−
129−-- | Operations supported by all elements that can be stored in
130−-- arrays.
131−class Elt e where
132− -- | Indicate how many bytes would be used for an array of the
133− -- given size.
134− bytesInArray :: Int -> e -> Int
135− -- | Unchecked read of an immutable array. May return garbage or
136− -- crash on an out-of-bounds access.
137− unsafeIndex :: Array e -> Int -> e
138− -- | Unchecked read of a mutable array. May return garbage or
139− -- crash on an out-of-bounds access.
140− unsafeRead :: MArray s e -> Int -> ST s e
141− -- | Unchecked write of a mutable array. May return garbage or
142− -- crash on an out-of-bounds access.
143− unsafeWrite :: MArray s e -> Int -> e -> ST s ()
144−
145− -- | Read an immutable array. An invalid index results in a
146− -- runtime error.
147− index :: Array e -> Int -> e
148− index ary i = check "index" ary i unsafeIndex
149− {-# INLINE index #-}
150−
151− -- | Read a mutable array. An invalid index results in a runtime
152− -- error.
153− read :: Array e -> Int -> ST s e
154− read ary i = check "read" ary i read
155− {-# INLINE read #-}
156−
157− -- | Write a mutable array. An invalid index results in a runtime
158− -- error.
159− write :: Array e -> Int -> ST s e
160− write ary i = check "write" ary i write
161− {-# INLINE write #-}
162−
16390-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
164−unsafeFreeze :: MArray s e -> ST s (Array e)
165−
166−#if defined(__GLASGOW_HASKELL__)
167−
168−wORD16_SCALE :: Int# -> Int#
169−wORD16_SCALE n# = scale# *# n# where !(I# scale#) = SIZEOF_WORD16
91+unsafeFreeze :: MArray s -> ST s (Array)
17092
17193-- | Create an uninitialized mutable array.
172−unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)
94+unsafeNew :: forall s. Int -> ST s (MArray s)
17395unsafeNew n = assert (n >= 0) . ST $ \s1# ->
174− case bytesInArray n (undefined :: e) of
96+ case bytesInArray n of
17597 len@(I# len#) ->
17698#if defined(BOUNDS_CHECKING)
17799 if len < 0 then error (show ("unsafeNew",len)) else
@@ -184,97 +106,57 @@ unsafeFreeze (MArray len mba#) = ST $ \s# ->
184106 (# s#, Array len (unsafeCoerce# mba#) #)
185107{-# INLINE unsafeFreeze #-}
186108
187−-- | Create a mutable array, with its elements initialized with the
188−-- given value.
189−new :: forall s e. Elt e => Int -> e -> ST s (MArray s e)
190−
191−#elif defined(__HUGS__)
192−
193−unsafeIndexArray :: Storable e => Array e -> Int -> e
194−unsafeIndexArray (Array off len arr) i =
195− assert (i >= 0 && i < len) $ readByteArray arr (off + i)
196−
197−unsafeReadMArray :: Storable e => MArray s e -> Int -> ST s e
198−unsafeReadMArray (MArray _len marr) i =
199− assert (i >= 0 && i < len) $ readMutableByteArray marr
200−
201−unsafeWriteMArray :: Storable e => MArray s e -> Int -> e -> ST s ()
202−unsafeWriteMArray (MArray len marr) i =
203− assert (i >= 0 && i < len) $ writeMutableByteArray marr
204−
205−-- | Create an uninitialized mutable array.
206−unsafeNew :: (Storable e) => Int -> ST s (MArray s e)
207−unsafeNew n = new undefined
208− where new :: (Storable e) => e -> ST s (MArray s e)
209− new unused = do
210− marr <- newMutableByteArray (n * sizeOf unused)
211− return (MArray n marr)
212−
213−unsafeFreeze (MArray len mba) = do
214− ba <- unsafeFreezeMutableByteArray mba
215− return (Array 0 len ba)
216−
217−-- | Create a mutable array, with its elements initialized with the
218−-- given value.
219−new :: (Storable e) => Int -> e -> ST s (MArray s e)
220−#endif
221−
222−new len initVal = do
223− marr <- unsafeNew len
224− sequence_ [unsafeWrite marr i initVal | i <- [0..len-1]]
225− return marr
226−
227−instance Elt Word16 where
228−#if defined(__GLASGOW_HASKELL__)
229−
230− bytesInArray (I# i#) _ = I# (wORD16_SCALE i#)
231− {-# INLINE bytesInArray #-}
232−
233− unsafeIndex (Array len ba#) i@(I# i#) =
234− CHECK_BOUNDS("unsafeIndex",len,i)
235− case indexWord16Array# ba# i# of r# -> (W16# r#)
236− {-# INLINE unsafeIndex #-}
237−
238− unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->
239− CHECK_BOUNDS("unsafeRead",len,i)
240− case readWord16Array# mba# i# s# of
241− (# s2#, r# #) -> (# s2#, W16# r# #)
242− {-# INLINE unsafeRead #-}
243−
244− unsafeWrite (MArray len marr#) i@(I# i#) (W16# e#) = ST $ \s1# ->
245− CHECK_BOUNDS("unsafeWrite",len,i)
246− case writeWord16Array# marr# i# e# s1# of
247− s2# -> (# s2#, () #)
248− {-# INLINE unsafeWrite #-}
249−
250−#elif defined(__HUGS__)
251−
252− bytesInArray n w = sizeOf w * n
253− unsafeIndex = unsafeIndexArray
254− unsafeRead = unsafeReadMArray
255− unsafeWrite = unsafeWriteMArray
256−
257−#endif
109+-- | Indicate how many bytes would be used for an array of the given
110+-- size.
111+bytesInArray :: Int -> Int
112+bytesInArray n = n `shiftL` 1
113+{-# INLINE bytesInArray #-}
114+
115+-- | Unchecked read of an immutable array. May return garbage or
116+-- crash on an out-of-bounds access.
117+unsafeIndex :: Array -> Int -> Word16
118+unsafeIndex (Array len ba#) i@(I# i#) =
119+ CHECK_BOUNDS("unsafeIndex",len,i)
120+ case indexWord16Array# ba# i# of r# -> (W16# r#)
121+{-# INLINE unsafeIndex #-}
122+
123+-- | Unchecked read of a mutable array. May return garbage or
124+-- crash on an out-of-bounds access.
125+unsafeRead :: MArray s -> Int -> ST s Word16
126+unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->
127+ CHECK_BOUNDS("unsafeRead",len,i)
128+ case readWord16Array# mba# i# s# of
129+ (# s2#, r# #) -> (# s2#, W16# r# #)
130+{-# INLINE unsafeRead #-}
131+
132+-- | Unchecked write of a mutable array. May return garbage or crash
133+-- on an out-of-bounds access.
134+unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()
135+unsafeWrite (MArray len marr#) i@(I# i#) (W16# e#) = ST $ \s1# ->
136+ CHECK_BOUNDS("unsafeWrite",len,i)
137+ case writeWord16Array# marr# i# e# s1# of
138+ s2# -> (# s2#, () #)
139+{-# INLINE unsafeWrite #-}
258140
259141-- | Convert an immutable array to a list.
260−toList :: Elt e => Array e -> [e]
142+toList :: Array -> [Word16]
261143toList a = loop 0
262144 where loop i | i < len = unsafeIndex a i : loop (i+1)
263145 | otherwise = []
264146 len = length a
265147
266148-- | An empty immutable array.
267−empty :: Elt e => Array e
149+empty :: Array
268150empty = runST (unsafeNew 0 >>= unsafeFreeze)
269151
270152-- | Run an action in the ST monad and return an immutable array of
271153-- its result.
272−run :: Elt e => (forall s. ST s (MArray s e)) -> Array e
154+run :: (forall s. ST s (MArray s)) -> Array
273155run k = runST (k >>= unsafeFreeze)
274156
275157-- | Run an action in the ST monad and return an immutable array of
276158-- its result paired with whatever else the action returns.
277−run2 :: Elt e => (forall s. ST s (MArray s e, a)) -> (Array e, a)
159+run2 :: (forall s. ST s (MArray s, a)) -> (Array, a)
278160run2 k = runST (do
279161 (marr,b) <- k
280162 arr <- unsafeFreeze marr
@@ -282,8 +164,8 @@ run2 k = runST (do
282164
283165-- | Copy an array in its entirety. The destination array must be at
284166-- least as big as the source.
285−copy :: Elt e => MArray s e -- ^ source array
286− -> MArray s e -- ^ destination array
167+copy :: MArray s -- ^ source array
168+ -> MArray s -- ^ destination array
287169 -> ST s ()
288170copy src dest
289171 | length dest >= length src = copy_loop 0
@@ -297,8 +179,7 @@ copy src dest
297179{-# INLINE copy #-}
298180
299181-- | Unsafely copy the elements of an array.
300−unsafeCopy :: Elt e =>
301− MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
182+unsafeCopy :: MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
302183unsafeCopy src sidx dest didx count =
303184 assert (sidx + count <= length src) .
304185 assert (didx + count <= length dest) $