1{-# LANGUAGE BangPatterns, CPP, 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-- 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 qualified
23-- naming.
24module Data.Text.Array
25    (
26    -- * Types
27      Array(Array, aBA)
28    , MArray(MArray, maBA)
29
30    -- * Functions
31    , copyM
32    , copyI
33    , empty
34    , equal
35#if defined(ASSERTS)
36    , length
37#endif
38    , run
39    , run2
40    , toList
41    , unsafeFreeze
42    , unsafeIndex
43    , new
44    , unsafeWrite
45    ) where
46
47#if defined(ASSERTS)
48-- This fugly hack is brought by GHC's apparent reluctance to deal
49-- with MagicHash and UnboxedTuples when inferring types. Eek!
50# define CHECK_BOUNDS(_func_,_len_,_k_) \
51if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else
52#else
53# define CHECK_BOUNDS(_func_,_len_,_k_)
54#endif
55
56#include "MachDeps.h"
57
58#if defined(ASSERTS)
59import Control.Exception (assert)
60#endif
61#if MIN_VERSION_base(4,4,0)
62import Control.Monad.ST.Unsafe (unsafeIOToST)
63#else
64import Control.Monad.ST (unsafeIOToST)
65#endif
66import Data.Bits ((.&.), xor)
67import Data.Text.Internal.Unsafe (inlinePerformIO)
68import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
69#if MIN_VERSION_base(4,5,0)
70import Foreign.C.Types (CInt(CInt), CSize(CSize))
71#else
72import Foreign.C.Types (CInt, CSize)
73#endif
74import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
75                 indexWord16Array#, newByteArray#,
76                 unsafeFreezeByteArray#, writeWord16Array#)
77import GHC.ST (ST(..), runST)
78import GHC.Word (Word16(..))
79import Prelude hiding (length, read)
80
81-- | Immutable array type.
82--
83-- The 'Array' constructor is exposed since @text-1.1.1.3@
84data Array = Array {
85      aBA :: ByteArray#
86#if defined(ASSERTS)
87    , aLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
88#endif
89    }
90
91-- | Mutable array type, for use in the ST monad.
92--
93-- The 'MArray' constructor is exposed since @text-1.1.1.3@
94data MArray s = MArray {
95      maBA :: MutableByteArray# s
96#if defined(ASSERTS)
97    , maLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
98#endif
99    }
100
101#if defined(ASSERTS)
102-- | Operations supported by all arrays.
103class IArray a where
104    -- | Return the length of an array.
105    length :: a -> Int
106
107instance IArray Array where
108    length = aLen
109    {-# INLINE length #-}
110
111instance IArray (MArray s) where
112    length = maLen
113    {-# INLINE length #-}
114#endif
115
116-- | Create an uninitialized mutable array.
117new :: forall s. Int -> ST s (MArray s)
118new n
119  | n < 0 || n .&. highBit /= 0 = array_size_error
120  | otherwise = ST $ \s1# ->
121       case newByteArray# len# s1# of
122         (# s2#, marr# #) -> (# s2#, MArray marr#
123#if defined(ASSERTS)
124                                n
125#endif
126                                #)
127  where !(I# len#) = bytesInArray n
128        highBit    = maxBound `xor` (maxBound `shiftR` 1)
129{-# INLINE new #-}
130
131array_size_error :: a
132array_size_error = error "Data.Text.Array.new: size overflow"
133
134-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
135unsafeFreeze :: MArray s -> ST s Array
136unsafeFreeze MArray{..} = ST $ \s1# ->
137    case unsafeFreezeByteArray# maBA s1# of
138        (# s2#, ba# #) -> (# s2#, Array ba#
139#if defined(ASSERTS)
140                             maLen
141#endif
142                             #)
143{-# INLINE unsafeFreeze #-}
144
145-- | Indicate how many bytes would be used for an array of the given
146-- size.
147bytesInArray :: Int -> Int
148bytesInArray n = n `shiftL` 1
149{-# INLINE bytesInArray #-}
150
151-- | Unchecked read of an immutable array.  May return garbage or
152-- crash on an out-of-bounds access.
153unsafeIndex :: Array -> Int -> Word16
154unsafeIndex Array{..} i@(I# i#) =
155  CHECK_BOUNDS("unsafeIndex",aLen,i)
156    case indexWord16Array# aBA i# of r# -> (W16# r#)
157{-# INLINE unsafeIndex #-}
158
159-- | Unchecked write of a mutable array.  May return garbage or crash
160-- on an out-of-bounds access.
161unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()
162unsafeWrite MArray{..} i@(I# i#) (W16# e#) = ST $ \s1# ->
163  CHECK_BOUNDS("unsafeWrite",maLen,i)
164  case writeWord16Array# maBA i# e# s1# of
165    s2# -> (# s2#, () #)
166{-# INLINE unsafeWrite #-}
167
168-- | Convert an immutable array to a list.
169toList :: Array -> Int -> Int -> [Word16]
170toList ary off len = loop 0
171    where loop i | i < len   = unsafeIndex ary (off+i) : loop (i+1)
172                 | otherwise = []
173
174-- | An empty immutable array.
175empty :: Array
176empty = runST (new 0 >>= unsafeFreeze)
177
178-- | Run an action in the ST monad and return an immutable array of
179-- its result.
180run :: (forall s. ST s (MArray s)) -> Array
181run k = runST (k >>= unsafeFreeze)
182
183-- | Run an action in the ST monad and return an immutable array of
184-- its result paired with whatever else the action returns.
185run2 :: (forall s. ST s (MArray s, a)) -> (Array, a)
186run2 k = runST (do
187                 (marr,b) <- k
188                 arr <- unsafeFreeze marr
189                 return (arr,b))
190{-# INLINE run2 #-}
191
192-- | Copy some elements of a mutable array.
193copyM :: MArray s               -- ^ Destination
194      -> Int                    -- ^ Destination offset
195      -> MArray s               -- ^ Source
196      -> Int                    -- ^ Source offset
197      -> Int                    -- ^ Count
198      -> ST s ()
199copyM dest didx src sidx count
200    | count <= 0 = return ()
201    | otherwise =
202#if defined(ASSERTS)
203    assert (sidx + count <= length src) .
204    assert (didx + count <= length dest) .
205#endif
206    unsafeIOToST $ memcpyM (maBA dest) (fromIntegral didx)
207                           (maBA src) (fromIntegral sidx)
208                           (fromIntegral count)
209{-# INLINE copyM #-}
210
211-- | Copy some elements of an immutable array.
212copyI :: MArray s               -- ^ Destination
213      -> Int                    -- ^ Destination offset
214      -> Array                  -- ^ Source
215      -> Int                    -- ^ Source offset
216      -> Int                    -- ^ First offset in destination /not/ to
217                                -- copy (i.e. /not/ length)
218      -> ST s ()
219copyI dest i0 src j0 top
220    | i0 >= top = return ()
221    | otherwise = unsafeIOToST $
222                  memcpyI (maBA dest) (fromIntegral i0)
223                          (aBA src) (fromIntegral j0)
224                          (fromIntegral (top-i0))
225{-# INLINE copyI #-}
226
227-- | Compare portions of two arrays for equality.  No bounds checking
228-- is performed.
229equal :: Array                  -- ^ First
230      -> Int                    -- ^ Offset into first
231      -> Array                  -- ^ Second
232      -> Int                    -- ^ Offset into second
233      -> Int                    -- ^ Count
234      -> Bool
235equal arrA offA arrB offB count = inlinePerformIO $ do
236  i <- memcmp (aBA arrA) (fromIntegral offA)
237                     (aBA arrB) (fromIntegral offB) (fromIntegral count)
238  return $! i == 0
239{-# INLINE equal #-}
240
241foreign import ccall unsafe "_hs_text_memcpy" memcpyI
242    :: MutableByteArray# s -> CSize -> ByteArray# -> CSize -> CSize -> IO ()
243
244foreign import ccall unsafe "_hs_text_memcmp" memcmp
245    :: ByteArray# -> CSize -> ByteArray# -> CSize -> CSize -> IO CInt
246
247foreign import ccall unsafe "_hs_text_memcpy" memcpyM
248    :: MutableByteArray# s -> CSize -> MutableByteArray# s -> CSize -> CSize
249    -> IO ()
250