a871416 · text · git.iko.soy

git.iko.soy/text

on master help sign in

Switch to native code for copying and comparison.

a871416Bryan O'Sullivan15 years ago

Data/Text/Array.hs+39−101

compare with master

unifiedsplit

@@ -1,9 +1,9 @@

1−{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, RecordWildCards,

1+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash, Rank2Types,

2− UnboxedTuples #-}

2+ RecordWildCards, UnboxedTuples, UnliftedFFITypes #-}

3{-# OPTIONS_GHC -fno-warn-unused-matches #-}

4-- |

5-- Module : Data.Text.Array

7--

8-- License : BSD-style

9-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

@@ -60,14 +60,16 @@ if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ "

60#if defined(ASSERTS)

61import Control.Exception (assert)

62#endif

63+import Control.Monad.ST (unsafeIOToST)

63import Data.Bits ((.&.), xor)

64import Data.Bits ((.&.), xor)

65+import Data.Text.Unsafe.Base (inlinePerformIO)

64import Data.Text.UnsafeShift (shiftL, shiftR)

66import Data.Text.UnsafeShift (shiftL, shiftR)

67+import Foreign.C.Types (CInt, CSize)

65import GHC.Base (ByteArray#, MutableByteArray#, Int(..),

68import GHC.Base (ByteArray#, MutableByteArray#, Int(..),

66− indexWord16Array#, indexWordArray#, newByteArray#,

69+ indexWord16Array#, newByteArray#,

67− readWord16Array#, readWordArray#, unsafeCoerce#,

68− writeWord16Array#, writeWordArray#)

70+ unsafeCoerce#, writeWord16Array#)

69import GHC.ST (ST(..), runST)

71import GHC.ST (ST(..), runST)

70−import GHC.Word (Word16(..), Word(..))

72+import GHC.Word (Word16(..))

71import Prelude hiding (length, read)

73import Prelude hiding (length, read)

73-- | Immutable array type.

75-- | Immutable array type.

@@ -140,23 +142,6 @@ unsafeIndex Array{..} i@(I# i#) =

140 case indexWord16Array# aBA i# of r# -> (W16# r#)

142 case indexWord16Array# aBA i# of r# -> (W16# r#)

141{-# INLINE unsafeIndex #-}

143{-# INLINE unsafeIndex #-}

142

144

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

145-- | Unchecked write of a mutable array. May return garbage or crash

161-- on an out-of-bounds access.

146-- on an out-of-bounds access.

162unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()

147unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()

@@ -166,24 +151,6 @@ unsafeWrite MArray{..} i@(I# i#) (W16# e#) = ST $ \s1# ->

166 s2# -> (# s2#, () #)

151 s2# -> (# s2#, () #)

167{-# INLINE unsafeWrite #-}

152{-# INLINE unsafeWrite #-}

168

153

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 #-}

186−

187-- | Convert an immutable array to a list.

154-- | Convert an immutable array to a list.

188toList :: Array -> Int -> Int -> [Word16]

155toList :: Array -> Int -> Int -> [Word16]

189toList ary off len = loop 0

156toList ary off len = loop 0

@@ -207,15 +174,6 @@ run2 k = runST (do

207 arr <- unsafeFreeze marr

174 arr <- unsafeFreeze marr

208 return (arr,b))

175 return (arr,b))

209

176

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.

177-- | Copy some elements of a mutable array.

220copyM :: MArray s -- ^ Destination

178copyM :: MArray s -- ^ Destination

221 -> Int -- ^ Destination offset

179 -> Int -- ^ Destination offset

@@ -223,49 +181,33 @@ copyM :: MArray s -- ^ Destination

223 -> Int -- ^ Source offset

181 -> Int -- ^ Source offset

224 -> Int -- ^ Count

182 -> Int -- ^ Count

225 -> ST s ()

183 -> ST s ()

226−copyM dest didx src sidx count =

184+copyM dest didx src sidx count

185+ | count <= 0 = return ()

186+ | otherwise =

227#if defined(ASSERTS)

187#if defined(ASSERTS)

228 assert (sidx + count <= length src) .

188 assert (sidx + count <= length src) .

229− assert (didx + count <= length dest) $

189+ assert (didx + count <= length dest) .

230#endif

190#endif

231− if srem == 0 && drem == 0

191+ unsafeIOToST $ memcpyM (maBA dest) (fromIntegral didx)

232− then fast_loop 0

192+ (maBA src) (fromIntegral sidx)

233− else slow_loop 0

193+ (fromIntegral count)

234− where

194+{-# INLINE copyM #-}

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

195

248-- | Copy some elements of an immutable array.

196-- | Copy some elements of an immutable array.

249copyI :: MArray s -- ^ Destination

197copyI :: MArray s -- ^ Destination

250 -> Int -- ^ Destination offset

198 -> Int -- ^ Destination offset

251 -> Array -- ^ Source

199 -> Array -- ^ Source

252 -> Int -- ^ Source offset

200 -> Int -- ^ Source offset

253− -> Int -- ^ First offset in source /not/ to

201+ -> Int -- ^ First offset in destination /not/ to

254 -- copy (i.e. /not/ length)

202 -- copy (i.e. /not/ length)

255 -> ST s ()

203 -> ST s ()

256copyI dest i0 src j0 top

204copyI 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 ()

205+ | i0 >= top = return ()

267− | otherwise = do unsafeWrite dest i (src `unsafeIndex` j)

206+ | otherwise = unsafeIOToST $

268− slow (i+1) (j+1)

207+ memcpyI (maBA dest) (fromIntegral i0)

208+ (aBA src) (fromIntegral j0)

209+ (fromIntegral (top-i0))

210+{-# INLINE copyI #-}

269

211

270-- | Compare portions of two arrays for equality. No bounds checking

212-- | Compare portions of two arrays for equality. No bounds checking

271-- is performed.

213-- is performed.

@@ -275,22 +217,18 @@ equal :: Array -- ^ First

275 -> Int -- ^ Offset into second

217 -> Int -- ^ Offset into second

276 -> Int -- ^ Count

218 -> Int -- ^ Count

277 -> Bool

219 -> Bool

278−equal arrA offA arrB offB count

220+equal arrA offA arrB offB count = inlinePerformIO $ do

279− | wordAligned offA && wordAligned offB = fast 0

221+ i <- memcmp (aBA arrA) (fromIntegral offA)

280− | otherwise = slow 0

222+ (aBA arrB) (fromIntegral offB) (fromIntegral count)

281− where

223+ return $! i == 0

282− countWords = count `div` wordFactor

224+{-# INLINE equal #-}

283− fast !i

225+

284− | i >= countWords = slow (i * wordFactor)

226+foreign import ccall unsafe "_hs_text_memcpy" memcpyI

285− | a /= b = False

227+ :: MutableByteArray# s -> CSize -> ByteArray# -> CSize -> CSize -> IO ()

286− | otherwise = fast (i+1)

228+

287− where a = unsafeIndexWord arrA (offAW+i)

229+foreign import ccall unsafe "_hs_text_memcmp" memcmp

288− b = unsafeIndexWord arrB (offBW+i)

230+ :: ByteArray# -> CSize -> ByteArray# -> CSize -> CSize -> IO CInt

289− offAW = offA `div` wordFactor

231+

290− offBW = offB `div` wordFactor

232+foreign import ccall unsafe "_hs_text_memcpy" memcpyM

291− slow !i

233+ :: MutableByteArray# s -> CSize -> MutableByteArray# s -> CSize -> CSize

292− | i >= count = True

234+ -> IO ()

293− | a /= b = False

294− | otherwise = slow (i+1)

295− where a = unsafeIndex arrA (offA+i)

296− b = unsafeIndex arrB (offB+i)

Data/Text/Unsafe.hs+2−37

@@ -1,7 +1,7 @@

1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}

2-- |

3-- Module : Data.Text.Unsafe

5-- License : BSD-style

6-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

7-- duncan@haskell.org

@@ -30,17 +30,9 @@ import Control.Exception (assert)

30#endif

31import Data.Text.Encoding.Utf16 (chr2)

32import Data.Text.Internal (Text(..))

33+import Data.Text.Unsafe.Base (inlineInterleaveST, inlinePerformIO)

33import Data.Text.UnsafeChar (unsafeChr)

34import Data.Text.UnsafeChar (unsafeChr)

34−import GHC.ST (ST(..))

35import qualified Data.Text.Array as A

36−#if defined(__GLASGOW_HASKELL__)

37−# if __GLASGOW_HASKELL__ >= 611

38−import GHC.IO (IO(IO))

39−# else

40−import GHC.IOBase (IO(IO))

41−# endif

42−import GHC.Base (realWorld#)

43−#endif

45-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'

37-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'

46-- omits the check for the empty case, so there is an obligation on

38-- omits the check for the empty case, so there is an obligation on

@@ -101,33 +93,6 @@ reverseIter (Text arr off _len) i

101 k = j - 1

93 k = j - 1

102{-# INLINE reverseIter #-}

94{-# INLINE reverseIter #-}

103

104−-- | Just like unsafePerformIO, but we inline it. Big performance gains as

105−-- it exposes lots of things to further inlining. /Very unsafe/. In

106−-- particular, you should do no memory allocation inside an

107−-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.

108−--

109−{-# INLINE inlinePerformIO #-}

110−inlinePerformIO :: IO a -> a

111−#if defined(__GLASGOW_HASKELL__)

112−inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r

113−#else

114−inlinePerformIO = unsafePerformIO

115−#endif

116−

117−-- | Allow an 'ST' computation to be deferred lazily. When passed an

118−-- action of type 'ST' @s@ @a@, the action will only be performed when

119−-- the value of @a@ is demanded.

120−--

121−-- This function is identical to the normal unsafeInterleaveST, but is

122−-- inlined and hence faster.

123−--

124−-- /Note/: This operation is highly unsafe, as it can introduce

125−-- externally visible non-determinism into an 'ST' action.

126−inlineInterleaveST :: ST s a -> ST s a

127−inlineInterleaveST (ST m) = ST $ \ s ->

128− let r = case m s of (# _, res #) -> res in (# s, r #)

129−{-# INLINE inlineInterleaveST #-}

130−

131-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This

96-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This

132-- is useful for sizing a target array appropriately before using

97-- is useful for sizing a target array appropriately before using

133-- 'unsafeCopyToPtr'.

98-- 'unsafeCopyToPtr'.

Data/Text/Unsafe/Base.hsnew file+55

@@ -0,0 +1,55 @@

1+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}

2+-- |

3+-- Module : Data.Text.Unsafe.Base

5+-- License : BSD-style

6+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

7+-- duncan@haskell.org

8+-- Stability : experimental

9+-- Portability : portable

10+--

11+-- A module containing unsafe operations, for very very careful use in

12+-- heavily tested code.

13+module Data.Text.Unsafe.Base

14+ (

15+ inlineInterleaveST

16+ , inlinePerformIO

17+ ) where

18+

19+import GHC.ST (ST(..))

20+#if defined(__GLASGOW_HASKELL__)

21+# if __GLASGOW_HASKELL__ >= 611

22+import GHC.IO (IO(IO))

23+# else

24+import GHC.IOBase (IO(IO))

25+# endif

26+import GHC.Base (realWorld#)

27+#endif

28+

29+

30+-- | Just like unsafePerformIO, but we inline it. Big performance gains as

31+-- it exposes lots of things to further inlining. /Very unsafe/. In

32+-- particular, you should do no memory allocation inside an

33+-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.

34+--

35+{-# INLINE inlinePerformIO #-}

36+inlinePerformIO :: IO a -> a

37+#if defined(__GLASGOW_HASKELL__)

38+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r

39+#else

40+inlinePerformIO = unsafePerformIO

41+#endif

42+

43+-- | Allow an 'ST' computation to be deferred lazily. When passed an

44+-- action of type 'ST' @s@ @a@, the action will only be performed when

45+-- the value of @a@ is demanded.

46+--

47+-- This function is identical to the normal unsafeInterleaveST, but is

48+-- inlined and hence faster.

49+--

50+-- /Note/: This operation is highly unsafe, as it can introduce

51+-- externally visible non-determinism into an 'ST' action.

52+inlineInterleaveST :: ST s a -> ST s a

53+inlineInterleaveST (ST m) = ST $ \ s ->

54+ let r = case m s of (# _, res #) -> res in (# s, r #)

55+{-# INLINE inlineInterleaveST #-}

cbits/cbits.cnew file+13

@@ -0,0 +1,13 @@

1+#include <string.h>

3+void _hs_text_memcpy(void *dest, size_t doff, const void *src, size_t soff,

4+ size_t n)

5+{

6+ memcpy(dest + (doff<<1), src + (soff<<1), n<<1);

7+}

9+int _hs_text_memcmp(const void *a, size_t aoff, const void *b, size_t boff,

10+ size_t n)

11+{

12+ return memcmp(a + (aoff<<1), b + (boff<<1), n<<1);

13+}

tests/benchmarks/text-benchmarks.cabal+1

@@ -17,6 +17,7 @@ cabal-version: >=1.2

18executable text-benchmarks

19 hs-source-dirs: src ../..

20+ c-sources: ../../cbits/cbits.c

20 main-is: Data/Text/Benchmarks.hs

21 main-is: Data/Text/Benchmarks.hs

21 ghc-options: -Wall -O2

22 ghc-options: -Wall -O2

22 cpp-options: -DHAVE_DEEPSEQ

23 cpp-options: -DHAVE_DEEPSEQ

tests/tests/text-tests.cabal+4−5

@@ -24,9 +24,7 @@ executable text-tests

24 main-is: Data/Text/Tests.hs

26 ghc-options:

27− -Wall

28− -threaded

27+ -Wall -threaded -O0 -rtsopts

29− -O0

31 if flag(hpc)

29 if flag(hpc)

32 ghc-options:

30 ghc-options:

@@ -54,8 +52,7 @@ executable text-tests-stdio

54 main-is: Data/Text/Tests/IO.hs

52 main-is: Data/Text/Tests/IO.hs

56 ghc-options:

54 ghc-options:

57− -Wall

58− -threaded

55+ -Wall -threaded -rtsopts

60 -- Optional HPC support

57 -- Optional HPC support

61 if flag(hpc)

58 if flag(hpc)

@@ -68,6 +65,7 @@ executable text-tests-stdio

69library

66library

70 hs-source-dirs: ../..

67 hs-source-dirs: ../..

68+ c-sources: ../../cbits/cbits.c

71 exposed-modules:

69 exposed-modules:

72 Data.Text

70 Data.Text

73 Data.Text.Array

71 Data.Text.Array

@@ -103,6 +101,7 @@ library

103 Data.Text.Lazy.Search

101 Data.Text.Lazy.Search

104 Data.Text.Search

102 Data.Text.Search

105 Data.Text.Unsafe

103 Data.Text.Unsafe

104+ Data.Text.Unsafe.Base

106 Data.Text.UnsafeChar

105 Data.Text.UnsafeChar

107 Data.Text.UnsafeShift

106 Data.Text.UnsafeShift

108 Data.Text.Util

107 Data.Text.Util

text.cabal+11−5

@@ -1,5 +1,5 @@

1name: text

2−version: 0.11.1.1

2+version: 0.11.1.2

3homepage: https://bitbucket.org/bos/text

4bug-reports: https://bitbucket.org/bos/text/issues

5synopsis: An efficient packed Unicode text type.

@@ -37,7 +37,7 @@ author: Bryan O'Sullivan <bos@serpentine.com>

37maintainer: Bryan O'Sullivan <bos@serpentine.com>

38 Tom Harper <rtomharper@googlemail.com>

39 Duncan Coutts <duncan@haskell.org>

40−copyright: 2008-2009 Tom Harper, 2009-2010 Bryan O'Sullivan

40+copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper

41category: Data, Text

42build-type: Simple

43cabal-version: >= 1.6

@@ -46,8 +46,6 @@ extra-source-files:

46 -- scripts/CaseFolding.txt

47 -- scripts/SpecialCasing.txt

48 scripts/*.hs

49− tests/*.hs

50− tests/Makefile

51 tests/README.markdown

49 tests/README.markdown

52 tests/benchmarks/Setup.hs

50 tests/benchmarks/Setup.hs

53 tests/benchmarks/python/*.py

51 tests/benchmarks/python/*.py

@@ -55,13 +53,20 @@ extra-source-files:

55 tests/benchmarks/src/Data/Text/*.hs

53 tests/benchmarks/src/Data/Text/*.hs

56 tests/benchmarks/src/Data/Text/Benchmarks/*.hs

54 tests/benchmarks/src/Data/Text/Benchmarks/*.hs

57 tests/benchmarks/text-benchmarks.cabal

55 tests/benchmarks/text-benchmarks.cabal

58− tests/cover-stdio.sh

56+ tests/tests/.ghci

57+ tests/tests/Makefile

58+ tests/tests/scripts/*.sh

59+ tests/tests/src/Data/Text/*.hs

60+ tests/tests/src/Data/Text/Tests/*.hs

61+ tests/tests/text-tests.cabal

60flag developer

63flag developer

61 description: operate in developer mode

64 description: operate in developer mode

62 default: False

65 default: False

64library

67library

68+ c-sources: cbits/cbits.c

69+

65 exposed-modules:

70 exposed-modules:

66 Data.Text

71 Data.Text

67 Data.Text.Array

72 Data.Text.Array

@@ -98,6 +103,7 @@ library

98 Data.Text.Lazy.Search

103 Data.Text.Lazy.Search

99 Data.Text.Search

104 Data.Text.Search

100 Data.Text.Unsafe

105 Data.Text.Unsafe

106+ Data.Text.Unsafe.Base

101 Data.Text.UnsafeChar

107 Data.Text.UnsafeChar

102 Data.Text.UnsafeShift

108 Data.Text.UnsafeShift

103 Data.Text.Util

109 Data.Text.Util