(let ((*profiles* (table))) (set-top-level-value! '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-top-level-value! 'show-profiles (λ () (def pr (filter (λ (x) (> (cadr x) 0)) (table->assoc-list *profiles*))) (def width (+ 4 (apply max (map (λ (x) (length (str x))) (cons 'Function (map car pr)))))) (princ (str-pad "Function" width) "#Calls Time (seconds)") (newline) (princ (str-pad "--------" width) "------ --------------") (newline) (for-each (λ (p) (princ (str-pad (str (caddr p)) width) (str-pad (str (cadr p)) 11) (/ (car p) 1000000000)) (newline)) (simple-sort (map (λ (l) (reverse (to-proper l))) pr))))) (set-top-level-value! '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 lookup-sym in-env? any every compile-sym compile-if compile-begin compile-arglist macroexpand builtin->instruction compile-app nconc get-defined-vars compile-in compile compile-f remove-duplicates map length> length= count filter append last-cdr to-proper reverse reverse! list->vec nthcdr assq memq assoc member assv memv nreconc bq-process))
(let ((*profiles* (table)))
(set-top-level-value! '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-top-level-value! 'show-profiles
(λ ()
(def pr (filter (λ (x) (> (cadr x) 0))
(table->assoc-list *profiles*)))
(def width (+ 4
(apply max
(map (λ (x)
(length (str x)))
(cons 'Function
(map car pr))))))
(princ (str-pad "Function" width)
"#Calls Time (seconds)")
(newline)
(princ (str-pad "--------" width)
"------ --------------")
(newline)
(for-each
(λ (p)
(princ (str-pad (str (caddr p)) width)
(str-pad (str (cadr p)) 11)
(/ (car p) 1000000000))
(newline))
(simple-sort (map (λ (l) (reverse (to-proper l)))
pr)))))
(set-top-level-value! '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
lookup-sym in-env? any every
compile-sym compile-if compile-begin
compile-arglist macroexpand builtin->instruction
compile-app nconc get-defined-vars
compile-in compile compile-f remove-duplicates
map length> length= count filter append
last-cdr to-proper reverse reverse! list->vec
nthcdr assq memq assoc member
assv memv nreconc bq-process))