/usr/share/racket/pkgs/unstable-lib/time.rkt is in racket-common 6.1-4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | #lang racket/base
;; An improved `time' variant: better output, and repetitions with averages
(provide time*)
(require racket/list)
(define (time/proc thunk times)
(define throw
(if (<= times 0)
(error 'time "bad count: ~e" times)
(floor (* times 2/7))))
(define results #f)
(define timings '())
(define (run n)
(when (<= n times)
(when (> times 1) (printf "; run #~a..." n) (flush-output))
(let ([r (call-with-values (lambda () (time-apply thunk '())) list)])
(set! results (car r))
(set! timings (cons (cdr r) timings))
(when (> times 1)
(printf " ->")
(if (null? results)
(printf " (0 values returned)")
(begin (printf " ~.s" (car results))
(for ([r (in-list (cdr results))]) (printf ", ~s" r))
(newline))))
(run (add1 n)))))
(collect-garbage)
(collect-garbage)
(collect-garbage)
(run 1)
(set! timings (sort timings < #:key car)) ; sort by cpu-time
(set! timings (drop timings throw)) ; throw extreme bests
(set! timings (take timings (- (length timings) throw))) ; and worsts
(set! timings (let ([n (length timings)]) ; average
(map (lambda (x) (round (/ x n))) (apply map + timings))))
(let-values ([(cpu real gc) (apply values timings)])
(when (> times 1)
(printf "; ~a runs, ~a best/worst removed, ~a left for average:\n"
times throw (- times throw throw)))
(printf "; cpu time: ~sms = ~sms + ~sms gc; real time: ~sms\n"
cpu (- cpu gc) gc real))
(apply values results))
(define-syntax time*
(syntax-rules ()
[(_ n expr0 expr ...) (time/proc (lambda () expr0 expr ...) n)]
[(_ expr0 expr ...) (time/proc (lambda () expr0 expr ...) 1)]))
|