codepad

Language:

; profiling

(define sort #f)
(define merge #f)
(let ()
  (define dosort
    (lambda (pred? ls n)
      (if (= n 1)
          (list (car ls))
          (let ((i (quotient n 2)))
            (domerge pred?
                     (dosort pred? ls i)
                     (dosort pred? (list-tail ls i) (- n i)))))))
  (define domerge
    (lambda (pred? l1 l2)
      (cond
        ((null? l1) l2)
        ((null? l2) l1)
        ((pred? (car l2) (car l1))
         (cons (car l2) (domerge pred? l1 (cdr l2))))
        (else (cons (car l1) (domerge pred? (cdr l1) l2))))))
  (set! sort
    (lambda (pred? l)
      (if (null? l) l (dosort pred? l (length l)))))
  (set! merge
    (lambda (pred? l1 l2)
      (domerge pred? l1 l2))))

(define (uniq-c eql? xs)
  (if (null? xs) xs
    (let loop ((xs (cdr xs)) (prev (car xs)) (k 1) (result '()))
      (cond ((null? xs) (reverse (cons (cons prev k) result)))
            ((eql? (car xs) prev) (loop (cdr xs) prev (+ k 1) result))
            (else (loop (cdr xs) (car xs) 1 (cons (cons prev k) result)))))))

(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*))))

(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)))))

(display (prime-pi 1000)) (newline)
(display (profile)) (newline)

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

(reset-profile)
(display (prime-pi 1000)) (newline)
(display (profile)) (newline)

Private [?]

Run code