/usr/share/racket/pkgs/profile-lib/main.rkt is in racket-common 6.3-1.
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 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | #lang racket/base
(provide profile-thunk profile)
(require "sampler.rkt" (except-in "analyzer.rkt" profile)
(prefix-in text: "render-text.rkt")
(for-syntax racket/base))
(define (profile-thunk thunk
#:delay [delay 0.05]
#:repeat [rpt 1]
#:threads [threads? #f]
#:render [renderer text:render]
#:periodic-renderer [periodic-renderer #f]
#:use-errortrace? [et? #f])
(define cust (and threads? (make-custodian (current-custodian))))
(define sampler (create-sampler (if threads?
(list cust (current-thread))
(current-thread))
delay
#:use-errortrace? et?))
(define periodic-thread
(and periodic-renderer
(let ([delay (car periodic-renderer)]
[renderer (cadr periodic-renderer)])
(define (loop)
(sleep delay)
(renderer (analyze-samples (sampler 'get-snapshots)))
(loop))
(thread loop))))
(define (run) (for/last ([i (in-range rpt)]) (thunk)))
(begin0 (with-handlers ([void (λ (e) (eprintf "profiled thunk error: ~a\n"
(if (exn? e)
(exn-message e)
(format "~e" e))))])
(if threads?
(parameterize ([current-custodian cust]) (run))
(run)))
(when periodic-thread (kill-thread periodic-thread))
(sampler 'stop)
(renderer (analyze-samples (sampler 'get-snapshots)))))
(define-syntax (profile stx)
(syntax-case stx ()
[(_ x ...)
(let loop ([expr #f] [kwds '()] [xs (syntax->list #'(x ...))])
(cond
[(null? xs)
(if expr
(with-syntax ([expr expr] [kwds (reverse kwds)])
#'(profile-thunk (λ () expr) . kwds))
(raise-syntax-error 'profile "missing expression" stx))]
[(keyword? (syntax-e (car xs)))
(if (pair? (cdr xs))
(loop expr (list* (cadr xs) (car xs) kwds) (cddr xs))
;; let #%app throw the error
(loop expr (cons (car xs) kwds) (cdr xs)))]
[expr (raise-syntax-error 'profile "redundant expresion given"
stx (car xs))]
[else (loop (car xs) kwds (cdr xs))]))]))
#|
(define (fib1 n) (if (<= n 1) n (+ (fib1 (- n 1)) (fib1 (- n 2)))))
(define (fib22 n) (if (<= n 2) 1 (+ (fib22 (- n 1)) (fib22 (- n 2)))))
(define (fib3 n)
(for ([i (in-range 100000000)]) (* i 3))
(if (<= n 2) 1 (+ (fib22 (- n 1)) (fib22 (- n 2)))))
(define (fibs n) (+ (fib1 n) (fib22 n) (fib3 n)))
(define (foo n)
(define ch (make-channel))
(define (bg-fib) (channel-put ch (fib1 n)))
(thread bg-fib)
(list (fibs n) (channel-get ch)))
(require "render-graphviz.rkt")
(profile ;(fibs 40)
;(dynamic-require '(lib "scribblings/reference/reference.scrbl") #f)
(foo 40)
;#:render render
#:threads #t
#:periodic-renderer
(list 0.5 text:render)
)
|#
(module+ test
(require rackunit racket/string racket/list)
;; `profile' and `profile-thunk' should return the value of the
;; profiled expression
(check-equal?
(profile (for/last ([i (in-range 1000 5 -1)])
(string-join (map number->string (range i)))))
"0 1 2 3 4 5")
(check-equal?
(profile-thunk (lambda () (for/last ([i (in-range 1000 5 -1)])
(string-join (map number->string (range i))))))
"0 1 2 3 4 5"))
|