#define private public - A poor man's Common Lisp profiler (08 Mar 2016)

topic end
<!--
   * Set TOPICTITLE = #define private public - A poor man's Common Lisp profiler (08 Mar 2016)
-->

<style type="text/css">
pre {background-color:#ffeecc;}
</style>

%STARTINCLUDE%
<a name="08"></a>

---+++ [[DefinePrivatePublic20160308LispProfiler][A poor man's Common Lisp profiler]] (08 Mar 2016)

<summary>
In 2009, I parted with the !CoCreate Modeling development team, but I still pay the occasional visit to !SolidDesigner customer forums:
First, it is heart-warming to find the product still in widespread use, and second, customer questions give me a great excuse 
to dabble in Lisp again - such as the
<a href="http://forum.cad.de/foren/ubb/Forum92/HTML/000814.shtml">question
by forum member !AlexG</a> who was working on code which essentially was an early nucleus
of a code profiler for Lisp.
</summary>

Alex's original code used quite some Lisp magic, including the little-known [[http://l1sp.org/cl/symbol-function][symbol-function]] which I 
[[CoCreateModeling.MacroSymbolFunction][elaborated about long time ago]]. But the code did not quite work yet. I gladly took the challenge.
and ended up with a few lines of Lisp code which could profile (almost) any Lisp function in the system. The technique I used
was to wrap the original function definition in a lambda closure. That closure is then installed using =symbol-function=.

<blockquote>
<style type="text/css">
<!--
pre { white-space: pre-wrap; font-family: monospace; color: #000000; background-color: #eeeeee; }
* { font-size: 1em; }
.String { color: #4a708b; }
.Type { color: #008b00; font-weight: bold; }
.Statement { color: #b03060; font-weight: bold; }
.Comment { color: #0000ee; font-style: italic; }
.Special { color: #8a2be2; }
.Identifier { color: #458b74; }
.Constant { color: #ff8c00; }
-->
</style>

<pre id='vimCodeElement'>
<span class="Special">(</span><span class="Statement">in-package</span> :clausbrod.de<span class="Special">)</span>
<span class="Special">(</span><span class="Statement">export</span> <span class="Special">'</span><span class="Special">(</span>profile-function unprofile-function list-profiling-results<span class="Special">)</span><span class="Special">)</span>

<span class="Special">(</span><span class="Statement">let</span> <span class="Special">((</span>profile-hashtable <span class="Special">(</span><span class="Statement">make-hash-table</span><span class="Special">)))</span>
  <span class="Special">(</span><span class="Statement">defun</span> profile-function<span class="Special">(</span>func<span class="Special">)</span>
    <span class="String">&quot;Instrument function for profiling&quot;</span>

    <span class="Comment">;; check if symbol-plist already contains profiler flag</span>
    <span class="Special">(</span><span class="Statement">unless</span> <span class="Special">(</span><span class="Statement">get</span> func :profile-original-symbol-function<span class="Special">)</span>
      <span class="Special">(</span><span class="Statement">let</span> <span class="Special">((</span>original-symbol-function <span class="Special">(</span><span class="Statement">symbol-function</span> func<span class="Special">)))</span>
   <span class="Special">(</span><span class="Statement">when</span> original-symbol-function
     <span class="Special">(</span><span class="Statement">setf</span> <span class="Special">(</span><span class="Statement">get</span> func :profile-original-symbol-function<span class="Special">)</span> original-symbol-function<span class="Special">)</span> <span class="Comment">;; mark as profiled</span>

     <span class="Comment">;; install profiler code</span>
     <span class="Special">(</span><span class="Statement">setf</span> <span class="Special">(</span><span class="Statement">symbol-function</span> func<span class="Special">)</span>
      <span class="Special">(</span><span class="Statement">lambda</span><span class="Special">(</span><span class="Type">&amp;rest</span> r<span class="Special">)</span>
        <span class="Special">(</span><span class="Statement">let</span> <span class="Special">((</span>start-time <span class="Special">(</span>f2::seconds-since-1970<span class="Special">)))</span>
          <span class="Special">(</span><span class="Statement">unwind-protect</span>
         <span class="Special">(</span><span class="Statement">if</span> r
             <span class="Special">(</span><span class="Statement">apply</span> original-symbol-function r<span class="Special">)</span>
           <span class="Special">(</span><span class="Statement">funcall</span> original-symbol-function<span class="Special">))</span>
            <span class="Special">(</span><span class="Statement">let</span> <span class="Special">((</span>execution-time <span class="Special">(</span><span class="Statement">-</span> <span class="Special">(</span>f2::seconds-since-1970<span class="Special">)</span> start-time<span class="Special">))</span>
             <span class="Special">(</span>accum <span class="Special">(</span><span class="Statement">gethash</span> func profile-hashtable<span class="Special">)))</span>
         <span class="Special">(</span><span class="Statement">if</span> accum
             <span class="Special">(</span><span class="Statement">setf</span> <span class="Special">(</span><span class="Statement">gethash</span> func profile-hashtable<span class="Special">)</span> <span class="Special">(</span><span class="Statement">+</span> accum execution-time<span class="Special">))</span>
           <span class="Special">(</span><span class="Statement">setf</span> <span class="Special">(</span><span class="Statement">gethash</span> func profile-hashtable<span class="Special">)</span> execution-time<span class="Special">))</span>
         <span class="Special">(</span><span class="Statement">format</span> <span class="Statement">*standard-output*</span> <span class="String">&quot;~%Execution time for ~S: ~,10F~%&quot;</span> func execution-time<span class="Special">))))))</span>
     <span class="Special">))))</span>

  <span class="Special">(</span><span class="Statement">defun</span> unprofile-function<span class="Special">(</span>func<span class="Special">)</span>
    <span class="String">&quot;Remove profiling instrumentation for function&quot;</span>
    <span class="Special">(</span><span class="Statement">let</span> <span class="Special">((</span>original-symbol-function <span class="Special">(</span><span class="Statement">get</span> func :profile-original-symbol-function<span class="Special">)))</span>
      <span class="Special">(</span><span class="Statement">when</span> <span class="Special">(</span><span class="Statement">remprop</span> func :profile-original-symbol-function<span class="Special">)</span>
   <span class="Special">(</span><span class="Statement">setf</span> <span class="Special">(</span><span class="Statement">symbol-function</span> func<span class="Special">)</span> original-symbol-function<span class="Special">))))</span>

  <span class="Special">(</span><span class="Statement">defun</span> list-profiling-results<span class="Special">()</span>
    <span class="String">&quot;List profiling results in order of decreasing accumulated execution times&quot;</span>
    <span class="Special">(</span><span class="Statement">format</span> <span class="Statement">*standard-output*</span> <span class="String">&quot;~%Accumulated execution times:~%&quot;</span><span class="Special">)</span>
    <span class="Special">(</span><span class="Statement">let</span> <span class="Special">(</span>table-as-list<span class="Special">)</span>
      <span class="Special">(</span><span class="Statement">maphash</span> <span class="Special">(</span><span class="Statement">lambda</span><span class="Special">(</span>k v<span class="Special">)</span> <span class="Special">(</span><span class="Statement">push</span> <span class="Special">(</span><span class="Statement">cons</span> k v<span class="Special">)</span> table-as-list<span class="Special">))</span> profile-hashtable<span class="Special">)</span>
      <span class="Special">(</span><span class="Statement">dolist</span> <span class="Special">(</span>pair <span class="Special">(</span><span class="Statement">sort</span> table-as-list <span class="Type">#'&gt;</span> <span class="Type">:key</span> <span class="Type">#'cdr</span><span class="Special">))</span>
   <span class="Special">(</span><span class="Statement">format</span> <span class="Statement">*standard-output*</span> <span class="String">&quot;~S:  ~,10F~%&quot;</span> <span class="Special">(</span><span class="Statement">car</span> pair<span class="Special">)</span> <span class="Special">(</span><span class="Statement">cdr</span> pair<span class="Special">)))))</span>
  <span class="Special">)</span>

<span class="Special">(</span>f2::win-open-console-window<span class="Special">)</span>
<span class="Special">(</span><span class="Statement">setf</span> si::*enter-break-handler* <span class="Statement">t</span><span class="Special">)</span>
<span class="Special">(</span>use-fast-links <span class="Statement">nil</span><span class="Special">)</span>

</blockquote>

There are other profilers out there for Common Lisp, but it is not always straightforward to make them
work in !CoCreate Modeling which implements a subset of !CLtL1 only. So who knows, maybe someone
out there will actually find this useful! :-D

To profile a function:
<pre>
  (clausbrod.de:profile-function 'my-function)
</pre>

Now execute =my-function= at your heart's content. Every time the function is called, the profiler measures its execution time.
When the test session is completed, accumulated execution times can be listed as follows:

<pre>
  (clausbrod.de:list-profiling-results)
</pre>

And here is how to profile all functions in a given Lisp package:

<pre>
  (do-external-symbols (s (find-package "FOO"))
    (when (function s)
      (clausbrod.de:profile-function s)))
</pre>

My implementation differs almost entirely from Alex' version, which allows me to call it my own, but of course I owe thanks
to Alex for starting the discussion in the forum and posting his original inspirational code!

The code is now available as a Github project, see https://github.com/clausb/lisp-profiler. There is even a simple GUI
dialog on top of the low-level profiling code:

    <img src="%ATTACHURLPATH%/profiler-gui.png" alt="profiler-gui.png"  width="190" height="147"  />

The version of the code shown above uses a !SolidDesigner-specific way of getting the current time in high precision. The improved
version in the Github project should work in other Lisp dialects as well. Fingers crossed.


<!--
   * Set ALLOWTOPICCHANGE = Main.ClausBrod
-->

---

%STOPINCLUDE%

%COMMENT{type="below" nonotify="on"}%

---
to top
End of topic
Skip to action links | Back to top
You are here: Blog > DefinePrivatePublic20160308LispProfiler

r1.9 - 11 Jun 2016 - 14:36 - ClausBrod to top
Blog