mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 05:39:18 +02:00
36 lines
1.1 KiB
Scheme
36 lines
1.1 KiB
Scheme
|
|
(import (chibi ast) (chibi time) (scheme cxr) (srfi 33) (srfi 39))
|
|
|
|
(define (timeval->milliseconds tv)
|
|
(quotient (+ (* 1000000 (timeval-seconds tv)) (timeval-microseconds tv))
|
|
1000))
|
|
|
|
(define (time* thunk)
|
|
(call-with-output-string
|
|
(lambda (out)
|
|
(let* ((start (car (get-time-of-day)))
|
|
(gc-start (gc-usecs))
|
|
(result (parameterize ((current-output-port out)) (thunk)))
|
|
(end (car (get-time-of-day)))
|
|
(gc-end (gc-usecs))
|
|
(gc-msecs (quotient (- gc-end gc-start) 1000))
|
|
(msecs (- (timeval->milliseconds end)
|
|
(timeval->milliseconds start))))
|
|
(display "user: ")
|
|
(display msecs)
|
|
(display " system: 0")
|
|
(display " real: ")
|
|
(display msecs)
|
|
(display " gc: ")
|
|
(display gc-msecs)
|
|
(display " (")
|
|
(display (gc-count))
|
|
(display " times)\n")
|
|
(display "result: ")
|
|
(write result)
|
|
(newline)
|
|
result))))
|
|
|
|
(define-syntax time
|
|
(syntax-rules ()
|
|
((_ expr) (time* (lambda () expr)))))
|