on master help sign in
Extend the Data.Text.Array API and add assertions.
92bb005Bryan O'Sullivan
Data/Text/Array.hs+45−4
@@ -1,5 +1,5 @@
1−{-# LANGUAGE CPP, ExistentialQuantification, MagicHash, Rank2Types,
1+{-# LANGUAGE BangPatterns, CPP, ExistentialQuantification, MagicHash,
2− ScopedTypeVariables, UnboxedTuples #-}
2+ Rank2Types, ScopedTypeVariables, UnboxedTuples #-}
3-- |
3-- |
4-- Module : Data.Text.Array
4-- Module : Data.Text.Array
5-- Copyright : (c) Bryan O'Sullivan 2009
5-- Copyright : (c) Bryan O'Sullivan 2009
@@ -35,7 +35,10 @@ module Data.Text.Array
35 , unsafeNew
35 , unsafeNew
36 , unsafeFreeze
36 , unsafeFreeze
37 , run
37 , run
38+ , run2
38 , toList
39 , toList
40+ , copy
41+ , unsafeCopy
39 ) where
42 ) where
40
43
41#if 0
44#if 0
@@ -61,7 +64,6 @@ import GHC.Word (Word16(..))
61
64
62#elif defined(__HUGS__)
65#elif defined(__HUGS__)
63
66
64−import Control.Exception (assert)
65import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,
67import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,
66 newMutableByteArray, readMutableByteArray,
68 newMutableByteArray, readMutableByteArray,
67 unsafeFreezeMutableByteArray, writeMutableByteArray)
69 unsafeFreezeMutableByteArray, writeMutableByteArray)
@@ -72,6 +74,7 @@ import Hugs.ST (ST(..), runST)
72# error not implemented for this compiler
74# error not implemented for this compiler
73#endif
75#endif
74
76
77+import Control.Exception (assert)
75import Data.Typeable (Typeable1(..), Typeable2(..), TyCon, mkTyCon, mkTyConApp)
78import Data.Typeable (Typeable1(..), Typeable2(..), TyCon, mkTyCon, mkTyConApp)
76import Data.Word (Word16)
79import Data.Word (Word16)
77import Prelude hiding (length, read)
80import Prelude hiding (length, read)
@@ -169,7 +172,7 @@ wORD16_SCALE n# = scale# *# n# where I# scale# = SIZEOF_WORD16
169
172
170-- | Create an uninitialized mutable array.
173-- | Create an uninitialized mutable array.
171unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)
174unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)
172−unsafeNew n = ST $ \s1# ->
175+unsafeNew n = assert (n >= 0) . ST $ \s1# ->
173 case bytesInArray n (undefined :: e) of
176 case bytesInArray n (undefined :: e) of
174 len@(I# len#) ->
177 len@(I# len#) ->
175#if defined(BOUNDS_CHECKING)
178#if defined(BOUNDS_CHECKING)
@@ -302,3 +305,41 @@ empty = runST (unsafeNew 0 >>= unsafeFreeze)
302-- its result.
305-- its result.
303run :: Elt e => (forall s. ST s (MArray s e)) -> Array e
306run :: Elt e => (forall s. ST s (MArray s e)) -> Array e
304run k = runST (k >>= unsafeFreeze)
307run k = runST (k >>= unsafeFreeze)
308+
309+-- | Run an action in the ST monad and return an immutable array of
310+-- its result paired with whatever else the action returns.
311+run2 :: Elt e => (forall s. ST s (MArray s e, a)) -> (Array e, a)
312+run2 k = runST (do
313+ (marr,b) <- k
314+ arr <- unsafeFreeze marr
315+ return (arr,b))
316+
317+-- | Copy an array in its entirety. The destination array must be at
318+-- least as big as the source.
319+copy :: Elt e => MArray s e -- ^ source array
320+ -> MArray s e -- ^ destination array
321+ -> ST s ()
322+copy 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 #-}
332+
333+-- | Unsafely copy the elements of an array.
334+unsafeCopy :: Elt e =>
335+ MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
336+unsafeCopy 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 #-}