]> gitweb.factorcode.org Git - factor.git/blob - extra/benchmark/dispatch4/dispatch4.factor
Fixing everything for mandatory stack effects
[factor.git] / extra / benchmark / dispatch4 / dispatch4.factor
1 USING: kernel.private kernel sequences math combinators
2 sequences.private ;
3 IN: benchmark.dispatch4
4
5 : foobar-1 ( n -- val )
6     dup {
7         [ 0 eq? [ 0 ] [ "x" ] if ]
8         [ 1 eq? [ 1 ] [ "x" ] if ]
9         [ 2 eq? [ 2 ] [ "x" ] if ]
10         [ 3 eq? [ 3 ] [ "x" ] if ]
11         [ 4 eq? [ 4 ] [ "x" ] if ]
12         [ 5 eq? [ 5 ] [ "x" ] if ]
13         [ 6 eq? [ 6 ] [ "x" ] if ]
14         [ 7 eq? [ 7 ] [ "x" ] if ]
15         [ 8 eq? [ 8 ] [ "x" ] if ]
16         [ 9 eq? [ 9 ] [ "x" ] if ]
17         [ 10 eq? [ 10 ] [ "x" ] if ]
18         [ 11 eq? [ 11 ] [ "x" ] if ]
19         [ 12 eq? [ 12 ] [ "x" ] if ]
20         [ 13 eq? [ 13 ] [ "x" ] if ]
21         [ 14 eq? [ 14 ] [ "x" ] if ]
22         [ 15 eq? [ 15 ] [ "x" ] if ]
23         [ 16 eq? [ 16 ] [ "x" ] if ]
24         [ 17 eq? [ 17 ] [ "x" ] if ]
25         [ 18 eq? [ 18 ] [ "x" ] if ]
26         [ 19 eq? [ 19 ] [ "x" ] if ]
27     } dispatch ;
28
29 : foobar-2 ( n -- val )
30     {
31         { [ dup 0 eq? ] [ drop 0 ] }
32         { [ dup 1 eq? ] [ drop 1 ] }
33         { [ dup 2 eq? ] [ drop 2 ] }
34         { [ dup 3 eq? ] [ drop 3 ] }
35         { [ dup 4 eq? ] [ drop 4 ] }
36         { [ dup 5 eq? ] [ drop 5 ] }
37         { [ dup 6 eq? ] [ drop 6 ] }
38         { [ dup 7 eq? ] [ drop 7 ] }
39         { [ dup 8 eq? ] [ drop 8 ] }
40         { [ dup 9 eq? ] [ drop 9 ] }
41         { [ dup 10 eq? ] [ drop 10 ] }
42         { [ dup 11 eq? ] [ drop 11 ] }
43         { [ dup 12 eq? ] [ drop 12 ] }
44         { [ dup 13 eq? ] [ drop 13 ] }
45         { [ dup 14 eq? ] [ drop 14 ] }
46         { [ dup 15 eq? ] [ drop 15 ] }
47         { [ dup 16 eq? ] [ drop 16 ] }
48         { [ dup 17 eq? ] [ drop 17 ] }
49         { [ dup 18 eq? ] [ drop 18 ] }
50         { [ dup 19 eq? ] [ drop 19 ] }
51     } cond ;
52
53 : foobar-test-1 ( -- )
54     20000000 [
55         20 [
56             foobar-1 drop
57         ] each
58     ] times ;
59
60 : foobar-test-2 ( -- )
61     20000000 [
62         20 [
63             foobar-2 drop
64         ] each
65     ] times ;
66
67 MAIN: foobar-test-1