Commits

Bryan O'Sullivan  committed 67e3ab4

Get rid of obsolete benchmarking code.

  • Participants
  • Parent commits 81b74a3

Comments (0)

Files changed (4)

File tests/Bench.hs

-import BenchUtils
-import System.Mem 
-import Control.Concurrent
-import Data.Char
-import System.CPUTime
-import System.IO
-import System.IO.Unsafe
-import Text.Printf
-import Control.Exception
-
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as E
-import Data.Text.Internal
-import qualified Data.Text.Fusion as S
-
-import qualified Data.List as L
-import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString as B8
-import Data.ByteString (ByteString)
-import Data.Word
-import qualified System.IO.UTF8 as UTF8
-
-main = do ascii_bs <- B.readFile "text/test/ascii.txt"
-          let ascii_txt = E.decodeASCII 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
-          
-          
-ascii_tests = [
-                ("cons",
-                 [F (app1 (T.cons '\88')),
-                  F (app2 ((:) '\88')    ),
-                  F (app3 (B8.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 $ B8.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),
-                   F (app3 $ B.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

-{-# LANGUAGE ExistentialQuantification #-}
-module BenchUtils where
-
-import qualified Data.List as L
-import Data.ByteString (ByteString(..))
-import Data.Word
-import Text.Printf
-import System.IO
-import Data.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

-{-# LANGUAGE ExistentialQuantification #-}
-
-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)
-
-import BenchUtils
-import Data.Char
-import qualified Data.List as L
-import qualified Data.ByteString as B
-import qualified Data.Text as T
-import Data.Text.Fusion (Encoding(..))
-import qualified Data.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
-
-trd (a,b,c) = c
-
-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])
- ]