1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
| {-# OPTIONS -cpp -fffi #-}
module Main ( main ) where
import System.IO
import System.CPUTime
import Data.List
import Control.Exception
import System.Environment
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Internal as B
import qualified Data.Set as Set
import qualified Data.IntSet as IntSet
import qualified Data.Adaptive.Map as AMap
import Data.Char
import Data.Int
import Data.Typeable
import Data.Binary
import Control.Monad.State
import System.Random
import Shuffle
--import qualified Data.CompactString as C
--import qualified Data.CompactString.Encodings as C
import qualified Data.CompactMap as Compact
foreign import ccall unsafe "getAllocations" getAllocations :: IO Int64
--------------------------------------------------------------
-- Input
--------------------------------------------------------------
--getWordsCompact :: IO [C.CompactString C.UTF8]
--getWordsCompact = fmap (C.lines) (C.readFile "words2.unicode")
getWordsString :: IO [String]
getWordsString = fmap (lines) $ readFile "words2.unicode"
getWordsByteString :: IO [B.ByteString]
getWordsByteString = fmap (B.lines) $ B.readFile "words2.unicode"
--------------------------------------------------------------
-- The functions we're benchmarking.
--------------------------------------------------------------
{- SPECIALIZE diskSetInsert :: [String] -> IO Int -}
{-# SPECIALIZE compactMapInsert :: [B.ByteString] -> IO Int #-}
{- SPECIALIZE diskSetInsert :: [C.CompactString C.UTF8] -> IO Int -}
{- SPECIALIZE diskSetInsert :: [Int] -> IO Int -}
compactMapInsert input
= do evaluate (Compact.size $ Compact.fromList [ (n, ()) | n <- input ])
return 0
{-# SPECIALIZE mapInsert :: [String] -> IO Int #-}
{-# SPECIALIZE mapInsert :: [B.ByteString] -> IO Int #-}
{- SPECIALIZE mapInsert :: [C.CompactString C.UTF8] -> IO Int -}
{-# SPECIALIZE mapInsert :: [Int] -> IO Int #-}
mapInsert input
= do evaluate (Map.size (Map.fromList [ (n,()) | n <- input ]))
return 0
{-# SPECIALIZE amapInsert :: [Int] -> IO Int #-}
amapInsert :: (AMap.AdaptMap k Int, Ord k) => [k] -> IO Int
amapInsert input
= do evaluate (AMap.size (AMap.fromList [ (n, 0::Int) | n <- input ]))
--------------------------------------------------------------
-- Runner code
--------------------------------------------------------------
runTest n fn
= do t1 <- getCPUTime
allocs1 <- getAllocations
res <- fn
allocs2 <- getAllocations
t2 <- getCPUTime
let t = max 1 ((t2-t1) `div` cpuTimePrecision)
reqsPerSec = fromIntegral n `div` t * 100
alloc = (allocs2-allocs1+fromIntegral res) `div` 1024 `div` 1024
return (reqsPerSec, alloc)
stdGen = mkStdGen 98159874
performTest testType n style
= let {-# INLINE fn #-}
fn :: (Typeable a, Show a, Ord a, Binary a) => [a] -> [a]
fn = case testType of
Insert -> id
RandomInsert -> shuffle stdGen
ReverseInsert -> reverse
DuplicateInsert -> take n . cycle . take (n`div`10) . shuffle stdGen
{-# INLINE outputTest #-}
outputTest :: (AMap.AdaptMap a Int, Typeable a, Show a, Ord a, Binary a) => [a] -> IO ()
outputTest inp
= let modifier = fn
inp' = modifier (take n $ cycle inp)
in length inp' `seq`
do (reqsPerSecDisk, mbAllocDisk) <- runTest n (amapInsert inp') -- (compactMapInsert inp')
(reqsPerSecSet, mbAllocSet) <- runTest n (mapInsert inp')
putStrLn $ unwords [show (n`div`1000), show reqsPerSecDisk, show mbAllocDisk, show reqsPerSecSet, show mbAllocSet]
in case style of
-- CompactString -> outputTest =<< getWordsCompact
-- String -> outputTest =<< getWordsString
-- ByteString -> outputTest =<< getWordsByteString
Int -> outputTest [1::Int ..]
-- HostInt -> outputTest [1::OptInt ..]
data TestType = Insert | RandomInsert | ReverseInsert | DuplicateInsert
parseType s = case map toLower s of
"insert" -> Insert
"random-insert" -> RandomInsert
"reverse-insert" -> ReverseInsert
"duplicate-insert" -> DuplicateInsert
data Input = ByteString | CompactString | String | Int | HostInt | Word
parseStyle s = case map toLower s of
"bytestring" -> ByteString
"compactstring" -> CompactString
"string" -> String
"int" -> Int
"hostint" -> HostInt
"word" -> Word
_ -> error $ "failed to parse style: " ++ s
main :: IO ()
main = do args <- getArgs
case args of
[testType, n, style]
-> performTest (parseType testType) (read n) (parseStyle style)
[testType, n] -> performTest (parseType testType) (read n) ByteString
[testType] -> performTest (parseType testType) 200000 ByteString
_ -> do prog <- getProgName
putStrLn $ "Usage: " ++ prog ++ " test [n]"
|