source: project/chicken/trunk/benchmarks/regex/benchmark.scm @ 15576

Last change on this file since 15576 was 15576, checked in by felix winkelmann, 11 years ago

slight changes

File size: 1.9 KB
Line 
1
2(use chicken extras regex data-structures srfi-13)
3(import irregex)
4
5(define-syntax time-expr
6  (syntax-rules ()
7    ((time-expr expr)
8     (let ((start (nth-value 0 (cpu-time))))
9       expr
10       (- (nth-value 0 (cpu-time)) start)))))
11
12(define (string-replicate str reps)
13  (let lp ((ls '()) (reps reps))
14    (if (<= reps 0)
15        (string-concatenate-reverse ls)
16        (lp (cons str ls) (- reps 1)))))
17
18(define (run-bench name pat str prefix comp-count exec-count)
19  (let-syntax
20      ((bench (syntax-rules ()
21                ((bench variation expr count)
22                 (let ((time-taken
23                        (time-expr (do ((i count (- i 1)))
24                                       ((< i 0))
25                                     expr))))
26                   (display name) (display ": ")
27                   (display variation) (display ": ")
28                   (write time-taken) (newline))))))
29    (let ((comp-count (string->number comp-count))
30          (exec-count (string->number exec-count)))
31      ;; compile time
32      (bench "compile-time" (string->irregex pat) comp-count)
33      (let ((irx (string->irregex pat)))
34        ;; match time
35        (bench "match-time" (irregex-match irx str) exec-count)
36        ;; search times
37        (let lp ((mult 1) (reps exec-count))
38          (cond
39           ((>= reps 10)
40            (let ((str (string-append (string-replicate prefix mult) str)))
41              (bench (string-append "search prefix x " (number->string mult))
42                     (irregex-search irx str)
43                     reps)
44              (lp (* mult 10) (quotient reps 10))))))))))
45
46(call-with-input-file "re-benchmarks.txt"
47  (lambda (in)
48    (let lp ()
49      (let ((line (read-line in)))
50        (cond
51         ((eof-object? line))
52         ((string-match "^\\s*#.*" line)
53          (lp))
54         (else
55          (let ((ls (string-split line "\t")))
56            (apply run-bench ls)
57            (lp))))))))
58
Note: See TracBrowser for help on using the repository browser.