git.iko.soy/text
on 9c141bc help sign in
text/Data/Text/Array.hs
250 lines 8.0 kB history raw
1{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash, Rank2Types,
2 RecordWildCards, UnboxedTuples, UnliftedFFITypes #-}
3{-# OPTIONS_GHC -fno-warn-unused-matches #-}
4-- |
5-- Module : Data.Text.Array
6-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
7--
8-- License : BSD-style
9-- Maintainer : bos@serpentine.com
10-- Stability : experimental
11-- Portability : portable
12--
13-- Packed, unboxed, heap-resident arrays. Suitable for performance
14-- critical use, both in terms of large data quantities and high
15-- speed.
16--
17-- This module is intended to be imported @qualified@, to avoid name
18-- clashes with "Prelude" functions, e.g.
19--
20-- > import qualified Data.Text.Array as A
21--
22-- The names in this module resemble those in the 'Data.Array' family
23-- of modules, but are shorter due to the assumption of qualified
24-- naming.
25module Data.Text.Array
26 (
27 -- * Types
28 Array(Array, aBA)
29 , MArray(MArray, maBA)
31 -- * Functions
32 , copyM
33 , copyI
34 , empty
35 , equal
36#if defined(ASSERTS)
37 , length
38#endif
39 , run
40 , run2
41 , toList
42 , unsafeFreeze
43 , unsafeIndex
44 , new
45 , unsafeWrite
46 ) where
48#if defined(ASSERTS)
49-- This fugly hack is brought by GHC's apparent reluctance to deal
50-- with MagicHash and UnboxedTuples when inferring types. Eek!
51# define CHECK_BOUNDS(_func_,_len_,_k_) \
52if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else
53#else
54# define CHECK_BOUNDS(_func_,_len_,_k_)
55#endif
57#include "MachDeps.h"
59#if defined(ASSERTS)
60import Control.Exception (assert)
61#endif
62#if __GLASGOW_HASKELL__ >= 702
63import Control.Monad.ST.Unsafe (unsafeIOToST)
64#else
65import Control.Monad.ST (unsafeIOToST)
66#endif
67import Data.Bits ((.&.), xor)
68import Data.Text.Internal.Unsafe (inlinePerformIO)
69import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
70#if __GLASGOW_HASKELL__ >= 703
71import Foreign.C.Types (CInt(CInt), CSize(CSize))
72#else
73import Foreign.C.Types (CInt, CSize)
74#endif
75import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
76 indexWord16Array#, newByteArray#,
77 unsafeFreezeByteArray#, writeWord16Array#)
78import GHC.ST (ST(..), runST)
79import GHC.Word (Word16(..))
80import Prelude hiding (length, read)
82-- | Immutable array type.
83--
84-- The 'Array' constructor is exposed since @text-1.1.1.3@
85data Array = Array {
86 aBA :: ByteArray#
87#if defined(ASSERTS)
88 , aLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
89#endif
90 }
92-- | Mutable array type, for use in the ST monad.
93--
94-- The 'MArray' constructor is exposed since @text-1.1.1.3@
95data MArray s = MArray {
96 maBA :: MutableByteArray# s
97#if defined(ASSERTS)
98 , maLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
99#endif
100 }
102#if defined(ASSERTS)
103-- | Operations supported by all arrays.
104class IArray a where
105 -- | Return the length of an array.
106 length :: a -> Int
108instance IArray Array where
109 length = aLen
110 {-# INLINE length #-}
112instance IArray (MArray s) where
113 length = maLen
114 {-# INLINE length #-}
115#endif
117-- | Create an uninitialized mutable array.
118new :: forall s. Int -> ST s (MArray s)
119new n
120 | n < 0 || n .&. highBit /= 0 = array_size_error
121 | otherwise = ST $ \s1# ->
122 case newByteArray# len# s1# of
123 (# s2#, marr# #) -> (# s2#, MArray marr#
124#if defined(ASSERTS)
125 n
126#endif
127 #)
128 where !(I# len#) = bytesInArray n
129 highBit = maxBound `xor` (maxBound `shiftR` 1)
130{-# INLINE new #-}
132array_size_error :: a
133array_size_error = error "Data.Text.Array.new: size overflow"
135-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
136unsafeFreeze :: MArray s -> ST s Array
137unsafeFreeze MArray{..} = ST $ \s1# ->
138 case unsafeFreezeByteArray# maBA s1# of
139 (# s2#, ba# #) -> (# s2#, Array ba#
140#if defined(ASSERTS)
141 maLen
142#endif
143 #)
144{-# INLINE unsafeFreeze #-}
146-- | Indicate how many bytes would be used for an array of the given
147-- size.
148bytesInArray :: Int -> Int
149bytesInArray n = n `shiftL` 1
150{-# INLINE bytesInArray #-}
152-- | Unchecked read of an immutable array. May return garbage or
153-- crash on an out-of-bounds access.
154unsafeIndex :: Array -> Int -> Word16
155unsafeIndex Array{..} i@(I# i#) =
156 CHECK_BOUNDS("unsafeIndex",aLen,i)
157 case indexWord16Array# aBA i# of r# -> (W16# r#)
158{-# INLINE unsafeIndex #-}
160-- | Unchecked write of a mutable array. May return garbage or crash
161-- on an out-of-bounds access.
162unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()
163unsafeWrite MArray{..} i@(I# i#) (W16# e#) = ST $ \s1# ->
164 CHECK_BOUNDS("unsafeWrite",maLen,i)
165 case writeWord16Array# maBA i# e# s1# of
166 s2# -> (# s2#, () #)
167{-# INLINE unsafeWrite #-}
169-- | Convert an immutable array to a list.
170toList :: Array -> Int -> Int -> [Word16]
171toList ary off len = loop 0
172 where loop i | i < len = unsafeIndex ary (off+i) : loop (i+1)
173 | otherwise = []
175-- | An empty immutable array.
176empty :: Array
177empty = runST (new 0 >>= unsafeFreeze)
179-- | Run an action in the ST monad and return an immutable array of
180-- its result.
181run :: (forall s. ST s (MArray s)) -> Array
182run k = runST (k >>= unsafeFreeze)
184-- | Run an action in the ST monad and return an immutable array of
185-- its result paired with whatever else the action returns.
186run2 :: (forall s. ST s (MArray s, a)) -> (Array, a)
187run2 k = runST (do
188 (marr,b) <- k
189 arr <- unsafeFreeze marr
190 return (arr,b))
191{-# INLINE run2 #-}
193-- | Copy some elements of a mutable array.
194copyM :: MArray s -- ^ Destination
195 -> Int -- ^ Destination offset
196 -> MArray s -- ^ Source
197 -> Int -- ^ Source offset
198 -> Int -- ^ Count
199 -> ST s ()
200copyM dest didx src sidx count
201 | count <= 0 = return ()
202 | otherwise =
203#if defined(ASSERTS)
204 assert (sidx + count <= length src) .
205 assert (didx + count <= length dest) .
206#endif
207 unsafeIOToST $ memcpyM (maBA dest) (fromIntegral didx)
208 (maBA src) (fromIntegral sidx)
209 (fromIntegral count)
210{-# INLINE copyM #-}
212-- | Copy some elements of an immutable array.
213copyI :: MArray s -- ^ Destination
214 -> Int -- ^ Destination offset
215 -> Array -- ^ Source
216 -> Int -- ^ Source offset
217 -> Int -- ^ First offset in destination /not/ to
218 -- copy (i.e. /not/ length)
219 -> ST s ()
220copyI dest i0 src j0 top
221 | i0 >= top = return ()
222 | otherwise = unsafeIOToST $
223 memcpyI (maBA dest) (fromIntegral i0)
224 (aBA src) (fromIntegral j0)
225 (fromIntegral (top-i0))
226{-# INLINE copyI #-}
228-- | Compare portions of two arrays for equality. No bounds checking
229-- is performed.
230equal :: Array -- ^ First
231 -> Int -- ^ Offset into first
232 -> Array -- ^ Second
233 -> Int -- ^ Offset into second
234 -> Int -- ^ Count
235 -> Bool
236equal arrA offA arrB offB count = inlinePerformIO $ do
237 i <- memcmp (aBA arrA) (fromIntegral offA)
238 (aBA arrB) (fromIntegral offB) (fromIntegral count)
239 return $! i == 0
240{-# INLINE equal #-}
242foreign import ccall unsafe "_hs_text_memcpy" memcpyI
243 :: MutableByteArray# s -> CSize -> ByteArray# -> CSize -> CSize -> IO ()
245foreign import ccall unsafe "_hs_text_memcmp" memcmp
246 :: ByteArray# -> CSize -> ByteArray# -> CSize -> CSize -> IO CInt
248foreign import ccall unsafe "_hs_text_memcpy" memcpyM
249 :: MutableByteArray# s -> CSize -> MutableByteArray# s -> CSize -> CSize
250 -> IO ()