@@ -37,6 +37,16 @@ module Data.Text.Array
3737 , run
3838 ) where
3939
40+#if 0
41+#define BOUNDS_CHECKING
42+-- This fugly hack is brought by GHC's apparent reluctance to deal
43+-- with MagicHash and UnboxedTuples when inferring types. Eek!
44+#define CHECK_BOUNDS(_func_,_len_,_k_) \
45+if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else
46+#else
47+#define CHECK_BOUNDS(_func_,_len_,_k_)
48+#endif
49+
4050#if defined(__GLASGOW_HASKELL__)
4151#include "MachDeps.h"
4252
@@ -49,6 +59,7 @@ import GHC.Word (Word16(..))
4959
5060#elif defined(__HUGS__)
5161
62+import Control.Exception (assert)
5263import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,
5364 newMutableByteArray, readMutableByteArray,
5465 unsafeFreezeMutableByteArray, writeMutableByteArray)
@@ -152,8 +163,12 @@ wORD16_SCALE n# = scale# *# n# where I# scale# = SIZEOF_WORD16
152163unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)
153164unsafeNew n = ST $ \s1# ->
154165 case bytesInArray n (undefined :: e) of
155− (I# len#) -> case newByteArray# len# s1# of
156− (# s2#, marr# #) -> (# s2#, MArray n marr# #)
166+ len@(I# len#) ->
167+#if defined(BOUNDS_CHECKING)
168+ if len < 0 then error (show ("unsafeNew",len)) else
169+#endif
170+ case newByteArray# len# s1# of
171+ (# s2#, marr# #) -> (# s2#, MArray n marr# #)
157172{-# INLINE unsafeNew #-}
158173
159174unsafeFreeze (MArray len mba#) = ST $ \s# ->
@@ -167,13 +182,16 @@ new :: forall s e. Elt e => Int -> e -> ST s (MArray s e)
167182#elif defined(__HUGS__)
168183
169184unsafeIndexArray :: Storable e => Array e -> Int -> e
170−unsafeIndexArray (Array off _len arr) i = readByteArray arr (off + i)
185+unsafeIndexArray (Array off len arr) i =
186+ assert (i >= 0 && i < len) $ readByteArray arr (off + i)
171187
172188unsafeReadMArray :: Storable e => MArray s e -> Int -> ST s e
173−unsafeReadMArray (MArray _len marr) = readMutableByteArray marr
189+unsafeReadMArray (MArray _len marr) i =
190+ assert (i >= 0 && i < len) $ readMutableByteArray marr
174191
175192unsafeWriteMArray :: Storable e => MArray s e -> Int -> e -> ST s ()
176−unsafeWriteMArray (MArray _len marr) = writeMutableByteArray marr
193+unsafeWriteMArray (MArray len marr) i =
194+ assert (i >= 0 && i < len) $ writeMutableByteArray marr
177195
178196-- | Create an uninitialized mutable array.
179197unsafeNew :: (Storable e) => Int -> ST s (MArray s e)
@@ -203,16 +221,19 @@ instance Elt Word16 where
203221 bytesInArray (I# i#) _ = I# (wORD16_SCALE i#)
204222 {-# INLINE bytesInArray #-}
205223
206− unsafeIndex (Array _len ba#) (I# i#) =
224+ unsafeIndex (Array len ba#) i@(I# i#) =
225+ CHECK_BOUNDS("unsafeIndex",len,i)
207226 case indexWord16Array# ba# i# of r# -> (W16# r#)
208227 {-# INLINE unsafeIndex #-}
209228
210− unsafeRead (MArray _len mba#) (I# i#) = ST $ \s# ->
229+ unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->
230+ CHECK_BOUNDS("unsafeRead",len,i)
211231 case readWord16Array# mba# i# s# of
212232 (# s2#, r# #) -> (# s2#, W16# r# #)
213233 {-# INLINE unsafeRead #-}
214234
215− unsafeWrite (MArray _len marr#) (I# i#) (W16# e#) = ST $ \s1# ->
235+ unsafeWrite (MArray len marr#) i@(I# i#) (W16# e#) = ST $ \s1# ->
236+ CHECK_BOUNDS("unsafeWrite",len,i)
216237 case writeWord16Array# marr# i# e# s1# of
217238 s2# -> (# s2#, () #)
218239 {-# INLINE unsafeWrite #-}