Commits

Anonymous committed 4b0c785

Add the test code

  • Participants
  • Parent commits 183df05

Comments (0)

Files changed (6)

File tests/Bench.hs

+{-# OPTIONS_GHC -fglasgow-exts -fbang-patterns #-}
+
+--module Bench where
+
+import BenchUtils
+import System.Mem 
+import Control.Concurrent
+import Char 
+import Data.Array.IArray
+import System.CPUTime
+import System.IO
+import System.IO.Unsafe
+import Text.Printf
+import Control.Exception
+
+import qualified Text as T
+import Text.Internal
+import qualified Text.Fusion as S
+import Text.Fusion (Encoding(..))
+
+import qualified Data.List as L
+import qualified Data.ByteString as B
+import Data.ByteString (ByteString)
+import Data.Word
+import qualified System.IO.UTF8 as UTF8
+
+main = do ascii_bs <- B.readFile "ascii.txt"
+          let ascii_txt = T.decode ASCII ascii_bs 
+          let ascii_str = T.unpack ascii_txt
+          force (ascii_txt,ascii_str,ascii_bs)
+          printf " # Text\t\tString\tByteString\n"
+          run 1 (ascii_txt,ascii_str,ascii_bs) ascii_tests
+          performGC
+          bmp_txt <- T.readFile Utf8 "bmp.txt"
+          let bmp_str = T.unpack bmp_txt
+          force (bmp_txt,bmp_str)
+          printf " # Text\t\tString\t\n"
+          run 1 (bmp_txt, bmp_str, B.empty)     bmp_tests
+          performGC
+          smp_sip_txt <- T.readFile Utf8 "smp_sip.txt"
+          let smp_sip_str = T.unpack smp_sip_txt
+          force (smp_sip_txt, smp_sip_str)
+          printf " # Text\t\tString\t\n"
+          run 1 (smp_sip_txt, smp_sip_str,B.empty) smp_sip_tests
+          
+          
+ascii_tests = [
+                ("cons",
+                 [F (app1 (T.cons '\88')),
+                  F (app2 ((:) '\88')    ),
+                  F (app3 (B.cons 88) )]),
+                ("head",
+                 [F (app1 T.head), 
+                  F (app2 L.head),
+                  F (app3 B.head)]),
+                ("last",
+                 [F (app1 T.last),
+                  F (app2 L.last),
+                  F (app3 B.last)]),
+                ("tail",
+                 [F (app1 T.tail),
+                  F (app2 L.tail),
+                  F (app3 B.tail)]),
+                ("init",
+                 [F (app1 T.init),
+                  Flist (app2 L.init),
+                  F (app3 B.init) ]),
+                ("null",
+                 [F (app1 T.null),
+                  F (app2 L.null),
+                  F (app3 B.null) ]),
+                ("length",
+                 [F (app1 T.length),
+                  F (app2 L.length),
+                  F (app3 B.length)]),
+                 ("map",
+                  [F (app1 $ T.map succ), 
+                   Flist (app2 (L.map succ)),
+                   F (app3 $ B.map succ)]),
+                 ("filter",
+                  [F $ app1 $ T.filter (/= '\101'),
+                   Flist $ app2 $ L.filter (/= '\101'),
+                   F $ app3 $ B.filter (/= 101)]),
+                 ("foldl'",
+                  [F (app1 $ T.foldl' (\a w -> a+1::Int) 0),
+                   F (app2 $ L.foldl' (\a w -> a+1::Int) 0),
+                   F (app3 $ B.foldl' (\a w -> a+1::Int) 0)
+                  ]),
+                 ("drop",
+                  [F (app1 $ T.drop 30000000),
+                   Flist (app2 $ L.drop 30000000),
+                   F (app3 $ B.drop 30000000)
+                  ]),
+                 ("take",
+                  [F (app1 $ T.take 30000000),
+                   Flist (app2 $ L.take 30000000),
+                   F (app3 $ B.take 30000000)]),
+                 ("words",
+                  [F (app1 $ T.words),
+                   Flist (app2 $ L.words)])
+ ]
+
+bmp_tests = [
+                ("cons",
+                 [F (app1 (T.cons '\88')),
+                  F (app2 ((:) '\88')    )]),
+                ("head",
+                 [F (app1 T.head), 
+                  F (app2 L.head)]),
+                ("last",
+                 [F (app1 T.last),
+                  F (app2 L.last)]),
+                ("tail",
+                 [F (app1 T.tail),
+                  F (app2 L.tail)]),
+                ("init",
+                 [F (app1 T.init),
+                  Flist (app2 L.init)]),
+                ("null",
+                 [F (app1 T.null),
+                  F (app2 L.null),
+                  F (app3 B.null)]),
+                  ("length",
+                   [F (app1 T.length),
+                    F (app2 L.length),
+                    F (app3 B.length)]),
+                 ("map",
+                  [F (app1 $ T.map succ), 
+                   Flist (app2 (L.map succ))]),
+                 ("filter",
+                  [F $ app1 $ T.filter (/= '\101'),
+                   Flist $ app2 $ L.filter (/= '\101')]),
+                 ("foldl'",
+                  [F (app1 $ T.foldl' (\a w -> a+1::Int) 0),
+                   F (app2 $ L.foldl' (\a w -> a+1::Int) 0)]),
+                 ("drop",
+                  [F (app1 $ T.drop 30000000),
+                   Flist (app2 $ L.drop 30000000)]),
+                 ("take",
+                  [F (app1 $ T.take 30000000),
+                   Flist (app2 $ L.take 30000000)]),
+                 ("words",
+                  [F (app1 $ T.words),
+                   Flist (app2 $ L.words)])
+ ]
+
+smp_sip_tests = [
+                ("cons",
+                 [F (app1 (T.cons '\65624')),
+                  F (app2 ((:) '\65624'))]),
+                ("head",
+                 [F (app1 T.head), 
+                  F (app2 L.head)]),
+                ("last",
+                 [F (app1 T.last),
+                  F (app2 L.last)]),
+                ("tail",
+                 [F (app1 T.tail),
+                  F (app2 L.tail)]),
+                ("init",
+                 [F (app1 T.init),
+                  Flist (app2 L.init)]),
+                ("null",
+                 [F (app1 T.null),
+                  F (app2 L.null),
+                  F (app3 B.null) ]),
+                ("length",
+                 [F (app1 T.length ),
+                  F (app2 L.length),
+                  F (app3 B.length)]),
+                 ("map",
+                  [F (app1 $ T.map succ), 
+                   Flist (app2 (L.map succ))]),
+                 ("filter",
+                  [F $ app1 $ T.filter (/= '\65624'),
+                   Flist $ app2 $ L.filter (/= '\65624')]),
+                 ("foldl'",
+                  [F (app1 $ T.foldl' (\a w -> a+1::Int) 0),
+                   F (app2 $ L.foldl' (\a w -> a+1::Int) 0)]),
+                 ("drop",
+                  [F (app1 $ T.drop 30000000),
+                   Flist (app2 $ L.drop 30000000)]),
+                 ("take",
+                  [F (app1 $ T.take 30000000),
+                   Flist (app2 $ L.take 30000000)])
+                ]

File tests/BenchUtils.hs

+{-# OPTIONS_GHC -fglasgow-exts -fbang-patterns #-}
+
+module BenchUtils where
+
+import qualified Data.List as L
+import Data.ByteString (ByteString(..))
+import Data.Word
+import Text.Printf
+import System.IO
+import Text.Internal (Text(..))
+import System.Mem
+import System.CPUTime
+import Control.Exception
+import Control.Concurrent
+
+data Result = T | B
+
+data F a = forall b. F (a -> b) | forall b. Flist (a -> [b])
+
+class Forceable a where
+    force :: a -> IO Result
+    force v = v `seq` return T
+
+instance Forceable Text 
+
+seqList = L.foldl' (flip seq) (return ())
+instance Forceable [a] where
+    force = L.foldl' (flip seq) (return T)
+
+instance Forceable ByteString
+instance Forceable Char
+instance Forceable Bool
+instance Forceable Int
+instance Forceable Word8
+
+instance (Forceable a, Forceable b) => Forceable (a,b) where
+    force (a,b) = force a >> force b
+
+instance (Forceable a, Forceable b, Forceable c) => Forceable (a,b,c) where
+    force (a,b,c) = force a >> force b >> force c
+
+run c x tests = sequence_ $ zipWith (runTest c x) [1..] tests
+
+runTest :: Int -> a -> Int -> (String,[F a]) -> IO ()
+runTest count x n (name,tests) = do 
+  printf "%2d " n
+  fn tests
+  printf "\t# %-16s\n" (show name)
+  hFlush stdout
+         where fn xs = case xs of
+                         [f,g,h] -> runN count f x >> putStr "\t" 
+                                  >> runN count g x >> putStr "\t"
+                                  >> runN count h x >> putStr "\t"
+                         [f,g]   -> runN count f x >> putStr "\t"
+                                 >> runN count g x >> putStr "\t\t"
+                         [f]     -> runN count f x >> putStr "\t\t\t"
+                         _       -> return ()
+               run f x = performGC >> threadDelay 100 >> time f x
+               runN 0 f x = return ()
+               runN c f x = run f x >> runN (c-1) f x
+
+time (Flist f) a = do 
+  start <- getCPUTime
+  v     <- seqList (f a)
+  end   <- getCPUTime
+  let diff = (fromIntegral (end - start)) / 10^12
+  printf "%0.3f" (diff :: Double)
+  hFlush stdout
+                    
+time (F f) a = do
+  start <- getCPUTime
+  v <- evaluate (f a)
+  end <- getCPUTime
+  let diff = (fromIntegral (end - start)) / 10^12
+  printf "%0.3f" (diff :: Double)
+  hFlush stdout
+
+app1 f (x,y,z) = f x
+app2 f (x,y,z) = f y
+app3 f (x,y,z) = f z 

File tests/EncodingBench.hs

+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+import BenchUtils
+import qualified Data.Text.Utf8.Fusion as U8
+import qualified Data.Text.Utf8.Internal as U8I
+import qualified Data.Text.Utf32.Fusion as U32
+import qualified Data.Text.Utf32.Internal as U32I
+import qualified Data.Text.Fusion as S
+import Data.Text.Fusion (bsStream,Encoding(..))
+import qualified Data.Text as T
+import qualified Data.ByteString as B
+import Text.Printf
+import System.Mem
+
+instance Forceable U32I.Text
+instance Forceable U8I.Text
+
+data E a = forall b. E (a -> b) | EText (a -> S.Stream Char)
+
+main = do force (ascii_tests, smp_sip_tests)
+          ascii       <- B.readFile "ascii.txt"
+          let ascii8  = U8.unstream  (bsStream ascii ASCII)
+          let ascii16 = S.unstream   (bsStream ascii ASCII)
+          let ascii32 = U32.unstream (bsStream ascii ASCII)
+          force (ascii8, ascii16, ascii32)
+          printf " # Utf8\t\tUtf16\tUtf32\n"
+          run 1 (ascii8, ascii16, ascii32) ascii_tests
+          performGC
+          bmp   <- B.readFile "bmp.txt"
+          let bmp8  = U8.unstream  (bsStream bmp Utf8)
+          let bmp16 = S.unstream   (bsStream bmp Utf8)
+          let bmp32 = U32.unstream (bsStream bmp Utf8)
+          force (bmp8, bmp16, bmp32)
+          printf " # Utf8\t\tUtf16\tUtf32\n"
+          run 1 (bmp8, bmp16, bmp32)     ascii_tests
+          performGC
+          smp_sip       <- B.readFile "smp_sip.txt"
+          let smp_sip8  = U8.unstream (bsStream smp_sip Utf8)
+          let smp_sip16 = S.unstream (bsStream smp_sip Utf8)
+          let smp_sip32 = U32.unstream (bsStream smp_sip Utf8)
+          force (smp_sip8, smp_sip16, smp_sip32)
+          printf " # Utf8\t\tUtf16\tUtf32\n"
+          run 1 (smp_sip8, smp_sip16, smp_sip32) smp_sip_tests
+          
+ascii_tests = [
+    ("cons"  , 
+     [F $ app1 $ U8.unstream  . S.cons '\88' . U8.stream, 
+      F $ app2 $ S.unstream   . S.cons '\88' . S.stream, 
+      F $ app3 $ U32.unstream . S.cons '\88' . U32.stream]),
+    ("length", 
+     [F $ app1 $ S.length . U8.stream,
+      F $ app2 $ S.length . S.stream,
+      F $ app3 $ S.length . U32.stream]),
+    ("map"   , 
+     [F $ app1 $ U8.unstream  . S.map succ . U8.stream,
+      F $ app2 $ S.unstream   . S.map succ . S.stream, 
+      F $ app3 $ U32.unstream . S.map succ . U32.stream]),
+    ("filter", 
+     [F $ app1 $ U8.unstream  . S.filter (/= '\101') . U8.stream,
+      F $ app2 $ S.unstream   . S.filter (/= '\101') . S.stream,
+      F $ app3 $ U32.unstream . S.filter (/= '\101') . U32.stream]),
+    ("take", 
+     [F $ app1 $ U8.unstream  . S.take 1000000 . U8.stream,
+      F $ app2 $ S.unstream   . S.take 1000000 . S.stream,
+      F $ app3 $ U32.unstream . S.take 1000000 . U32.stream]),
+    ("drop"  , 
+     [F $ app1 $ U8.unstream  . S.drop 1000000 . U8.stream,
+      F $ app2 $ S.unstream   . S.drop 1000000 . S.stream,
+      F $ app3 $ U32.unstream . S.drop 1000000 . U32.stream]),
+    ("foldl'",
+     [F $ app1 $ S.foldl' (\a w -> a+1::Int) 0 . U8.stream,
+      F $ app2 $ S.foldl' (\a w -> a+1::Int) 0 . S.stream,
+      F $ app3 $ S.foldl' (\a w -> a+1::Int) 0 . U32.stream
+     ])
+ ]
+
+smp_sip_tests = [
+    ("cons"  , 
+     [F $ app1 $ U8.unstream  . S.cons '\88' . U8.stream, 
+      F $ app2 $ S.unstream   . S.cons '\88' . S.stream, 
+      F $ app3 $ U32.unstream . S.cons '\88' . U32.stream]),
+    ("length", 
+     [F $ app1 $ S.length . U8.stream,
+      F $ app2 $ S.length . S.stream,
+      F $ app3 $ S.length . U32.stream]),
+    ("map"   , 
+     [F $ app1 $ U8.unstream  . S.map succ . U8.stream,
+      F $ app2 $ S.unstream   . S.map succ . S.stream, 
+      F $ app3 $ U32.unstream . S.map succ . U32.stream]),
+    ("filter", 
+     [F $ app1 $ U8.unstream  . S.filter (/= '\101') . U8.stream,
+      F $ app2 $ S.unstream   . S.filter (/= '\101') . S.stream,
+      F $ app3 $ U32.unstream . S.filter (/= '\101') . U32.stream]),
+    ("take", 
+     [F $ app1 $ U8.unstream  . S.take 1000000 . U8.stream,
+      F $ app2 $ S.unstream   . S.take 1000000 . S.stream,
+      F $ app3 $ U32.unstream . S.take 1000000 . U32.stream]),
+    ("drop"  , 
+     [F $ app1 $ U8.unstream  . S.drop 1000000 . U8.stream,
+      F $ app2 $ S.unstream   . S.drop 1000000 . S.stream,
+      F $ app3 $ U32.unstream . S.drop 1000000 . U32.stream]),
+    ("foldl'",
+     [F $ app1 $ S.foldl' (\a w -> a+1::Int) 0 . U8.stream,
+      F $ app2 $ S.foldl' (\a w -> a+1::Int) 0 . S.stream,
+      F $ app3 $ S.foldl' (\a w -> a+1::Int) 0 . U32.stream])
+ ]

File tests/FusionBench.hs

+import Prelude hiding (zip,zip3,fst,snd)
+
+import BenchUtils
+import Char
+import qualified Data.List as L
+import qualified Data.ByteString as B
+import qualified Text as T
+import Text.Fusion (Encoding(..))
+import qualified Text.Fusion as S
+import Text.Printf
+import System.IO
+import System.Mem
+import qualified System.IO.UTF8 as UTF8
+
+main = do ascii_str <- readFile "ascii.txt" 
+          ascii_bs  <- B.readFile "ascii.txt"
+          let ascii_txt = T.decode ASCII ascii_bs
+          force (ascii_txt,ascii_str,ascii_bs)
+          printf " # Text\t\tString\tByteString\n"
+          run 1 (ascii_txt,ascii_str,ascii_bs) ascii_tests
+
+ascii_tests =  [
+ ("map/map",
+  [F $ T.map pred . T.map succ . fst, 
+   Flist $ L.map pred . L.map succ . snd,
+   F $ B.map pred . B.map succ . trd]),
+ ("filter/filter",
+  [F $ T.filter (/= '\101') . T.filter (/= '\102') . fst,
+   Flist $ L.filter (/= '\101') . L.filter (/= '\102') . snd,
+   F $ B.filter (/= 101) . B.filter (/= 102) . trd]),
+ ("filter/map",
+  [F $ T.filter (/= '\103') . T.map succ . fst,
+   Flist $ L.filter (/= '\103') . L.map succ . snd,
+   F $ B.filter (/= 103) . B.map succ . trd]),
+ ("map/filter",
+  [F $ T.map succ . T.filter (/= '\104') . fst,
+   Flist $ L.map succ . L.filter (/= '\104') . snd,
+   F $ B.map succ . B.filter (/= 104) . trd]),
+ ("foldl'/map",
+  [F $ T.foldl' (const . (+1)) (0 :: Int) . T.map succ . fst,
+   F $ L.foldl' (const . (+1)) (0 :: Int) . L.map succ . snd,
+   F $ B.foldl' (const . (+1)) (0 :: Int) . B.map succ . trd]),
+ ("foldl'/filter",
+  [F $ T.foldl' (const . (+2)) (0::Int) . T.filter (/= '\105') . fst,
+   F $ L.foldl' (const . (+2)) (0::Int) . L.filter (/= '\105') . snd,
+   F $ B.foldl' (const . (+2)) (0::Int) . B.filter (/= 105) . trd]),
+ ("foldl'/map/filter",
+  [F $ T.foldl' (const.(+3)) (0::Int) . T.map succ . T.filter (/='\110') . fst,
+   F $ L.foldl' (const.(+3)) (0::Int) . L.map succ . L.filter (/='\110') . snd,
+   F $ B.foldl' (const . (+3)) (0::Int) . B.map succ . B.filter (/= 110) . trd])
+ ]

File tests/Properties.hs

+{-# OPTIONS_GHC -fno-rewrite-rules #-}
+
+import Test.QuickCheck
+import Text.Show.Functions
+
+import Prelude 
+import qualified Text as T
+import Text (pack,unpack)
+import qualified Text.Fusion as S
+import Text.Fusion (unstream,stream)
+import qualified Data.List as L
+
+
+import QuickCheckUtils
+
+prop_pack_unpack s   = (unpack . pack) s == s
+prop_stream_unstream t = (unstream . stream) t == t
+prop_singleton c     = [c] == (unpack . T.singleton) c
+
+prop_cons x xs       = (x:xs) == (unpack . T.cons x . pack) xs
+prop_snoc x xs       = (xs ++ [x]) == (unpack . (flip T.snoc) x . pack) xs
+prop_append s1 s2    = (s1 ++ s2) == (unpack $ T.append (pack s1) (pack s2))
+prop_appendS s1 s2   = (s1 ++ s2) == ((unpack . unstream) $ S.append ((stream . pack) s1) ((stream . pack) s2))
+prop_head s          = not (null s) ==> head s == (T.head . pack) s
+prop_last s          = not (null s) ==> last s == (T.last . pack) s
+prop_lastS s         = not (null s) ==> last s == (S.last . stream . pack) s
+prop_tail s          = not (null s) ==> tail s == (unpack . T.tail . pack) s
+prop_tailS s         = not (null s) ==> tail s == (unpack . unstream . S.tail . stream . pack) s
+prop_init s          = not (null s) ==> init s == (unpack . T.init . pack) s
+prop_initS s         = not (null s) ==> init s == (unpack . unstream . S.init . stream . pack) s
+prop_null s          = null s == (T.null . pack) s
+prop_length s        = length s == (T.length . pack) s
+prop_map f s         = (map f s) == (unpack . T.map f . pack) s
+prop_intersperse c s = (L.intersperse c s) == (unpack . T.intersperse c . pack) s
+prop_transpose ss    = (L.transpose ss) == (map unpack . T.transpose . map pack) ss
+
+prop_foldl f z s     = L.foldl f z s == T.foldl f z (pack s)
+prop_foldl' f z s    = L.foldl' f z s == T.foldl' f z (pack s)
+prop_foldl1 f s      = not (null s) ==> L.foldl1 f s == T.foldl1 f (pack s)
+prop_foldl1' f s     = not (null s) ==> L.foldl1' f s == T.foldl1' f (pack s)
+prop_foldr f z s     = L.foldr f z s == T.foldr f z (pack s)
+prop_foldr1 f s      = not (null s) ==> L.foldr1 f s == T.foldr1 f (pack s)
+
+prop_concat ss       = (L.concat ss) == (unpack . T.concat . map pack) ss    
+prop_concatMap f s   = (L.concatMap f s) == (unpack (T.concatMap (pack . f) (pack s)))
+prop_any p s         = L.any p s == T.any p (pack s)
+prop_all p s         = L.all p s == T.all p (pack s)
+prop_minimum s       = not (null s) ==> L.minimum s == T.minimum (pack s)
+prop_maximum s       = not (null s) ==> L.maximum s == T.maximum (pack s)
+
+prop_take n s        = L.take n s == (unpack . T.take n . pack) s
+prop_drop n s        = L.drop n s == (unpack . T.drop n . pack) s
+prop_takeWhile p s   = L.takeWhile p s == (unpack . T.takeWhile p . pack) s
+prop_dropWhile p s   = L.dropWhile p s == (unpack . T.dropWhile p . pack) s
+prop_elem c s        = L.elem c s == (T.elem c . pack) s
+prop_find p s        = L.find p s == (T.find p . pack) s
+prop_filter p s      = L.filter p s == (unpack . T.filter p . pack) s
+prop_index x s       = x < L.length s && x >= 0 ==> (L.!!) s x == T.index (pack s) x
+prop_findIndex p s   = L.findIndex p s == T.findIndex p (pack s)
+prop_elemIndex c s   = L.elemIndex c s == T.elemIndex c (pack s)
+prop_zipWith c s1 s2 = L.zipWith c s1 s2 == unpack (T.zipWith c (pack s1) (pack s2))
+prop_words s         = L.words s == L.map unpack (T.words (pack s))

File tests/QuickCheckUtils.hs

+module QuickCheckUtils where
+
+import Test.QuickCheck
+import Test.QuickCheck.Batch
+
+import Char
+
+import Text
+import Text.Internal
+
+instance Arbitrary Char where
+    arbitrary    = oneof [choose ('\0','\55295'), choose ('\57334','\1114111')]
+    coarbitrary c = variant (ord c `rem` 4)
+
+instance Arbitrary Text where
+    arbitrary     = pack `fmap` arbitrary
+    coarbitrary s = coarbitrary (unpack s)