« back to all changes in this revision
Viewing changes to Data/Text/Array.hs
- browse files at revision 6
- compare with another revision
- download diff
- download tarball
- view history from revision 6
- Committer: Bazaar Package Importer
- Author(s): Joachim Breitner
- Date: 2011-04-13 11:38:29 UTC
- mfrom: (4.1.3 sid)
- Revision ID: james.westby@ubuntu.com-20110413113829-f4ss61ivg720e5bu
Tags: 0.11.0.6-1
New upstream release
- files added:
- Data/Text/Lazy/Builder.hs
- tests/benchmarks
- files removed:
- README
- files modified:
- Data/Text.hs
added
removed
Data/Text/Array.hs
1
{-# LANGUAGE BangPatterns, CPP, ExistentialQuantification, MagicHash,
2
Rank2Types, ScopedTypeVariables, UnboxedTuples #-}
1
{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, RecordWildCards,
2
UnboxedTuples #-}
3
3
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
4
4
-- |
5
5
-- Module : Data.Text.Array
6
-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
6
7
--
7
8
-- License : BSD-style
9
-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,
8
10
-- duncan@haskell.org
9
11
-- Stability : experimental
10
12
-- Portability : portable
26
26
module Data.Text.Array
27
27
(
28
28
-- * Types
29
IArray(..)
30
, Elt(..)
31
, Array
32
, MArray
29
Array(aBA)
30
, MArray(maBA)
33
31
34
32
-- * Functions
33
, copyM
34
, copyI
35
35
, empty
36
, new
37
, unsafeNew
38
, unsafeFreeze
36
, equal
37
#if defined(ASSERTS)
38
, length
39
#endif
39
40
, run
40
41
, run2
41
42
, toList
42
, copy
43
, unsafeCopy
43
, unsafeFreeze
44
, unsafeIndex
45
, new
46
, unsafeWrite
44
47
) where
45
48
46
#if 0
47
#define BOUNDS_CHECKING
49
#if defined(ASSERTS)
48
50
-- This fugly hack is brought by GHC's apparent reluctance to deal
49
51
-- with MagicHash and UnboxedTuples when inferring types. Eek!
50
#define CHECK_BOUNDS(_func_,_len_,_k_) \
52
# define CHECK_BOUNDS(_func_,_len_,_k_) \
51
53
if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else
52
54
#else
53
#define CHECK_BOUNDS(_func_,_len_,_k_)
55
# define CHECK_BOUNDS(_func_,_len_,_k_)
54
56
#endif
55
57
56
#if defined(__GLASGOW_HASKELL__)
57
58
#include "MachDeps.h"
58
59
60
#if defined(ASSERTS)
61
import Control.Exception (assert)
62
#endif
63
import Data.Bits ((.&.), xor)
64
import Data.Text.UnsafeShift (shiftL, shiftR)
59
65
import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
60
indexWord16Array#, newByteArray#,
61
readWord16Array#, unsafeCoerce#,
62
writeWord16Array#, (*#))
63
import GHC.Prim (Int#)
66
indexWord16Array#, indexWordArray#, newByteArray#,
67
readWord16Array#, readWordArray#, unsafeCoerce#,
68
writeWord16Array#, writeWordArray#)
64
69
import GHC.ST (ST(..), runST)
65
import GHC.Word (Word16(..))
66
67
#elif defined(__HUGS__)
68
69
import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,
70
newMutableByteArray, readMutableByteArray,
71
unsafeFreezeMutableByteArray, writeMutableByteArray)
72
import Foreign.Storable (Storable, sizeOf)
73
import Hugs.ST (ST(..), runST)
74
75
#else
76
# error not implemented for this compiler
77
#endif
78
79
import Control.Exception (assert)
80
import Data.Typeable (Typeable1(..), Typeable2(..), TyCon, mkTyCon, mkTyConApp)
70
import GHC.Word (Word16(..), Word(..))
81
71
import Prelude hiding (length, read)
82
72
83
#include "Typeable.h"
84
85
73
-- | Immutable array type.
86
data Array e = Array
87
{-# UNPACK #-} !Int -- length (in units of e, not bytes)
88
#if defined(__GLASGOW_HASKELL__)
89
ByteArray#
90
#elif defined(__HUGS__)
91
!ByteArray
74
data Array = Array {
75
aBA :: ByteArray#
76
#if defined(ASSERTS)
77
, aLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
92
78
#endif
93
94
INSTANCE_TYPEABLE1(Array,arrayTc,"Array")
79
}
95
80
96
81
-- | Mutable array type, for use in the ST monad.
97
data MArray s e = MArray
98
{-# UNPACK #-} !Int -- length (in units of e, not bytes)
99
#if defined(__GLASGOW_HASKELL__)
100
(MutableByteArray# s)
101
#elif defined(__HUGS__)
102
!(MutableByteArray s)
82
data MArray s = MArray {
83
maBA :: MutableByteArray# s
84
#if defined(ASSERTS)
85
, maLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
103
86
#endif
104
105
INSTANCE_TYPEABLE2(MArray,mArrayTc,"MArray")
106
87
}
88
89
#if defined(ASSERTS)
107
90
-- | Operations supported by all arrays.
108
91
class IArray a where
109
92
-- | Return the length of an array.
110
93
length :: a -> Int
111
94
112
instance IArray (Array e) where
113
length (Array len _ba) = len
114
{-# INLINE length #-}
115
116
instance (Elt e, Show e) => Show (Array e) where
117
show = show . toList
118
119
instance IArray (MArray s e) where
120
length (MArray len _ba) = len
121
{-# INLINE length #-}
122
123
check :: IArray a => String -> a -> Int -> (a -> Int -> b) -> b
124
check func ary i f
125
| i >= 0 && i < length ary = f ary i
126
| otherwise = error ("Data.Array.Flat." ++ func ++ ": index out of bounds")
127
{-# INLINE check #-}
128
129
class Elt e where
130
-- | Indicate how many bytes would be used for an array of the
131
-- given size.
132
bytesInArray :: Int -> e -> Int
133
-- | Unchecked read of an immutable array. May return garbage or
134
-- crash on an out-of-bounds access.
135
unsafeIndex :: Array e -> Int -> e
136
-- | Unchecked read of a mutable array. May return garbage or
137
-- crash on an out-of-bounds access.
138
unsafeRead :: MArray s e -> Int -> ST s e
139
-- | Unchecked write of a mutable array. May return garbage or
140
-- crash on an out-of-bounds access.
141
unsafeWrite :: MArray s e -> Int -> e -> ST s ()
142
143
-- | Read an immutable array. An invalid index results in a
144
-- runtime error.
145
index :: Array e -> Int -> e
146
index ary i = check "index" ary i unsafeIndex
147
{-# INLINE index #-}
148
149
-- | Read a mutable array. An invalid index results in a runtime
150
-- error.
151
read :: Array e -> Int -> ST s e
152
read ary i = check "read" ary i read
153
{-# INLINE read #-}
154
155
-- | Write a mutable array. An invalid index results in a runtime
156
-- error.
157
write :: Array e -> Int -> ST s e
158
write ary i = check "write" ary i write
159
{-# INLINE write #-}
95
instance IArray Array where
96
length = aLen
97
{-# INLINE length #-}
98
99
instance IArray (MArray s) where
100
length = maLen
101
{-# INLINE length #-}
102
#endif
103
104
-- | Create an uninitialized mutable array.
105
new :: forall s. Int -> ST s (MArray s)
106
new n
107
| n < 0 || n .&. highBit /= 0 = error $ "Data.Text.Array.new: size overflow"
108
| otherwise = ST $ \s1# ->
109
case newByteArray# len# s1# of
110
(# s2#, marr# #) -> (# s2#, MArray marr#
111
#if defined(ASSERTS)
112
n
113
#endif
114
#)
115
where !(I# len#) = bytesInArray n
116
highBit = maxBound `xor` (maxBound `shiftR` 1)
117
{-# INLINE new #-}
160
118
161
119
-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
162
unsafeFreeze :: MArray s e -> ST s (Array e)
163
164
#if defined(__GLASGOW_HASKELL__)
165
166
wORD16_SCALE :: Int# -> Int#
167
wORD16_SCALE n# = scale# *# n# where !(I# scale#) = SIZEOF_WORD16
168
169
unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)
170
unsafeNew n = assert (n >= 0) . ST $ \s1# ->
171
case bytesInArray n (undefined :: e) of
172
len@(I# len#) ->
173
#if defined(BOUNDS_CHECKING)
174
if len < 0 then error (show ("unsafeNew",len)) else
120
unsafeFreeze :: MArray s -> ST s Array
121
unsafeFreeze MArray{..} = ST $ \s# ->
122
(# s#, Array (unsafeCoerce# maBA)
123
#if defined(ASSERTS)
124
maLen
175
125
#endif
176
case newByteArray# len# s1# of
177
(# s2#, marr# #) -> (# s2#, MArray n marr# #)
178
{-# INLINE unsafeNew #-}
179
180
unsafeFreeze (MArray len mba#) = ST $ \s# ->
181
(# s#, Array len (unsafeCoerce# mba#) #)
126
#)
182
127
{-# INLINE unsafeFreeze #-}
183
128
184
new :: forall s e. Elt e => Int -> e -> ST s (MArray s e)
185
186
#elif defined(__HUGS__)
187
188
unsafeIndexArray :: Storable e => Array e -> Int -> e
189
unsafeIndexArray (Array off len arr) i =
190
assert (i >= 0 && i < len) $ readByteArray arr (off + i)
191
192
unsafeReadMArray :: Storable e => MArray s e -> Int -> ST s e
193
unsafeReadMArray (MArray _len marr) i =
194
assert (i >= 0 && i < len) $ readMutableByteArray marr
195
196
unsafeWriteMArray :: Storable e => MArray s e -> Int -> e -> ST s ()
197
unsafeWriteMArray (MArray len marr) i =
198
assert (i >= 0 && i < len) $ writeMutableByteArray marr
199
200
unsafeNew :: (Storable e) => Int -> ST s (MArray s e)
201
unsafeNew n = new undefined
202
where new :: (Storable e) => e -> ST s (MArray s e)
203
new unused = do
204
marr <- newMutableByteArray (n * sizeOf unused)
205
return (MArray n marr)
206
207
unsafeFreeze (MArray len mba) = do
208
ba <- unsafeFreezeMutableByteArray mba
209
return (Array 0 len ba)
210
211
new :: (Storable e) => Int -> e -> ST s (MArray s e)
212
#endif
213
214
new len initVal = do
215
marr <- unsafeNew len
216
sequence_ [unsafeWrite marr i initVal | i <- [0..len-1]]
217
return marr
218
219
instance Elt Word16 where
220
#if defined(__GLASGOW_HASKELL__)
221
222
bytesInArray (I# i#) _ = I# (wORD16_SCALE i#)
223
{-# INLINE bytesInArray #-}
224
225
unsafeIndex (Array len ba#) i@(I# i#) =
226
CHECK_BOUNDS("unsafeIndex",len,i)
227
case indexWord16Array# ba# i# of r# -> (W16# r#)
228
{-# INLINE unsafeIndex #-}
229
230
unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->
231
CHECK_BOUNDS("unsafeRead",len,i)
232
case readWord16Array# mba# i# s# of
233
(# s2#, r# #) -> (# s2#, W16# r# #)
234
{-# INLINE unsafeRead #-}
235
236
unsafeWrite (MArray len marr#) i@(I# i#) (W16# e#) = ST $ \s1# ->
237
CHECK_BOUNDS("unsafeWrite",len,i)
238
case writeWord16Array# marr# i# e# s1# of
239
s2# -> (# s2#, () #)
240
{-# INLINE unsafeWrite #-}
241
242
#elif defined(__HUGS__)
243
244
bytesInArray n w = sizeOf w * n
245
unsafeIndex = unsafeIndexArray
246
unsafeRead = unsafeReadMArray
247
unsafeWrite = unsafeWriteMArray
248
249
#endif
129
-- | Indicate how many bytes would be used for an array of the given
130
-- size.
131
bytesInArray :: Int -> Int
132
bytesInArray n = n `shiftL` 1
133
{-# INLINE bytesInArray #-}
134
135
-- | Unchecked read of an immutable array. May return garbage or
136
-- crash on an out-of-bounds access.
137
unsafeIndex :: Array -> Int -> Word16
138
unsafeIndex Array{..} i@(I# i#) =
139
CHECK_BOUNDS("unsafeIndex",aLen,i)
140
case indexWord16Array# aBA i# of r# -> (W16# r#)
141
{-# INLINE unsafeIndex #-}
142
143
-- | Unchecked read of an immutable array. May return garbage or
144
-- crash on an out-of-bounds access.
145
unsafeIndexWord :: Array -> Int -> Word
146
unsafeIndexWord Array{..} i@(I# i#) =
147
CHECK_BOUNDS("unsafeIndexWord",aLen`div`wordFactor,i)
148
case indexWordArray# aBA i# of r# -> (W# r#)
149
{-# INLINE unsafeIndexWord #-}
150
151
-- | Unchecked read of a mutable array. May return garbage or
152
-- crash on an out-of-bounds access.
153
unsafeRead :: MArray s -> Int -> ST s Word16
154
unsafeRead MArray{..} i@(I# i#) = ST $ \s# ->
155
CHECK_BOUNDS("unsafeRead",maLen,i)
156
case readWord16Array# maBA i# s# of
157
(# s2#, r# #) -> (# s2#, W16# r# #)
158
{-# INLINE unsafeRead #-}
159
160
-- | Unchecked write of a mutable array. May return garbage or crash
161
-- on an out-of-bounds access.
162
unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()
163
unsafeWrite 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 #-}
168
169
-- | Unchecked read of a mutable array. May return garbage or
170
-- crash on an out-of-bounds access.
171
unsafeReadWord :: MArray s -> Int -> ST s Word
172
unsafeReadWord MArray{..} i@(I# i#) = ST $ \s# ->
173
CHECK_BOUNDS("unsafeRead64",maLen`div`wordFactor,i)
174
case readWordArray# maBA i# s# of
175
(# s2#, r# #) -> (# s2#, W# r# #)
176
{-# INLINE unsafeReadWord #-}
177
178
-- | Unchecked write of a mutable array. May return garbage or crash
179
-- on an out-of-bounds access.
180
unsafeWriteWord :: MArray s -> Int -> Word -> ST s ()
181
unsafeWriteWord MArray{..} i@(I# i#) (W# e#) = ST $ \s1# ->
182
CHECK_BOUNDS("unsafeWriteWord",maLen`div`wordFactor,i)
183
case writeWordArray# maBA i# e# s1# of
184
s2# -> (# s2#, () #)
185
{-# INLINE unsafeWriteWord #-}
250
186
251
187
-- | Convert an immutable array to a list.
252
toList :: Elt e => Array e -> [e]
253
toList a = loop 0
254
where loop i | i < len = unsafeIndex a i : loop (i+1)
188
toList :: Array -> Int -> Int -> [Word16]
189
toList ary off len = loop 0
190
where loop i | i < len = unsafeIndex ary (off+i) : loop (i+1)
255
191
| otherwise = []
256
len = length a
257
192
258
193
-- | An empty immutable array.
259
empty :: Elt e => Array e
260
empty = runST (unsafeNew 0 >>= unsafeFreeze)
194
empty :: Array
195
empty = runST (new 0 >>= unsafeFreeze)
261
196
262
197
-- | Run an action in the ST monad and return an immutable array of
263
198
-- its result.
264
run :: Elt e => (forall s. ST s (MArray s e)) -> Array e
199
run :: (forall s. ST s (MArray s)) -> Array
265
200
run k = runST (k >>= unsafeFreeze)
266
201
267
202
-- | Run an action in the ST monad and return an immutable array of
268
203
-- its result paired with whatever else the action returns.
269
run2 :: Elt e => (forall s. ST s (MArray s e, a)) -> (Array e, a)
204
run2 :: (forall s. ST s (MArray s, a)) -> (Array, a)
270
205
run2 k = runST (do
271
206
(marr,b) <- k
272
207
arr <- unsafeFreeze marr
273
208
return (arr,b))
274
209
275
copy :: Elt e => MArray s e -- ^ source array
276
-> MArray s e -- ^ destination array
277
-> ST s ()
278
copy src dest
279
| length dest >= length src = copy_loop 0
280
| otherwise = fail "Data.Text.Array.copy: array too small"
281
where
282
len = length src
283
copy_loop i
284
| i >= len = return ()
285
| otherwise = do unsafeRead src i >>= unsafeWrite dest i
286
copy_loop (i+1)
287
{-# INLINE copy #-}
288
289
unsafeCopy :: Elt e =>
290
MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
291
unsafeCopy src sidx dest didx count =
210
-- | The amount to divide or multiply by to switch between units of
211
-- 'Word16' and units of 'Word'.
212
wordFactor :: Int
213
wordFactor = SIZEOF_HSWORD `shiftR` 1
214
215
-- | Indicate whether an offset is word-aligned.
216
wordAligned :: Int -> Bool
217
wordAligned i = i .&. (wordFactor - 1) == 0
218
219
-- | Copy some elements of a mutable array.
220
copyM :: MArray s -- ^ Destination
221
-> Int -- ^ Destination offset
222
-> MArray s -- ^ Source
223
-> Int -- ^ Source offset
224
-> Int -- ^ Count
225
-> ST s ()
226
copyM dest didx src sidx count =
227
#if defined(ASSERTS)
292
228
assert (sidx + count <= length src) .
293
229
assert (didx + count <= length dest) $
294
copy_loop sidx didx 0
230
#endif
231
if srem == 0 && drem == 0
232
then fast_loop 0
233
else slow_loop 0
295
234
where
296
copy_loop !i !j !c
297
| c >= count = return ()
298
| otherwise = do unsafeRead src i >>= unsafeWrite dest j
299
copy_loop (i+1) (j+1) (c+1)
300
{-# INLINE unsafeCopy #-}
235
(swidx,srem) = sidx `divMod` wordFactor
236
(dwidx,drem) = didx `divMod` wordFactor
237
nwds = count `div` wordFactor
238
fast_loop !i
239
| i >= nwds = slow_loop (i * wordFactor)
240
| otherwise = do w <- unsafeReadWord src (swidx+i)
241
unsafeWriteWord dest (dwidx+i) w
242
fast_loop (i+1)
243
slow_loop !i
244
| i >= count= return ()
245
| otherwise = do unsafeRead src (sidx+i) >>= unsafeWrite dest (didx+i)
246
slow_loop (i+1)
247
248
-- | Copy some elements of an immutable array.
249
copyI :: MArray s -- ^ Destination
250
-> Int -- ^ Destination offset
251
-> Array -- ^ Source
252
-> Int -- ^ Source offset
253
-> Int -- ^ First offset in source /not/ to
254
-- copy (i.e. /not/ length)
255
-> ST s ()
256
copyI dest i0 src j0 top
257
| wordAligned i0 && wordAligned j0 = fast (i0 `div` wordFactor) (j0 `div` wordFactor)
258
| otherwise = slow i0 j0
259
where
260
topwds = top `div` wordFactor
261
fast !i !j
262
| i >= topwds = slow (i * wordFactor) (j * wordFactor)
263
| otherwise = do unsafeWriteWord dest i (src `unsafeIndexWord` j)
264
fast (i+1) (j+1)
265
slow !i !j
266
| i >= top = return ()
267
| otherwise = do unsafeWrite dest i (src `unsafeIndex` j)
268
slow (i+1) (j+1)
269
270
-- | Compare portions of two arrays for equality. No bounds checking
271
-- is performed.
272
equal :: Array -- ^ First
273
-> Int -- ^ Offset into first
274
-> Array -- ^ Second
275
-> Int -- ^ Offset into second
276
-> Int -- ^ Count
277
-> Bool
278
equal arrA offA arrB offB count
279
| wordAligned offA && wordAligned offB = fast 0
280
| otherwise = slow 0
281
where
282
countWords = count `div` wordFactor
283
fast !i
284
| i >= countWords = slow (i * wordFactor)
285
| a /= b = False
286
| otherwise = fast (i+1)
287
where a = unsafeIndexWord arrA (offAW+i)
288
b = unsafeIndexWord arrB (offBW+i)
289
offAW = offA `div` wordFactor
290
offBW = offB `div` wordFactor
291
slow !i
292
| i >= count = True
293
| a /= b = False
294
| otherwise = slow (i+1)
295
where a = unsafeIndex arrA (offA+i)
296
b = unsafeIndex arrB (offB+i)
Loggerhead is a web-based interface for Breezy
Version: 2.0.1