ref: bfe38a2454609a60bffe2f59340b075faeca7c4d
dir: /test/test.lsp/
(let ((*profiles* (table)))
(set! profile
(λ (s)
(let ((f (top-level-value s)))
(put! *profiles* s (cons 0 0))
(set-top-level-value! s
(λ args
(def tt (get *profiles* s))
(def count (car tt))
(def time (cdr tt))
(def t0 (time-now))
(def v (apply f args))
(set-cdr! tt (+ time (- (time-now) t0)))
(set-car! tt (+ count 1))
v)))))
(set! show-profiles
(λ ()
(def pr (filter (λ (x) (> (cadr x) 0))
(table-pairs *profiles*)))
(def width (+ 4
(apply max
(map (λ (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
(λ (p)
(princ (string-rpad (string (caddr p)) width #\ )
(string-rpad (string (cadr p)) 11 #\ )
(car p))
(newline))
(simple-sort (map (λ (l) (reverse (to-proper l)))
pr)))))
(set! clear-profiles
(λ ()
(for-each (λ (k)
(put! *profiles* k (cons 0 0)))
(table-keys *profiles*)))))
#;(for-each profile
'(emit encode-byte-code const-to-idx-vec
index-of lookup-sym in-env? any every
compile-sym compile-if compile-begin
compile-arglist expand builtin->instruction
compile-app separate nconc get-defined-vars
compile-in compile compile-f delete-duplicates
map length> length= count filter append
lastcdr to-proper reverse reverse! list->vector
taboreach list-head list-tail assq memq assoc member
assv memv nreconc bq-process))