ref: 3efd625f94ba38fb5c37499441fdad603db25cd3
dir: /test/test.sl/
(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 (str x)))
(cons 'Function
(map car pr))))))
(princ (str-rpad "Function" width #\ )
"#Calls Time (seconds)")
(newline)
(princ (str-rpad "--------" width #\ )
"------ --------------")
(newline)
(for-each
(λ (p)
(princ (str-rpad (str (caddr p)) width #\ )
(str-rpad (str (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->vec
taboreach list-head list-tail assq memq assoc member
assv memv nreconc bq-process))