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