diff --git a/Data/Text/Encoding.hs b/Data/Text/Encoding.hs --- a/Data/Text/Encoding.hs +++ b/Data/Text/Encoding.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, ForeignFunctionInterface, MagicHash, +{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash, UnliftedFFITypes #-} -- | -- Module : Data.Text.Encoding @@ -48,7 +48,11 @@ ) where import Control.Exception (evaluate, try) +#if __GLASGOW_HASKELL__ >= 702 +import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO) +#else import Control.Monad.ST (unsafeIOToST, unsafeSTToIO) +#endif import Data.Bits ((.&.)) import Data.ByteString as B import Data.ByteString.Internal as B diff --git a/Data/Text/Lazy/Search.hs b/Data/Text/Lazy/Search.hs --- a/Data/Text/Lazy/Search.hs +++ b/Data/Text/Lazy/Search.hs @@ -77,10 +77,11 @@ go !(g::Int64) !i !msk !skp | i >= xlast = case xs of Empty -> (msk .|. swizzle z) :*: skp - Chunk y ys -> buildTable y ys g 0 msk skp - | otherwise = go (g+1) (i+1) (msk .|. swizzle c) skp' + Chunk y ys -> buildTable y ys g 0 msk' skp' + | otherwise = go (g+1) (i+1) msk' skp' where c = A.unsafeIndex xarr (xoff+i) - skp' | c == z = nlen - fromIntegral g - 2 + msk' = msk .|. swizzle c + skp' | c == z = nlen - g - 2 | otherwise = skp xlast = xlen - 1 -- | Check whether an attempt to index into the haystack at the diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -19,15 +19,15 @@ # Get involved! Please report bugs via the -[bitbucket issue tracker](http://bitbucket.org/bos/text/issues). +[github issue tracker](https://github.com/bos/text/issues). -Master [Mercurial repository](http://bitbucket.org/bos/text): +Master [git repository](https://github.com/bos/text): -* `hg clone http://bitbucket.org/bos/text` +* `git clone git://github.com/bos/text.git` -There's also a [git mirror](http://github.com/bos/text): +There's also a [Mercurial mirror](https://bitbucket.org/bos/text): -* `git clone git://github.com/bos/text.git` +* `hg clone https://bitbucket.org/bos/text` (You can create and contribute changes using either Mercurial or git.) diff --git a/tests/benchmarks/src/Data/Text/Benchmarks.hs b/tests/benchmarks/src/Data/Text/Benchmarks.hs --- a/tests/benchmarks/src/Data/Text/Benchmarks.hs +++ b/tests/benchmarks/src/Data/Text/Benchmarks.hs @@ -19,6 +19,7 @@ import qualified Data.Text.Benchmarks.ReadNumbers as ReadNumbers import qualified Data.Text.Benchmarks.Replace as Replace import qualified Data.Text.Benchmarks.Search as Search +import qualified Data.Text.Benchmarks.Stream as Stream import qualified Data.Text.Benchmarks.WordFrequencies as WordFrequencies import qualified Data.Text.Benchmarks.Programs.BigTable as Programs.BigTable @@ -52,6 +53,7 @@ , ReadNumbers.benchmark (tf "numbers.txt") , Replace.benchmark (tf "russian.txt") "принимая" "своем" , Search.benchmark (tf "russian.txt") "принимая" + , Stream.benchmark (tf "russian.txt") , WordFrequencies.benchmark (tf "russian.txt") ] diff --git a/tests/benchmarks/src/Data/Text/Benchmarks/Stream.hs b/tests/benchmarks/src/Data/Text/Benchmarks/Stream.hs new file mode 100644 --- /dev/null +++ b/tests/benchmarks/src/Data/Text/Benchmarks/Stream.hs @@ -0,0 +1,94 @@ +-- | This module contains a number of benchmarks for the different streaming +-- functions +-- +-- Tested in this benchmark: +-- +-- * Most streaming functions +-- +{-# LANGUAGE BangPatterns #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Data.Text.Benchmarks.Stream + ( benchmark + ) where + +import Control.DeepSeq (NFData (..)) +import Criterion (Benchmark, bgroup, bench, nf) +import Data.Text.Fusion.Internal (Step (..), Stream (..)) +import qualified Data.Text.Encoding as T +import qualified Data.Text.Encoding.Error as E +import qualified Data.Text.Encoding.Fusion as T +import qualified Data.Text.Encoding.Fusion.Common as F +import qualified Data.Text.Fusion as T +import qualified Data.Text.IO as T +import qualified Data.Text.Lazy.Encoding as TL +import qualified Data.Text.Lazy.Encoding.Fusion as TL +import qualified Data.Text.Lazy.Fusion as TL +import qualified Data.Text.Lazy.IO as TL + +instance NFData a => NFData (Stream a) where + -- Currently, this implementation does not force evaluation of the size hint + rnf (Stream next s0 _) = go s0 + where + go !s = case next s of + Done -> () + Skip s' -> go s' + Yield x s' -> rnf x `seq` go s' + +benchmark :: FilePath -> IO Benchmark +benchmark fp = do + -- Different formats + t <- T.readFile fp + let !utf8 = T.encodeUtf8 t + !utf16le = T.encodeUtf16LE t + !utf16be = T.encodeUtf16BE t + !utf32le = T.encodeUtf32LE t + !utf32be = T.encodeUtf32BE t + + -- Once again for the lazy variants + tl <- TL.readFile fp + let !utf8L = TL.encodeUtf8 tl + !utf16leL = TL.encodeUtf16LE tl + !utf16beL = TL.encodeUtf16BE tl + !utf32leL = TL.encodeUtf32LE tl + !utf32beL = TL.encodeUtf32BE tl + + -- For the functions which operate on streams + let !s = T.stream t + + return $ bgroup "Stream" + + -- Fusion + [ bgroup "stream" $ + [ bench "Text" $ nf T.stream t + , bench "LazyText" $ nf TL.stream tl + ] + + -- Encoding.Fusion + , bgroup "streamUtf8" + [ bench "Text" $ nf (T.streamUtf8 E.lenientDecode) utf8 + , bench "LazyText" $ nf (TL.streamUtf8 E.lenientDecode) utf8L + ] + , bgroup "streamUtf16LE" + [ bench "Text" $ nf (T.streamUtf16LE E.lenientDecode) utf16le + , bench "LazyText" $ nf (TL.streamUtf16LE E.lenientDecode) utf16leL + ] + , bgroup "streamUtf16BE" + [ bench "Text" $ nf (T.streamUtf16BE E.lenientDecode) utf16be + , bench "LazyText" $ nf (TL.streamUtf16BE E.lenientDecode) utf16beL + ] + , bgroup "streamUtf32LE" + [ bench "Text" $ nf (T.streamUtf32LE E.lenientDecode) utf32le + , bench "LazyText" $ nf (TL.streamUtf32LE E.lenientDecode) utf32leL + ] + , bgroup "streamUtf32BE" + [ bench "Text" $ nf (T.streamUtf32BE E.lenientDecode) utf32be + , bench "LazyText" $ nf (TL.streamUtf32BE E.lenientDecode) utf32beL + ] + + -- Encoding.Fusion.Common + , bench "restreamUtf8" $ nf F.restreamUtf8 s + , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s + , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s + , bench "restreamUtf32LE" $ nf F.restreamUtf32LE s + , bench "restreamUtf32BE" $ nf F.restreamUtf32BE s + ] diff --git a/text.cabal b/text.cabal --- a/text.cabal +++ b/text.cabal @@ -1,7 +1,7 @@ name: text -version: 0.11.1.5 -homepage: https://bitbucket.org/bos/text -bug-reports: https://bitbucket.org/bos/text/issues +version: 0.11.1.6 +homepage: https://github.com/bos/text +bug-reports: https://github.com/bos/text/issues synopsis: An efficient packed Unicode text type. description: . @@ -40,7 +40,7 @@ copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper category: Data, Text build-type: Simple -cabal-version: >= 1.6 +cabal-version: >= 1.8 extra-source-files: README.markdown -- scripts/CaseFolding.txt @@ -137,10 +137,34 @@ cpp-options: -DINTEGER_GMP build-depends: integer >= 0.1 && < 0.2 -source-repository head - type: mercurial - location: https://bitbucket.org/bos/text +test-suite tests + type: exitcode-stdio-1.0 + hs-source-dirs: . tests/tests/src + main-is: Data/Text/Tests.hs + c-sources: cbits/cbits.c + ghc-options: + -Wall -threaded -O0 -rtsopts + + cpp-options: + -DASSERTS -DHAVE_DEEPSEQ + + build-depends: + base >= 4 && < 5, + bytestring >= 0.9 && < 0.10, + deepseq >= 1.1 && < 1.2, + directory >= 1.0 && < 1.2, + random >= 1.0 && < 1.1, + QuickCheck >= 2.4 && < 2.5, + HUnit >= 1.2 && < 1.3, + test-framework >= 0.4 && < 0.5, + test-framework-quickcheck2 >= 0.2 && < 0.3, + test-framework-hunit >= 0.2 && < 0.3 + source-repository head type: git location: https://github.com/bos/text + +source-repository head + type: mercurial + location: https://bitbucket.org/bos/text