a871416 · text · git.iko.soy

git.iko.soy/text

Switch to native code for copying and comparison.

--HG-- rename : Data/Text/Unsafe.hs => Data/Text/Unsafe/Base.hs

commita871416fb443db1c0f3400d90090781baa6f14a3 authorBryan O'Sullivan <bos@serpentine.com> dateMon 27 Jun 2011, 00:21 (15 years ago) parentc186479

7 files changed+125−148

compare with master

unifiedsplit

Data/Text/Array.hs+39−101 Data/Text/Unsafe.hs+2−37 Data/Text/Unsafe/Base.hs+55 cbits/cbits.c+13 tests/benchmarks/text-benchmarks.cabal+1 tests/tests/text-tests.cabal+4−5 text.cabal+11−5

Data/Text/Array.hs+39−101

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

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

2− UnboxedTuples #-}

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

2+ RecordWildCards, UnboxedTuples, UnliftedFFITypes #-}

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

44-- |

55-- Module : Data.Text.Array

77--

88-- License : BSD-style

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

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

6060#if defined(ASSERTS)

6161import Control.Exception (assert)

6262#endif

63+import Control.Monad.ST (unsafeIOToST)

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

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

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

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

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

66− indexWord16Array#, indexWordArray#, newByteArray#,

67− readWord16Array#, readWordArray#, unsafeCoerce#,

68− writeWord16Array#, writeWordArray#)

69+ indexWord16Array#, newByteArray#,

70+ unsafeCoerce#, writeWord16Array#)

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

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

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

7173import Prelude hiding (length, read)

7274

7375-- | Immutable array type.

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

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

141143{-# INLINE unsafeIndex #-}

142144

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−

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

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

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

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

166151 s2# -> (# s2#, () #)

167152{-# INLINE unsafeWrite #-}

168153

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−

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

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

189156toList ary off len = loop 0

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

207174 arr <- unsafeFreeze marr

208175 return (arr,b))

209176

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−

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

220178copyM :: MArray s -- ^ Destination

221179 -> Int -- ^ Destination offset

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

223181 -> Int -- ^ Source offset

224182 -> Int -- ^ Count

225183 -> ST s ()

226−copyM dest didx src sidx count =

184+copyM dest didx src sidx count

185+ | count <= 0 = return ()

186+ | otherwise =

227187#if defined(ASSERTS)

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

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

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

230190#endif

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

232− then fast_loop 0

233− else slow_loop 0

234− where

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)

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

192+ (maBA src) (fromIntegral sidx)

193+ (fromIntegral count)

194+{-# INLINE copyM #-}

247195

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

249197copyI :: MArray s -- ^ Destination

250198 -> Int -- ^ Destination offset

251199 -> Array -- ^ Source

252200 -> Int -- ^ Source offset

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

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

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

255203 -> ST s ()

256204copyI 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)

205+ | i0 >= top = return ()

206+ | otherwise = unsafeIOToST $

207+ memcpyI (maBA dest) (fromIntegral i0)

208+ (aBA src) (fromIntegral j0)

209+ (fromIntegral (top-i0))

210+{-# INLINE copyI #-}

269211

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

271213-- is performed.

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

275217 -> Int -- ^ Offset into second

276218 -> Int -- ^ Count

277219 -> 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)

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

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

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

223+ return $! i == 0

224+{-# INLINE equal #-}

225+

226+foreign import ccall unsafe "_hs_text_memcpy" memcpyI

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

228+

229+foreign import ccall unsafe "_hs_text_memcmp" memcmp

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

231+

232+foreign import ccall unsafe "_hs_text_memcpy" memcpyM

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

234+ -> IO ()

Data/Text/Unsafe.hs+2−37

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

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

22-- |

33-- Module : Data.Text.Unsafe

55-- License : BSD-style

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

77-- duncan@haskell.org

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

3030#endif

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

3232import Data.Text.Internal (Text(..))

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

3334import Data.Text.UnsafeChar (unsafeChr)

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

3535import 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

4436

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

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

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

10193 k = j - 1

10294{-# INLINE reverseIter #-}

10395

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−

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

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

13398-- '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

1717

1818executable text-benchmarks

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

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

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

2122 ghc-options: -Wall -O2

2223 cpp-options: -DHAVE_DEEPSEQ

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

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

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

2525

2626 ghc-options:

27− -Wall

28− -threaded

29− -O0

27+ -Wall -threaded -O0 -rtsopts

3028

3129 if flag(hpc)

3230 ghc-options:

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

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

5553

5654 ghc-options:

57− -Wall

58− -threaded

55+ -Wall -threaded -rtsopts

5956

6057 -- Optional HPC support

6158 if flag(hpc)

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

6865

6966library

7067 hs-source-dirs: ../..

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

7169 exposed-modules:

7270 Data.Text

7371 Data.Text.Array

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

103101 Data.Text.Lazy.Search

104102 Data.Text.Search

105103 Data.Text.Unsafe

104+ Data.Text.Unsafe.Base

106105 Data.Text.UnsafeChar

107106 Data.Text.UnsafeShift

108107 Data.Text.Util

text.cabal+11−5

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

11name: text

2−version: 0.11.1.1

2+version: 0.11.1.2

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

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

55synopsis: An efficient packed Unicode text type.

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

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

3838 Tom Harper <rtomharper@googlemail.com>

3939 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

4141category: Data, Text

4242build-type: Simple

4343cabal-version: >= 1.6

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

4646 -- scripts/CaseFolding.txt

4747 -- scripts/SpecialCasing.txt

4848 scripts/*.hs

49− tests/*.hs

50− tests/Makefile

5149 tests/README.markdown

5250 tests/benchmarks/Setup.hs

5351 tests/benchmarks/python/*.py

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

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

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

5755 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

5962

6063flag developer

6164 description: operate in developer mode

6265 default: False

6366

6467library

68+ c-sources: cbits/cbits.c

69+

6570 exposed-modules:

6671 Data.Text

6772 Data.Text.Array

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

98103 Data.Text.Lazy.Search

99104 Data.Text.Search

100105 Data.Text.Unsafe

106+ Data.Text.Unsafe.Base

101107 Data.Text.UnsafeChar

102108 Data.Text.UnsafeShift

103109 Data.Text.Util