@@ -0,0 +1,237 @@
1+{-# LANGUAGE CPP, ExistentialQuantification, MagicHash, Rank2Types,
2+ ScopedTypeVariables, UnboxedTuples #-}
4+-- Module : Data.Text.Array
5+-- Copyright : (c) Bryan O'Sullivan 2009
8+-- Maintainer : bos@serpentine.com,
9+-- Stability : experimental
10+-- Portability : portable
12+-- Packed, unboxed, heap-resident arrays. Suitable for performance
13+-- critical use, both in terms of large data quantities and high
16+-- This module is intended to be imported @qualified@, to avoid name
17+-- clashes with "Prelude" functions, e.g.
19+-- > import qualified Data.Text.Array as A
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
24+module Data.Text.Array
40+#if defined(__GLASGOW_HASKELL__)
43+import GHC.Base (ByteArray#, MutableByteArray#, indexWord16Array#,
44+ newByteArray#, readWord16Array#, unsafeCoerce#,
45+ writeWord16Array#, (+#), (*#))
46+import GHC.Prim (Int#)
47+import GHC.ST (ST(..), runST)
48+import GHC.Types (Int(..))
49+import GHC.Word (Word16(..))
51+#elif defined(__HUGS__)
53+import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,
54+ newMutableByteArray, readMutableByteArray,
55+ unsafeFreezeMutableByteArray, writeMutableByteArray)
56+import Foreign.Storable (Storable, sizeOf)
57+import Hugs.ST (ST(..), runST)
60+# error not implemented for this compiler
64+import Data.Word (Word16)
65+import Prelude hiding (length, read)
69+-- | Immutable array type.
71+ {-# UNPACK #-} !Int -- length (in units of e, not bytes)
72+#if defined(__GLASGOW_HASKELL__)
74+#elif defined(__HUGS__)
78+INSTANCE_TYPEABLE1(Array,arrayTc,"Array")
80+-- | Mutable array type, for use in the ST monad.
81+data MArray s e = MArray
82+ {-# UNPACK #-} !Int -- length (in units of e, not bytes)
83+#if defined(__GLASGOW_HASKELL__)
84+ (MutableByteArray# s)
85+#elif defined(__HUGS__)
86+ !(MutableByteArray s)
89+INSTANCE_TYPEABLE2(MArray,mArrayTc,"MArray")
91+-- | Operations supported by all arrays.
93+ -- | Return the length of an array.
96+instance IArray (Array e) where
97+ length (Array len _ba) = len
98+ {-# INLINE length #-}
100+instance IArray (MArray s e) where
101+ length (MArray len _ba) = len
102+ {-# INLINE length #-}
104+check :: IArray a => String -> a -> Int -> (a -> Int -> b) -> b
106+ | i >= 0 && i < length ary = f ary i
107+ | otherwise = error ("Data.Array.Flat." ++ func ++ ": index out of bounds")
110+-- | Operations supported by all elements that can be stored in
113+ -- | Indicate how many bytes would be used for an array of the
115+ bytesInArray :: Int -> e -> Int
116+ -- | Unchecked read of an immutable array. May return garbage or
117+ -- crash on an out-of-bounds access.
118+ unsafeIndex :: Array e -> Int -> e
119+ -- | Unchecked read of a mutable array. May return garbage or
120+ -- crash on an out-of-bounds access.
121+ unsafeRead :: MArray s e -> Int -> ST s e
122+ -- | Unchecked write of a mutable array. May return garbage or
123+ -- crash on an out-of-bounds access.
124+ unsafeWrite :: MArray s e -> Int -> e -> ST s ()
126+ -- | Read an immutable array. An invalid index results in a
128+ index :: Array e -> Int -> e
129+ index ary i = check "index" ary i unsafeIndex
130+ {-# INLINE index #-}
132+ -- | Read a mutable array. An invalid index results in a runtime
134+ read :: Array e -> Int -> ST s e
135+ read ary i = check "read" ary i read
138+ -- | Write a mutable array. An invalid index results in a runtime
140+ write :: Array e -> Int -> ST s e
141+ write ary i = check "write" ary i write
142+ {-# INLINE write #-}
144+-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
145+unsafeFreeze :: MArray s e -> ST s (Array e)
147+#if defined(__GLASGOW_HASKELL__)
149+wORD16_SCALE :: Int# -> Int#
150+wORD16_SCALE n# = scale# *# n# where I# scale# = SIZEOF_WORD16
152+-- | Create an uninitialized mutable array.
153+unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)
154+unsafeNew n = ST $ \s1# ->
155+ case bytesInArray n (undefined :: e) of
156+ (I# len#) -> case newByteArray# len# s1# of
157+ (# s2#, marr# #) -> (# s2#, MArray n marr# #)
158+{-# INLINE unsafeNew #-}
160+unsafeFreeze (MArray len mba#) = ST $ \s# ->
161+ (# s#, Array len (unsafeCoerce# mba#) #)
162+{-# INLINE unsafeFreeze #-}
164+-- | Create a mutable array, with its elements initialized with the
166+new :: forall s e. Elt e => Int -> e -> ST s (MArray s e)
168+#elif defined(__HUGS__)
170+unsafeIndexArray :: Storable e => Array e -> Int -> e
171+unsafeIndexArray (Array off _len arr) i = readByteArray arr (off + i)
173+unsafeReadMArray :: Storable e => MArray s e -> Int -> ST s e
174+unsafeReadMArray (MArray _len marr) = readMutableByteArray marr
176+unsafeWriteMArray :: Storable e => MArray s e -> Int -> e -> ST s ()
177+unsafeWriteMArray (MArray _len marr) = writeMutableByteArray marr
179+-- | Create an uninitialized mutable array.
180+unsafeNew :: (Storable e) => Int -> ST s (MArray s e)
181+unsafeNew n = new undefined
182+ where new :: (Storable e) => e -> ST s (MArray s e)
184+ marr <- newMutableByteArray (n * sizeOf unused)
185+ return (MArray n marr)
187+unsafeFreeze (MArray len mba) = do
188+ ba <- unsafeFreezeMutableByteArray mba
189+ return (Array 0 len ba)
191+-- | Create a mutable array, with its elements initialized with the
193+new :: (Storable e) => Int -> e -> ST s (MArray s e)
197+ marr <- unsafeNew len
198+ sequence_ [unsafeWrite marr i initVal | i <- [0..len-1]]
201+instance Elt Word16 where
202+#if defined(__GLASGOW_HASKELL__)
204+ bytesInArray (I# i#) _ = I# (wORD16_SCALE i#)
205+ {-# INLINE bytesInArray #-}
207+ unsafeIndex (Array _len ba#) (I# i#) =
208+ case indexWord16Array# ba# i# of r# -> (W16# r#)
209+ {-# INLINE unsafeIndex #-}
211+ unsafeRead (MArray _len mba#) (I# i#) = ST $ \s# ->
212+ case readWord16Array# mba# i# s# of
213+ (# s2#, r# #) -> (# s2#, W16# r# #)
214+ {-# INLINE unsafeRead #-}
216+ unsafeWrite (MArray _len marr#) (I# i#) (W16# e#) = ST $ \s1# ->
217+ case writeWord16Array# marr# i# e# s1# of
218+ s2# -> (# s2#, () #)
219+ {-# INLINE unsafeWrite #-}
221+#elif defined(__HUGS__)
223+ bytesInArray n w = sizeOf w * n
224+ unsafeIndex = unsafeIndexArray
225+ unsafeRead = unsafeReadMArray
226+ unsafeWrite = unsafeWriteMArray
230+-- | An empty immutable array.
231+empty :: Elt e => Array e
232+empty = runST (unsafeNew 0 >>= unsafeFreeze)
234+-- | Run an action in the ST monad and return an immutable array of
236+run :: Elt e => (forall s. ST s (MArray s e)) -> Array e
237+run k = runST (k >>= unsafeFreeze)