(defun format-info (info)
  (etypecase info
    ((or list symbol) (substitute #\/ #\; (write-to-string info :case :downcase)))
    (string (format nil "~A_[k]" info))
    (sb-di:debug-fun (format-info (sb-di:debug-fun-name info)))))

(defun draw-flamegraph.pl (pathname samples)
  (with-open-file (f pathname :direction :output :if-exists :supersede)
    (let ((seen (make-hash-table :test #'equal)))
      (sb-sprof:map-traces
       (lambda (thread trace)
         (declare (ignore thread))
         (let ((calls '()))
           (sb-sprof::map-trace-pc-locs
            (lambda (info offset)
              (declare (ignore offset))
              (push (format-info info) calls))
            trace)
           (incf (gethash (format nil "~{~A~^;~}" (reverse calls)) seen 0))))
       samples)
      (loop for name being the hash-keys of seen
            for count being the hash-values of seen
            do (format f "~&~A ~D" name count)))))