profile.scm

(define (string.rpad s n c) (string s (string.rep c (- n (string.count s)))))

(define (string.rep s k)
  (cond ((< k 4)
	 (cond ((<= k 0) "")
	       ((=  k 1) (string s))
	       ((=  k 2) (string s s))
	       (else     (string s s s))))
	((odd? k) (string s (string.rep s (- k 1))))
	(else     (string.rep (string s s) (/ k 2)))))

(let ((*profiles* (table)))
  (set! profile
	(lambda (s)
	  (let ((f (top-level-value s)))
	    (put! *profiles* s (cons 0 0))
	    (set-top-level-value! s
	     (lambda args
	       (define tt (get *profiles* s))
	       (define count (car tt))
	       (define time  (cdr tt))
	       (define t0 (time.now))
	       (define v (apply f args))
	       (set-cdr! tt (+ time (- (time.now) t0)))
	       (set-car! tt (+ count 1))
	       v)))))
  (set! show-profiles
	(lambda ()
	  (define pr (filter (lambda (x) (> (cadr x) 0))
			     (table.pairs *profiles*)))
	  (define width (+ 4
			   (apply max
				  (map (lambda (x)
					 (length (string x)))
				       (cons 'Function
					     (map car pr))))))
	  (princ (string.rpad "Function" width #\ )
		 "#Calls     Time (seconds)")
	  (newline)
	  (princ (string.rpad "--------" width #\ )
		 "------     --------------")
	  (newline)
	  (for-each
	   (lambda (p)
	     (princ (string.rpad (string (caddr p)) width #\ )
		    (string.rpad (string (cadr p)) 11 #\ )
		    (car p))
	     (newline))
	   (reverse (simple-sort (map (lambda (l) (reverse (to-proper l)))
				      pr))))))
  (set! clear-profiles
	(lambda ()
	  (for-each (lambda (k)
		      (put! *profiles* k (cons 0 0)))
		    (table.keys *profiles*)))))

(for-each profile
	  '(julia-expand1 to-goto-form analyze-variables flatten-scopes
	    identify-locals to-LFF expand-forms
	    expand-binding-forms julia-expand-macros
	    julia-expand0 julia-expand01 find-possible-globals
	    toplevel-expr-globals expand-toplevel-expr--
	    expand-toplevel-expr julia-parse))