1
2(import (chibi ast) (chibi time) (scheme cxr) (srfi 33) (srfi 39))
3
4(define (timeval->milliseconds tv)
5  (quotient (+ (* 1000000 (timeval-seconds tv)) (timeval-microseconds tv))
6            1000))
7
8(define (timeval-diff start end)
9  (- (timeval->milliseconds end)
10     (timeval->milliseconds start)))
11
12(define (time* thunk)
13  (call-with-output-string
14    (lambda (out)
15      (gc)
16      (let* ((start (car (get-time-of-day)))
17             (start-rusage (get-resource-usage))
18             (gc-start (gc-usecs))
19             (gc-start-count (gc-count))
20             ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21             (result (parameterize ((current-output-port out)) (thunk)))
22             ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23             (end (car (get-time-of-day)))
24             (end-rusage (get-resource-usage))
25             (gc-end (gc-usecs))
26             (gc-msecs (quotient (- gc-end gc-start) 1000))
27             (real-msecs (timeval-diff start end))
28             (user-msecs
29              (timeval-diff (resource-usage-time start-rusage)
30                            (resource-usage-time end-rusage)))
31             (system-msecs
32              (timeval-diff (resource-usage-system-time start-rusage)
33                            (resource-usage-system-time end-rusage))))
34        (display "user: ")
35        (display user-msecs)
36        (display " system: ")
37        (display system-msecs)
38        (display " real: ")
39        (display real-msecs)
40        (display " gc: ")
41        (display gc-msecs)
42        (display " (")
43        (display (- (gc-count) gc-start-count))
44        (display " times)\n")
45        (display "result: ")
46        (write result)
47        (newline)
48        result))))
49
50(define-syntax time
51  (syntax-rules ()
52    ((_ expr) (time* (lambda () expr)))))
53