How to write a simple profiler for Scheme

Question

I would like to write a simple profiler for Scheme that gives a count of the number of times each function in a program is called. I tried to redefine the define command like this (eventually I'll add the other forms of define, but for now I am just trying to write proof-of-concept code):

(define-syntax define
  (syntax-rules ()
    ((define (name args ...) body ...)
      (set! name
        (lambda (args ...)
          (begin
            (set! *profile* (cons name *profile*))
            body ...))))))

My idea was to record in a list *profile* each call to a function, then later to examine the list and determine function counts. This works, but stores the function itself (that is, the printable representation of the function name, which in Chez Scheme is #<procedure f> for a function named f), but then I can't count or sort or otherwise process the function names.

How can I write a simple profiler for Scheme?

EDIT: Here is my simple profiler (the uniq-c function that counts adjacent duplicates in a list comes from my Standard Prelude):

(define *profile* (list))

(define (reset-profile)
  (set! *profile* (list)))

(define-syntax define-profiling
  (syntax-rules ()
    ((_ (name args ...) body ...)
      (define (name args ...)
          (begin
            (set! *profile*
              (cons 'name *profile*))
            body ...)))))

(define (profile)
  (uniq-c string=?
    (sort string<?
      (map symbol->string *profile*)))))

As a simple demonstration, here is a function to identify prime numbers by trial division. Function divides? is broken out separately because the profiler only counts function calls, not individual statements.

(define-profiling (divides? d n)
  (zero? (modulo n d)))

(define-profiling (prime? n)
  (let loop ((d 2))
    (cond ((= d n) #t)
          ((divides? d n) #f)
          (else (loop (+ d 1))))))

(define-profiling (prime-pi n)
  (let loop ((k 2) (pi 0))
    (cond ((< n k) pi)
          ((prime? k) (loop (+ k 1) (+ pi 1)))
          (else (loop (+ k 1) pi)))))

> (prime-pi 1000)
168
> (profile)
(("divides?" . 78022) ("prime-pi" . 1) ("prime?" . 999))

And here is an improved version of the function, which stops trial division at the square root of n:

(define-profiling (prime? n)
  (let loop ((d 2))
    (cond ((< (sqrt n) d) #t)
          ((divides? d n) #f)
          (else (loop (+ d 1))))))

> (reset-profile)
> (prime-pi 1000)
168
> (profile)
(("divides?" . 5288) ("prime-pi" . 1) ("prime?" . 999))

I'll have more to say about profiling at my blog. Thanks to both @uselpa and @GoZoner for their answers.

Answer 1

Change your line that says:

    (set! *profile* (cons name *profile*))

to

    (set! *profile* (cons 'name *profile*))

The evaluation of name in the body of a function defining name is the procedure for name. By quoting you avoid the evaluation and are left with the symbol/identifier. As you had hoped, your *profile* variable will be a growing list with one symbol for each function call. You can count the number of occurrences of a given name.

Answer 2

Here's a sample way to implement it. It's written in Racket but trivial to transform to your Scheme dialect.

without syntax

Let's try without macros first.

Here's the profile procedure:

(define profile
  (let ((cache (make-hash)))  ; the cache memorizing call info
    (lambda (cmd . pargs)     ; parameters of profile procedure
      (case cmd
        ((def) (lambda args                  ; the function returned for 'def
                 (hash-update! cache (car pargs) add1 0) ; prepend cache update
                 (apply (cadr pargs) args))) ; call original procedure
        ((dmp) (hash-ref cache (car pargs))) ; return cache info for one procedure
        ((all) cache)                        ; return all cache info
        ((res) (set! cache (make-hash)))     ; reset cache
        (else  (error "wot?"))))))           ; unknown parameter

and here's how to use it:

(define test1 (profile 'def 'test1 (lambda (x) (+ x 1))))
(for/list ((i 3)) (test1 i))
=> '(1 2 3)
(profile 'dmp 'test1)
=> 3

adding syntax

(define-syntax define!
  (syntax-rules ()
    ((_ (name args ...) body ...)
     (define name (profile 'def 'name (lambda (args ...) body ...))))))

(define! (test2 x) (* x 2))
(for/list ((i 4)) (test2 i))
=> '(0 2 4 6)
(profile 'dmp 'test2)
=> 4

To dump all:

(profile 'all)
=> '#hash((test2 . 4) (test1 . 3))

EDIT applied to your last example:

(define! (divides? d n) (zero? (modulo n d)))

(define! (prime? n)
  (let loop ((d 2))
    (cond ((< (sqrt n) d) #t)
          ((divides? d n) #f)
          (else (loop (+ d 1))))))

(define! (prime-pi n)
  (let loop ((k 2) (pi 0))
    (cond ((< n k) pi)
          ((prime? k) (loop (+ k 1) (+ pi 1)))
          (else (loop (+ k 1) pi)))))

(prime-pi 1000)
=> 168
(profile 'all)
=> '#hash((divides? . 5288) (prime-pi . 1) (prime? . 999))