public
Created

Stroustrup et al. Haskell Benchmark

  • Download Gist
cmp_haskell.hs
Haskell
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 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269
import Text.Printf
import Data.List
import System.CPUTime.Rdtsc
import Control.Seq
import Data.Bits
 
data Shape = Shape00 | Shape01 | Shape02 | Shape03 | Shape04 | Shape05 | Shape06 | Shape07 | Shape08 | Shape09
| Shape10 | Shape11 | Shape12 | Shape13 | Shape14 | Shape15 | Shape16 | Shape17 | Shape18 | Shape19
| Shape20 | Shape21 | Shape22 | Shape23 | Shape24 | Shape25 | Shape26 | Shape27 | Shape28 | Shape29
| Shape30 | Shape31 | Shape32 | Shape33 | Shape34 | Shape35 | Shape36 | Shape37 | Shape38 | Shape39
| Shape40 | Shape41 | Shape42 | Shape43 | Shape44 | Shape45 | Shape46 | Shape47 | Shape48 | Shape49
| Shape50 | Shape51 | Shape52 | Shape53 | Shape54 | Shape55 | Shape56 | Shape57 | Shape58 | Shape59
| Shape60 | Shape61 | Shape62 | Shape63 | Shape64 | Shape65 | Shape66 | Shape67 | Shape68 | Shape69
| Shape70 | Shape71 | Shape72 | Shape73 | Shape74 | Shape75 | Shape76 | Shape77 | Shape78 | Shape79
| Shape80 | Shape81 | Shape82 | Shape83 | Shape84 | Shape85 | Shape86 | Shape87 | Shape88 | Shape89
| Shape90 | Shape91 | Shape92 | Shape93 | Shape94 | Shape95 | Shape96 | Shape97 | Shape98 | Shape99
 
make_shape n = case n of
0 -> Shape00
1 -> Shape01
2 -> Shape02
3 -> Shape03
4 -> Shape04
5 -> Shape05
6 -> Shape06
7 -> Shape07
8 -> Shape08
9 -> Shape09
10 -> Shape10
11 -> Shape11
12 -> Shape12
13 -> Shape13
14 -> Shape14
15 -> Shape15
16 -> Shape16
17 -> Shape17
18 -> Shape18
19 -> Shape19
20 -> Shape20
21 -> Shape21
22 -> Shape22
23 -> Shape23
24 -> Shape24
25 -> Shape25
26 -> Shape26
27 -> Shape27
28 -> Shape28
29 -> Shape29
30 -> Shape30
31 -> Shape31
32 -> Shape32
33 -> Shape33
34 -> Shape34
35 -> Shape35
36 -> Shape36
37 -> Shape37
38 -> Shape38
39 -> Shape39
40 -> Shape40
41 -> Shape41
42 -> Shape42
43 -> Shape43
44 -> Shape44
45 -> Shape45
46 -> Shape46
47 -> Shape47
48 -> Shape48
49 -> Shape49
50 -> Shape50
51 -> Shape51
52 -> Shape52
53 -> Shape53
54 -> Shape54
55 -> Shape55
56 -> Shape56
57 -> Shape57
58 -> Shape58
59 -> Shape59
60 -> Shape60
61 -> Shape61
62 -> Shape62
63 -> Shape63
64 -> Shape64
65 -> Shape65
66 -> Shape66
67 -> Shape67
68 -> Shape68
69 -> Shape69
70 -> Shape70
71 -> Shape71
72 -> Shape72
73 -> Shape73
74 -> Shape74
75 -> Shape75
76 -> Shape76
77 -> Shape77
78 -> Shape78
79 -> Shape79
80 -> Shape80
81 -> Shape81
82 -> Shape82
83 -> Shape83
84 -> Shape84
85 -> Shape85
86 -> Shape86
87 -> Shape87
88 -> Shape88
89 -> Shape89
90 -> Shape90
91 -> Shape91
92 -> Shape92
93 -> Shape93
94 -> Shape94
95 -> Shape95
96 -> Shape96
97 -> Shape97
98 -> Shape98
99 -> Shape99
 
do_match Shape00 = 0
do_match Shape01 = 1
do_match Shape02 = 2
do_match Shape03 = 3
do_match Shape04 = 4
do_match Shape05 = 5
do_match Shape06 = 6
do_match Shape07 = 7
do_match Shape08 = 8
do_match Shape09 = 9
do_match Shape10 = 10
do_match Shape11 = 11
do_match Shape12 = 12
do_match Shape13 = 13
do_match Shape14 = 14
do_match Shape15 = 15
do_match Shape16 = 16
do_match Shape17 = 17
do_match Shape18 = 18
do_match Shape19 = 19
do_match Shape20 = 20
do_match Shape21 = 21
do_match Shape22 = 22
do_match Shape23 = 23
do_match Shape24 = 24
do_match Shape25 = 25
do_match Shape26 = 26
do_match Shape27 = 27
do_match Shape28 = 28
do_match Shape29 = 29
do_match Shape30 = 30
do_match Shape31 = 31
do_match Shape32 = 32
do_match Shape33 = 33
do_match Shape34 = 34
do_match Shape35 = 35
do_match Shape36 = 36
do_match Shape37 = 37
do_match Shape38 = 38
do_match Shape39 = 39
do_match Shape40 = 40
do_match Shape41 = 41
do_match Shape42 = 42
do_match Shape43 = 43
do_match Shape44 = 44
do_match Shape45 = 45
do_match Shape46 = 46
do_match Shape47 = 47
do_match Shape48 = 48
do_match Shape49 = 49
do_match Shape50 = 50
do_match Shape51 = 51
do_match Shape52 = 52
do_match Shape53 = 53
do_match Shape54 = 54
do_match Shape55 = 55
do_match Shape56 = 56
do_match Shape57 = 57
do_match Shape58 = 58
do_match Shape59 = 59
do_match Shape60 = 60
do_match Shape61 = 61
do_match Shape62 = 62
do_match Shape63 = 63
do_match Shape64 = 64
do_match Shape65 = 65
do_match Shape66 = 66
do_match Shape67 = 67
do_match Shape68 = 68
do_match Shape69 = 69
do_match Shape70 = 70
do_match Shape71 = 71
do_match Shape72 = 72
do_match Shape73 = 73
do_match Shape74 = 74
do_match Shape75 = 75
do_match Shape76 = 76
do_match Shape77 = 77
do_match Shape78 = 78
do_match Shape79 = 79
do_match Shape80 = 80
do_match Shape81 = 81
do_match Shape82 = 82
do_match Shape83 = 83
do_match Shape84 = 84
do_match Shape85 = 85
do_match Shape86 = 86
do_match Shape87 = 87
do_match Shape88 = 88
do_match Shape89 = 89
do_match Shape90 = 90
do_match Shape91 = 91
do_match Shape92 = 92
do_match Shape93 = 93
do_match Shape94 = 94
do_match Shape95 = 95
do_match Shape96 = 96
do_match Shape97 = 97
do_match Shape98 = 98
do_match Shape99 = 99
 
lssb :: Int -> Int
lssb n = go 0 where
go 33 = 0
go k | testBit k n = k + go (k + 1)
| otherwise = go (k + 1)
 
--test1 :: Int -> [Shape] -> Int
--test1 a [] = a
--test1 a (s:xs) = let a1 = (a + (do_match s))
-- in test1 a1 xs
 
dummy :: a -> a
dummy a = a
 
test1 :: [Shape] -> Int -> Int
test1 [] a = a
test1 (s:xs) a = test1 xs $! ((+) (do_match s) $! a)
 
--test2 :: Int -> [Shape] -> Int
--test2 a xs =
-- test1 xs a
-- where test1 [] a = a
-- test1 (s:xs) a = test1 xs $! ((+) (do_match s) $! a)
-- --test1 (s:xs) a = let b = (do_match $! s) + a in test1 xs $! b
 
 
test :: Int -> Int -> [Shape] -> Int
test 0 a _ = a
test k a shapes = test (k-1) (test1 shapes a) shapes
 
main :: IO ()
main = do
let n = 1000000 -- The amount of times visitor and matching procedure is invoked in one time measuring
let m = 101 -- The amount of times time measuring is done
let k = 100 -- Maximum number of shapes that can be created
let shapes = [make_shape (lssb i `mod` k) | i <- [1..n]]
return $! length shapes
 
t1 <- rdtsc
let matches = map do_match shapes
return $! withStrategy (seqList rseq) matches
t2 <- rdtsc
 
t3 <- rdtsc
let t = test m 0 shapes
return $! t
t4 <- rdtsc
let secs = (fromIntegral(t4 - t3)::Double) / ((fromIntegral(m)::Double)*2530000000)
printf "\nAverage time for %d runs takes %.5f seconds: %d\n" (n::Int) secs (t::Int)

07fa278a0084f09fcfb35116bcc1617a3d1e1c41 is the original
424fc264fca42caf2798e40f79171e4c43353c45 fixes the benchmark to only test only the match
013d61c461c5f3b8644f53042eae926ebd3b51bd limits us to 7 constructors
bd3ccc7cf2ed8c64d4305c83777e8cbdf6a20195 changes the distribution to logarithmic but uses more constructors and is more realistic

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.