git.iko.soy/text
on 802c8a8 help sign in
text/Data/Text/Array.hs
237 lines 7.2 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 ) where
40#if defined(__GLASGOW_HASKELL__)
41#include "MachDeps.h"
43import GHC.Base (ByteArray#, MutableByteArray#, indexWord16Array#,
44 newByteArray#, readWord16Array#, unsafeCoerce#,
45 writeWord16Array#, (+#), (*#))
46import GHC.Prim (Int#)
47import GHC.ST (ST(..), runST)
48import GHC.Types (Int(..))
49import GHC.Word (Word16(..))
51#elif defined(__HUGS__)
53import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,
54 newMutableByteArray, readMutableByteArray,
55 unsafeFreezeMutableByteArray, writeMutableByteArray)
56import Foreign.Storable (Storable, sizeOf)
57import Hugs.ST (ST(..), runST)
59#else
60# error not implemented for this compiler
61#endif
63import Data.Typeable (Typeable1(..), Typeable2(..), TyCon, mkTyCon, mkTyConApp)
64import Data.Word (Word16)
65import Prelude hiding (length, read)
67#include "Typeable.h"
69-- | Immutable array type.
70data Array e = Array
71 {-# UNPACK #-} !Int -- length (in units of e, not bytes)
72#if defined(__GLASGOW_HASKELL__)
73 ByteArray#
74#elif defined(__HUGS__)
75 !ByteArray
76#endif
78INSTANCE_TYPEABLE1(Array,arrayTc,"Array")
80-- | Mutable array type, for use in the ST monad.
81data 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)
87#endif
89INSTANCE_TYPEABLE2(MArray,mArrayTc,"MArray")
91-- | Operations supported by all arrays.
92class IArray a where
93 -- | Return the length of an array.
94 length :: a -> Int
96instance IArray (Array e) where
97 length (Array len _ba) = len
98 {-# INLINE length #-}
100instance IArray (MArray s e) where
101 length (MArray len _ba) = len
102 {-# INLINE length #-}
104check :: IArray a => String -> a -> Int -> (a -> Int -> b) -> b
105check func ary i f
106 | i >= 0 && i < length ary = f ary i
107 | otherwise = error ("Data.Array.Flat." ++ func ++ ": index out of bounds")
108{-# INLINE check #-}
110-- | Operations supported by all elements that can be stored in
111-- arrays.
112class Elt e where
113 -- | Indicate how many bytes would be used for an array of the
114 -- given size.
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
127 -- runtime error.
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
133 -- error.
134 read :: Array e -> Int -> ST s e
135 read ary i = check "read" ary i read
136 {-# INLINE read #-}
138 -- | Write a mutable array. An invalid index results in a runtime
139 -- error.
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!
145unsafeFreeze :: MArray s e -> ST s (Array e)
147#if defined(__GLASGOW_HASKELL__)
149wORD16_SCALE :: Int# -> Int#
150wORD16_SCALE n# = scale# *# n# where I# scale# = SIZEOF_WORD16
152-- | Create an uninitialized mutable array.
153unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)
154unsafeNew 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 #-}
160unsafeFreeze (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
165-- given value.
166new :: forall s e. Elt e => Int -> e -> ST s (MArray s e)
168#elif defined(__HUGS__)
170unsafeIndexArray :: Storable e => Array e -> Int -> e
171unsafeIndexArray (Array off _len arr) i = readByteArray arr (off + i)
173unsafeReadMArray :: Storable e => MArray s e -> Int -> ST s e
174unsafeReadMArray (MArray _len marr) = readMutableByteArray marr
176unsafeWriteMArray :: Storable e => MArray s e -> Int -> e -> ST s ()
177unsafeWriteMArray (MArray _len marr) = writeMutableByteArray marr
179-- | Create an uninitialized mutable array.
180unsafeNew :: (Storable e) => Int -> ST s (MArray s e)
181unsafeNew n = new undefined
182 where new :: (Storable e) => e -> ST s (MArray s e)
183 new unused = do
184 marr <- newMutableByteArray (n * sizeOf unused)
185 return (MArray n marr)
187unsafeFreeze (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
192-- given value.
193new :: (Storable e) => Int -> e -> ST s (MArray s e)
194#endif
196new len initVal = do
197 marr <- unsafeNew len
198 sequence_ [unsafeWrite marr i initVal | i <- [0..len-1]]
199 return marr
201instance 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
228#endif
230-- | An empty immutable array.
231empty :: Elt e => Array e
232empty = runST (unsafeNew 0 >>= unsafeFreeze)
234-- | Run an action in the ST monad and return an immutable array of
235-- its result.
236run :: Elt e => (forall s. ST s (MArray s e)) -> Array e
237run k = runST (k >>= unsafeFreeze)