text 1.1.1.4 → 1.2.0.0
raw patch · 25 files changed
+459/−120 lines, 25 filesdep ~base
Dependency ranges changed: base
Files
- Data/Text.hs +50/−9
- Data/Text/Encoding.hs +1/−3
- Data/Text/Internal.hs +64/−4
- Data/Text/Internal/Builder.hs +2/−14
- Data/Text/Internal/Fusion/Common.hs +1/−1
- Data/Text/Internal/Fusion/Size.hs +1/−6
- Data/Text/Lazy.hs +22/−0
- Data/Text/Lazy/Encoding.hs +3/−3
- benchmarks/haskell/Benchmarks.hs +2/−0
- benchmarks/haskell/Benchmarks/DecodeUtf8.hs +2/−2
- benchmarks/haskell/Benchmarks/FileRead.hs +11/−11
- benchmarks/haskell/Benchmarks/FoldLines.hs +2/−2
- benchmarks/haskell/Benchmarks/Mul.hs +138/−0
- benchmarks/haskell/Benchmarks/Programs/BigTable.hs +2/−2
- benchmarks/haskell/Benchmarks/Programs/Cut.hs +2/−2
- benchmarks/haskell/Benchmarks/Programs/Fold.hs +2/−2
- benchmarks/haskell/Benchmarks/Programs/Sort.hs +10/−9
- benchmarks/haskell/Benchmarks/Programs/StripTags.hs +5/−5
- benchmarks/haskell/Benchmarks/Programs/Throughput.hs +8/−8
- benchmarks/text-benchmarks.cabal +3/−2
- changelog.md +13/−0
- tests/Tests/Properties.hs +63/−34
- tests/Tests/Properties/Mul.hs +40/−0
- tests/text-tests.cabal +9/−0
- text.cabal +3/−1
Data/Text.hs view
@@ -3,6 +3,9 @@ #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif+#if __GLASGOW_HASKELL__ >= 708+{-# LANGUAGE TypeFamilies #-}+#endif -- | -- Module : Data.Text@@ -193,8 +196,8 @@ import Prelude (Char, Bool(..), Int, Maybe(..), String, Eq(..), Ord(..), Ordering(..), (++), Read(..), Show(..),- (&&), (||), (+), (-), (.), ($), ($!), (>>), (*),- maxBound, not, return, otherwise, quot)+ (&&), (||), (+), (-), (.), ($), ($!), (>>),+ not, return, otherwise, quot) #if defined(HAVE_DEEPSEQ) import Control.DeepSeq (NFData) #endif@@ -205,6 +208,7 @@ import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex, Constr, mkConstr, DataType, mkDataType, Fixity(Prefix)) import Control.Monad (foldM)+import Control.Monad.ST (ST) import qualified Data.Text.Array as A import qualified Data.List as L import Data.Monoid (Monoid(..))@@ -213,11 +217,11 @@ import qualified Data.Text.Internal.Fusion.Common as S import Data.Text.Internal.Fusion (stream, reverseStream, unstream) import Data.Text.Internal.Private (span_)-import Data.Text.Internal (Text(..), empty, firstf, safe, text)+import Data.Text.Internal (Text(..), empty, empty_, firstf, mul, safe, text) import qualified Prelude as P import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter, reverseIter_, unsafeHead, unsafeTail)-import Data.Text.Internal.Unsafe.Char (unsafeChr)+import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeWrite) import qualified Data.Text.Internal.Functions as F import qualified Data.Text.Internal.Encoding.Utf16 as U16 import Data.Text.Internal.Search (indices)@@ -231,6 +235,9 @@ #else import qualified GHC.Base as GHC #endif+#if __GLASGOW_HASKELL__ >= 708+import qualified GHC.Exts as Exts+#endif import GHC.Prim (Addr#) -- $strict@@ -331,6 +338,13 @@ instance IsString Text where fromString = pack +#if __GLASGOW_HASKELL__ >= 708+instance Exts.IsList Text where+ type Item Text = Char+ fromList = pack+ toList = unpack+#endif+ #if defined(HAVE_DEEPSEQ) instance NFData Text #endif@@ -405,12 +419,36 @@ unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a))) = unpackCString# a #-} +{-# RULES "TEXT empty literal"+ unstream (S.map safe (S.streamList []))+ = empty_ #-}++{-# RULES "TEXT singleton literal" forall a.+ unstream (S.map safe (S.streamList [a]))+ = singleton_ a #-}+ -- | /O(1)/ Convert a character into a Text. Subject to fusion. -- Performs replacement on invalid scalar values. singleton :: Char -> Text singleton = unstream . S.singleton . safe {-# INLINE [1] singleton #-} +{-# RULES "TEXT singleton" forall a.+ unstream (S.singleton (safe a))+ = singleton_ a #-}++-- This is intended to reduce inlining bloat.+singleton_ :: Char -> Text+singleton_ c = Text (A.run x) 0 len+ where x :: ST s (A.MArray s)+ x = do arr <- A.new len+ _ <- unsafeWrite arr 0 d+ return arr+ len | d < '\x10000' = 1+ | otherwise = 2+ d = safe c+{-# NOINLINE singleton_ #-}+ -- ----------------------------------------------------------------------------- -- * Basic functions @@ -441,6 +479,7 @@ | otherwise = overflowError "append" where len = len1+len2+ x :: ST s (A.MArray s) x = do arr <- A.new len A.copyI arr 0 arr1 off1 len1@@ -638,11 +677,11 @@ | neeLen == 0 = emptyError "replace" | L.null ixs = haystack | len > 0 = Text (A.run x) 0 len- | len < 0 = overflowError "replace" | otherwise = empty where ixs = indices needle haystack- len = hayLen - (neeLen - repLen) * L.length ixs+ len = hayLen - (neeLen - repLen) `mul` L.length ixs+ x :: ST s (A.MArray s) x = do marr <- A.new len let loop (i:is) o d = do@@ -853,6 +892,7 @@ where ts' = L.filter (not . null) ts len = sumP "concat" $ L.map lengthWord16 ts'+ go :: ST s (A.MArray s) go = do arr <- A.new len let step i (Text a o l) =@@ -963,10 +1003,10 @@ | n <= 0 || l <= 0 = empty | n == 1 = t | isSingleton t = replicateChar n (unsafeHead t)- | n <= maxBound `quot` l = Text (A.run x) 0 len- | otherwise = overflowError "replicate"+ | otherwise = Text (A.run x) 0 len where- len = l * n+ len = l `mul` n+ x :: ST s (A.MArray s) x = do arr <- A.new len let loop !d !i | i >= n = return arr@@ -1670,6 +1710,7 @@ copy :: Text -> Text copy (Text arr off len) = Text (A.run go) 0 len where+ go :: ST s (A.MArray s) go = do marr <- A.new len A.copyI marr 0 arr off len
Data/Text/Encoding.hs view
@@ -119,8 +119,6 @@ -- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII -- encoded text.------ This function is deprecated. Use 'decodeLatin1' instead. decodeASCII :: ByteString -> Text decodeASCII = decodeUtf8 {-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}@@ -269,6 +267,7 @@ UTF8_REJECT -> do -- We encountered an encoding error x <- peek curPtr'+ poke statePtr 0 case onErr desc (Just x) of Nothing -> loop $ curPtr' `plusPtr` 1 Just c -> do@@ -276,7 +275,6 @@ w <- unsafeSTToIO $ unsafeWrite dest (fromIntegral destOff) (safe c) poke destOffPtr (destOff + fromIntegral w)- poke statePtr 0 loop $ curPtr' `plusPtr` 1 _ -> do
Data/Text/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, DeriveDataTypeable #-}+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-} {-# OPTIONS_HADDOCK not-home #-} -- |@@ -20,6 +20,10 @@ -- with the internals, as the functions here do just about nothing to -- preserve data invariants. You have been warned! +#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#include "MachDeps.h"+#endif+ module Data.Text.Internal ( -- * Types@@ -32,8 +36,13 @@ , safe -- * Code that must be here for accessibility , empty+ , empty_ -- * Utilities , firstf+ -- * Checked multiplication+ , mul+ , mul32+ , mul64 -- * Debugging , showText ) where@@ -41,10 +50,11 @@ #if defined(ASSERTS) import Control.Exception (assert) #endif-import Data.Bits ((.&.))-import qualified Data.Text.Array as A+import Data.Bits+import Data.Int (Int32, Int64) import Data.Text.Internal.Unsafe.Char (ord) import Data.Typeable (Typeable)+import qualified Data.Text.Array as A -- | A space efficient, packed, unboxed Unicode text type. data Text = Text@@ -72,6 +82,11 @@ empty = Text A.empty 0 0 {-# INLINE [1] empty #-} +-- | A non-inlined version of 'empty'.+empty_ :: Text+empty_ = Text A.empty 0 0+{-# NOINLINE empty_ #-}+ -- | Construct a 'Text' without invisibly pinning its byte array in -- memory if its length has dwindled to zero. text :: A.Array -> Int -> Int -> Text@@ -101,12 +116,57 @@ safe c | ord c .&. 0x1ff800 /= 0xd800 = c | otherwise = '\xfffd'-{-# INLINE safe #-}+{-# INLINE [0] safe #-} -- | Apply a function to the first element of an optional pair. firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b) firstf f (Just (a, b)) = Just (f a, b) firstf _ Nothing = Nothing++-- | Checked multiplication. Calls 'error' if the result would+-- overflow.+mul :: Int -> Int -> Int+#if WORD_SIZE_IN_BITS == 64+mul a b = fromIntegral $ fromIntegral a `mul64` fromIntegral b+#else+mul a b = fromIntegral $ fromIntegral a `mul32` fromIntegral b+#endif+{-# INLINE mul #-}+infixl 7 `mul`++-- | Checked multiplication. Calls 'error' if the result would+-- overflow.+mul64 :: Int64 -> Int64 -> Int64+mul64 a b+ | a >= 0 && b >= 0 = mul64_ a b+ | a >= 0 = -mul64_ a (-b)+ | b >= 0 = -mul64_ (-a) b+ | otherwise = mul64_ (-a) (-b)+{-# INLINE mul64 #-}+infixl 7 `mul64`++mul64_ :: Int64 -> Int64 -> Int64+mul64_ a b+ | ahi > 0 && bhi > 0 = error "overflow"+ | top > 0x7fffffff = error "overflow"+ | total < 0 = error "overflow"+ | otherwise = total+ where (# ahi, alo #) = (# a `shiftR` 32, a .&. 0xffffffff #)+ (# bhi, blo #) = (# b `shiftR` 32, b .&. 0xffffffff #)+ top = ahi * blo + alo * bhi+ total = (top `shiftL` 32) + alo * blo+{-# INLINE mul64_ #-}++-- | Checked multiplication. Calls 'error' if the result would+-- overflow.+mul32 :: Int32 -> Int32 -> Int32+mul32 a b = case fromIntegral a * fromIntegral b of+ ab | ab < min32 || ab > max32 -> error "overflow"+ | otherwise -> fromIntegral ab+ where min32 = -0x80000000 :: Int64+ max32 = 0x7fffffff+{-# INLINE mul32 #-}+infixl 7 `mul32` -- $internals --
Data/Text/Internal/Builder.hs view
@@ -58,13 +58,11 @@ ) where import Control.Monad.ST (ST, runST)-import Data.Bits ((.&.)) import Data.Monoid (Monoid(..)) import Data.Text.Internal (Text(..)) import Data.Text.Internal.Lazy (smallChunkSize) import Data.Text.Unsafe (inlineInterleaveST)-import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)-import Data.Text.Internal.Unsafe.Shift (shiftR)+import Data.Text.Internal.Unsafe.Char (unsafeWrite) import Prelude hiding (map, putChar) import qualified Data.String as String@@ -127,17 +125,7 @@ -- * @'toLazyText' ('singleton' c) = 'L.singleton' c@ -- singleton :: Char -> Builder-singleton c = writeAtMost 2 $ \ marr o ->- if n < 0x10000- then A.unsafeWrite marr o (fromIntegral n) >> return 1- else do- A.unsafeWrite marr o lo- A.unsafeWrite marr (o+1) hi- return 2- where n = ord c- m = n - 0x10000- lo = fromIntegral $ (m `shiftR` 10) + 0xD800- hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00+singleton c = writeAtMost 2 $ \ marr o -> unsafeWrite marr o c {-# INLINE singleton #-} ------------------------------------------------------------------------
Data/Text/Internal/Fusion/Common.hs view
@@ -123,7 +123,7 @@ singleton c = Stream next False 1 where next False = Yield c True next True = Done-{-# INLINE singleton #-}+{-# INLINE [0] singleton #-} streamList :: [a] -> Stream a {-# INLINE [0] streamList #-}
Data/Text/Internal/Fusion/Size.hs view
@@ -32,6 +32,7 @@ , isEmpty ) where +import Data.Text.Internal (mul) #if defined(ASSERTS) import Control.Exception (assert) #endif@@ -99,12 +100,6 @@ subtractSize (Between _ mb) Unknown = Between 0 mb subtractSize _ _ = Unknown {-# INLINE subtractSize #-}--mul :: Int -> Int -> Int-mul m n- | m <= maxBound `quot` n = m * n- | otherwise = overflowError-{-# INLINE mul #-} mulSize :: Size -> Size -> Size mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)
Data/Text/Lazy.hs view
@@ -3,6 +3,10 @@ #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif+#if __GLASGOW_HASKELL__ >= 708+{-# LANGUAGE TypeFamilies #-}+#endif+ -- | -- Module : Data.Text.Lazy -- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan@@ -223,6 +227,9 @@ #else import qualified GHC.Base as GHC #endif+#if __GLASGOW_HASKELL__ >= 708+import qualified GHC.Exts as Exts+#endif import GHC.Prim (Addr#) -- $fusion@@ -329,6 +336,13 @@ instance IsString Text where fromString = pack +#if __GLASGOW_HASKELL__ >= 708+instance Exts.IsList Text where+ type Item Text = Char+ fromList = pack+ toList = unpack+#endif+ #if defined(HAVE_DEEPSEQ) instance NFData Text where rnf Empty = ()@@ -366,6 +380,14 @@ {-# RULES "TEXT literal UTF8" forall a. unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a))) = unpackCString# a #-}++{-# RULES "LAZY TEXT empty literal"+ unstream (S.streamList (L.map safe []))+ = Empty #-}++{-# RULES "LAZY TEXT empty literal" forall a.+ unstream (S.streamList (L.map safe [a]))+ = Chunk (T.singleton a) Empty #-} -- | /O(1)/ Convert a character into a Text. Subject to fusion. -- Performs replacement on invalid scalar values.
Data/Text/Lazy/Encoding.hs view
@@ -62,7 +62,7 @@ import qualified Data.ByteString.Unsafe as B #if MIN_VERSION_bytestring(0,10,4) import Data.Word (Word8)-import Data.Monoid (mempty, mappend)+import Data.Monoid (mempty, (<>)) import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith) import qualified Data.ByteString.Builder.Prim as BP@@ -163,12 +163,12 @@ strategy = B.safeStrategy firstChunkSize B.defaultChunkSize encodeUtf8Builder :: Text -> B.Builder-encodeUtf8Builder = foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) mempty+encodeUtf8Builder = foldrChunks (\c b -> TE.encodeUtf8Builder c <> b) mempty {-# INLINE encodeUtf8BuilderEscaped #-} encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder encodeUtf8BuilderEscaped prim =- foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty+ foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c <> b) mempty #else encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)
benchmarks/haskell/Benchmarks.hs view
@@ -15,6 +15,7 @@ import qualified Benchmarks.Equality as Equality import qualified Benchmarks.FileRead as FileRead import qualified Benchmarks.FoldLines as FoldLines+import qualified Benchmarks.Mul as Mul import qualified Benchmarks.Pure as Pure import qualified Benchmarks.ReadNumbers as ReadNumbers import qualified Benchmarks.Replace as Replace@@ -49,6 +50,7 @@ , Equality.benchmark (tf "japanese.txt") , FileRead.benchmark (tf "russian.txt") , FoldLines.benchmark (tf "russian.txt")+ , Mul.benchmark , Pure.benchmark "tiny" (tf "tiny.txt") , Pure.benchmark "ascii" (tf "ascii-small.txt") , Pure.benchmark "france" (tf "france.html")
benchmarks/haskell/Benchmarks/DecodeUtf8.hs view
@@ -25,7 +25,7 @@ import Foreign.ForeignPtr (withForeignPtr) import Data.Word (Word8) import qualified Criterion as C-import Criterion (Benchmark, bgroup, nf)+import Criterion (Benchmark, bgroup, nf, whnfIO) import qualified Codec.Binary.UTF8.Generic as U8 import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL@@ -48,7 +48,7 @@ return $ bgroup "DecodeUtf8" [ bench "Strict" $ nf T.decodeUtf8 bs , bench "Stream" $ nf decodeStream lbs- , bench "IConv" $ iconv bs+ , bench "IConv" $ whnfIO $ iconv bs , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs , bench "Lazy" $ nf TL.decodeUtf8 lbs
benchmarks/haskell/Benchmarks/FileRead.hs view
@@ -8,8 +8,8 @@ ( benchmark ) where -import Control.Exception (evaluate)-import Criterion (Benchmark, bgroup, bench)+import Control.Applicative ((<$>))+import Criterion (Benchmark, bgroup, bench, whnfIO) import qualified Data.ByteString as SB import qualified Data.ByteString.Lazy as LB import qualified Data.Text as T@@ -21,13 +21,13 @@ benchmark :: FilePath -> IO Benchmark benchmark p = return $ bgroup "FileRead"- [ bench "String" $ readFile p >>= evaluate . length- , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length- , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length- , bench "Text" $ T.readFile p >>= evaluate . T.length- , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length- , bench "TextByteString" $- SB.readFile p >>= evaluate . T.length . T.decodeUtf8- , bench "LazyTextByteString" $- LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8+ [ bench "String" $ whnfIO $ length <$> readFile p+ , bench "ByteString" $ whnfIO $ SB.length <$> SB.readFile p+ , bench "LazyByteString" $ whnfIO $ LB.length <$> LB.readFile p+ , bench "Text" $ whnfIO $ T.length <$> T.readFile p+ , bench "LazyText" $ whnfIO $ LT.length <$> LT.readFile p+ , bench "TextByteString" $ whnfIO $+ (T.length . T.decodeUtf8) <$> SB.readFile p+ , bench "LazyTextByteString" $ whnfIO $+ (LT.length . LT.decodeUtf8) <$> LB.readFile p ]
benchmarks/haskell/Benchmarks/FoldLines.hs view
@@ -10,7 +10,7 @@ ( benchmark ) where -import Criterion (Benchmark, bgroup, bench)+import Criterion (Benchmark, bgroup, bench, whnfIO) import System.IO import qualified Data.ByteString as B import qualified Data.Text as T@@ -22,7 +22,7 @@ , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int) ] where- withHandle f = do+ withHandle f = whnfIO $ do h <- openFile fp ReadMode hSetBuffering h (BlockBuffering (Just 16384)) x <- f h
+ benchmarks/haskell/Benchmarks/Mul.hs view
@@ -0,0 +1,138 @@+module Benchmarks.Mul (benchmark) where++import Control.Exception (evaluate)+import Criterion.Main+import Data.Int (Int32, Int64)+import Data.Text.Internal (mul32, mul64)+import qualified Data.Vector.Unboxed as U++oldMul :: Int64 -> Int64 -> Int64+oldMul m n+ | n == 0 = 0+ | m <= maxBound `quot` n = m * n+ | otherwise = error "overflow"++benchmark :: IO Benchmark+benchmark = do+ _ <- evaluate testVector32+ _ <- evaluate testVector64+ return $ bgroup "Mul" [+ bench "oldMul" $ whnf (U.map (uncurry oldMul)) testVector64+ , bench "mul64" $ whnf (U.map (uncurry mul64)) testVector64+ , bench "*64" $ whnf (U.map (uncurry (*))) testVector64+ , bench "mul32" $ whnf (U.map (uncurry mul32)) testVector32+ , bench "*32" $ whnf (U.map (uncurry (*))) testVector32+ ]++testVector64 :: U.Vector (Int64,Int64)+testVector64 = U.fromList [+ (0,1248868987182846646),(169004623633872,24458),(482549039517835,7614),+ (372,8157063115504364),(27,107095594861148252),(3,63249878517962420),+ (4363,255694473572912),(86678474,1732634806),(1572453024,1800489338),+ (9384523143,77053781),(49024709555,75095046),(7,43457620410239131),+ (8,8201563008844571),(387719037,1520696708),(189869238220197,1423),+ (46788016849611,23063),(503077742109974359,0),(104,1502010908706487),+ (30478140346,207525518),(80961140129236192,14),(4283,368012829143675),+ (1028719181728108146,6),(318904,5874863049591),(56724427166898,110794),+ (234539368,31369110449),(2,251729663598178612),(103291548194451219,5),+ (76013,5345328755566),(1769631,2980846129318),(40898,60598477385754),+ (0,98931348893227155),(573555872156917492,3),(318821187115,4476566),+ (11152874213584,243582),(40274276,16636653248),(127,4249988676030597),+ (103543712111871836,5),(71,16954462148248238),(3963027173504,216570),+ (13000,503523808916753),(17038308,20018685905),(0,510350226577891549),+ (175898,3875698895405),(425299191292676,5651),(17223451323664536,50),+ (61755131,14247665326),(0,1018195131697569303),(36433751497238985,20),+ (3473607861601050,1837),(1392342328,1733971838),(225770297367,3249655),+ (14,127545244155254102),(1751488975299136,2634),(3949208,504190668767),+ (153329,831454434345),(1066212122928663658,2),(351224,2663633539556),+ (344565,53388869217),(35825609350446863,54),(276011553660081475,10),+ (1969754174790470349,3),(35,68088438338633),(506710,3247689556438),+ (11099382291,327739909),(105787303549,32824363),(210366111,14759049409),+ (688893241579,3102676),(8490,70047474429581),(152085,29923000251880),+ (5046974599257095,400),(4183167795,263434071),(10089728,502781960687),+ (44831977765,4725378),(91,8978094664238578),(30990165721,44053350),+ (1772377,149651820860),(243420621763408572,4),(32,5790357453815138),+ (27980806337993771,5),(47696295759774,20848),(1745874142313778,1098),+ (46869334770121,1203),(886995283,1564424789),(40679396544,76002479),+ (1,672849481568486995),(337656187205,3157069),(816980552858963,6003),+ (2271434085804831543,1),(0,1934521023868747186),(6266220038281,15825),+ (4160,107115946987394),(524,246808621791561),(0,1952519482439636339),+ (128,2865935904539691),(1044,3211982069426297),(16000511542473,88922),+ (1253596745404082,2226),(27041,56836278958002),(23201,49247489754471),+ (175906590497,21252392),(185163584757182295,24),(34742225226802197,150),+ (2363228,250824838408),(216327527109550,45),(24,81574076994520675),+ (28559899906542,15356),(10890139774837133,511),(2293,707179303654492),+ (2749366833,40703233),(0,4498229704622845986),(439,4962056468281937),+ (662,1453820621089921),(16336770612459631,220),(24282989393,74239137),+ (2724564648490195,3),(743672760,124992589),(4528103,704330948891),+ (6050483122491561,250),(13322953,13594265152),(181794,22268101450214),+ (25957941712,75384092),(43352,7322262295009),(32838,52609059549923),+ (33003585202001564,2),(103019,68430142267402),(129918230800,8742978),+ (0,2114347379589080688),(2548,905723041545274),(222745067962838382,0),+ (1671683850790425181,1),(455,4836932776795684),(794227702827214,6620),+ (212534135175874,1365),(96432431858,29784975),(466626763743380,3484),+ (29793949,53041519613),(8359,309952753409844),(3908960585331901,26),+ (45185288970365760,114),(10131829775,68110174),(58039242399640479,83),+ (628092278238719399,6),(1,196469106875361889),(302336625,16347502444),+ (148,3748088684181047),(1,1649096568849015456),(1019866864,2349753026),+ (8211344830,569363306),(65647579546873,34753),(2340190,1692053129069),+ (64263301,30758930355),(48681618072372209,110),(7074794736,47640197),+ (249634721521,7991792),(1162917363807215,232),(7446433349,420634045),+ (63398619383,60709817),(51359004508011,14200),(131788797028647,7072),+ (52079887791430043,7),(7,136277667582599838),(28582879735696,50327),+ (1404582800566278,833),(469164435,15017166943),(99567079957578263,49),+ (1015285971,3625801566),(321504843,4104079293),(5196954,464515406632),+ (114246832260876,7468),(8149664437,487119673),(12265299,378168974869),+ (37711995764,30766513),(3971137243,710996152),(483120070302,603162),+ (103009942,61645547145),(8476344625340,6987),(547948761229739,1446),+ (42234,18624767306301),(13486714173011,58948),(4,198309153268019840),+ (9913176974,325539248),(28246225540203,116822),(2882463945582154,18),+ (959,25504987505398),(3,1504372236378217710),(13505229956793,374987),+ (751661959,457611342),(27375926,36219151769),(482168869,5301952074),+ (1,1577425863241520640),(714116235611821,1164),(904492524250310488,0),+ (5983514941763398,68),(10759472423,23540686),(72539568471529,34919),+ (4,176090672310337473),(938702842110356453,1),(673652445,3335287382),+ (3111998893666122,917),(1568013,3168419765469)]++testVector32 :: U.Vector (Int32,Int32)+testVector32 = U.fromList [+ (39242,410),(0,100077553),(2206,9538),(509400240,1),(38048,6368),+ (1789,651480),(2399,157032),(701,170017),(5241456,14),(11212,70449),+ (1,227804876),(749687254,1),(74559,2954),(1158,147957),(410604456,1),+ (170851,1561),(92643422,1),(6192,180509),(7,24202210),(3440,241481),+ (5753677,5),(294327,1622),(252,4454673),(127684121,11),(28315800,30),+ (340370905,0),(1,667887987),(592782090,1),(49023,27641),(750,290387),+ (72886,3847),(0,301047933),(3050276,473),(1,788366142),(59457,15813),+ (637726933,1),(1135,344317),(853616,264),(696816,493),(7038,12046),+ (125219574,4),(803694088,1),(107081726,1),(39294,21699),(16361,38191),+ (132561123,12),(1760,23499),(847543,484),(175687349,1),(2963,252678),+ (6248,224553),(27596,4606),(5422922,121),(1542,485890),(131,583035),+ (59096,4925),(3637115,132),(0,947225435),(86854,6794),(2984745,339),+ (760129569,1),(1,68260595),(380835652,2),(430575,2579),(54514,7211),+ (15550606,3),(9,27367402),(3007053,207),(7060988,60),(28560,27130),+ (1355,21087),(10880,53059),(14563646,4),(461886361,1),(2,169260724),+ (241454126,2),(406797,1),(61631630,16),(44473,5943),(63869104,12),+ (950300,1528),(2113,62333),(120817,9358),(100261456,1),(426764723,1),+ (119,12723684),(3,53358711),(4448071,18),(1,230278091),(238,232102),+ (8,57316440),(42437979,10),(6769,19555),(48590,22006),(11500585,79),+ (2808,97638),(42,26952545),(11,32104194),(23954638,1),(785427272,0),+ (513,81379),(31333960,37),(897772,1009),(4,25679692),(103027993,12),+ (104972702,11),(546,443401),(7,65137092),(88574269,3),(872139069,0),+ (2,97417121),(378802603,0),(141071401,4),(22613,10575),(2191743,118),+ (470,116119),(7062,38166),(231056,1847),(43901963,9),(2400,70640),+ (63553,1555),(34,11249573),(815174,1820),(997894011,0),(98881794,2),+ (5448,43132),(27956,9),(904926,1357),(112608626,3),(124,613021),+ (282086,1966),(99,10656881),(113799,1501),(433318,2085),(442,948171),+ (165380,1043),(28,14372905),(14880,50462),(2386,219918),(229,1797565),+ (1174961,298),(3925,41833),(3903515,299),(15690452,111),(360860521,3),+ (7440846,81),(2541026,507),(0,492448477),(6869,82469),(245,8322939),+ (3503496,253),(123495298,0),(150963,2299),(33,4408482),(1,200911107),+ (305,252121),(13,123369189),(215846,8181),(2440,65387),(776764401,1),+ (1241172,434),(8,15493155),(81953961,6),(17884993,5),(26,6893822),+ (0,502035190),(1,582451018),(2,514870139),(227,3625619),(49,12720258),+ (1456769,207),(94797661,10),(234407,893),(26843,5783),(15688,24547),+ (4091,86268),(4339448,151),(21360,6294),(397046497,2),(1227,205936),+ (9966,21959),(160046791,1),(0,159992224),(27,24974797),(19177,29334),+ (4136148,42),(21179785,53),(61256583,31),(385,344176),(7,11934915),+ (1,18992566),(3488065,5),(768021,224),(36288474,7),(8624,117561),+ (8,20341439),(5903,261475),(561,1007618),(1738,392327),(633049,1708)]
benchmarks/haskell/Benchmarks/Programs/BigTable.hs view
@@ -11,7 +11,7 @@ ( benchmark ) where -import Criterion (Benchmark, bench)+import Criterion (Benchmark, bench, whnfIO) import Data.Monoid (mappend, mconcat) import Data.Text.Lazy.Builder (Builder, fromText, toLazyText) import Data.Text.Lazy.IO (hPutStr)@@ -19,7 +19,7 @@ import qualified Data.Text as T benchmark :: Handle -> IO Benchmark-benchmark sink = return $ bench "BigTable" $ do+benchmark sink = return $ bench "BigTable" $ whnfIO $ do hPutStr sink "Content-Type: text/html\n\n<table>" hPutStr sink . toLazyText . makeTable =<< rows hPutStr sink "</table>"
benchmarks/haskell/Benchmarks/Programs/Cut.hs view
@@ -16,7 +16,7 @@ ( benchmark ) where -import Criterion (Benchmark, bgroup, bench)+import Criterion (Benchmark, bgroup, bench, whnfIO) import System.IO (Handle, hPutStr) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC@@ -40,7 +40,7 @@ , bench' "LazyTextByteString" lazyTextByteString ] where- bench' n s = bench n (s p sink from to)+ bench' n s = bench n $ whnfIO (s p sink from to) string :: FilePath -> Handle -> Int -> Int -> IO () string fp sink from to = do
benchmarks/haskell/Benchmarks/Programs/Fold.hs view
@@ -21,7 +21,7 @@ import Data.List (intersperse) import Data.Monoid (mempty, mappend, mconcat) import System.IO (Handle)-import Criterion (Benchmark, bench)+import Criterion (Benchmark, bench, whnfIO) import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy.Builder as TLB@@ -30,7 +30,7 @@ benchmark :: FilePath -> Handle -> IO Benchmark benchmark i o = return $- bench "Fold" $ T.readFile i >>= TL.hPutStr o . fold 80+ bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80 -- | We represent a paragraph by a word list --
benchmarks/haskell/Benchmarks/Programs/Sort.hs view
@@ -17,7 +17,7 @@ ( benchmark ) where -import Criterion (Benchmark, bgroup, bench)+import Criterion (Benchmark, bgroup, bench, whnfIO) import Data.Monoid (mconcat) import System.IO (Handle, hPutStr) import qualified Data.ByteString as B@@ -35,16 +35,17 @@ benchmark :: FilePath -> Handle -> IO Benchmark benchmark i o = return $ bgroup "Sort"- [ bench "String" $ readFile i >>= hPutStr o . string- , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString- , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString- , bench "Text" $ T.readFile i >>= T.hPutStr o . text- , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText- , bench "TextByteString" $ B.readFile i >>=+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString+ , bench "LazyByteString" $ whnfIO $+ BL.readFile i >>= BL.hPutStr o . lazyByteString+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text+ , bench "LazyText" $ whnfIO $ TL.readFile i >>= TL.hPutStr o . lazyText+ , bench "TextByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8- , bench "LazyTextByteString" $ BL.readFile i >>=+ , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>= BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8- , bench "TextBuilder" $ B.readFile i >>=+ , bench "TextBuilder" $ whnfIO $ B.readFile i >>= BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8 ]
benchmarks/haskell/Benchmarks/Programs/StripTags.hs view
@@ -15,7 +15,7 @@ ( benchmark ) where -import Criterion (Benchmark, bgroup, bench)+import Criterion (Benchmark, bgroup, bench, whnfIO) import Data.List (mapAccumL) import System.IO (Handle, hPutStr) import qualified Data.ByteString as B@@ -26,10 +26,10 @@ benchmark :: FilePath -> Handle -> IO Benchmark benchmark i o = return $ bgroup "StripTags"- [ bench "String" $ readFile i >>= hPutStr o . string- , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString- , bench "Text" $ T.readFile i >>= T.hPutStr o . text- , bench "TextByteString" $+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text+ , bench "TextByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8 ]
benchmarks/haskell/Benchmarks/Programs/Throughput.hs view
@@ -18,7 +18,7 @@ ( benchmark ) where -import Criterion (Benchmark, bgroup, bench)+import Criterion (Benchmark, bgroup, bench, whnfIO) import System.IO (Handle, hPutStr) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL@@ -29,13 +29,13 @@ benchmark :: FilePath -> Handle -> IO Benchmark benchmark fp sink = return $ bgroup "Throughput"- [ bench "String" $ readFile fp >>= hPutStr sink- , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink- , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink- , bench "Text" $ T.readFile fp >>= T.hPutStr sink- , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink- , bench "TextByteString" $+ [ bench "String" $ whnfIO $ readFile fp >>= hPutStr sink+ , bench "ByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink+ , bench "LazyByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink+ , bench "Text" $ whnfIO $ T.readFile fp >>= T.hPutStr sink+ , bench "LazyText" $ whnfIO $ TL.readFile fp >>= TL.hPutStr sink+ , bench "TextByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8- , bench "LazyTextByteString" $+ , bench "LazyTextByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8 ]
benchmarks/text-benchmarks.cabal view
@@ -36,14 +36,15 @@ bytestring, bytestring-lexing, containers,- criterion >= 0.6.0.1,+ criterion >= 0.10.0.0, deepseq, directory, filepath, ghc-prim, integer-gmp, stringsearch,- utf8-string+ utf8-string,+ vector executable text-multilang hs-source-dirs: haskell
changelog.md view
@@ -1,3 +1,16 @@+1.2.0.0++* Fixed an integer overflow in the replace function+ (https://github.com/bos/text/issues/81)++* Fixed a hang in lazy decodeUtf8With+ (https://github.com/bos/text/issues/87)++* Reduced codegen bloat caused by use of empty and single-character+ literals++* Added an instance of IsList for GHC 7.8 and above+ 1.1.1.0 * The Data.Data instance now allows gunfold to work, via a virtual
tests/Tests/Properties.hs view
@@ -54,6 +54,7 @@ import qualified Data.Text.Lazy.Encoding as EL import qualified Data.Text.Lazy.IO as TL import qualified System.IO as IO+import qualified Tests.Properties.Mul as Mul import qualified Tests.SlowFunctions as Slow t_pack_unpack = (T.unpack . T.pack) `eq` id@@ -197,8 +198,10 @@ tl_Show = show `eq` (show . TL.pack) t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s)) tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))-t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)-tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)+t_mconcat = unsquare $+ mconcat `eq` (unpackS . mconcat . L.map T.pack)+tl_mconcat = unsquare $+ mconcat `eq` (unpackS . mconcat . L.map TL.pack) t_mempty = mempty == (unpackS (mempty :: T.Text)) tl_mempty = mempty == (unpackS (mempty :: TL.Text)) t_IsString = fromString `eqP` (T.unpack . fromString)@@ -262,11 +265,14 @@ sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p) t_map f = map f `eqP` (unpackS . T.map f) tl_map f = map f `eqP` (unpackS . TL.map f)-s_intercalate c = L.intercalate c `eq`+s_intercalate c = unsquare $+ L.intercalate c `eq` (unpackS . S.intercalate (packS c) . map packS)-t_intercalate c = L.intercalate c `eq`+t_intercalate c = unsquare $+ L.intercalate c `eq` (unpackS . T.intercalate (packS c) . map packS)-tl_intercalate c = L.intercalate c `eq`+tl_intercalate c = unsquare $+ L.intercalate c `eq` (unpackS . TL.intercalate (TL.pack c) . map TL.pack) s_intersperse c = L.intersperse c `eqP` (unpackS . S.intersperse c)@@ -274,10 +280,14 @@ (unpackS . S.unstream . S.intersperse c) sf_intersperse p c= (L.intersperse c . L.filter p) `eqP` (unpackS . S.intersperse c . S.filter p)-t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)-tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)-t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)-tl_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)+t_intersperse c = unsquare $+ L.intersperse c `eqP` (unpackS . T.intersperse c)+tl_intersperse c = unsquare $+ L.intersperse c `eqP` (unpackS . TL.intersperse c)+t_transpose = unsquare $+ L.transpose `eq` (map unpackS . T.transpose . map packS)+tl_transpose = unsquare $+ L.transpose `eq` (map unpackS . TL.transpose . map TL.pack) t_reverse = L.reverse `eqP` (unpackS . T.reverse) tl_reverse = L.reverse `eqP` (unpackS . TL.reverse) t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)@@ -374,17 +384,24 @@ where _types = f :: Char -> Char -> Char t_foldr f z = L.foldr f z `eqP` T.foldr f z where _types = f :: Char -> Char -> Char-tl_foldr f z = L.foldr f z `eqP` TL.foldr f z+tl_foldr f z = unsquare $+ L.foldr f z `eqP` TL.foldr f z where _types = f :: Char -> Char -> Char-sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)+sf_foldr1 p f = unsquare $+ (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p) t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f-tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f+tl_foldr1 f = unsquare $+ L.foldr1 f `eqP` TL.foldr1 f -s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)-sf_concat p = (L.concat . map (L.filter p)) `eq`+s_concat_s = unsquare $+ L.concat `eq` (unpackS . S.unstream . S.concat . map packS)+sf_concat p = unsquare $+ (L.concat . map (L.filter p)) `eq` (unpackS . S.concat . map (S.filter p . packS))-t_concat = L.concat `eq` (unpackS . T.concat . map packS)-tl_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)+t_concat = unsquare $+ L.concat `eq` (unpackS . T.concat . map packS)+tl_concat = unsquare $+ L.concat `eq` (unpackS . TL.concat . map TL.pack) sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP` (unpackS . S.concatMap (packS . f) . S.filter p) t_concatMap f = unsquare $@@ -540,24 +557,27 @@ t_inits = L.inits `eqP` (map unpackS . T.inits) tl_inits = L.inits `eqP` (map unpackS . TL.inits) t_tails = L.tails `eqP` (map unpackS . T.tails)-tl_tails = L.tails `eqP` (map unpackS . TL.tails)-t_findAppendId (NotEmpty s) = unsquare $ \ts ->+tl_tails = unsquare $+ L.tails `eqP` (map unpackS . TL.tails)+t_findAppendId = unsquare $ \(NotEmpty s) ts -> let t = T.intercalate s ts in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)-tl_findAppendId (NotEmpty s) = unsquare $ \ts ->+tl_findAppendId = unsquare $ \(NotEmpty s) ts -> let t = TL.intercalate s ts in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)-t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .- T.intercalate s-tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .+t_findContains = unsquare $ \(NotEmpty s) ->+ all (T.isPrefixOf s . snd) . T.breakOnAll s . T.intercalate s+tl_findContains = unsquare $ \(NotEmpty s) -> all (TL.isPrefixOf s . snd) . TL.breakOnAll s . TL.intercalate s sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s -t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s-tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`- (map TL.fromStrict . T.splitOn s)) . T.intercalate s+t_splitOn_split s = unsquare $+ (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s+tl_splitOn_split s = unsquare $+ ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`+ (map TL.fromStrict . T.splitOn s)) . T.intercalate s t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t) tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t) @@ -599,10 +619,14 @@ t_words = L.words `eqP` (map unpackS . T.words) tl_words = L.words `eqP` (map unpackS . TL.words)-t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)-tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)-t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)-tl_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)+t_unlines = unsquare $+ L.unlines `eq` (unpackS . T.unlines . map packS)+tl_unlines = unsquare $+ L.unlines `eq` (unpackS . TL.unlines . map packS)+t_unwords = unsquare $+ L.unwords `eq` (unpackS . T.unwords . map packS)+tl_unwords = unsquare $+ L.unwords `eq` (unpackS . TL.unwords . map packS) s_isPrefixOf s = L.isPrefixOf s `eqP` (S.isPrefixOf (S.stream $ packS s) . S.stream)@@ -679,8 +703,9 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t) conc = T.concat . TL.toChunks-t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts- in Slow.indices t s == indices t s+t_indices_occurs = unsquare $ \(NotEmpty t) ts ->+ let s = T.intercalate t ts+ in Slow.indices t s == indices t s -- Bit shifts. shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k@@ -756,14 +781,16 @@ tl_decimal (n::Int) s = TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t) where t = TL.dropWhile isDigit s-t_hexadecimal (n::Positive Int) s ox =+t_hexadecimal m s ox = T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t) where t = T.dropWhile isHexDigit s p = if ox then "0x" else ""-tl_hexadecimal (n::Positive Int) s ox =+ n = getPositive m :: Int+tl_hexadecimal m s ox = TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t) where t = TL.dropWhile isHexDigit s p = if ox then "0x" else ""+ n = getPositive m :: Int isFloaty c = c `elem` "+-.0123456789eE" @@ -1282,5 +1309,7 @@ testProperty "t_take_drop_16" t_take_drop_16, testProperty "t_use_from" t_use_from, testProperty "t_copy" t_copy- ]+ ],++ testGroup "mul" Mul.tests ]
+ tests/Tests/Properties/Mul.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Tests.Properties.Mul (tests) where++import Control.Applicative ((<$>), pure)+import Control.Exception as E (SomeException, catch, evaluate)+import Data.Int (Int32, Int64)+import Data.Text.Internal (mul, mul32, mul64)+import System.IO.Unsafe (unsafePerformIO)+import Test.Framework (Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck hiding ((.&.))++mulRef :: (Integral a, Bounded a) => a -> a -> Maybe a+mulRef a b+ | ab < bot || ab > top = Nothing+ | otherwise = Just (fromIntegral ab)+ where ab = fromIntegral a * fromIntegral b+ top = fromIntegral (maxBound `asTypeOf` a) :: Integer+ bot = fromIntegral (minBound `asTypeOf` a) :: Integer++eval :: (a -> b -> c) -> a -> b -> Maybe c+eval f a b = unsafePerformIO $+ (Just <$> evaluate (f a b)) `E.catch` (\(_::SomeException) -> pure Nothing)++t_mul32 :: Int32 -> Int32 -> Property+t_mul32 a b = mulRef a b === eval mul32 a b++t_mul64 :: Int64 -> Int64 -> Property+t_mul64 a b = mulRef a b === eval mul64 a b++t_mul :: Int -> Int -> Property+t_mul a b = mulRef a b === eval mul a b++tests :: [Test]+tests = [+ testProperty "t_mul" t_mul+ , testProperty "t_mul32" t_mul32+ , testProperty "t_mul64" t_mul64+ ]
tests/text-tests.cabal view
@@ -23,6 +23,15 @@ executable text-tests main-is: Tests.hs + other-modules:+ Tests.IO+ Tests.Properties+ Tests.Properties.Mul+ Tests.QuickCheckUtils+ Tests.Regressions+ Tests.SlowFunctions+ Tests.Utils+ ghc-options: -Wall -threaded -O0 -rtsopts
text.cabal view
@@ -1,5 +1,5 @@ name: text-version: 1.1.1.4+version: 1.2.0.0 homepage: https://github.com/bos/text bug-reports: https://github.com/bos/text/issues synopsis: An efficient packed Unicode text type.@@ -59,6 +59,7 @@ tests/.ghci tests/Makefile tests/Tests/*.hs+ tests/Tests/Properties/*.hs tests/cabal.config tests/scripts/*.sh tests/text-tests.cabal@@ -136,6 +137,7 @@ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 if flag(developer) ghc-prof-options: -auto-all+ ghc-options: -Werror cpp-options: -DASSERTS if flag(integer-simple)