Language AgnosticLangnostic Atom FeedProfiling `house`. Again.2020-12-21T05:10:24.000Zinaimathi<p>So I've plowed some of my vacation time into polishing up/hacking on some old projects. Including <a href='https://github.com/inaimathi/house'><code>house</code></a>, the web server I <a href='http://langnostic.inaimathi.ca/posts/a-bit-more-work-on-cl-vote#house-still-sucks-and-i-m-still-keeping-it'>complained</a> was garbage, but still had one distinct advantage over other Common Lisp webservers. Namely; because it's the only natively implemented one, it will work out-of-the-box, without issue, anywhere you can install <a href='https://www.quicklisp.org/beta/'><code>quicklisp</code></a> and a LISP it runs on.</p><p>This hacking attempt was aimed at addressing the complaint. <i>Most</i> of <a href='https://github.com/inaimathi/house/tree/major-overhaul'>the <code>major-overhaul</code> branch</a> was aimed at making the code more readable and sensical. Making <code>handlers</code> and <code>http-type</code>s much simpler, both implementationally and conceptually. But I want to throw at least <i>a little</i> effort at performance. With that in mind, I wanted a preliminary benchmark. I'm following <a href='https://github.com/fukamachi/woo/blob/master/benchmark.md'><code>fukamachi</code>s' procedure for <code>woo</code></a>. Note that, since <code>house</code> is a single-threaded server (for now), I'm only doing single-threaded benchmarks.</p><pre><code>; SLIME 2.26
CL-USER> (ql:quickload :house)
To load "house":
Load 1 ASDF system:
house
; Loading "house"
.....
(:HOUSE)
CL-USER> (in-package :house)
#<PACKAGE "HOUSE">
HOUSE> (define-handler (root) () "Hello world!")
#<HANDLER-TABLE {1004593CF3}>
HOUSE> (house:start 5000)
</code></pre><pre><code>inaimathi@this:~$ wrk -c 10 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 10 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 1.01ms 5.85ms 204.63ms 98.73%
Req/Sec 2.64k 0.89k 7.22k 62.16%
104779 requests in 10.10s, 30.58MB read
Socket errors: connect 0, read 104775, write 0, timeout 0
Requests/sec: 10374.93
Transfer/sec: 3.03MB
inaimathi@this:~$ wrk -c 10 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 10 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 2.74ms 19.05ms 408.54ms 98.18%
Req/Sec 2.58k 0.85k 4.64k 57.39%
102543 requests in 10.10s, 29.92MB read
Socket errors: connect 0, read 102539, write 0, timeout 0
Requests/sec: 10152.79
Transfer/sec: 2.96MB
inaimathi@this:~$ wrk -c 100 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 100 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 4.56ms 59.54ms 1.66s 99.27%
Req/Sec 3.10k 1.83k 9.56k 76.72%
103979 requests in 10.01s, 30.34MB read
Socket errors: connect 0, read 103979, write 0, timeout 4
Requests/sec: 10392.46
Transfer/sec: 3.03MB
inaimathi@this:~$ wrk -c 100 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 100 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 8.49ms 85.22ms 1.66s 98.81%
Req/Sec 3.23k 2.16k 11.90k 81.01%
102236 requests in 10.01s, 29.83MB read
Socket errors: connect 0, read 102232, write 0, timeout 4
Requests/sec: 10215.87
Transfer/sec: 2.98MB
inaimathi@this:~$
</code></pre><p>So that puts <code>house</code> comfortably in the same league as Tornado on PyPy or the <code>node.js</code> server. This is not a bad league to be in, but I want to see if I can do better.</p><h2><a name="step-1-kill-methods"></a><a href="#step-1-kill-methods">Step 1 - Kill Methods</a></h2><p><code>defmethod</code> is a thing I was seemingly obsessed with when I wrote <code>house</code>. This isn't necessarily a bad thing from the legibility perspective; because they have type annotations, it's clearer what an expected input is from a reading of the code. However, there's two disadvantages to using <code>method</code>s where you don't have to.</p><ol><li>You'll often get a <code>no-defined-method</code> error on weird input, rather than something more descriptive and specific the way you probably would when using a normal function</li><li>Your performance will sometimes irredeemably suck.</li></ol><p>The first point is a nit, but the second one is worth dealing with in the context of a library that should probably perform reasonably well at least <i>some</i> of the time. The <i>cause</i> of that problem is that <code>method</code>s can't be <code>inline</code>d. Because the point of them is to dispatch on a type-table of their arguments at runtime, they can't do their work at compile-time to inline the result without some <a href='http://metamodular.com/SICL/generic-dispatch.pdf'>serious trickery</a><a href='#fn-1' id='fnref1'><sup>1</sup></a>. Today, I'm avoiding trickery and just re-writing every <code>method</code> in <code>house</code> that I can into a function, usually by using <code>etypecase</code>.</p><p>Some of these are trivial conversions</p><pre><code>;;; house.lisp
...
-(defmethod start ((port integer) &optional (host usocket:*wildcard-host*))
+(defun start (port &optional (host usocket:*wildcard-host*))
+ (assert (integerp port))
...
-(defmethod process-ready ((ready stream-server-usocket) (conns hash-table))
- (setf (gethash (socket-accept ready :element-type 'octet) conns) nil))
-
-(defmethod process-ready ((ready stream-usocket) (conns hash-table))
+(defun process-ready (ready conns)
+ (assert (hash-table-p conn))
+ (etypecase ready
+ (stream-server-usocket (setf (gethash (socket-accept ready :element-type 'octet) conns) nil))
+ (stream-usocket
...
-(defmethod parse-cookies ((cookie string))
+(defun parse-cookies (cookie)
+ (assert (stringp cookie))
...
-(defmethod handle-request! ((sock usocket) (req request))
+(defun handle-request! (sock req)
...
-(defmethod error! ((err response) (sock usocket) &optional instance)
- (declare (ignorable instance))
+(defun error! (err sock)
,,,
</code></pre><pre><code>;;; session.lisp
...
-(defmethod new-session-hook! ((callback function))
+(defun new-session-hook! (callback)
...
-(defmethod poke! ((sess session))
+(defun poke! (sess)
...
</code></pre><pre><code>;;; util.lisp
...
-(defmethod path->uri ((path pathname) &key stem-from)
+(defun path->uri (path &key stem-from)
...
-(defmethod path->mimetype ((path pathname))
+(defun path->mimetype (path)
...
</code></pre><p>Some are <i>slightly</i> more complicated. In particular, <code>parse</code> looks like it would conflate two entirely separate functions, but on inspection, we know the type of its argument at every call site.</p><pre><code>./house.lisp:46: (setf (parameters (request buf)) (nconc (parse buf) (parameters (request buf)))))
./house.lisp:68: do (multiple-value-bind (parsed expecting) (parse buffer)
./house.lisp:92:(defmethod parse ((str string))
./house.lisp:110:(defmethod parse ((buf buffer))
./house.lisp:116: (parse str))))
</code></pre><p>So, we can convert <code>parse</code> to two separate, named functions. <code>write!</code> is basically the same situation.</p><pre><code>;;; house.lisp
...
-(defmethod parse ((str string))
+(defun parse-request-string (str)
...
-(defmethod parse ((buf buffer))
+(defun parse-buffer (buf)
...
-(defmethod write! ((res response) (stream stream))
+(defun write-response! (res stream)
...
-(defmethod write! ((res sse) (stream stream))
+(defun write-sse! (res stream)
...
</code></pre><p>Not pictured; changes at each call-site to call the correct one.</p><p>The <code>parse-params</code> method is a bit harder to tease out. Because it looks like it genuinely is one polymorphic function. Again, though, on closer inspection of the <i>fully internal to <code>house</code></i> call-sites makes it clear that we almost always know what we're passing as arguments at compile-time.</p><pre><code>./house.lisp:78:(defmethod parse-params (content-type (params null)) nil)
./house.lisp:79:(defmethod parse-params (content-type (params string))
./house.lisp:83:(defmethod parse-params ((content-type (eql :application/json)) (params string))
./house.lisp:107: (setf (parameters req) (parse-params nil parameters))
./house.lisp:113: (parse-params
(->keyword (cdr (assoc :content-type (headers (request buf)))))
str)
</code></pre><p>That "almost" is going to be a slight pain though; we need to do a runtime dispatch inside of <code>parse-buffer</code> to figure out whether we're parsing JSON or a param-encoded string.</p><pre><code>...
-(defmethod parse-params (content-type (params null)) nil)
-(defmethod parse-params (content-type (params string))
+(defun parse-param-string (params)
(loop for pair in (split "&" params)
- for (name val) = (split "=" pair)
- collect (cons (->keyword name) (or val ""))))
-
-(defmethod parse-params ((content-type (eql :application/json)) (params string))
- (cl-json:decode-json-from-string params))
+ for (name val) = (split "=" pair)
+ collect (cons (->keyword name) (or val ""))))
...
- (parse-params
- (->keyword (cdr (assoc :content-type (headers (request buf)))))
- str)
- (parse str))))
+ (if (eq :application/json (->keyword (cdr (assoc :content-type (headers (request buf))))))
+ (cl-json:decode-json-from-string str)
+ (parse-param-string str))
+ (parse-request-string str))))
...
</code></pre><p>The <i>last</i> one is going to be a headache. The <code>lookup</code> method is meant to be a general accessor, <i>and</i> has a <code>setf</code> method defined. I'm not going that way right now; lets see if we gained anything with our current efforts.</p><p>Second verse same as the first.</p><pre><code>; SLIME 2.26
CL-USER> (ql:quickload :house)
To load "house":
Load 1 ASDF system:
house
; Loading "house"
.....
(:HOUSE)
CL-USER> (in-package :house)
#<PACKAGE "HOUSE">
HOUSE> (define-handler (root) () "Hello world!")
#<HANDLER-TABLE {1004593CF3}>
HOUSE> (house:start 5000)
</code></pre><pre><code>inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 10 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 10 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 0.96ms 4.02ms 76.87ms 98.43%
Req/Sec 2.70k 0.98k 7.57k 73.83%
103951 requests in 10.10s, 30.34MB read
Socket errors: connect 0, read 103947, write 0, timeout 0
Requests/sec: 10292.48
Transfer/sec: 3.00MB
inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 10 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 10 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 846.32us 2.63ms 58.29ms 98.26%
Req/Sec 2.64k 0.94k 11.13k 72.89%
102661 requests in 10.10s, 29.96MB read
Socket errors: connect 0, read 102658, write 0, timeout 0
Requests/sec: 10165.46
Transfer/sec: 2.97MB
inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 100 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 100 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 8.57ms 90.07ms 1.66s 98.96%
Req/Sec 3.71k 2.87k 11.73k 74.30%
105162 requests in 10.10s, 30.69MB read
Socket errors: connect 0, read 105159, write 0, timeout 2
Requests/sec: 10412.91
Transfer/sec: 3.04MB
inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 100 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 100 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 5.69ms 70.32ms 1.66s 99.25%
Req/Sec 3.06k 1.82k 9.46k 74.40%
101302 requests in 10.10s, 29.56MB read
Socket errors: connect 0, read 101299, write 0, timeout 3
Requests/sec: 10030.14
Transfer/sec: 2.93MB
inaimathi@this:~/quicklisp/local-projects/house$
</code></pre><p>Aaand it looks like the effect was neglegible. Oh well. I honestly think that the untangling we've done so far makes the parts of the codebase that its' touched <i>more</i> readable, so I'm keeping them, but there's no great improvement yet. Perhaps if we inline some things?</p><pre><code>;;; package.lisp
-(declaim (inline crlf write-ln idling? flex-stream))
+(declaim (inline crlf write-ln idling? flex-stream write-response! write-sse! process-ready parse-param-string parse-request-string))
</code></pre><pre><code class="inaimathi@this:~/quicklisp/local-projects/house$">wrk -c 10 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 10 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 1.71ms 15.37ms 412.51ms 98.91%
Req/Sec 2.69k 0.91k 6.28k 65.37%
103607 requests in 10.10s, 30.24MB read
Socket errors: connect 0, read 103603, write 0, timeout 0
Requests/sec: 10258.44
Transfer/sec: 2.99MB
inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 10 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 10 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 837.49us 2.66ms 58.36ms 98.36%
Req/Sec 2.63k 836.52 3.81k 49.37%
103449 requests in 10.10s, 30.19MB read
Socket errors: connect 0, read 103446, write 0, timeout 0
Requests/sec: 10242.91
Transfer/sec: 2.99MB
inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 100 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 100 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 6.23ms 74.76ms 1.89s 99.08%
Req/Sec 4.01k 2.20k 10.23k 58.89%
101524 requests in 10.10s, 29.63MB read
Socket errors: connect 0, read 101522, write 0, timeout 4
Requests/sec: 10052.56
Transfer/sec: 2.93MB
inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 100 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 100 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 5.75ms 70.98ms 1.67s 99.27%
Req/Sec 3.19k 2.11k 10.26k 81.39%
100944 requests in 10.01s, 29.46MB read
Socket errors: connect 0, read 100941, write 0, timeout 1
Requests/sec: 10088.23
Transfer/sec: 2.94MB
</code></pre><p>Again, no huge difference. On closer inspection, <code>lookup</code> is only used in one place internally, and it's easy to replace with <code>gethash</code> so I'm just going to do that and re-check real quick.</p><pre><code>;;; channel.lisp
...
- (push sock (lookup channel *channels*))
+ (push sock (gethash channel *channels*))
...
</code></pre><pre><code>inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 10 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 10 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 0.95ms 3.72ms 72.70ms 98.43%
Req/Sec 2.66k 1.00k 11.52k 73.45%
102839 requests in 10.10s, 30.01MB read
Socket errors: connect 0, read 102835, write 0, timeout 0
Requests/sec: 10183.46
Transfer/sec: 2.97MB
inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 10 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 10 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 0.87ms 2.85ms 59.32ms 98.19%
Req/Sec 2.62k 0.86k 3.87k 54.82%
102818 requests in 10.10s, 30.00MB read
Socket errors: connect 0, read 102814, write 0, timeout 0
Requests/sec: 10180.62
Transfer/sec: 2.97MB
inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 100 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 100 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 6.96ms 80.03ms 1.68s 99.10%
Req/Sec 3.11k 2.12k 11.72k 78.40%
105460 requests in 10.10s, 30.78MB read
Socket errors: connect 0, read 105456, write 0, timeout 5
Requests/sec: 10441.77
Transfer/sec: 3.05MB
inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 100 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 100 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 8.22ms 83.95ms 1.66s 98.84%
Req/Sec 3.19k 2.07k 11.66k 73.23%
103933 requests in 10.10s, 30.33MB read
Socket errors: connect 0, read 103930, write 0, timeout 5
Requests/sec: 10290.43
Transfer/sec: 3.00MB
</code></pre><p>To no ones' great surprise, still not much of a difference. I'm going to let the <code>lookup</code> issue dangle for the moment, because it has to do with a trick I want to pull a bit later on, but before we get to that...</p><h2><a name="step-2-kill-classes"></a><a href="#step-2-kill-classes">Step 2 - Kill Classes</a></h2><p>The second step is to kill <code>class</code> definitions entirely. Their <code>accessor</code> functions are <i>also</i> generic, and therefore rely on method dispatch. <code>struct</code>s are a bit clumsier, but <i>probably</i> faster in the end. Now, we can't <i>really</i> mess with <code>session</code>, <code>request</code> and <code>response</code>, because those are part of <code>house</code>s' external interface, but there's three places where we can replace <code>defclass</code> with <code>defstruct</code>.</p><p>Re-writing <code>buffer</code>, <code>sse</code> and <code>handler-entry</code> ...</p><pre><code>;;; model.lisp
...
-(defclass sse ()
- ((id :reader id :initarg :id :initform nil)
- (event :reader event :initarg :event :initform nil)
- (retry :reader retry :initarg :retry :initform nil)
- (data :reader data :initarg :data)))
...
-(defclass buffer ()
- ((tries :accessor tries :initform 0)
- (contents :accessor contents :initform nil)
- (bi-stream :reader bi-stream :initarg :bi-stream)
- (total-buffered :accessor total-buffered :initform 0)
- (started :reader started :initform (get-universal-time))
- (request :accessor request :initform nil)
- (expecting :accessor expecting :initform 0)))
...
-(defclass handler-entry ()
- ((fn :reader fn :initarg :fn :initform nil)
- (closing? :reader closing? :initarg :closing? :initform t)))
...
</code></pre><pre><code>;;; house.lisp
...
-(defun write-sse! (res stream)
- (format stream "~@[id: ~a~%~]~@[event: ~a~%~]~@[retry: ~a~%~]data: ~a~%~%"
- (id res) (event res) (retry res) (data res)))
...
-(defun buffer! (buffer)
- (handler-case
- (let ((stream (bi-stream buffer)))
- (incf (tries buffer))
- (loop for char = (read-char-no-hang stream)
- until (or (null char) (eql :eof char))
- do (push char (contents buffer))
- do (incf (total-buffered buffer))
- when (request buffer) do (decf (expecting buffer))
- when (and #-windows(char= char #\linefeed)
- #+windows(char= char #\newline)
- (line-terminated? (contents buffer)))
- do (multiple-value-bind (parsed expecting) (parse-buffer buffer)
- (setf (request buffer) parsed
- (expecting buffer) expecting
- (contents buffer) nil)
- (return char))
- when (> (total-buffered buffer) +max-request-size+) return char
- finally (return char)))
- (error () :eof)))
...
-(defun parse-buffer (buf)
- (let ((str (coerce (reverse (contents buf)) 'string)))
- (if (request buf)
- (if (eq :application/json (->keyword (cdr (assoc :content-type (headers (request buf))))))
- (cl-json:decode-json-from-string str)
- (parse-param-string str))
- (parse-request-string str))))
...
</code></pre><pre><code>;;; define-handler.lisp
+(defstruct handler-entry
+ (fn nil)
+ (closing? t))
...
- (make-instance
- 'handler-entry
+ (make-handler-entry
</code></pre><pre><code>;;; channel.lisp
...
+(defstruct (sse (:constructor make-sse (data &key id event retry)))
+ (id nil) (event nil) (retry nil)
+ (data (error "an SSE must have :data") :type string))
...
-(defun make-sse (data &key id event retry)
- (make-instance 'sse :data data :id id :event event :retry retry))
+(defun write-sse! (res stream)
+ (format stream "~@[id: ~a~%~]~@[event: ~a~%~]~@[retry: ~a~%~]data: ~a~%~%"
+ (ss-id res) (sse-event res) (sse-retry res) (sse-data res)))
...
</code></pre><pre><code>;;; buffer.lisp
+(in-package :house)
+
+(defstruct (buffer (:constructor make-buffer (bi-stream)))
+ (tries 0 :type integer)
+ (contents nil)
+ (bi-stream nil)
+ (total-buffered 0 :type integer)
+ (started (get-universal-time))
+ (request nil)
+ (expecting 0 :type integer))
+
+(defun buffer! (buffer)
+ (handler-case
+ (let ((stream (buffer-bi-stream buffer)))
+ (incf (buffer-tries buffer))
+ (loop for char = (read-char-no-hang stream)
+ until (or (null char) (eql :eof char))
+ do (push char (buffer-contents buffer))
+ do (incf (buffer-total-buffered buffer))
+ when (buffer-request buffer) do (decf (buffer-expecting buffer))
+ when (and #-windows(char= char #\linefeed)
+ #+windows(char= char #\newline)
+ (line-terminated? (buffer-contents buffer)))
+ do (multiple-value-bind (parsed expecting) (parse-buffer buffer)
+ (setf (buffer-request buffer) parsed
+ (buffer-expecting buffer) expecting
+ (buffer-contents buffer) nil)
+ (return char))
+ when (> (buffer-total-buffered buffer) +max-request-size+) return char
+ finally (return char)))
+ (error () :eof)))
+
+(defun parse-buffer (buf)
+ (let ((str (coerce (reverse (buffer-contents buf)) 'string)))
+ (if (buffer-request buf)
+ (if (eq :application/json (->keyword (cdr (assoc :content-type (headers (buffer-request buf))))))
+ (cl-json:decode-json-from-string str)
+ (parse-param-string str))
+ (parse-request-string str))))
</code></pre><p>... should get us _something. Right?</p><pre><code>inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 10 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 10 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 1.09ms 6.18ms 202.73ms 98.55%
Req/Sec 2.69k 0.89k 4.02k 56.74%
105108 requests in 10.10s, 30.67MB read
Socket errors: connect 0, read 105105, write 0, timeout 0
Requests/sec: 10406.92
Transfer/sec: 3.04MB
inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 10 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 10 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 0.98ms 5.78ms 204.47ms 98.86%
Req/Sec 2.67k 848.77 3.98k 54.71%
104242 requests in 10.10s, 30.42MB read
Socket errors: connect 0, read 104242, write 0, timeout 0
Requests/sec: 10321.40
Transfer/sec: 3.01MB
inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 100 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 100 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 6.93ms 79.75ms 1.66s 99.10%
Req/Sec 3.33k 2.46k 11.95k 79.87%
105920 requests in 10.10s, 30.91MB read
Socket errors: connect 0, read 105918, write 0, timeout 2
Requests/sec: 10487.59
Transfer/sec: 3.06MB
inaimathi@this:~/quicklisp/local-projects/house$ wrk -c 100 -t 4 -d 10 http://127.0.0.1:5000
Running 10s test @ http://127.0.0.1:5000
4 threads and 100 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 4.78ms 61.11ms 1.68s 99.30%
Req/Sec 2.83k 1.26k 7.01k 70.22%
103381 requests in 10.10s, 30.17MB read
Socket errors: connect 0, read 103378, write 0, timeout 0
Requests/sec: 10235.14
Transfer/sec: 2.99MB
</code></pre><p>Very little noticeable gain, I'm afraid. Ok, there's one more thing I'm tempted to try. There were hints earlier that this was coming, including <a href='https://github.com/inaimathi/house/issues/18'>this</a>, but if you don't follow my <code>github</code> you might still be surprised.</p><h2><a name="step-3-musing-on-clj"></a><a href="#step-3-musing-on-clj">Step 3 - Musing on CLJ</a></h2><p>Now that we have what I <i>think</i> is a reasonably fast implementation of <code>house</code>, I want to see whether<a href='#fn-2' id='fnref2'><sup>2</sup></a> [<code>clj</code>](https://github.com/inaimathi/clj) does performance damage to the implementation. I want to see this because, the <code>clj</code> datastructures and syntax <i>really</i> improve readability and <code>REPL</code> development; there's a <i>bunch</i> of situations in which I missed having that level of visibility into my structures before I even began this benchmark article. There's even probably a few places where it <i>saves</i> some performance by referencing other partial structures. The problem is that <i>I'm guessing</i> it's a net negative in terms of performance, so I want to see what a conversion would do to my benchmark before I go through with it.</p><p>This is going to be <i>especially</i> useful for <code>house</code>s' external interface. And given that I've already had to break compatibility to write this overhaul, this is probably the best possible time to test the theory. The trouble is that I'm not <i>entirely</i> sure what the real interface looks like quite yet, so I'm <i>not</i> going to be implementing it today. These are just some musings.</p><p>The current <code>house</code> model for <code>handler</code>/<code>response</code> interaction is that a handler returns either a <code>response</code> (in the event of a <code>redirect!</code>) or a <code>string</code> (in any other event). This makes a few things kind of difficult. Firstly, it means that <code>session</code> and <code>header</code> manipulation has to happen by effect. That is, they're not included as part of the return value; they have to be exposed in some other way. In the case of <code>headers</code>, it's via an <code>alist</code> bound to the invisible symbol <code>headers</code> inside of the handler body. This ... is less than ideal.</p><p>If we take the <code>http-kit</code> approach, we'd expect our handlers to always return a <code>map</code>. And if that <code>map</code> had slots for <code>headers</code>/<code>session</code>, those things would be set as appropriate in the outgoing <code>response</code> and/or server state. Our input would <i>also</i> be a <code>map</code>. And it would naturally contain <code>method</code>/<code>headers</code>/<code>path</code>/<code>parameters</code>/<code>session</code>/etc slots that a handler writer would want to make use of. I'm not <i>entirely</i> clear on whether we'd want to make this the primary internal and external representation, or if we're just looking for an easily manipulated layer for the users. I'm leaning towards the first of those options.</p><p>This ... actually doesn't sound too hard if cut at the right level. Lets give it a shot, I guess.</p><p><img src="/static/img/one-eternity-later.jpg" alt="" /></p><p>It wasn't.</p><p>There's enough weird shit happening here that I need a fresh brain for it. That was enough for now. The main roadblock I hit is that it turns out that a lot more of the internal interface here depends on mutation than I thought. This is bad for readability and coceptual simplicity, but good in the sense that I can move away from these models first, <i>then</i> see about integrating <code>clj</code> later.</p><p>I'll <i>probably</i> take another run up this hill later, but for now, I think I'm moving on to <a href='https://github.com/inaimathi/house/issues'>other issues</a>. <ol class='footnotes'><li id='fn-1'>Wait, why use methods then? They're good <i>specifically</i> in the situation where you want to establish an interface for a set of datastructures that you expect to have to extend <i>outside of your library</i>. If all the extension is going to happen inside, you can still make the argument that <code>etypecase</code> is the right way to go. But if you want the <i>callers</i> of your code to be able to define new behaviors for datastructures they specify themselves, then absolutely reach for <code>defmethod</code>.<a href='#fnref1'>↩</a></li><li id='fn-2'>More realistically, "how much" rather than "whether"<a href='#fnref2'>↩</a></li></ol></p>The Prisoners Part 22020-09-20T04:25:30.000Zinaimathi<p>Dawn of the second day.</p><p>According to the internet, the thing I intend to build is <a href='https://bp.io/howroguelike/'>called a Roguelikelike</a>, teetering on the very edge of being a Roguelike. So it goes; we'll see if I end up taking the title or not.</p><p>Last time, we laid out the basics of <code>prisoner</code>s, their interactions and their strategies. This time, lets get some different scenarios and some player interaction going.</p><h2><a name="scenarios"></a><a href="#scenarios">Scenarios</a></h2><p>Payoff matrices involve deciding who gets what bonus or penalty as a result of an interaction. Given a pair of <code>defect</code>/<code>cooperate</code> choices, a <code>payoff-matrix</code> will return the scores to be delivered to each player in turn.</p><pre><code>(defun payoff-matrix (cc-a cc-b cd-a cd-b dc-a dc-b dd-a dd-b)
(let ((tbl {(cons :cooperate :cooperate) (list cc-a cc-b)
(cons :defect :cooperate) (list dc-a dc-b)
(cons :cooperate :defect) (list cd-a cd-b)
(cons :defect :defect) (list dd-a dd-b)}))
(lambda (a b) (lookup tbl (cons a b)))))
</code></pre><p>Now we can define some basic scenarios. A <code>dilemma</code> is the name I'll pick for the situation where co-operating is better for the group, and both defecting is the worst thing for everyone, but a single defector will end out better off <i>by</i> defecting.</p><pre><code>(defparameter dilemma
(payoff-matrix
3 3 1 5
5 1 0 0))
</code></pre><p>A <code>stag-hunt</code> is a situation where a pair of players can pool their resources for a greater prize, and ignore each other for the lesser. If either player attempts to hunt the stag alone, they get nothing, while their defecting partner still gets a rabbit.</p><pre><code>(defparameter stag-hunt
(payoff-matrix
3 3 0 1
1 0 1 1))
</code></pre><p>A <code>trade</code> is one in which both parties benefit, but to which both parties must agree.</p><pre><code>(defparameter trade
(payoff-matrix
3 3 0 0
0 0 0 0))
</code></pre><p>A <code>theft</code> is one where a player takes from the other. But if both players cooperate, or both try to rob each other, they come to an impasse.</p><pre><code>(defparameter theft
(payoff-matrix
0 0 -3 3
3 -3 0 0))
</code></pre><p>A <code>trap</code> is a situation where cooperating leads to disaster, ignoring the situation leads to no gain, and <code>defect</code>ing to make it clear to your partner that you don't intend to follow ends up benefiting both players.</p><pre><code>(defparameter trap
(payoff-matrix
-3 -3 2 2
2 2 0 0))
</code></pre><p>The last scenario I'll concern myself with is the <code>mutual-prediction</code>. Where guessing what your partner/opponent will choose benefits you, and failing to do so does nothing.</p><pre><code>(defparameter mutual-prediction
(payoff-matrix
3 3 0 0
0 0 3 3))
</code></pre><h2><a name="adventure"></a><a href="#adventure">Adventure</a></h2><p>In order to move through the world, our <code>prisoner</code>s need a world to move through. Let us begin at the ending.</p><pre><code>(defparameter ending
{:description "You have come to the end of your long, perilous journey."})
</code></pre><p>There is nothing to do at the end other than display this fact.</p><pre><code>(defun repl! (adventure)
(format t "~%~%~a~%~%" (lookup adventure :description)))
</code></pre><pre><code>THE-PRISONERS> (repl! ending)
You have come to the end of your long, perilous journey.
NIL
THE-PRISONERS>
</code></pre><p>But what led us here was a choice. An adventure is more than a description, it's also the options, a <code>prisoner</code>, the <code>scenario</code>, and a way to <code>continue</code> the action. <code>continue</code>ing means making a choice and effectively playing the opposing/cooperating <code>prisoner</code> and abiding by the results.</p><pre><code>(defun mk-adventure ()
(let ((prisoner (polo)))
{:description
"A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\""
:cooperate "accept" :defect "refuse" :prisoner prisoner :scenario trade
:continue (lambda (choice)
(let ((their-choice (play prisoner)))
(update! prisoner choice)
(funcall trade choice their-choice)
ending))}))
</code></pre><p>This sort of adventure also takes a bit more machinery to run from the <code>repl</code>. We need to present the <code>description</code>, but also get an appropriate choice from the user. Getting that choice is a bit more complicated than you might think at first.</p><pre><code>(defun get-by-prefix (lst prefix)
(let ((l (length prefix)))
(loop for elem in lst
when (and (>= (length elem) l)
(== (subseq elem 0 l) prefix))
do (return elem))))
(defun get-repl-choice (adventure)
(let* ((responses (mapcar #'string-downcase (list (lookup adventure :cooperate) (lookup adventure :defect))))
(r-map {(string-downcase (lookup adventure :cooperate)) :cooperate
(string-downcase (lookup adventure :defect)) :defect})
(by-pref nil)
(resp ""))
(loop until (and (symbolp resp)
(setf by-pref
(get-by-prefix
responses
(string-downcase (symbol-name resp)))))
do (format
t "~a/~a:"
(lookup adventure :cooperate)
(lookup adventure :defect))
do (setf resp (read)))
(lookup r-map by-pref)))
</code></pre><p>Well behaved players are easy to deal with, true...</p><pre><code>THE-PRISONERS> (get-repl-choice (mk-adventure))
Accept/Refuse:acc
:COOPERATE
T
THE-PRISONERS> (get-repl-choice (mk-adventure))
Accept/Refuse:ref
:DEFECT
T
THE-PRISONERS> (get-repl-choice (mk-adventure))
Accept/Refuse:a
:COOPERATE
T
</code></pre><p>... but we want to be a bit more general than that.</p><pre><code>THE-PRISONERS> (get-repl-choice (mk-adventure))
Accept/Refuse:fuck you
Accept/Refuse:Accept/Refuse:boo
Accept/Refuse: (error 'error)
Accept/Refuse: (quit)
Accept/Refuse:r
:DEFECT
T
THE-PRISONERS>
</code></pre><p>That's the only hard par though. Interacting with the game once we're sure we have valid input from our player is relatively simple.</p><pre><code>(defun repl! (adventure)
(format t "~%~%~a~%~%" (lookup adventure :description))
(when (contains? adventure :continue)
(let ((choice (get-repl-choice adventure)))
(repl! (funcall (lookup adventure :continue) choice)))))
</code></pre><pre><code>THE-PRISONERS> (repl! (mk-adventure))
A stranger approaches. "I see you have baubles. Would you like to trade, that we both may enrich ourselves?"
Accept/Refuse:acc
You have come to the end of your long, perilous journey.
NIL
THE-PRISONERS>
</code></pre><p>This is obviously not the perilous journey being spoken of. At least, not all of it. The simplest way to extend it into one is to wrap <code>scenario</code>s around our existing <code>adventure</code>.</p><pre><code>(defun mk-adventure ()
(let ((def (defector)))
{:description "A muscled street thug approachs, knife drawn."
:cooperate "surrender" :defect "run" :prisoner def :scenario theft
:continue (lambda (choice)
(let ((their-choice (play def)))
(update! def choice)
(funcall theft choice their-choice))
(let ((prisoner (polo)))
{:description
"A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\""
:cooperate "accept" :defect "refuse" :prisoner prisoner :scenario trade
:continue (lambda (choice)
(let ((their-choice (play prisoner)))
(update! prisoner choice)
(funcall trade choice their-choice)
ending))}))}))
</code></pre><pre><code>THE-PRISONERS> (repl! (mk-adventure))
A muscled street thug approachs, knife drawn.
Surrender/Run:run
A stranger approaches. "I see you have baubles. Would you like to trade, that we both may enrich ourselves?"
Accept/Refuse:acc
You have come to the end of your long, perilous journey.
NIL
THE-PRISONERS>
</code></pre><p>Of course, since we want it to be much longer and more perilous, we'll want that process automated to at least some degree.</p><pre><code>(defun wrap-scenario (adventure scenario)
(insert
scenario
(cons
:continue
(lambda (choice)
(let* ((them (lookup scenario :prisoner))
(their-choice (play them)))
(update! them choice)
(funcall (lookup scenario :scenario) choice their-choice)
adventure)))))
(defun mk-adventure ()
(wrap-scenario
(wrap-scenario
ending
{:description
"A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\""
:cooperate "accept" :defect "refuse" :prisoner (polo) :scenario trade})
{:description
"A muscled street thug approachs, knife drawn. \"Yer money or yer life, fop!\""
:cooperate "surrender" :defect "run" :prisoner (defector) :scenario theft}))
</code></pre><p>This isn't enough for the Roguelikelike title, and I don't think I'll get there today, but I do want the ability to make an arbitrarily long adventure. The dumbest way of doing this is to make a list of scenarios, and pick from them when the need arises.</p><pre><code>(defun random-scenario ()
(pick
(list
{:description
"A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\""
:cooperate "accept" :defect "refuse" :prisoner (polo) :scenario trade}
{:description
"A muscled street thug approachs, knife drawn. \"Yer money or yer life, fop!\""
:cooperate "surrender" :defect "run" :prisoner (defector) :scenario theft})))
(defun mk-adventure (&key (scenarios 5))
(let ((adventure ending))
(loop repeat scenarios
do (setf adventure (wrap-scenario adventure (random-scenario))))
adventure))
</code></pre><p>An adventure of even 5 scenarios will end up being repetitive since we currently only have a grand total of two. But we can do something about that...</p><pre><code>(defun random-scenario ()
(pick
(list
{:description
"A stranger approaches. \"I see you have baubles. Would you like to trade, that we both may enrich ourselves?\""
:cooperate "accept" :defect "refuse" :prisoner (polo) :scenario trade}
{:description
"A muscled street thug approachs, knife drawn. \"Yer money or yer life, fop!\""
:cooperate "surrender" :defect "run" :prisoner (defector) :scenario theft}
{:description
"As you walk through an expansive market square, a gambler motions you over. \"Fancy your chances at evens or odds?"
:cooperate "Evens!" :defect "Odds!" :prisoner (gambler) :scenario mutual-prediction}
{:description
"A hunter approaches you in a forest clearing. \"Hallo there, young one. Would you help me hunt a deer? I've had enough hares for now, but I promise we'll eat well if we work together!\""
:cooperate "<Nocks bow>" :defect "Rather go my own way" :prisoner (dantes) :scenario stag-hunt}
{:description
"\"Hey follow me into this bear trap!\""
:cooperate "Sure; I've grown tired of living" :defect "No. No, I'd rather not."
:prisoner (robin) :scenario trap}
{:description
"You see a merchant ahead of you, paying little attention to his overfull coin purse. You could cut it and run."
:cooperate "It's too tempting" :defect "No; I hold strong"
:prisoner (dantes) :scenario theft}
{:description
"At the end of your travails with your co-conspirator, you get to the treasure first and can pocket some if you want."
:cooperate "Take it" :defect "No, we split fairly"
:prisoner (gambler :defect 5) :scenario dilemma})))
</code></pre><p>This gives me some ideas about how to go about generating scenarios a lot more programmatically, but I'll leave that for later, when I'm in the right frame of mind to do cosmetic improvements.</p><p><img src="/static/img/the-prisoners/wanna-play-a-game.jpg" alt="Wanna play a game?" /></p><pre><code>THE-PRISONERS> (repl! (mk-adventure))
At the end of your travails with your co-conspirator, you get to the treasure first and can pocket some if you want.
Take it/Split fairly:split
You see a merchant ahead of you, paying little attention to his overfull coin purse. You could cut it and run.
It's too tempting/No:it's
"Hey follow me into this bear trap!"
Sure; I've grown tired of living/No. No, I'd rather not.:no
You see a merchant ahead of you, paying little attention to his overfull coin purse. You could cut it and run.
It's too tempting/No:it's
A stranger approaches. "I see you have baubles. Would you like to trade, that we both may enrich ourselves?"
accept/refuse:accept
You have come to the end of your long, perilous journey.
NIL
THE-PRISONERS>
</code></pre><p>This is about as far as I'm going today, and I'm not entirely sure how far I'm going during my next session.</p><p>As always, I'll let you know.</p>The Prisoners Part 12020-09-19T00:19:48.000Zinaimathi<p>Ok, so I guess I'm doing this.</p><p>In hopes of participating in the <a href='https://itch.io/jam/autumn-lisp-game-jam-2020'>Autumn Lisp 2020 Game Jam</a>, I'm going to write a multiplayer game. It's going to deal with players in several ways, implement 1FA, and probably end up being asymmetric and heavily infulenced by some readings that The Cabal have been doing lately.</p><p>But don't worry about that for the moment.</p><h2><a name="piece-by-piece"></a><a href="#piece-by-piece">Piece by piece</a></h2><h3><a name="the-basics"></a><a href="#the-basics">The basics</a></h3><pre><code>(in-package #:the-prisoners)
(named-readtables:in-readtable clj:syntax)
</code></pre>I'm using <a href='/posts/subverting-common-lisp-types-and-emacs-interaction-for-clj'><code>clj</code></a>. You can find it on <a href='https://github.com/inaimathi/clj'>my github</a>, and it'll be included as part of the <code>asd</code> file.<p>Ahem.</p><p>Prisoners can do two things. They can <code>cooperate</code> or they can <code>defect</code>.</p><pre><code>(defun coop? (res) (eq :cooperate res))
(defun defe? (res) (eq :defect res))
</code></pre><p>In order to play a game, you take the <code>game</code> function and <code>apply</code> it to the ordered list of <code>prisoners</code> that will be playing.</p><pre><code>(defun play! (game &rest players)
(apply game players))
</code></pre><p>A two-player, one-time game looks like this:</p><ol><li>We take two <code>prisoner</code>s</li><li>We ask them to either <code>cooperate</code> or <code>defect</code></li><li>We tell each of them what the other did</li><li>We score them</li></ol><p>To start with, we're going with a payoff matrix that looks like</p><pre><code> | Cooperate | Defect
------------------------------
Cooperate | 3, 3 | 1, 5
------------------------------
Defect | 5, 1 | 0, 0
------------------------------
</code></pre><p>We might play with this later, but lets pretend we won't have the time.</p><pre><code>(defun one-time (player-a player-b)
(let ((a (funcall (lookup player-a :strategy)))
(b (funcall (lookup player-b :strategy))))
(if-let (update (lookup player-a :update))
(funcall update b))
(if-let (update (lookup player-b :update))
(funcall update a))
(cond ((and (coop? a) (coop? b))
(list 3 3))
((and (coop? a) (defe? b))
(list 1 5))
((and (defe? a) (coop? b))
(list 5 1))
(t
(list 0 0)))))
</code></pre><p>The two simplest possible prisoners we can have are one who always <code>:cooperate</code>s, and one who always <code>:defect</code>s. A <code>prisoner</code> needs to be able to take into account what their opponent did last time, and separately, do something.</p><pre><code>(defun defector ()
{:name :defector :strategy (lambda () :defect)})
(defun cooperator ()
{:name :cooperator :strategy (lambda () :cooperate)})
</code></pre><p>We can now play. Would you like to play a game?</p><h3><a name="the-simplest-game"></a><a href="#the-simplest-game">The Simplest Game</a></h3><p><img src="/static/img/the-prisoners/would-you-like-to-play-a-game.jpg" alt="Would you like to play a game?" /></p><pre><code>THE-PRISONERS> (play! #'one-time (defector) (cooperator))
(5 1)
THE-PRISONERS> (play! #'one-time (cooperator) (defector))
(1 5)
THE-PRISONERS> (play! #'one-time (cooperator) (cooperator))
(3 3)
THE-PRISONERS> (play! #'one-time (defector) (defector))
(0 0)
THE-PRISONERS>
</code></pre><p>There are other, simple kinds of prisoners. One is the prisoner who tosses a coin and does what it tells them to.</p><pre><code>(defun gambler ()
{:name :gambler :strategy (lambda () (nth (random 2) (list :cooperate :defect)))})
</code></pre><p>The more general case doesn't necessarily flip a coin, but can weigh either <code>:cooperate</code> or <code>:defect</code> more strongly.</p><pre><code>(defun gambler (&key (cooperate 1) (defect 1))
(let ((total (+ cooperate defect))
(moves (concatenate
'list
(loop repeat cooperate collect :cooperate)
(loop repeat defect collect :defect))))
{:name (intern (format nil "GAMBLER~a/~a" cooperate defect) :keyword)
:strategy (lambda () (nth (random total) moves))}))
</code></pre><p>This way, we can get a true coin-flipper.</p><pre><code>THE-PRISONERS> (gambler)
{:NAME :GAMBLER1/1 :STRATEGY #<CLOSURE (LAMBDA () :IN GAMBLER) {1003B5824B}>}
THE-PRISONERS>
</code></pre><p>Or someone who mostly cooperates/defects, but sometimes defects/cooperates.</p><pre><code>THE-PRISONERS> (gambler :cooperate 5)
{:NAME :GAMBLER5/1 :STRATEGY #<CLOSURE (LAMBDA () :IN GAMBLER) {1003B69F0B}>}
THE-PRISONERS> (gambler :defect 5)
{:NAME :GAMBLER1/5 :STRATEGY #<CLOSURE (LAMBDA () :IN GAMBLER) {1003B6C38B}>}
THE-PRISONERS>
</code></pre><p>How do they play against each of the others? Lets find out.</p><h3><a name="the-second-simplest-game"></a><a href="#the-second-simplest-game">The Second Simplest Game</a></h3><pre><code>(defun matches (elems &key (mirror? t))
(loop for (a . rest) on elems while rest
if mirror? collect (cons a a)
append (loop for b in rest collect (cons a b))))
(defun all-against-all! (game matches)
(reduce
(lambda (memo res)
(merge-by #'+ memo res))
(loop for (a . b) in matches
collect (let ((res (play! game a b)))
{(lookup a :name) (first res) (lookup b :name) (second res)}))))
</code></pre><p>This lets us see who does better against everyone.</p><pre><code>THE-PRISONERS> (all-against-all! #'one-time (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 13 :GAMBLER1/1 9 :GAMBLER5/1 8 :DEFECTOR 10 :COOPERATOR 8}
THE-PRISONERS> (all-against-all! #'one-time (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 8 :GAMBLER1/1 7 :GAMBLER5/1 8 :DEFECTOR 15 :COOPERATOR 10}
THE-PRISONERS> (all-against-all! #'one-time (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 10 :GAMBLER1/1 7 :GAMBLER5/1 8 :DEFECTOR 15 :COOPERATOR 8}
THE-PRISONERS> (all-against-all! #'one-time (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 11 :GAMBLER1/1 10 :GAMBLER5/1 11 :DEFECTOR 10 :COOPERATOR 6}
THE-PRISONERS>
</code></pre><p>The <code>defector</code> comes out on top here. And the mostly-defecting <code>gambler</code> doesn't do bad either. Of course, this is what we would expect from the <code>one-time</code> game.</p><p>An <code>iterated</code> game is like a series of <code>one-time</code> games, and it keeps a running total of the score.</p><pre><code>(defun iterated (&key (iterations 10))
(lambda (player-a player-b)
(loop repeat iterations
for (a b) = (one-time player-a player-b)
sum a into a-sum sum b into b-sum
finally (return (list a-sum b-sum)))))
</code></pre><p>It plays about how you'd expect</p><pre><code>THE-PRISONERS> (play! (iterated) (defector) (cooperator))
(50 10)
THE-PRISONERS> (play! (iterated) (cooperator) (cooperator))
(30 30)
THE-PRISONERS> (play! (iterated) (defector) (defector))
(0 0)
THE-PRISONERS>
</code></pre><p>And setting the world at its' own throat works the way you'd expect of this process so far.</p><pre><code>THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 119 :GAMBLER1/1 117 :GAMBLER5/1 105 :DEFECTOR 135 :COOPERATOR 100}
THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 132 :GAMBLER1/1 109 :GAMBLER5/1 103 :DEFECTOR 120 :COOPERATOR 100}
THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5))))
{:GAMBLER1/5 100 :GAMBLER1/1 124 :GAMBLER5/1 92 :DEFECTOR 130 :COOPERATOR 96}
THE-PRISONERS>
</code></pre><p>There are more elaborate strategies we can call upon. I won't implement them all here, but these have <a href='https://plato.stanford.edu/entries/prisoner-dilemma/strategy-table.html'>been thought of</a>.</p><h3><a name="thoughtful-players"></a><a href="#thoughtful-players">Thoughtful Players</a></h3><p>Robin alternates between cooperating and defecting.</p><pre><code>(defun robin ()
(let ((prev :cooperate))
{:name :robin
:strategy (lambda ()
(if (coop? prev)
(setf prev :defect)
(setf prev :cooperate)))}))
</code></pre><p>And then, there are the simplest strategies that consider their opponent.</p><pre><code>(defun polo ()
(let ((prev nil))
{:name :polo
:update (lambda (opponent-action) (setf prev opponent-action))
:strategy (lambda () (or prev :cooperate))}))
(defun dantes ()
(let ((plan :cooperate))
{:name :dantes
:update (lambda (action) (when (defe? action) (setf plan :defect)))
:strategy (lambda () plan)}))
</code></pre><p>With the addition of these, it's no longer obviously a <code>defector</code>s game.</p><pre><code>THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 164 :DANTES 131 :GAMBLER1/1 150 :GAMBLER5/1 169 :DEFECTOR 150 :COOPERATOR 184 :POLO 120 :ROBIN 147}
THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 168 :DANTES 126 :GAMBLER1/1 176 :GAMBLER5/1 159 :DEFECTOR 165 :COOPERATOR 184 :POLO 129 :ROBIN 136}
THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 158 :DANTES 121 :GAMBLER1/1 154 :GAMBLER5/1 156 :DEFECTOR 150 :COOPERATOR 184 :POLO 123 :ROBIN 154}
THE-PRISONERS> (all-against-all! (iterated) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 163 :DANTES 131 :GAMBLER1/1 163 :GAMBLER5/1 161 :DEFECTOR 175 :COOPERATOR 184 :POLO 117 :ROBIN 146}
THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 789 :DANTES 656 :GAMBLER1/1 940 :GAMBLER5/1 964 :DEFECTOR 720 :COOPERATOR 1056 :POLO 585 :ROBIN 752}
THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 845 :DANTES 651 :GAMBLER1/1 892 :GAMBLER5/1 959 :DEFECTOR 775 :COOPERATOR 1054 :POLO 609 :ROBIN 719}
THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 788 :DANTES 651 :GAMBLER1/1 929 :GAMBLER5/1 946 :DEFECTOR 775 :COOPERATOR 1044 :POLO 609 :ROBIN 744}
THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 859 :DANTES 651 :GAMBLER1/1 867 :GAMBLER5/1 952 :DEFECTOR 765 :COOPERATOR 1048 :POLO 609 :ROBIN 729}
THE-PRISONERS> (all-against-all! (iterated :iterations 50) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 833 :DANTES 666 :GAMBLER1/1 920 :GAMBLER5/1 953 :DEFECTOR 775 :COOPERATOR 1046 :POLO 603 :ROBIN 720}
THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 8325 :DANTES 6436 :GAMBLER1/1 9255 :GAMBLER5/1 9544 :DEFECTOR 7565 :COOPERATOR 10508 :POLO 8976 :ROBIN 7383}
THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 8365 :DANTES 6531 :GAMBLER1/1 9289 :GAMBLER5/1 9531 :DEFECTOR 7645 :COOPERATOR 10486 :POLO 6018 :ROBIN 7379}
THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 8407 :DANTES 6546 :GAMBLER1/1 9139 :GAMBLER5/1 9574 :DEFECTOR 7590 :COOPERATOR 10554 :POLO 6117 :ROBIN 7389}
THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 8063 :DANTES 6371 :GAMBLER1/1 9231 :GAMBLER5/1 9492 :DEFECTOR 7555 :COOPERATOR 10508 :POLO 6084 :ROBIN 7412}
THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 8068 :DANTES 6456 :GAMBLER1/1 9165 :GAMBLER5/1 9614 :DEFECTOR 7395 :COOPERATOR 10516 :POLO 6003 :ROBIN 7451}
THE-PRISONERS> (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin))))
{:GAMBLER1/5 8241 :DANTES 6356 :GAMBLER1/1 9150 :GAMBLER5/1 9579 :DEFECTOR 7545 :COOPERATOR 10480 :POLO 9021 :ROBIN 7392}
THE-PRISONERS>
</code></pre><p>When it's a prisoner against the world, the makeup of the world makes a difference in which prisoner ultimately wins.</p><pre><code>(defun winner (results)
(let ((max nil)
(score nil))
(loop for (k . v) in (as-list results)
do (if (or (not score) (> v score))
(setf score v
max (cons k v))))
max))
</code></pre><p>Currently, with mirror matches happening, the world is tilted towards <code>cooperator</code>s.</p><pre><code>THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10554)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10532)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10486)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10536)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10478)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10502)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10540)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10516)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)))))
(:COOPERATOR . 10476)
THE-PRISONERS>
</code></pre><p>Without mirror matches, it's still mostly a <code>cooperator</code>s' game, but not quite so strongly.</p><pre><code>THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:DEFECTOR . 7665)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:ROBIN . 7497)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:COOPERATOR . 7512)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:COOPERATOR . 7580)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:COOPERATOR . 7516)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:COOPERATOR . 7528)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:DEFECTOR . 7615)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:DEFECTOR . 7610)
THE-PRISONERS> (winner (all-against-all! (iterated :iterations 500) (matches (list (cooperator) (defector) (gambler) (gambler :cooperate 5) (gambler :defect 5) (polo) (dantes) (robin)) :mirror? nil)))
(:COOPERATOR . 7550)
THE-PRISONERS>
</code></pre><p>This wasn't the end. It was step one.</p>A Bit More Work On Cl Vote2020-09-03T18:13:17.000Zinaimathi<p>So I've done a bit more work on <a href='https://github.com/inaimathi/cl-vote'><code>cl-vote</code></a>. The main thing I've learned so far is...</p><h2><a name="house-still-sucks-and-i-m-still-keeping-it"></a><a href="#house-still-sucks-and-i-m-still-keeping-it">House Still Sucks, and I'm Still Keeping It</a></h2><p>This project started off with an attempt to use <a href='http://edicl.github.io/hunchentoot/'><code>hunchentoot</code></a>. Which is a fine server, with much to recommend it. I actually got a fair way through the prototyping process, and everything was going fairly well at that point. And <i>then</i>, I needed to switch machines for a bit. The new computer had this to say about my attempt to load it:</p><pre><code>Unable to load any of the alternatives:
("libssl.so.1.1" "libssl.so.1.0.2m" "libssl.so.1.0.2k"
"libssl.so.1.0.2" "libssl.so.1.0.1l" "libssl.so.1.0.1j"
"libssl.so.1.0.1f" "libssl.so.1.0.1e" "libssl.so.1.0.1"
"libssl.so.1.0.0q" "libssl.so.1.0.0" "libssl.so.0.9.8ze"
"libssl.so.0.9.8" "libssl.so.10" "libssl.so.4" "libssl.so")
[Condition of type CFFI:LOAD-FOREIGN-LIBRARY-ERROR]
Restarts:
0: [RETRY] Try loading the foreign library again.
1: [USE-VALUE] Use another library instead.
2: [TRY-RECOMPILING] Recompile reload and try loading it again
3: [RETRY] Retry loading FASL for #<CL-SOURCE-FILE "cl+ssl" "src" "reload">.
4: [ACCEPT] Continue, treating loading FASL for #<CL-SOURCE-FILE "cl+ssl" "src" "reload"> as having been successful.
5: [RETRY] Retry ASDF operation.
--more--
Backtrace:
0: (CFFI::FL-ERROR "Unable to load any of the alternatives:~% ~S" ("libssl.so.1.1" "libssl.so.1.0.2m" "libssl.so.1.0.2k" "libssl.so.1.0.2" "libssl.so.1.0.1l" "libssl.so.1.0.1j" ...))
1: (CFFI::TRY-FOREIGN-LIBRARY-ALTERNATIVES CL+SSL::LIBSSL ("libssl.so.1.1" "libssl.so.1.0.2m" "libssl.so.1.0.2k" "libssl.so.1.0.2" "libssl.so.1.0.1l" "libssl.so.1.0.1j" ...) NIL)
2: ((FLET CFFI::%DO-LOAD :IN CFFI::%DO-LOAD-FOREIGN-LIBRARY) #<CFFI:FOREIGN-LIBRARY LIBSSL> CL+SSL::LIBSSL (:OR "libssl.so.1.1" "libssl.so.1.0.2m" "libssl.so.1.0.2k" "libssl.so.1.0.2" "libssl.so.1.0.1l" ..
3: (CFFI:LOAD-FOREIGN-LIBRARY CL+SSL::LIBSSL :SEARCH-PATH NIL)
4: (SB-FASL::LOAD-FASL-GROUP #S(SB-FASL::FASL-INPUT :STREAM #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.5.1-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/cl+ssl-2..
5: (SB-FASL::LOAD-AS-FASL #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.5.1-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/cl+ssl-20200427-git/src/reload.fasl" {1005..
6: ((FLET SB-FASL::THUNK :IN LOAD))
7: (SB-FASL::CALL-WITH-LOAD-BINDINGS #<CLOSURE (FLET SB-FASL::THUNK :IN LOAD) {7FD50D5AC88B}> #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.5.1-linux-x64/home/inaimathi/quicklisp..
8: ((FLET SB-FASL::LOAD-STREAM :IN LOAD) #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.5.1-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/cl+ssl-20200427-git/src/rel..
9: (LOAD #P"/home/inaimathi/.cache/common-lisp/sbcl-1.5.1-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/cl+ssl-20200427-git/src/reload.fasl" :VERBOSE NIL :PRINT NIL :IF-DOES-NOT-EXIST T :EX..
10: (UIOP/UTILITY:CALL-WITH-MUFFLED-CONDITIONS #<CLOSURE (LAMBDA NIL :IN UIOP/LISP-BUILD:LOAD*) {1005B381EB}> ("Overwriting already existing readtable ~S." #(#:FINALIZERS-OFF-WARNING :ASDF-FINALIZERS)))
11: ((SB-PCL::EMF ASDF/ACTION:PERFORM) #<unused argument> #<unused argument> #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "cl+ssl" "src" "reload">)
12: ((LAMBDA NIL :IN ASDF/ACTION:CALL-WHILE-VISITING-ACTION))
13: ((:METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS (ASDF/LISP-ACTION:LOAD-OP ASDF/LISP-ACTION:CL-SOURCE-FILE)) #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "cl+ssl" "src" "reload">) [fast-m..
14: ((:METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS :AROUND (T T)) #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "cl+ssl" "src" "reload">) [fast-method]
15: ((:METHOD ASDF/PLAN:PERFORM-PLAN (T)) #<ASDF/PLAN:SEQUENTIAL-PLAN {100411E773}>) [fast-method]
16: ((FLET SB-C::WITH-IT :IN SB-C::%WITH-COMPILATION-UNIT))
17: ((:METHOD ASDF/PLAN:PERFORM-PLAN :AROUND (T)) #<ASDF/PLAN:SEQUENTIAL-PLAN {100411E773}>) [fast-method]
18: ((:METHOD ASDF/OPERATE:OPERATE (ASDF/OPERATION:OPERATION ASDF/COMPONENT:COMPONENT)) #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/SYSTEM:SYSTEM "hunchentoot"> :PLAN-CLASS NIL :PLAN-OPTIONS NIL) [fast-method]
19: ((SB-PCL::EMF ASDF/OPERATE:OPERATE) #<unused argument> #<unused argument> #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/SYSTEM:SYSTEM "hunchentoot"> :VERBOSE NIL)
--more--
</code></pre><p>And once again, <code>:house</code> loaded and started without issue. Just like the <a href='/posts/tomb-and-more-cl-vote'>last time</a> I mentioned this, I <i>have</i> that library it's complaining about. And it's in a place perfectly consistent with being installed by <a href='https://github.com/NixOS/nix'><code>nix</code></a> or <a href='https://guix.gnu.org/'><code>guix</code></a>. And no amount of poking at <code>cffi</code>/<code>sbcl</code> configuration can get it loaded properly. So, if for no reason other than prototyping, there's absolutely a need for a Common Lisp-native web server.</p><p>The problem at this point is that I was basically a kid when I designed <code>house</code>. And I did it as part of a much more ambitious project that was actually the main goal, so the server itself got comparatively little of my brain time.</p><p>I'm very tempted to try again.</p><p>Maybe not from the ground up. There are a lot of hard-won bugfixes and <code>#+</code>/<code>#-</code> switches in that codebase, and I don't want to give up all that progress by going nuclear. But the way the handler/type system is built is less than stellar, sessions could use some touch-ups, and I could <i>probably</i> stand to be a bit more general in the handling of a few elegant flow points. Especially in the sense of providing better HTTP-client and/or websocket support. Im' not doing this <i>now</i>, but I've made a note to my future self.</p><h2><a name="recovery-token"></a><a href="#recovery-token">Recovery Token</a></h2><p>Now that I've got <a href='https://github.com/inaimathi/tomb'><code>tomb</code></a> ready to let me store passwords and password-like things in database without exposing the relevant plaintexts anywhere, I can use it to store a recovery token per user account.</p><p>The idea is that, since I'm using an authenticator app to log users in, and those authenticator apps are typically on a phone somewhere, they might need a way of accessing their account without having access to their phone. You can see the relevant changes in <a href='https://github.com/inaimathi/cl-vote/commit/4459cd9f743ec3080b6f23c27320b2249f899685'>this commit</a>.</p><p>To summarize:</p><ol><li>We <a href='https://github.com/inaimathi/cl-vote/commit/4459cd9f743ec3080b6f23c27320b2249f899685#diff-b093d9c9c5e061a6714cb5787ac6de96R11'>generate a recovery token when a user is created</a></li><li>There is a <a href='https://github.com/inaimathi/cl-vote/commit/4459cd9f743ec3080b6f23c27320b2249f899685#diff-d69eb77040218d8ff5b87e4eb7412d73R29-R38'>new handler</a> that expires the old token and generates a new one for the current user</li><li>We now <a href='https://github.com/inaimathi/cl-vote/commit/4459cd9f743ec3080b6f23c27320b2249f899685#diff-d69eb77040218d8ff5b87e4eb7412d73R69-R79'>accept either the authenticator challenge result <i>or</i> a users' recovery token</a> to log in that user, instead of just the challenge result.</li><li>If the correct recovery token is given, the users' recovery token is expired and given a new one as part of the login process. Specifically, by <a href='https://github.com/inaimathi/cl-vote/commit/4459cd9f743ec3080b6f23c27320b2249f899685#diff-d69eb77040218d8ff5b87e4eb7412d73R75-R78'>redirecting to that expire-and-create page</a> above.</li></ol><p>That does it for now. The next chunk of my work is going to focus first on a hammer-protection system, and then on going through the full usage path of an election. From creation, to voting to tallying results.</p><p>As always, I'll let you know how it goes.</p>Tomb And More cl-vote2020-08-27T22:59:03.000Zinaimathi<p>So apparently, there's no <code>bcrypt</code> implementation for Common Lisp. There's an <a href='https://github.com/gigamonkey/monkeylib-bcrypt'>ffi wrapper</a> which isn't in <code>quicklisp</code>, but that's all I could find. Which is mildly annoying, because as mentioned <a href='/posts/authentication-part-4.875'>last time</a>, I need to store tokens basically the same way I would store passwords. There doesn't seem to be anything similar at a cursory glance, although it's always possible I missed something.</p><p>Oh well.</p><p>According to the <a href='https://en.wikipedia.org/wiki/Bcrypt#Algorithm'>Wikipedia article pseudocode</a>, it looks like the essence of the algorithm is</p><ul><li>use the password as a key</li><li>to encrypt the plaintext "OrpheanBeholderScryDoubt" using <code>blowfish</code> in <code>ECB</code> mode</li><li>repeatedly some number of times (determined by the <code>cost</code> argument)</li></ul><p>And the end result is a <a href='https://crypto.stackexchange.com/questions/41955/why-bcrypt-is-one-way-while-blowfish-is-reversible'>sufficiently one-way</a> function that lets you store some string to compare with input later without actually keeping that string on file.</p><p>So.</p><h2><a name="-code-tomb-code-"></a><a href="#-code-tomb-code-"><code>tomb</code></a></h2><p>I preface this by saying that I am not a crypto nerd. Probably don't use this in production anywhere, and definitely don't use it anywhere security is an actual concern. <i>I'm</i> not aware of a way to back out the initial plaintext, but you should take <a href='https://www.schneier.com/blog/archives/2011/04/schneiers_law.html'>Schneier's advice</a> about what to think of that.</p><p>That being said, I've got this toy project with a <code>bcrypt</code>-shaped hole in its <code>:depends-on</code> list, and I may as well try something.</p><pre><code>;;;; src/tomb.lisp
(in-package #:tomb)
(defparameter *gen* (session-token:make-generator :token-length 16))
(defun entomb (string &key (salt (funcall *gen*)) (cost 10) (cipher-name :blowfish))
(let* ((arr (ironclad:ascii-string-to-byte-array (concatenate 'string string salt)))
(initial-hash (hash-for-tomb arr cipher-name))
(cipher (ironclad:make-cipher cipher-name :key initial-hash :mode :ecb))
(output (make-sequence '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) (length initial-hash))))
(ironclad:encrypt cipher initial-hash output)
(loop repeat (expt 2 cost)
do (ironclad:encrypt-in-place
(ironclad:make-cipher cipher-name :key output :mode :ecb)
output))
(format nil "$0w$~a$~a$~a$~a"
cipher-name
cost
salt
(ironclad:byte-array-to-hex-string output))))
(defun hash-for-tomb (arr cipher-name)
(ironclad:digest-sequence
(case cipher-name
(:threefish512 :sha512)
(:threefish1024 :skein1024)
(t :sha256))
arr))
(defun tomb-matches? (string hashed)
(destructuring-bind (name cipher-name cost salt hash) (split-sequence:split-sequence #\$ hashed :remove-empty-subseqs t)
(declare (ignore hash))
(assert (string= name "0w"))
(let ((cost (parse-integer cost))
(cipher-name (intern cipher-name :keyword)))
(string= (entomb string :salt salt :cost cost :cipher-name cipher-name) hashed))))
</code></pre><p>Principles first.</p><ol><li><em>Sane defaults</em> - We don't want to make the user<a href='#fn-1' id='fnref1'><sup>1</sup></a> do any more work than they have to. Which means that the minimal call to the top level interface should be something that goes <code>String -> String</code> rather than needing the user to generate their own salt, specify a cipher or do any type conversions.</li><li><em>Flexible implementation</em> - We shouldn't <i>assume</i> a particular salting strategy, input size, or cipher. We need to limit ourselves to <code>ECB</code> mode, because changing that is deep magic that I'm not getting anywhere near without a deeper understanding.</li><li><em>Use Crypto Primitives</em> - Speaking of deep magic, we're not writing anything ourselves from the bytes up. <a href='https://github.com/sharplispers/ironclad'><code>ironclad</code></a> is a thing, and it works well if sometimes counter-intuitively, and I fully intend to take advantage.</li></ol><p>With that out of the way, here's <code>tomb</code>, which is sort of like <code>crypt</code>.</p><pre><code>...
(defun entomb (string &key (salt (funcall *gen*)) (cost 10) (cipher-name :blowfish))
(let* ((arr (ironclad:ascii-string-to-byte-array (concatenate 'string string salt)))
(initial-hash (hash-for-tomb arr cipher-name))
(cipher (ironclad:make-cipher cipher-name :key initial-hash :mode :ecb))
(output (make-sequence '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) (length initial-hash))))
(ironclad:encrypt cipher initial-hash output)
(loop repeat (expt 2 cost)
do (ironclad:encrypt-in-place
(ironclad:make-cipher cipher-name :key output :mode :ecb)
output))
(format nil "$0w$~a$~a$~a$~a"
cipher-name
cost
salt
(ironclad:byte-array-to-hex-string output))))
...
</code></pre><p>The core function is <code>entomb</code>. It takes a <code>string</code> (your password/passphrase), and optionally also <code>salt</code>, <code>cost</code> and <code>cipher-name</code>. If you don't pass in any of those, it chooses sane defaults, including using <code>session-token</code>/<code>cl-isaac</code> to generate a secure random salt value.</p><p>The first thing we do is <code>concatenate</code> the <code>string</code> and <code>salt</code> values, convert the result to an <code>ironclad</code> <code>byte-array</code>, then hash it. Hashing it using some secure digest method that produces the appropriate number of bytes to be used as a <code>key</code> for the chosen <code>cipher</code>.</p><pre><code>...
(defun hash-for-tomb (arr cipher-name)
(ironclad:digest-sequence
(case cipher-name
(:threefish512 :sha512)
(:threefish1024 :skein1024)
(t :sha256))
arr))
...
</code></pre><p>It looks like <code>sha256</code> is good enough for most of the <code>ECB</code> capable ciphers in <code>ironclad</code>, but <code>threefish512</code> and <code>threefish1024</code> need larger keys than it provides, so we use other approaches when using those ciphers. I don't want to make it too easy to use weaker ciphers, so I don't bother using hashes that result in keys smaller than <code>sha256</code>.</p><pre><code>...
(cipher (ironclad:make-cipher cipher-name :key initial-hash :mode :ecb))
(output (make-sequence '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) (length initial-hash))))
(ironclad:encrypt cipher initial-hash output)
(loop repeat (expt 2 cost)
do (ironclad:encrypt-in-place
(ironclad:make-cipher cipher-name :key output :mode :ecb)
output))
(format nil "$0w$~a$~a$~a$~a"
cipher-name
cost
salt
(ironclad:byte-array-to-hex-string output))))
...
</code></pre><p>Next up, we initialize an <code>ironclad</code> cipher with the appropriate base state, and allocate an output <code>simple-array</code> to stuff the results in. Then we use the initialized <code>cipher</code> to <code>ironclad:encrypt</code> our input hash (complete with <code>salt</code>) and put the results in <code>output</code>. Once that's done, we <code>encrypt-in-place</code> the output with the same settings, changing out the key each time. The thing we're encrypting the first time though is the <code>key</code> (with itself), and every subsequent layer of encryption also uses itself as the key.</p><p>Once we've done this, we stitch everything together into a string that contains documentation about its' creation.</p><pre><code>(defun tomb-matches? (string hashed)
(destructuring-bind (name cipher-name cost salt hash) (split-sequence:split-sequence #\$ hashed :remove-empty-subseqs t)
(declare (ignore hash))
(assert (string= name "0w"))
(let ((cost (parse-integer cost))
(cipher-name (intern cipher-name :keyword)))
(string= (entomb string :salt salt :cost cost :cipher-name cipher-name) hashed))))
</code></pre><p><code>tomb-matches?</code> takes a string and an <code>entomb</code>ed string, and returns a yay or nay about whether they match. It does this by decomposing the <code>entomb</code>ed string in a way that lets it figure out what arguments to pass to <code>entomb</code>, and does so on the input string.</p><h2><a name="next-step"></a><a href="#next-step">Next Step</a></h2><p>This library is now <a href='https://github.com/inaimathi/tomb'>on <code>github</code></a> in case you are like me, and want to experiment with low-security-but-principled systems. For my part, I'll probably add it to <code>quicklisp</code>, and definitely as a requirement to <a href='https://github.com/inaimathi/cl-vote'><code>cl-vote</code></a> so that I can put together a good recovery token system.</p><p>It mildly amuses me to think that knowing that token in this case is technically a "known plaintext" attack. <ol class='footnotes'><li id='fn-1'>Me.<a href='#fnref1'>↩</a></li></ol></p>Authentication Part 4.8752020-08-25T22:59:32.000Zinaimathi<h2><a name="clj-in-practice"></a><a href="#clj-in-practice">CLJ in Practice</a></h2><p>I finally got around to using <a href='https://github.com/inaimathi/clj'><code>clj</code></a> in a prototyping context. And it's going relatively smoothly so far. My only real complaint is that I seem to have to put</p><pre><code>(named-readtables:in-readtable clj:syntax)
</code></pre><p>at the top of every file where I want to use my cool new <a href='/posts/more-on-clj#map-and-set-literals-with-functional-underpinnings'><code>map</code>/<code>set</code> literal syntax</a>. I'm hoping there's some way to fix this by just putting it at the top of a <code>package</code> file or something, but that naive solution doesn't seem to work. At first glance, there doesn't seem to be a way to express "load this project with a given, non-default <code>readtable</code>", and I'm not entirely sure why yet.</p><h2><a name="return-to-code-cl-vote-code-"></a><a href="#return-to-code-cl-vote-code-">Return to <code>cl-vote</code></a></h2><p>The project I put some work into is an old piece of arcana from the earlier days of the <a href='http://cscabal.com'>Toronto CS Cabal</a>. A <a href='https://github.com/inaimathi/cl-vote'>simple voting system</a> to help us decide what we're reading in a given week. The next step I'm going to take is implementing the actual voting. Step one was just the authentication system.</p><p>So here's the deal. Passwords suck, public keys aren't really being used widely for website/app authentication, and that doesn't seem to be something I can easily change. <a href='https://freeotp.github.io/'>Authenticator apps</a> and 2FA are propagating though. For low-security-requirement situtations, one plausible alternative to passwords is just using that authenticator. So, like, 1FA. The current state of <a href='https://github.com/inaimathi/cl-vote'><code>cl-vote</code></a> is an implementation of such a system in Common Lisp.</p><p>The workflow looks like this:</p><ol><li>You register by picking a user name that hasn't already been picked.</li><li>The system instantly sends you to a screen that displays a QR code compatible with <a href='https://freeotp.github.io/'>FreeOTP</a> or <a href='https://authy.com/'>Authy</a> or whatever</li><li>When you want to log in later, enter your username and your authentication code</li></ol><p>That's fairly simple. There's no need to remember passwords, though you do now need your phone or authenticator app/browser plugin/what-have-you.</p><h2><a name="considering-humane-interfaces"></a><a href="#considering-humane-interfaces">Considering Humane Interfaces</a></h2><p>During the construction of this, I briefly considered taking the <a href='/posts/jef-raskin-on-authentication'>Raskin approach</a> of letting users log in with just their "password"s. Mechanically, this would involve iterating through the entire user database in order to find if there's anyone whose next code matches the input at login. I decided against it for three reasons</p><ul><li>It opens up the attack surface; instead of guessing a particular users' next code an attacker now needs to guess any valid code that collides with any existing user. Still improbably, but lets not throw caution to the wind <i>entirely</i>, huh?</li><li>Makes login more expensive; instead of getting a particular user entry and checking their code against the given one, I need to do it for each user until I find a matching one. In the extreme case, like a user database big enough to shard, this will take an <i>extremely</i> long time. Which segues nicely into</li><li>Makes login more inconsistent; if we hit the negative extreme case, it might take long enough to verify codes that the given code might have expired in the meantime, giving us false negatives. This doesn't feel like something that would happen too often, but it's not something that's trivially or implicitly soluble either.</li></ul><p>A user name solves enough problems that I'm content burdening users with the task of picking one.</p><h2><a name="considering-further-security"></a><a href="#considering-further-security">Considering Further Security</a></h2><p>Once I combine it with some form of hammering protection, this system is resistant to the sorts of guessing attacks that plague password systems. It's still not resistant against server database breaches. Granted, this <i>particular</i> one is tricky to crack in that way because it's immune to injection attacks as a result of its' <a href='https://github.com/inaimathi/fact-base'>data storage</a> model <a href='#fn-1' id='fnref1'><sup>1</sup></a>, but that's cold comfort. If you did manage to expropriate a user record, you'd gain access to that users' shared secret and could thereafter generate correct solutions for their account at will.</p><p>That's sort of the point.</p><p>One thing I could do, as a web app proprietor, is keep client fingerprints around and be a bit more cautious about logins coming from devices that a user hasn't used before. It's not entirely clear to me what to do if I detect an anomaly. I guess one thing I could do is request a challenge answer through a different contact method. Like an <a href='https://www.textmagic.com/'>SMS</a> <a href='https://www.common-lisp.net/project/cl-clickatell/'>sender</a> or <a href='https://stackoverflow.com/questions/61423610/how-to-send-emails-directly-from-common-lisp'>email</a>, to which I would send a challenge generated by a session-specific secret key and then expect a response.</p><p>Doing that would also effectively mitigate the database expropriation attack. It <i>wouldn't</i> mitigate a successful server takeover, but I'm not sure there's a reasonable way to mitigate that at all yet. This might be good enough.</p><h2><a name="considering-account-recovery"></a><a href="#considering-account-recovery">Considering Account Recovery</a></h2><p>Account recovery codes are a thing that 2FA systems use to "make" "sure" that a user can still get into their account if they lose their phone/authenticator token/whatever. The way this works is by having the user write down a bunch of codes, each of which can presumably be used for a one-time entry into the system without other authentication methods being available. Cool, I guess. I haven't had to use them yet, and I suspect the sorts of systems I'm planning to build lend themselves more easily to the "make a new account" recovery path than this, but it might still be worth doing.</p><p>Mechanically, this means generating some number of alphanumeric codes that are either easy to write down or easy to remember. Then giving the user a workflow where they can enter one of these codes, at which point they are logged in but the code they used is marked as expired.</p><p>I'm going to try to implement a couple of these extras, then get bored and move on to the main point.</p><p>Which is collective decision making. <ol class='footnotes'><li id='fn-1'>And also the "Who would actually try to hack a Common Lisp app" thing. There are definitely lower hanging positions that bear more fruit.<a href='#fnref1'>↩</a></li></ol></p>Subverting Common Lisp Types And Emacs Interaction For Clj2020-05-24T14:21:04.000Zinaimathi<p>Ok, so <a href='http://inaimathi.ca/posts/profiling-polymorphic-options'>profiling the extra-low-hanging-fruit</a> in terms of generic function performance revealed that it didn't do much in our situation. My next idea was to subvert the Common Lisp type system to give our <code>set</code> and <code>map</code> primitives some hints about what kind of equality operations to use.</p><p>I'm once again starting this piece before having written the code it'll be explaining, so this is less a thoughtful tour and more a stream-of-consciousness account of the writing.</p><h3><a name="defining-types"></a><a href="#defining-types">Defining Types</a></h3><p>Assuming the thing you're defining fits into the pre-existing Common Lisp types, you're fine. As soon as you want to do something like define polymorphic key/value structures you are, near as I can tell, on your fucking own bucko.</p><p>So I guess I'm rolling my own here?</p><p>Ok, the good news is that I'm in just enough of a hacky mood that I don't give a flying fuck how shitty this is going to be. That... might come back to bite me later, but we'll burn that bridge and salt it as we pass.</p><p>Here's how I have to define type <code>map</code>.</p><pre><code>(deftype map (&optional keys vals)
(let ((sym (intern (format nil "MAP-TYPE-~a-~a" keys vals) :clj)))
(unless (fboundp sym)
(setf (fdefinition sym) (kv-types keys vals)))
`(and (satisfies map?) (satisfies ,sym))))
</code></pre><p>This feels batshit insane. In order to properly define a polymorphic key/value type, I have to <i>manually intern predicates that deal with the specific types in question at declaration time</i>. The problem is that <code>satisfies</code> specifically only accepts a <code>symbol</code> that must refer to a <code>function</code> of one argument that's meant to return a <code>boolean</code>. If it could take <code>lambda</code> terms, I could do something like</p><pre><code>(defun kv-type (k-type v-type)
(lambda (thing)
(and (map? thing)
(every (lambda (pair)
(and (typep (car pair) k-type)
(typep (cdr pair) v-type)))
(values thing)))))
...
(satisfies (kv-type 'keyword 'integer))
</code></pre><p>This is, unfortunately, off the table. Oh well. The complete definitions for both <code>map</code> and <code>set</code> types is</p><pre><code>(defun map? (thing)
(typep thing 'cl-hamt:hash-dict))
(defun map-type? (type)
(and type
(listp type)
(eq (car type) 'map)))
(defun kv-types (k-type v-type)
(lambda (map)
(cl-hamt:dict-reduce
(lambda (memo k v)
(and memo (typep k k-type) (typep v v-type)))
map t)))
(deftype map (&optional keys vals)
(let ((sym (intern (format nil "MAP-TYPE-~a-~a" keys vals) :clj)))
(unless (fboundp sym)
(setf (fdefinition sym) (kv-types keys vals)))
`(and (satisfies map?) (satisfies ,sym))))
(defun set? (thing)
(typep thing 'cl-hamt:hash-set))
(defun set-type? (type)
(and type
(listp type)
(eq (car type) 'set)))
(defun seq-types (v-type)
(lambda (set)
(cl-hamt:set-reduce
(lambda (memo elem)
(and memo (typep elem v-type)))
set t)))
(deftype set (&optional vals)
(let ((sym (intern (format nil "SET-TYPE-~a" vals) :clj)))
(unless (fboundp sym)
(setf (fdefinition sym) (seq-types vals)))
`(and (satisfies set?) (satisfies ,sym))))
</code></pre><p>Once I've got that, I can declare things. Like,</p><pre><code>CLJ> (let ((a {:a 1 :b 2}))
(declare (type (map keyword t) a))
a)
{:A 1 :B 2}
CLJ>
</code></pre><h3><a name="checking-for-equalities"></a><a href="#checking-for-equalities">Checking for equalities</a></h3><p>There's some more work to do. The whole point of this exercise is Once I've got a type declared, I need to do the work I actually care about. Which is: figure out which of the built-in structural equality operations is the most efficient I can use while <i>also</i> being as correct as possible.</p><pre><code>(defun fullest-equality (equalities)
(find-if
(lambda (e) (member e equalities :test #'eq))
'(clj:== cl:equalp cl:equal cl:eql cl:eq cl:string= cl:=)))
(defun equality-function (name) (fdefinition name))
(defun equality-of (type)
(cond
((member type '(integer number float ratio rational bignum bit complex long-float short-float signed-byte unsigned-byte single-float double-float fixnum))
'cl:=)
((member type '(string simple-string))
'cl:string=)
((member type '(atom symbol keyword package readtable null stream random-state))
'cl:eq)
((member type '(standard-char character pathname))
'cl:eql)
((member type '(cons list))
'cl:equal)
((and (listp type) (eq 'or (first type)))
(fullest-equality (mapcar #'equality-of (rest type))))
((member type '(hash-table sequence array bit-vector simple-array simple-bit-vector simple-vector vector))
'cl:equalp)
((and (listp type) (member (car type) '(array simple-array simple-bit-vector simple-vector vector)))
'cl:equalp)
((member type '(compiled-function function))
nil)
(t 'clj:==)))
</code></pre><p>It's a fairly naive binding table, completely inextensible for the moment, that maps a <code>type</code> to the name of an equality operation that will accurately compare them. Hopefully, I mean. As long as I didn't fuck something up.</p><pre><code>CLJ> (equality-of '(map keyword t))
==
CLJ> (equality-of 'keyword)
EQ
CLJ> (equality-of 'list)
EQUAL
CLJ> (equality-of 'hash-table)
EQUALP
CLJ> (equality-of 'string)
STRING=
CLJ>
</code></pre><p>Seems legit.</p><h3><a name="putting-it-all-together"></a><a href="#putting-it-all-together">Putting it all together</a></h3><p>The next step is, we want to use this equality selection procedure to make our <code>map</code> and <code>set</code> constructors pick a better one than <code>==</code> if it can.</p><pre><code>(defparameter *type* nil)
...
(defun alist->map (alist &key equality)
(let ((equality (or equality
(if (map-type? *type*)
(equality-function (equality-of (second *type*)))
#'==))))
(loop with dict = (cl-hamt:empty-dict :test equality)
for (k . v) in alist do (setf dict (cl-hamt:dict-insert dict k v))
finally (return dict))))
(defun list->map (lst &key equality)
(assert (evenp (length lst)) nil "Map literal must have an even number of elements")
(let ((equality (or equality
(if (map-type? *type*)
(equality-function (equality-of (second *type*)))
#'==))))
(loop with dict = (cl-hamt:empty-dict :test equality)
for (k v) on lst by #'cddr
do (setf dict (cl-hamt:dict-insert dict k v))
finally (return dict))))
...
(defun list->set (lst)
(let ((equality (if (set-type? *type*)
(equality-function (equality-of (second *type*)))
#'==)))
(reduce
(lambda (set elem)
(cl-hamt:set-insert set elem))
lst :initial-value (cl-hamt:empty-set :test equality))))
</code></pre><p>So, we've got a <code>*type*</code> <a href='http://clhs.lisp.se/Body/d_specia.htm'>special var</a> that we can use to declare the type of the <code>map</code>/<code>set</code> we're defining, and if it's set, we use it to pick an appropriate equality. Otherwise, we just go with <code>#'==</code>, because that's as general as it gets.</p><pre><code>CLJ> (list->set (list 1 2 3 4))
#{3 2 1 4}
CLJ> (cl-hamt::hamt-test (list->set (list 1 2 3 4)))
#<STANDARD-GENERIC-FUNCTION CLJ:== (8)>
CLJ> (let ((*type* '(set integer))) (list->set (list 1 2 3 4)))
#{3 2 1 4}
CLJ> (let ((*type* '(set integer))) (cl-hamt::hamt-test (list->set (list 1 2 3 4))))
#<FUNCTION =>
CLJ> (list->map (list :a 1 :b 2 :c 3))
{:A 1 :C 3 :B 2}
CLJ> (cl-hamt::hamt-test (list->map (list :a 1 :b 2 :c 3)))
#<STANDARD-GENERIC-FUNCTION CLJ:== (8)>
CLJ> (let ((*type* '(map keyword t))) (cl-hamt::hamt-test (list->map (list :a 1 :b 2 :c 3))))
#<FUNCTION EQ>
CLJ>
</code></pre>Nice.<p>It doesn't fit <i>all</i> of our use cases though.</p><pre><code>CLJ> {:a 1 :b 2 :c 3}
{:A 1 :C 3 :B 2}
CLJ> (let ((*type* '(map keyword t))) {:a 1 :b 2 :c 3})
{:A 1 :C 3 :B 2}
CLJ> (let ((*type* '(map keyword t))) (cl-hamt::hamt-test {:a 1 :b 2 :c 3}))
#<STANDARD-GENERIC-FUNCTION CLJ:== (8)>
CLJ>
</code></pre><p>The problem is that, because we have reader syntax for our <code>map</code>s and <code>set</code>s, this decision kicks in too late to deal with them. We unfortunately also need a reader macro to handle type declarations.</p><h3><a name="reader-macro-for-type-declaration"></a><a href="#reader-macro-for-type-declaration">Reader Macro for Type Declaration</a></h3><p>The naive solution here is</p><pre><code>...
(defun type-literal-reader (stream sub-char numarg)
(declare (ignore sub-char numarg))
(let* ((*type* (read stream))
(form (read stream))
(val (eval form)))
(assert (typep val *type*) nil "Type checking failure ~s ~s" *type* form)
val))
...
(:dispatch-macro-char #\# #\# #'type-literal-reader))
</code></pre><p>I don't really want to define this as using <code>::</code> because of the headache-inducing implications of doing <code>(make-dispatch-macro-character #\:)</code>. I'm trying to avoid those for the moment. Same story with <code>#:</code>, because <a href='https://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node110.html'>uninterned symbols</a> are common and I don't want to stomp them here. So, I had to pick something else, and arbitrarily accepted <code>##</code> even though <code>#t</code> or <code>#T</code> would have been equally reasonable choices.</p><p>This technically works.</p><pre><code>CLJ> {:a 1 :b 2 :c 3}
{:A 1 :C 3 :B 2}
CLJ> ## (map keyword t) {:a 1 :b 2 :c 3}
{:A 1 :C 3 :B 2}
CLJ> (cl-hamt::hamt-test ## (map keyword t) {:a 1 :b 2 :c 3})
#<FUNCTION EQ>
CLJ>
</code></pre><p>But I want to avoid calling <code>eval</code> as part of it. The more macro-like version would look something more like</p><pre><code>(defun type-literal-reader (stream sub-char numarg)
(declare (ignore sub-char numarg))
(let* ((*type* (read stream))
(form (read stream))
(res (gensym)))
(if *type*
`(let ((,res ,form))
(check-type ,res ,*type*)
,res)
res)))
</code></pre><p>It still works...</p><pre><code>CLJ> ## (map keyword t) {:a 1 :b 2}
{:A 1 :B 2}
CLJ> (cl-hamt::hamt-test ## (map keyword t) {:a 1 :b 2})
#<FUNCTION EQ>
CLJ>
</code></pre><p>... but has the added bonuses of not calling <code>eval</code> and also making use of <code>check-type</code>, which we couldn't do if we wanted to do that check inline at read time.</p><p>I don't really like the syntax<a href='#fn-1' id='fnref1'><sup>1</sup></a>, but that's good enough for now<a href='#fn-2' id='fnref2'><sup>2</sup></a>.</p><h3><a name="performance-implications"></a><a href="#performance-implications">Performance implications</a></h3><pre><code>(defun untyped-benchmark (&key (times 10000))
(loop repeat times
do (let* ((m {:a 1 :b "two" :c :three :d 44})
(inserted (insert m (cons :test-key :test-value))))
(list (len m)
(lookup inserted :test-key)
(len inserted)))))
(defun typed-benchmark (&key (times 10000))
(loop repeat times
do (let* ((m ## (map keyword t) {:a 1 :b "two" :c :three :d 44})
(inserted (insert m (cons :test-key :test-value))))
(list (len m)
(lookup inserted :test-key)
(len inserted)))))
</code></pre><p>With the above defined in <a href='https://github.com/inaimathi/clj/blob/master/src/benchmark.lisp'><code>benchmark.lisp</code></a>, running the benchmarks and reporting them with <code>M-x slime-profile-report slime-profile-reset</code> gives us...</p><pre><code>CLJ> (untyped-benchmark :times 1000000)
NIL
measuring PROFILE overhead..done
seconds | gc | consed | calls | sec/call | name
---------------------------------------------------------------
1.230 | 0.068 | 1,076,698,880 | 1,000,000 | 0.000001 | CLJ::INSERT
0.931 | 0.000 | 32,768 | 2,000,000 | 0.000000 | CLJ::LEN
0.617 | 0.000 | 1,679,216 | 1,000,000 | 0.000001 | CLJ::LOOKUP
0.000 | 0.018 | 59,768,832 | 1 | 0.000000 | CLJ::UNTYPED-BENCHMARK
0.000 | 0.000 | 0 | 1,000,000 | 0.000000 | CLJ:==
---------------------------------------------------------------
2.778 | 0.086 | 1,138,179,696 | 5,000,001 | | Total
estimated total profiling overhead: 9.09 seconds
overhead estimation parameters:
1.8e-8s/call, 1.8179999e-6s total profiling, 8.8e-7s internal profiling
These functions were not called:
CLJ:ALIST->MAP CLJ::EQUALITY-FUNCTION CLJ::EQUALITY-OF
CLJ::FULLEST-EQUALITY CLJ::KV-TYPES CLJ::LIST->MAP CLJ:LIST->SET
CLJ::MAP-LITERAL-READER CLJ::MAP-TYPE-KEYWORD-T CLJ::MAP-TYPE?
CLJ::MAP? CLJ::SEQ-TYPES CLJ::SET-LITERAL-READER CLJ::SET-TYPE?
CLJ::SET? CLJ::TYPE-LITERAL-READER CLJ::TYPED-BENCHMARK
CLJ> (typed-benchmark :times 1000000)
NIL
seconds | gc | consed | calls | sec/call | name
---------------------------------------------------------------
1.195 | 0.040 | 1,076,307,616 | 1,000,000 | 0.000001 | CLJ::INSERT
0.768 | 0.000 | 0 | 2,000,000 | 0.000000 | CLJ::LEN
0.605 | 0.000 | 0 | 1,000,000 | 0.000001 | CLJ::LOOKUP
0.000 | 0.004 | 59,703,296 | 1 | 0.000000 | CLJ::TYPED-BENCHMARK
---------------------------------------------------------------
2.568 | 0.044 | 1,136,010,912 | 4,000,001 | | Total
estimated total profiling overhead: 7.27 seconds
overhead estimation parameters:
1.8e-8s/call, 1.8179999e-6s total profiling, 8.8e-7s internal profiling
These functions were not called:
CLJ:== CLJ:ALIST->MAP CLJ::EQUALITY-FUNCTION CLJ::EQUALITY-OF
CLJ::FULLEST-EQUALITY CLJ::KV-TYPES CLJ::LIST->MAP CLJ:LIST->SET
CLJ::MAP-LITERAL-READER CLJ::MAP-TYPE-KEYWORD-T CLJ::MAP-TYPE?
CLJ::MAP? CLJ::SEQ-TYPES CLJ::SET-LITERAL-READER CLJ::SET-TYPE?
CLJ::SET? CLJ::TYPE-LITERAL-READER CLJ::UNTYPED-BENCHMARK
CLJ>
</code></pre><p>A pretty goddamn tiny difference. I'm not sure this approach is worth much more effort, but I'll plug away for a bit longer to see how elegant I can make it. In the meantime,</p><h3><a name="emacs-interaction-improvements"></a><a href="#emacs-interaction-improvements">Emacs Interaction Improvements</a></h3><p>So, the sad thing about all of this is that I've been lying to you. Whenever I show you those nice readouts from the SLIME <code>repl</code> that says something like <code>{:a 1 :b 2}</code>, that's a result of me correcting it. Because, by default, when I type <code>{</code>, what I get is <code>{$</code>. Which I then have to manually backspace and correct. Using this shiny new syntax in Common Lisp mode is also less than ideal, because the default <code>paredit</code> doesn't provide <code>s-exp</code> support for curly braces. It's not as simple as adding</p><pre><code>"{" 'paredit-open-curly
"}" 'paredit-close-curly
</code></pre><p>to a mode-map somewhere, because that <i>does</i> pair them, but <i>doesn't</i> help with navigation.</p><p>After messing around with modifying existing <code>syntax-table</code>s, redefining <code>matching-paren</code>, and poking around in <a href='https://www.emacswiki.org/emacs/ParEdit'><code>paredit</code></a> internals, the solution I settled on was just adding a <code>mode-hook</code> to a bunch of <code>lisp</code> modes and <code>slime-repl</code> modes that activates the <code>clojure-mode-syntax-table</code>.</p><p><i>You</i> can do this in <i>your</i> <code>.emacs</code> file by doing something like</p><pre><code>(defun use-clojure-syntax-table () (set-syntax-table (set-syntax-table clojure-mode-syntax-table)))
(add-hook 'common-lisp-mode-hook 'use-clojure-syntax-table)
(add-hook 'slime-mode-hook 'use-clojure-syntax-table)
(add-hook 'slime-repl-mode-hook 'use-clojure-syntax-table)
</code></pre><p><i>I</i> added it to <i>my</i> <code>.emacs</code> by doing</p><pre><code>(hooks (common-lisp lisp emacs-lisp scheme lisp-interaction slime clojure slime-repl)
(lambda ()
(setq autopair-dont-activate t)
(autopair-mode -1))
'enable-paredit-mode
(lambda () (set-syntax-table (set-syntax-table clojure-mode-syntax-table))))
</code></pre><p>Which is both more thorough and more extensive, but requires me to define <a href='https://github.com/inaimathi/machine-setup/blob/master/convenience.el#L61-L81'>some conveniences</a> first.</p><p>The next time I write about <code>CLJ</code>, the SLIME <code>repl</code> snippets will <i>not</i> be a lie. <ol class='footnotes'><li id='fn-1'>Ideally, the type annotation would be declared like <code>(:: type form)</code>, <code>:: type form</code>, or possibly <code>type :: form</code>. However, infix operators are more complicated to deal with, and <code>:</code> already has various meanings in Common Lisp that would make using it as a <code>read-macro-char</code> more complicated than I'd like. Specifically, as hinted at above, doing <code>(make-dispatch-macro-character #\:)</code> instantly complicates the parsing of <code>keyword</code>s, <code>uninterned-symbol</code>s and any qualified name you end up typing. I'll read up on it a bit and see if there's a way to fall through to the default behavior somehow, but in the absence of that option, this is absolutely more hassle than it's worth.<a href='#fnref1'>↩</a></li><li id='fn-2'>Possible future improvements include inferring the type of a <code>map</code> literal based on its initial values, and storing the type annotation somehow so that it can be checked against by <code>insert</code> later. I'm not sure any of this is worth the time, and once we pick an appropriate interface, it'll be easy to change internals later.<a href='#fnref2'>↩</a></li></ol></p>Profiling Polymorphic Options2020-05-20T00:51:49.000Zinaimathi<p>I mentioned at the <a href='/posts/more-on-clj#polymorphic-operators'>tail end of last piece</a> that a set of polymorphic data operators is what we want in the correctness sense, but seems like it would do poorly from the performance standpoint. It turns out that there's a bunch of options aimed at improving the performance of generic functions. There's <a href='https://github.com/alex-gutev/static-dispatch'><code>static-dispatch</code></a>, <a href='https://github.com/marcoheisig/fast-generic-functions'><code>fast-generic-functions</code></a>, and the archived but still available <a href='https://github.com/guicho271828/inlined-generic-function'><code>inlined-generic-function</code></a>.</p><h3><a name="the-operators"></a><a href="#the-operators">The operators</a></h3><p>So, we want <code>==</code>, that's obvious. But the end usability goal also <i>probably</i> demands <code>lookup</code>, <code>insert</code> and <code>len</code>. I'm leaving out some things we'll realistically <i>want</i> but that would be more complicated to implement<a href='#fn-1' id='fnref1'><sup>1</sup></a>. I want a minimal, benchmarkeabla set for my current purposes.</p><p>The naive implementations of these look like</p><pre><code>(defgeneric == (a b))
(defgeneric lookup (container key))
(defgeneric insert (container elem))
(defgeneric len (container))
(defmethod == (a b) (equalp a b))
(defmethod == ((a number) (b number)) (= a b))
(defmethod == ((a string) (b string)) (string= a b))
(defmethod == ((a character) (b character)) (char= a b))
(defmethod == ((a symbol) (b symbol)) (eq a b))
(defmethod == ((a list) (b list)) (equal a b))
(defmethod == ((a cl-hamt:hash-dict) (b cl-hamt:hash-dict))
(cl-hamt:dict-eq a b :value-test #'==))
(defmethod == ((a cl-hamt:hash-set) (b cl-hamt:hash-set))
(cl-hamt:set-eq a b))
(defmethod lookup ((container list) key)
(nth key container))
(defmethod lookup ((container hash-table) key)
(gethash key container))
(defmethod lookup ((container cl-hamt:hash-set) key)
(cl-hamt:set-lookup container key))
(defmethod lookup ((container cl-hamt:hash-dict) key)
(cl-hamt:dict-lookup container key))
(defmethod insert ((container list) elem) (cons elem container))
(defmethod insert ((container hash-table) k/v)
;; NOTE - strictly, this should copy the hash-table in order to be functional
;; Not right now.
(setf (gethash (car k/v) container) (cdr k/v)))
(defmethod insert ((container cl-hamt:hash-dict) k/v)
(cl-hamt:dict-insert container (car k/v) (cdr k/v)))
(defmethod insert ((container cl-hamt:hash-set) elem)
(cl-hamt:set-insert container elem))
(defmethod len ((container list)) (length container))
(defmethod len ((container hash-table)) (hash-table-count container))
(defmethod len ((container cl-hamt:hash-set)) (cl-hamt:set-size container))
(defmethod len ((container cl-hamt:hash-dict)) (cl-hamt:dict-size container))
</code></pre><p>We can debate about what the arglist of <code>insert</code> <i>should</i> look like or what <code>len</code> <i>should</i> be called later, ut this is a decent start.</p><p>The <code>static-dispatch</code> version basically just involves using <code>static-dispatch:defmethod</code> rather than the built-in <code>cl:defmethod</code>.</p><pre><code>(static-dispatch:defmethod static-dispatch-== (a b) (equalp a b))
(static-dispatch:defmethod static-dispatch-== ((a number) (b number)) (= a b))
(static-dispatch:defmethod static-dispatch-== ((a string) (b string)) (string= a b))
(static-dispatch:defmethod static-dispatch-== ((a character) (b character)) (char= a b))
(static-dispatch:defmethod static-dispatch-== ((a symbol) (b symbol)) (eq a b))
(static-dispatch:defmethod static-dispatch-== ((a list) (b list)) (equal a b))
(static-dispatch:defmethod static-dispatch-== ((a cl-hamt:hash-dict) (b cl-hamt:hash-dict))
(cl-hamt:dict-eq a b :value-test #'==))
(static-dispatch:defmethod static-dispatch-== ((a cl-hamt:hash-set) (b cl-hamt:hash-set))
(cl-hamt:set-eq a b))
(static-dispatch:defmethod static-dispatch-lookup ((container list) key)
(nth key container))
(static-dispatch:defmethod static-dispatch-lookup ((container hash-table) key)
(gethash key container))
(static-dispatch:defmethod static-dispatch-lookup ((container cl-hamt:hash-set) key)
(cl-hamt:set-lookup container key))
(static-dispatch:defmethod static-dispatch-lookup ((container cl-hamt:hash-dict) key)
(cl-hamt:dict-lookup container key))
(static-dispatch:defmethod static-dispatch-insert ((container list) elem) (cons elem container))
(static-dispatch:defmethod static-dispatch-insert ((container hash-table) k/v)
;; NOTE - strictly, this should copy the hash-table in order to be functional
;; Not right now.
(setf (gethash (car k/v) container) (cdr k/v)))
(static-dispatch:defmethod static-dispatch-insert ((container cl-hamt:hash-dict) k/v)
(cl-hamt:dict-insert container (car k/v) (cdr k/v)))
(static-dispatch:defmethod static-dispatch-insert ((container cl-hamt:hash-set) elem)
(cl-hamt:set-insert container elem))
(static-dispatch:defmethod static-dispatch-len ((container list)) (length container))
(static-dispatch:defmethod static-dispatch-len ((container hash-table)) (hash-table-count container))
(static-dispatch:defmethod static-dispatch-len ((container cl-hamt:hash-set)) (cl-hamt:set-size container))
(static-dispatch:defmethod static-dispatch-len ((container cl-hamt:hash-dict)) (cl-hamt:dict-size container))
</code></pre><p>If we wanted to allow users to define their own types, we'd also have to make sure that they use <code>static-dispatch:defmethod</code>, because there would otherwise be odd interoperability issues.</p><p>For <a href='https://github.com/marcoheisig/fast-generic-functions'><code>fast-generic-functions</code></a>, we've got some options. First, we can make <code>inline</code> declarations as part of each method, and second, we need to <code>seal-domain</code> each method that we want to run faster. There's a couple considerations here. First off, we have to be more stringent about the domains of our methods. In particular, and this really only affects the internal implementation of <code>==</code>, we can't have partially overlapping domains. So, if we have something that specializes on <code>(number number)</code>, we can't <i>also</i> have a <code>(number t)</code> or <code>(t t)</code> specializer. Second, once a <code>domain</code> is <code>seal</code>ed, no touching it again. Third, some domains can't be sealed. In particular</p><pre><code>CLJ> (defmethod fgf-== ((a cl-hamt:hash-dict) (b cl-hamt:hash-dict))
(cl-hamt:dict-eq a b :value-test #'==))
#<STANDARD-METHOD CLJ::FGF-== (CL-HAMT:HASH-DICT CL-HAMT:HASH-DICT) {100332D7E3}>
CLJ> (fast-generic-functions:seal-domain #'fgf-== '(cl-hamt:hash-dict cl-hamt:hash-dict))
The assertion SEALABLE-METAOBJECTS::SUCCESS failed.
[Condition of type SIMPLE-ERROR]
Restarts:
0: [CONTINUE] Retry assertion.
1: [RETRY] Retry SLIME REPL evaluation request.
2: [*ABORT] Return to SLIME's top level.
3: [ABORT] abort thread (#<THREAD "repl-thread" RUNNING {1004F19B63}>)
Backtrace:
0: (SB-KERNEL:ASSERT-ERROR SEALABLE-METAOBJECTS::SUCCESS NIL NIL NIL)
1: ((:METHOD SEALABLE-METAOBJECTS:SPECIALIZER-INTERSECTIONP (CLASS CLASS)) #<STANDARD-CLASS CL-HAMT:HASH-SET> #<STANDARD-CLASS CL-HAMT:HASH-DICT>) [fast-method]
2: ((FLET "WRAPPER9" :IN SEALABLE-METAOBJECTS:DOMAIN-INTERSECTIONP) #<STANDARD-CLASS CL-HAMT:HASH-SET> #<STANDARD-CLASS CL-HAMT:HASH-DICT>)
3: (SB-IMPL::%MAP-FOR-EFFECT #<CLOSURE (FLET "WRAPPER9" :IN SEALABLE-METAOBJECTS:DOMAIN-INTERSECTIONP) {7FFFEFDADB8B}> ((#1=#<STANDARD-CLASS CL-HAMT:HASH-SET> #1#) (#2=#<STANDARD-CLASS CL-HAMT:HASH-DICT>..
4: (SB-KERNEL:%MAP NIL #<CLOSURE (FLET "WRAPPER9" :IN SEALABLE-METAOBJECTS:DOMAIN-INTERSECTIONP) {7FFFEFDADB8B}> (#1=#<STANDARD-CLASS CL-HAMT:HASH-SET> #1#) (#1=#<STANDARD-CLASS CL-HAMT:HASH-DICT> #1#)) ..
5: ((:METHOD SEALABLE-METAOBJECTS:DOMAIN-INTERSECTIONP (SEALABLE-METAOBJECTS:DOMAIN SEALABLE-METAOBJECTS:DOMAIN)) #<SEALABLE-METAOBJECTS:DOMAIN CL-HAMT:HASH-SET CL-HAMT:HASH-SET> #<SEALABLE-METAOBJECTS:D..
6: ((:METHOD SEALABLE-METAOBJECTS:SEAL-DOMAIN (SEALABLE-METAOBJECTS:SEALABLE-GENERIC-FUNCTION SEALABLE-METAOBJECTS:DOMAIN)) #<FAST-GENERIC-FUNCTIONS:FAST-GENERIC-FUNCTION CLJ::FGF-== (7)> #<SEALABLE-META..
7: ((SB-PCL::EMF SEALABLE-METAOBJECTS:SEAL-DOMAIN) #<unused argument> #<unused argument> #<FAST-GENERIC-FUNCTIONS:FAST-GENERIC-FUNCTION CLJ::FGF-== (7)> #<SEALABLE-METAOBJECTS:DOMAIN CL-HAMT:HASH-DICT CL..
8: ((:METHOD SEALABLE-METAOBJECTS:SEAL-DOMAIN :AROUND (SEALABLE-METAOBJECTS:SEALABLE-GENERIC-FUNCTION SEALABLE-METAOBJECTS:DOMAIN)) #<FAST-GENERIC-FUNCTIONS:FAST-GENERIC-FUNCTION CLJ::FGF-== (7)> #<SEALA..
9: (SB-INT:SIMPLE-EVAL-IN-LEXENV (SEALABLE-METAOBJECTS:SEAL-DOMAIN (FUNCTION FGF-==) (QUOTE (CL-HAMT:HASH-DICT CL-HAMT:HASH-DICT))) #<NULL-LEXENV>)
10: (EVAL (SEALABLE-METAOBJECTS:SEAL-DOMAIN (FUNCTION FGF-==) (QUOTE (CL-HAMT:HASH-DICT CL-HAMT:HASH-DICT))))
--more--
</code></pre><p>This... might not be as horrible as it seems. I'm not prepared to write it off yet. In any case, I'm not about to do any of this manually. Not even for the benchmark.</p><pre><code>(defun seal-all-domains (generic-function)
(loop for m in (closer-mop:generic-function-methods generic-function)
do (format t "SEALING ~s~%" (mapcar #'class-name (closer-mop:method-specializers m)))
do (ignore-errors
(progn (fast-generic-functions:seal-domain
generic-function
(mapcar #'class-name (closer-mop:method-specializers m)))
(format t " Sealed...~%"))) ))
(defmacro -definlineable (name (&rest args) &body body)
`(defmethod ,name ,args
(declare (fast-generic-functions:method-properties fast-generic-functions:inlineable))
,@body))
(defgeneric fgf-== (a b)
(:generic-function-class fast-generic-functions:fast-generic-function))
(defgeneric fgf-lookup (container key)
(:generic-function-class fast-generic-functions:fast-generic-function))
(defgeneric fgf-insert (container elem)
(:generic-function-class fast-generic-functions:fast-generic-function))
(defgeneric fgf-len (container)
(:generic-function-class fast-generic-functions:fast-generic-function))
(-definlineable fgf-== (a b) (equalp a b))
(-definlineable fgf-== ((a number) (b number)) (= a b))
(-definlineable fgf-== ((a string) (b string)) (string= a b))
(-definlineable fgf-== ((a character) (b character)) (char= a b))
(-definlineable fgf-== ((a symbol) (b symbol)) (eq a b))
(-definlineable fgf-== ((a list) (b list)) (equal a b))
(-definlineable fgf-== ((a cl-hamt:hash-dict) (b cl-hamt:hash-dict))
(cl-hamt:dict-eq a b :value-test #'==))
(-definlineable fgf-== ((a cl-hamt:hash-set) (b cl-hamt:hash-set))
(cl-hamt:set-eq a b))
(seal-all-domains #'fgf-==)
(-definlineable fgf-lookup ((container list) key)
(nth key container))
(-definlineable fgf-lookup ((container hash-table) key)
(gethash key container))
(-definlineable fgf-lookup ((container cl-hamt:hash-set) key)
(cl-hamt:set-lookup container key))
(-definlineable fgf-lookup ((container cl-hamt:hash-dict) key)
(cl-hamt:dict-lookup container key))
(seal-all-domains #'fgf-lookup)
(-definlineable fgf-insert ((container list) elem) (cons elem container))
(-definlineable fgf-insert ((container hash-table) k/v)
;; NOTE - strictly, this should copy the hash-table in order to be functional
;; Not right now.
(setf (gethash (car k/v) container) (cdr k/v)))
(-definlineable fgf-insert ((container cl-hamt:hash-dict) k/v)
(cl-hamt:dict-insert container (car k/v) (cdr k/v)))
(-definlineable fgf-insert ((container cl-hamt:hash-set) elem)
(cl-hamt:set-insert container elem))
(seal-all-domains #'fgf-insert)
(-definlineable fgf-len ((container list)) (length container))
(-definlineable fgf-len ((container hash-table)) (hash-table-count container))
(-definlineable fgf-len ((container cl-hamt:hash-set)) (cl-hamt:set-size container))
(-definlineable fgf-len ((container cl-hamt:hash-dict)) (cl-hamt:dict-size container))
(seal-all-domains #'fgf-insert)
</code></pre><p>The benchmark suite is going to be two parts. First, one hitting only equality, and second, one hitting a bunch of round-trip <code>lookup</code>/<code>insert</code>/<code>len</code> operations, each of which will call equality under the hood.</p><h3><a name="the-benchmark-setup"></a><a href="#the-benchmark-setup">The Benchmark Setup</a></h3><p>Now that we've got our operators, we need to test between four and six approaches to optimizing them, depending on how you count. So lets set this up.</p><pre><code>(defun fgn-fn (a b)
(declare (inline fgf-==))
(fgf-== a b))
(defun static-fn (a b)
(declare (inline static-dispatch-==))
(static-dispatch-== a b))
(defun naive-fn (a b)
(declare (inline ==))
(== a b))
(defun built-in-fn (a b)
(declare (inline =))
(= a b))
(defun equality-benchmark ()
(loop for f in (list #'naive-fn #'built-in-fn #'fgn-fn #'static-fn)
do (loop repeat 1000000
do (funcall f (random 256) (random 256)))))
(defun lookup/insert/len-benchmark (equality insert lookup len &key (times 10000))
(let* ((elem-gen (test-utils:a-member (test-utils:a-member
test-utils:a-keyword
test-utils:a-number
test-utils:a-string)))
(pair-gen (test-utils:a-pair elem-gen elem-gen)))
(loop repeat times
do (let* ((map (alist->map
(test-utils:generate (test-utils:a-list pair-gen))
:equality equality))
(inserted (funcall insert map (cons :test-key :test-value))))
(list (funcall len map)
(funcall lookup inserted :test-key)
(funcall len inserted))))))
</code></pre><p>Let me highlight a few things, just to make them explicit.</p><p>First, the <code>equality-benchmark</code> only compares numbers. I wanted a single type so that we could have a general comparison benchmark that includes <code>fgf-==</code>. I had to play some tricks to achieve this; in particular, I had to comment out the <code>fgf-== (a b)</code> method, because generalizing a method like this makes it unsealable.</p><p>Second, the latter benchmark does not run against a sealed <code>fgf-==</code> method. Because there can't be a default fall-through case, I can't use a sealed <code>fgf-==</code> to compare keys on a polymorphic <code>cl-hamt:hash-dict</code>; it would throw errors.</p><p>Third, that second benchmark makes use of <code>generator</code>s exposed through <code>test-utils</code>. If you don't want to set this up yourself, check out the <a href='https://github.com/inaimathi/clj/blob/master/src/benchmark.lisp'><code>benchmark.lisp</code> file in the main <code>clj</code> repo</a>. You should be able to just</p><pre><code>CL-USER> (ql:quickload :clj) (in-package :clj) (load "benchmark.lisp")
</code></pre><p>to get in the right place. From there, since I'm a <a href='https://common-lisp.net/project/slime/'><code>SLIME</code></a> user, I evaluated <code>slime-profile-package CLJ</code>, followed by a <code>slime-profile-reset</code> for good measure, then ran</p><pre><code>CLJ> (equality-benchmark)
</code></pre>followed by <code>slime-profile-report</code>, followed by <code>slime-profile-reset</code>, followed by<pre><code>CLJ> (lookup/insert/len-benchmark #'static-dispatch-== #'static-dispatch-insert #'static-dispatch-lookup #'static-dispatch-len :times 10000)
NIL
CLJ> (lookup/insert/len-benchmark #'fgf-== #'fgf-insert #'fgf-lookup #'fgf-len :times 10000)
NIL
CLJ> (lookup/insert/len-benchmark #'== #'insert #'lookup #'len :times 10000)
NIL
</code></pre><p>and a final <code>slime-profile-report</code>.</p><p>Here are the results.</p><h3><a name="the-benchmark"></a><a href="#the-benchmark">The Benchmark</a></h3><pre><code>CLJ> (equality-benchmark)
NIL
seconds | gc | consed | calls | sec/call | name
------------------------------------------------------------
0.134 | 0.004 | 81,380,672 | 1,000,000 | 0.000000 | CLJ::FGF-==
0.058 | 0.000 | 32,768 | 1,000,000 | 0.000000 | CLJ::STATIC-DISPATCH-==
0.031 | 0.000 | 0 | 1,000,000 | 0.000000 | CLJ::BUILT-IN-FN
0.027 | 0.000 | 0 | 1,000,000 | 0.000000 | CLJ::FGN-FN
0.025 | 0.000 | 0 | 1,000,000 | 0.000000 | CLJ::STATIC-FN
0.024 | 0.000 | 0 | 1,000,000 | 0.000000 | CLJ:==
0.000 | 0.000 | 0 | 1 | 0.000000 | CLJ::EQUALITY-BENCHMARK
0.000 | 0.000 | 0 | 1,000,000 | 0.000000 | CLJ::NAIVE-FN
------------------------------------------------------------
0.299 | 0.004 | 81,413,440 | 7,000,001 | | Total
estimated total profiling overhead: 10.01 seconds
overhead estimation parameters:
8.000001e-9s/call, 1.4299999e-6s total profiling, 6.44e-7s internal profiling
</code></pre><p>Seems a bit suspect. I'm going to juggle the call order around, just to make sure I'm not priviledging any given function.</p><pre><code>CLJ> (equality-benchmark)
NIL
seconds | gc | consed | calls | sec/call | name
------------------------------------------------------------
0.141 | 0.028 | 81,382,992 | 1,000,000 | 0.000000 | CLJ::FGF-==
0.058 | 0.000 | 0 | 1,000,000 | 0.000000 | CLJ:==
0.032 | 0.000 | 0 | 1,000,000 | 0.000000 | CLJ::BUILT-IN-FN
0.016 | 0.000 | 0 | 1,000,000 | 0.000000 | CLJ::STATIC-FN
0.013 | 0.000 | 0 | 1,000,000 | 0.000000 | CLJ::FGN-FN
0.004 | 0.000 | 0 | 1,000,000 | 0.000000 | CLJ::NAIVE-FN
0.000 | 0.000 | 0 | 1 | 0.000000 | CLJ::EQUALITY-BENCHMARK
0.000 | 0.000 | 0 | 1,000,000 | 0.000000 | CLJ::STATIC-DISPATCH-==
------------------------------------------------------------
0.264 | 0.028 | 81,382,992 | 7,000,001 | | Total
estimated total profiling overhead: 10.01 seconds
overhead estimation parameters:
8.000001e-9s/call, 1.4299999e-6s total profiling, 6.44e-7s internal profiling
CLJ>
</code></pre><p>Not... that big a difference, it looks like. To a first approximation, in this specific case, <code>fast-generic-function</code> is much worse than the alternatives, taking more than double the time and more than 1000x the space of the next most performant option. This is pretty damning, given that the test was pared down specifically to conform to the limitations of <code>seal-domain</code> here.</p><p>Moving on.</p><pre><code>CLJ> (lookup/insert/len-benchmark #'static-dispatch-== #'static-dispatch-insert #'static-dispatch-lookup #'static-dispatch-len :times 10000)
NIL
CLJ> (lookup/insert/len-benchmark #'fgf-== #'fgf-insert #'fgf-lookup #'fgf-len :times 10000)
NIL
CLJ> (lookup/insert/len-benchmark #'== #'insert #'lookup #'len :times 10000)
NIL
measuring PROFILE overhead..done
seconds | gc | consed | calls | sec/call | name
-----------------------------------------------------------
0.589 | 0.024 | 207,097,712 | 3 | 0.196231 | CLJ::LOOKUP/INSERT/LEN-BENCHMARK
0.455 | 0.030 | 335,245,040 | 30,000 | 0.000015 | CLJ:ALIST->MAP
0.082 | 0.048 | 15,686,608 | 10,000 | 0.000008 | CLJ::FGF-INSERT
0.038 | 0.018 | 11,400,528 | 10,000 | 0.000004 | CLJ::INSERT
0.026 | 0.000 | 98,288 | 20,000 | 0.000001 | CLJ::STATIC-DISPATCH-LEN
0.025 | 0.000 | 1,738,336 | 10,000 | 0.000002 | CLJ::STATIC-DISPATCH-LOOKUP
0.022 | 0.000 | 1,570,448 | 20,000 | 0.000001 | CLJ::FGF-LEN
0.021 | 0.000 | 0 | 20,000 | 0.000001 | CLJ::LEN
0.021 | 0.000 | 0 | 10,000 | 0.000002 | CLJ::LOOKUP
0.019 | 0.000 | 7,848,400 | 10,528 | 0.000002 | CLJ::FGF-==
0.018 | 0.000 | 1,766,656 | 10,000 | 0.000002 | CLJ::FGF-LOOKUP
0.011 | 0.000 | 10,319,072 | 10,000 | 0.000001 | CLJ::STATIC-DISPATCH-INSERT
0.001 | 0.000 | 0 | 10,515 | 0.000000 | CLJ:==
0.000 | 0.000 | 0 | 10,579 | 0.000000 | CLJ::STATIC-DISPATCH-==
-----------------------------------------------------------
1.327 | 0.120 | 592,771,088 | 181,625 | | Total
estimated total profiling overhead: 0.26 seconds
overhead estimation parameters:
6.0e-9s/call, 1.4459999e-6s total profiling, 6.9e-7s internal profiling
</code></pre><p>So, weirdly, for our specific use-case, it looks like the <code>fast-generic-function</code> versions of these are slightly <i>worse</i> than just built-in generic functions, while the <code>static-dispatch</code> implementations are slightly faster. I do emphasize <i>slightly</i> in both of these situations. To the point that I'm seriously wondering whether the performance improvement made available by <a href='https://github.com/alex-gutev/static-dispatch'><code>static-dispatch</code></a> is actually worth <a href='https://github.com/alex-gutev/static-dispatch#usage'>giving up <code>before</code>/<code>after</code>/<code>around</code> methods the way their documentation implies</a>. I don't specifically want any of those for <code>clj</code> internals, but <code>clj</code> <i>would</i> have to expose <code>static-dispatch:defmethod</code> in order to avoid some weird interface incompatibility edge cases.</p><p>To be sure, there's a pretty serious improvement to <code>static-dispatch:insert</code> when compared to <code>insert</code> or <code>fgf-insert</code>, but the picture for <code>len</code>, <code>lookup</code> and <code>==</code> is less rosy. The naive <code>cl:defmethod</code> implementation beats both the others solidly for <code>len</code> and puts in a strong showing for both <code>==</code> and <code>lookup</code>. It's sort of hard for me to argue that <code>insert</code> is a more important operation than <code>lookup</code> or <code>==</code>. It probably depends on your use case, but this is not really a ringing endorsement either way.</p><h3><a name="conclusions"></a><a href="#conclusions">Conclusions</a></h3><p>The tentative conclusion is that all this performance grubbing is a relative boondoggle. For the moment, given a bout this undecisive, I have to give victory to the incumbent.</p><p>So it goes sometimes.</p><p>I'll keep the <code>benchmark</code> file around for fun and possibly future profiling purposes. I was going to talk a bit about the approaches I'm thinking about to save cycles at low-effort where it matters, but I think this piece is already long and dense enough. If you want a sneak peek, check out <a href='https://github.com/inaimathi/clj/blob/master/src/types.lisp'><code>types.lisp</code> in the main repo</a>, but I'm not going to talk about it quite yet. <ol class='footnotes'><li id='fn-1'>Things like polymorphic <code>map</code>, <code>reduce</code>, <code>mapcat</code>, <code>concat</code>, possibly <code>->list</code> and <code>conj</code>. First, these might be more complicated to implement, but second, I'm not entirely sure I want to or how specifically to do so. Most of the functions I list in this footnote could be implemented using an underlying <code>next</code>. Part of the thought for these systems is putting them together in a way that lets the end users define as little as they can to get the full benefit.<a href='#fnref1'>↩</a></li></ol></p>More On clj2020-05-14T01:23:36.000Zinaimathi<p>I mentioned the <a href='https://github.com/inaimathi/clj'><code>clj</code></a> repo last time. And mentioned off-handedly that there's a bunch of things I <i>really</i> like about Clojure, and also a few reason that, for my personal use at least, I'm definitely going to continue developing things in Common Lisp.</p><p>I intend to do something about this. If you like, you can <a href='https://github.com/inaimathi/clj/tree/master/src'>follow along</a>. Who knows, we may both learn something. We'll go from the trivial, to the difficult but hopefully possible. I'm not writing this piece after finishing development, the intent is to journal as I go.</p><h3><a name="readable-anaphora"></a><a href="#readable-anaphora">Readable Anaphora</a></h3><p><i>Implementation Complexity: Trivial</i></p><p>There's a chapter in <a href='http://www.paulgraham.com/onlisp.html'>On Lisp</a> that defines some <a href='https://letoverlambda.com/index.cl/guest/chap6.html'>anaphoric macros</a>. Things that bind the results of intermediate computations and expose them as symbols in their result bodies. The archetypal ones are <code>aif</code> and <code>awhen</code>, roughly defined as</p><pre><code>(defmacro aif (test then &optional else)
`(let ((it ,test))
(if it ,then ,else)))
(defmacro awhen (test &body then)
`(aif ,test (progn ,@then)))
</code></pre><p>The idea is that you then have the symbol <code>it</code> bound in the body of the <code>then</code> form. This is useful, but the Clojure approach of conditional binding forms makes the resulting code easier to read because it lacks symbols defined outside of the visible scope. Granted, the implementation is a bit more complex</p><pre><code>(defmacro if-let ((name test) then &optional else)
(let ((tmp (gensym "TMP")))
`(let ((,tmp ,test))
(if ,tmp
(let ((,name ,tmp)) then)
,else))))
(defmacro when-let ((name test) &body then)
`(if-let (,name ,test) (progn ,@then)))
</code></pre><p>...but not by much. And the calls are going to be more obvious to someone reading it.</p><pre><code>(aif (expensive-operation)
(some-interesting-transformation it))
</code></pre><p>vs</p><pre><code>(if-let (it (expensive-operation))
(some-interesting-transformation it))
</code></pre><p>The only finer point here is the use of the intermediate variable <code>tmp</code>, because we don't want to evaluate any of the inputs more than once.</p><h3><a name="arrow-macros"></a><a href="#arrow-macros">Arrow macros</a></h3><p><i>Implementation Complexity: Simple</i></p><p>The basic arrow macros are <code>-></code> and <code>->></code>. There's a bunch more that you can see over at the <a href='https://github.com/hipeta/arrow-macros/blob/master/arrow-macros.lisp'><code>arrow-macros</code> project</a>, but I'm going to stick to those two for now. The only non-trivial part of this is compensating for <code>lambda</code> expressions and <code>#'</code> symbols.</p><p>That is, it's not enough to</p><pre><code>(defmacro -> (exp &rest ops)
(reduce
(lambda (memo op)
(if (atom op)
`(,op ,memo)
`(,(first op) ,memo ,@(rest op))))
ops :initial-value exp))
</code></pre><p>because that fails on inputs like <code>(-> foo #'bar (lambda (n) (baz n)))</code>. Macroexpanding it will show you why:</p><pre><code>(LAMBDA (FUNCTION FOO BAR) (N) (BAZ N))
</code></pre><p>Ew.</p><p>You need to account for at least those two edge cases.</p><pre><code>(defmacro -> (exp &rest ops)
(reduce
(lambda (memo op)
(cond ((atom op) `(,op ,memo))
((and (consp op)
(or (eq 'cl:function (car op))
(eq 'cl:lambda (car op))))
`(funcall ,op ,memo))
(t `(,(first op) ,memo ,@(rest op)))))
ops :initial-value exp))
</code></pre><p>That should do the correct thing here.</p><pre><code>CLJ> (macroexpand '(-> foo #'bar (lambda (n) (baz n)) mumble))
(MUMBLE (FUNCALL (LAMBDA (N) (BAZ N)) (FUNCALL #'BAR FOO)))
T
CLJ>
</code></pre><p>Testing these by example is probably a thing we want. The particular two arrows we have above have some common ground:</p><pre><code>(subtest "Common threads"
(is-expand (-> a foo) (foo a)
"Thread applies a function to an argument")
(is-expand (-> a foo bar) (bar (foo a))
"Thread can compose multiple functions")
(is-expand (->> a foo) (foo a)
"Rthread applies a function to an argument")
(is-expand (->> a foo bar) (bar (foo a))
"Rthread can compose multiple functions"))
</code></pre><p>Function application and trivial composition ends up coming out the same way regardless of which you pick. That's where the similarities end though.</p><pre><code> (subtest "Thread"
(is-expand (-> a (foo 1)) (foo a 1)
"If called with a partially applied multi-argument function, thread plants the target in the first slot")
(is-expand (-> a (foo 1) (foo 2)) (foo (foo a 1) 2)
"Thread can nest multi-arity function calls")
(is-expand (-> a foo (bar 1) (bar 2)) (bar (bar (foo a) 1) 2)
"Thread can nest single and multi-arity function calls")
(is-expand (-> a foo (bar 1) (bar 2) baz) (baz (bar (bar (foo a) 1) 2))
"Thread can nest single and multi-arity function calls. Again.")
(is-expand (-> a #'foo (lambda (b) (bar b)) baz)
(BAZ (FUNCALL (LAMBDA (B) (BAR B)) (FUNCALL #'FOO A)))
"Thread handles #' terms and lambda forms properly"))
</code></pre><p>Using <code>-></code> stitches each sub-expression in as the first argument of the next, while using <code>->></code> slots it into the <i>last</i> argument.</p><pre><code>(subtest "Rthread"
(is-expand (->> a (foo 1)) (foo 1 a)
"If called with a partially applied multi-argument function, rthread plants the target in the last slot")
(is-expand (->> a (foo 1) (foo 2)) (foo 2 (foo 1 a))
"Rthread can nest multi-arity function calls")
(is-expand (->> a foo (bar 1) (bar 2)) (bar 2 (bar 1 (foo a)))
"Rthread can nest single and multi-arity function calls")
(is-expand (->> a foo (bar 1) (bar 2) baz) (baz (bar 2 (bar 1 (foo a))))
"Rthread can nest single and multi-arity function calls. Again.")
(is-expand (->> a #'foo (lambda (b) (bar b)) baz)
(BAZ (FUNCALL (LAMBDA (B) (BAR B)) (FUNCALL #'FOO A)))
"Rthread handles #' terms and lambda forms properly"))
</code></pre><p>Realistically, the only worthwhile code here is that test section. I should just use and re-export symbols from <code>arrow-macros</code> and make sure they check out. But it's still a good idea to think about what must be underneath the immediate interface we see, and why it might be there.</p><h3><a name="anaphoric-lambda"></a><a href="#anaphoric-lambda">Anaphoric lambda</a></h3><p><i>Implementation Complexity: Tricky</i></p><p>Anaphoric <code>lambda</code>, as opposed to <code>if-let</code> and <code>when-let</code> takes some matching to get working properly. So, we need to pull in <a href='https://github.com/m2ym/optima'><code>optima</code></a> for this one. I <i>don't</i> think some of the things that the Clojure dudes are up to in terms of argument lists are worth the complexity. In particular, the way they do optional arguments, while it is slightly more flexible, doesn't end up being especially useful given the complexity it introduces. I prefer the Common Lisp approach to <code>rest</code>/<code>body</code>/<code>keyword</code> args. Their <code>fn</code> has one trick up its' sleeve that I definitely want though, which is the ability to refer to itself.</p><pre><code class="clojure">user=> (fn a [b c] (if (even? c) (+ b c) (a b (inc c))))
#object[user$eval2021$a__2022 0x52b57247 "user$eval2021$a__2022@52b57247"]
user=> ((fn a [b c] (if (even? c) (+ b c) (a b (inc c)))) 3 5)
9
user=>
</code></pre><p>It's not useful often, but is sometimes. And I friggin' want it. The unfortunate part of this one, is that, even <i>with</i> <code>optima</code>, I can't figure out how to evaluate the function name only once. Also, ironically, this is one of the maybe handful of situations where Clojure-style optional arguments would be useful.</p><pre><code>(defmacro fn (&rest args)
(optima:match args
((optima:guard
(cons name (cons params body))
(and (symbolp name) (listp params)))
`(labels ((,name ,params ,@body))
#',name))
((optima:guard
(cons params body)
(and (listp params)))
`(lambda ,params ,@body))))
</code></pre><p>The only comfort I have is that it's guaranteed to be a symbol if it's there, so I figure that's not the worst thing that could happen. The named lambda case is about the only place I can think of where it seems you literally can't get around the requirement to evaluate the argument twice.</p><p>This is because</p><ol><li>The <code>body</code> needs to be able to refer to that <code>name</code>, which means it has to be present in the <code>labels</code> binding</li><li>We want to return that function which means we need to <code>name</code> it in the return value.</li></ol><p>It looks like no amount of aliasing is going to get us out of this one, but feel free to correct me if I'm wrong.</p><h3><a name="map-and-set-literals-with-functional-underpinnings"></a><a href="#map-and-set-literals-with-functional-underpinnings">Map and Set literals with functional underpinnings</a></h3><p><i>Implementation Complexity: Difficult</i></p><p>The data structures on their own are already implemented in the form of <a href='https://quickref.common-lisp.net/cl-hamt.html'><code>cl-hamt</code></a>. We don't necessarily want to commit to it, but it's available and we can probably make the interface agnostic to some degree. The syntax stuff involves defining some simple reader macros. Ideally, they'd be namespace-bounded which means we're pulling out <code>named-readtables</code>.</p><p>So, reader macros are things you can do in Lisp. You can read more about them <a href='https://gist.github.com/chaitanyagupta/9324402'>here</a>. The short version is that in order to get <i>namespaced</i> reader macros, which we want so that we don't have to stomp on everyone elses' tightly wound DSLs, we need to use <a href='https://common-lisp.net/project/named-readtables/'><code>named-readtables</code></a>.</p><p>In order to use it, you need to define some <code>macro-char</code>s and some parsing functions. Luckily for me, Common Lisp happens to already have <a href='http://www.lispworks.com/documentation/HyperSpec/Body/f_rd_del.htm'><code>read-delimited-list</code></a>, which does exactly what I want when defining <code>map</code> and <code>set</code> literals.</p><pre><code>(defun map-literal-reader (stream char)
(declare (ignore char))
(loop with dict = (cl-hamt:empty-dict)
for (k v) on (read-delimited-list #\} stream t) by #'cddr
do (setf dict (cl-hamt:dict-insert dict k v))
finally (return dict))
</code></pre><p>This is going to do exactly what you think it is. We <code>read-delimited-list</code> from the incoming stream, with <code>#&#125;</code> as the stop chararcter.</p><pre><code>CLJ> (with-input-from-string (stream ":a 1 :b 2}") (read-delimited-list #\} stream nil))
(:A 1 :B 2)
CLJ>
</code></pre><p>The function definition has a <code>t</code> in place of that trailing <code>nil</code> parameter because we'll want to read recursively from <code>standard-output</code>, but can't from a <code>string-stream</code>.</p><p>The trailing <code>t</code> of that call means we do this recursively if we have-sub-forms. Once we have the form <code>read</code>, we walk it pairwise, adding each pair of characters to a<code>cl-hamt:hash-dict</code>. Note to self; add some error handling here if we read an odd set of elements. The <code>set-literal-reader</code> is about the same thing but simpler because we don't need to worry about pairing elements off.</p><pre><code>(defun list->set (lst)
(reduce
(lambda (set elem)
(cl-hamt:set-insert set elem))
lst :initial-value (cl-hamt:empty-set)))
(defun set-literal-reader (stream sub-char numarg)
(declare (ignore sub-char numarg))
(list->set (read-delimited-list #\} stream t))))
</code></pre><p>Once that's all done, we need to define a local <code>read-table</code></p><pre><code>(named-readtables:defreadtable syntax
(:merge :standard)
(:macro-char #\{ #'map-literal-reader nil)
(:macro-char #\} (get-macro-character #\)) nil)
(:dispatch-macro-char #\# #\{ #'set-literal-reader))
</code></pre><p>This is such a table that uses the <code>:standard</code> Common Lisp readers, but adds support for forms beginning with <code>{</code>/<code>#{</code> and ending with <code>}</code> to be handled as part of the read step. In some other file of the project, we need to add a call to <code>(named-readtables:in-readtable syntax)</code>. Externally, we can use <code>(named-readtables:in-readtable clj:syntax)</code> to get access to these reader macros.</p><p>Once, we get all that evaluated, we've got <code>map</code> and <code>set</code> literals.</p><pre><code>CLJ> {:a 1 :b 2}
#<CL-HAMT:HASH-DICT {1003068E13}>
CLJ> #{:a :b :c}
#<CL-HAMT:HASH-SET {10034E20B3}>
CLJ>
</code></pre>And that's the very next thing I want to fix.<h3><a name="readable-datastructure-representations"></a><a href="#readable-datastructure-representations">Readable datastructure representations</a></h3><p><i>Implementation Complexity: Tricky</i></p><p>One thing Clojure does nicely and consistently is emit both its maps and sets in a <code>read</code>-able format. Lisp does this for <code>list</code>s and <code>simple-vector</code>s, but not <code>hash-tables</code>es or <code>hash-dict</code>s. And that kind of sucks.</p><p>To get this for our representations, we need to define <code>print-object</code> methods for them. That's the long and the short of it. It's <i>tricky</i>, not <i>difficult</i>. All we need to do is make sure that the <code>print-object</code> method for our datatypes emits the syntax we defined in our macros earlier.</p><pre><code>(defmethod print-object ((object cl-hamt:hash-dict) stream)
"The printable representation for clj:maps"
(format
stream
"{~{~s ~s~^ ~}}"
(reverse (cl-hamt:dict-reduce (lambda (memo k v) (cons v (cons k memo))) object nil))))
</code></pre><p>We need to iterate through the <code>hamt-dict</code>, collecting keys and values along the way, then <code>format</code> them into the given stream surrounded by <code>{</code> and <code>}</code>. And with that, we've left the world of opaque data.</p><pre><code>CLJ> {:a 1 :b 2}
{:A 1 :B 2}
CLJ> (prin1-to-string {:a 1 :b 2})
"{:A 1 :B 2}"
CLJ> (read-from-string (prin1-to-string {:a 1 :b 2}))
{:A 1 :B 2}
11
CLJ>
</code></pre><p>The only real problem left here is that it won't work unless we're in the <code>clj:syntax</code> <code>read-table</code>. As in</p><pre><code>CLJ> (defparameter *D* {:a 1 :b 2 :c 3})
*D*
CLJ> *d*
{:A 1 :C 3 :B 2}
CLJ> (in-package :cl-user)
#<PACKAGE "COMMON-LISP-USER">
CL-USER> clj::*D*
{:A 1 :C 3 :B 2}
CL-USER> (prin1-to-string clj::*D*)
"{:A 1 :C 3 :B 2}"
CL-USER> (read-from-string (prin1-to-string clj::*D*))
Package { does not exist.
Line: 1, Column: 2, File-Position: 2
Stream: #<SB-IMPL::STRING-INPUT-STREAM {1008382BB3}>
[Condition of type SB-INT:SIMPLE-READER-PACKAGE-ERROR]
Restarts:
0: [RETRY] Retry SLIME REPL evaluation request.
1: [*ABORT] Return to SLIME's top level.
2: [ABORT] abort thread (#<THREAD "repl-thread" RUNNING {1004F29B63}>)
Backtrace:
0: (SB-IMPL::READER-FIND-PACKAGE "{" #<SB-IMPL::STRING-INPUT-STREAM {1008382BB3}>)
1: (SB-IMPL::READ-TOKEN #<SB-IMPL::STRING-INPUT-STREAM {1008382BB3}> #\{)
2: (SB-IMPL::READ-MAYBE-NOTHING #<SB-IMPL::STRING-INPUT-STREAM {1008382BB3}> #\{)
3: (SB-IMPL::%READ-PRESERVING-WHITESPACE #<SB-IMPL::STRING-INPUT-STREAM {1008382BB3}> T (NIL) T)
4: (SB-IMPL::%READ-PRESERVING-WHITESPACE #<SB-IMPL::STRING-INPUT-STREAM {1008382BB3}> T (NIL) NIL)
5: (READ #<SB-IMPL::STRING-INPUT-STREAM {1008382BB3}> T NIL NIL)
6: (SB-IMPL::%READ-FROM-STRING "{:A 1 :C 3 :B 2}" T NIL 0 NIL NIL)
7: (SB-INT:SIMPLE-EVAL-IN-LEXENV (READ-FROM-STRING (PRIN1-TO-STRING CLJ::*D*)) #<NULL-LEXENV>)
8: (EVAL (READ-FROM-STRING (PRIN1-TO-STRING CLJ::*D*)))
--more--
</code></pre><p>Not a deal-breaker exactly, but it's not a great thing for interoperability. If we define our <code>print-object</code> as</p><pre><code>(defmethod print-object ((object cl-hamt:hash-dict) stream)
"The printable representation for clj:maps"
(if (eq 'clj:syntax (named-readtables:readtable-name *readtable*))
(format
stream
"{~{~s ~s~^ ~}}"
(reverse (cl-hamt:dict-reduce (lambda (memo k v) (cons v (cons k memo))) object nil)))
(format stream "(CLJ:ALIST->MAP (LIST ~{~S~^ ~}))" (cl-hamt:dict->alist object))))
</code></pre><p>instead, and additionally define</p><pre><code>(defun alist->map (alist)
(loop with dict = (cl-hamt:empty-dict :test #'==)
for (k . v) in alist do (setf dict (cl-hamt:dict-insert dict k v))
finally (return dict)))
</code></pre><p>we get what we want, although the representation <i>is</i> uglier.</p><pre><code>CL-USER> clj::*D*
(CLJ:ALIST->MAP (LIST (:B . 2) (:C . 3) (:A . 1)))
CL-USER> (prin1-to-string clj::*D*)
"(CLJ:ALIST->MAP (LIST (:B . 2) (:C . 3) (:A . 1)))"
CL-USER> (read-from-string (prin1-to-string clj::*D*))
(CLJ:ALIST->MAP (LIST (:B . 2) (:C . 3) (:A . 1)))
50
CL-USER>
</code></pre><p>The corresponding <code>set</code> method is</p><pre><code>(defmethod print-object ((object cl-hamt:hash-set) stream)
(if (eq 'clj:syntax (named-readtables:readtable-name *readtable*))
(format stream "#{~{~s~^ ~}}" (cl-hamt:set->list object))
(format stream "(CLJ:LIST->SET (LIST ~{~S~^ ~}))" (cl-hamt:set->list object))))
</code></pre><p>Next, we do in fact want these to be recursive. And, currently, they're not.</p><pre><code>CLJ> {:a 1 :b 2}
{:A 1 :B 2}
CLJ> {:a 1 :b {:c 3}}
{:A 1 :B {:C 3}}
CLJ> {{:a 1} {:b 2}}
Don't know how to hash {:A 1}
[Condition of type CL-MURMURHASH:UNHASHABLE-OBJECT-ERROR]
Restarts:
0: [RETRY] Retry SLIME REPL evaluation request.
1: [*ABORT] Return to SLIME's top level.
2: [ABORT] abort thread (#<THREAD "repl-thread" RUNNING {1004F29B63}>)
Backtrace:
0: ((:METHOD CL-MURMURHASH:MURMURHASH (T)) {:A 1}) [fast-method]
1: (CL-HAMT:DICT-INSERT {} {:A 1} {:B 2})
2: (MAP-LITERAL-READER #<SB-IMPL::STRING-INPUT-STREAM {1002A726D3}> #<unused argument>)
3: (SB-IMPL::READ-MAYBE-NOTHING #<SB-IMPL::STRING-INPUT-STREAM {1002A726D3}> #\{)
4: (SB-IMPL::%READ-PRESERVING-WHITESPACE #<SB-IMPL::STRING-INPUT-STREAM {1002A726D3}> NIL (NIL) T)
5: (SB-IMPL::%READ-PRESERVING-WHITESPACE #<SB-IMPL::STRING-INPUT-STREAM {1002A726D3}> NIL (NIL) NIL)
6: (READ #<SB-IMPL::STRING-INPUT-STREAM {1002A726D3}> NIL #<SB-IMPL::STRING-INPUT-STREAM {1002A726D3}> NIL)
--more--
CLJ> #{1 #{:a} #{"a"}}
Don't know how to hash #{:A}
[Condition of type CL-MURMURHASH:UNHASHABLE-OBJECT-ERROR]
Restarts:
0: [RETRY] Retry SLIME REPL evaluation request.
1: [*ABORT] Return to SLIME's top level.
2: [ABORT] abort thread (#<THREAD "repl-thread" RUNNING {1004F29B63}>)
Backtrace:
0: ((:METHOD CL-MURMURHASH:MURMURHASH (T)) #{:A}) [fast-method]
1: ((FLET CL-HAMT::%INSERT :IN CL-HAMT:SET-INSERT) #<CL-HAMT::SET-TABLE {10028D25D3}> #{:A})
2: (REDUCE #<CLOSURE (FLET CL-HAMT::%INSERT :IN CL-HAMT:SET-INSERT) {10028D265B}> (#{:A}) :INITIAL-VALUE #<CL-HAMT::SET-TABLE {10028D25D3}>)
3: (CL-HAMT:SET-INSERT #{1} #{:A})
4: (REDUCE #<FUNCTION (LAMBDA (SET ELEM) :IN LIST->SET) {228B851B}> (1 #{:A} #{"a"}) :INITIAL-VALUE #{})
5: (SB-IMPL::READ-MAYBE-NOTHING #<SB-IMPL::STRING-INPUT-STREAM {100247DD93}> #\#)
6: (SB-IMPL::%READ-PRESERVING-WHITESPACE #<SB-IMPL::STRING-INPUT-STREAM {100247DD93}> NIL (NIL) T)
7: (SB-IMPL::%READ-PRESERVING-WHITESPACE #<SB-IMPL::STRING-INPUT-STREAM {100247DD93}> NIL (NIL) NIL)
8: (READ #<SB-IMPL::STRING-INPUT-STREAM {100247DD93}> NIL #<SB-IMPL::STRING-INPUT-STREAM {100247DD93}> NIL)
--more--
</code></pre><h3><a name="recursive-dicts-and-sets"></a><a href="#recursive-dicts-and-sets">Recursive dicts and sets</a></h3><p><i>Implementation Complexity: Tricky</i></p><p>We need to define a hashing method that is <code>cl-hamt</code> compatible and works with <a href='https://github.com/ruricolist/cl-murmurhash'><code>cl-murmurhash</code></a>. All we really need are specializers on <code>hash-set</code> and <code>hash-dict</code>. Again, <i>tricky</i>, not <i>difficult</i>. It looks like</p><pre><code>(defmethod cl-murmurhash:murmurhash ((object cl-hamt:hash-dict) &key (seed cl-murmurhash:*default-seed*) mix-only)
(cl-murmurhash:murmurhash (cl-hamt:dict->alist object) :seed seed :mix-only mix-only))
(defmethod cl-murmurhash:murmurhash ((object cl-hamt:hash-set) &key (seed cl-murmurhash:*default-seed*) mix-only)
(cl-murmurhash:murmurhash (cl-hamt:set->list object) :seed seed :mix-only mix-only))
</code></pre><p>With that, <code>set</code>s can contain <code>set</code>s, <code>map</code>s can contain <code>map</code>s, even as keys, and they can both contain each other. Sort of.</p><pre><code>CLJ> {:a 1}
{:A 1}
CLJ> {:a {:b 1}}
{:A {:B 1}}
CLJ> {{:a 1} {:b 1}}
{{:A 1} {:B 1}}
CLJ> (cl-hamt:dict-lookup {{:a 1} {:b 1}} {:a 1})
NIL
NIL
CLJ> (cl-hamt:set-lookup #{1 2 {:a 1}} {:a 1})
NIL
</code></pre><p>The problem is that two <code>set</code>s/<code>dict</code>s are not <code>equal</code> or even <code>equalp</code> to each other.</p><pre><code>CLJ> (equal {:a 1} {:a 1})
NIL
CLJ> (equalp {:a 1} {:a 1})
NIL
CLJ> (equal #{:a 1} #{:a 1})
NIL
CLJ> (equalp #{:a 1} #{:a 1})
NIL
CLJ>
</code></pre><p>So to get any real use out of this, we actually also need...</p><h3><a name="polymorphic-operators"></a><a href="#polymorphic-operators">Polymorphic operators</a></h3><p><i>Implementation Complexity: Fiendish</i></p><p>Clojure doesn't have a bunch of equality operators. It has one; <a href='https://clojure.org/guides/equality'><code>=</code></a>. <a href='http://people.math.harvard.edu/~mazur/preprints/when_is_one.pdf'>Equality is fraught</a>, and if you don't believe me, give that a read. The basics are actually easy.</p><pre><code>(defmethod == (a b) (equalp a b))
(defmethod == ((a cl-hamt:hash-dict) (b cl-hamt:hash-dict))
(cl-hamt:dict-eq a b :value-test #'==))
(defmethod == ((a cl-hamt:hash-set) (b cl-hamt:hash-set))
(cl-hamt:set-eq a b))
</code></pre><p>With that,</p><pre><code>CLJ> (== {:a 1} {:a 1})
READING :A -> 1
READING :A -> 1
T
CLJ> (== {:a 1} {:a 2})
READING :A -> 1
READING :A -> 2
NIL
CLJ> (== #{:a 1} #{:a 1})
T
CLJ> (== #{:a 1} #{:a 2})
NIL
CLJ>
</code></pre><p>And, once we wire up our literal definition to account for it,</p><pre><code>...
(defun alist->map (alist)
(loop with dict = (cl-hamt:empty-dict :test #'==)
for (k . v) in alist do (setf dict (cl-hamt:dict-insert dict k v))
finally (return dict)))
(defun map-literal-reader (stream char)
(declare (ignore char))
(loop with dict = (cl-hamt:empty-dict :test #'==)
for (k v) on (read-delimited-list #\} stream t) by #'cddr
do (setf dict (cl-hamt:dict-insert dict k v))
finally (return dict))))
...
(defun list->set (lst)
(reduce
(lambda (set elem)
(cl-hamt:set-insert set elem))
lst :initial-value (cl-hamt:empty-set :test #'==))))
...
</code></pre><p>we get the behavior we want out of our hashes.</p><pre><code>CLJ> (cl-hamt:dict-lookup {:A 1 {:B 2} :C} {:b 2})
:C
T
CLJ> (cl-hamt:dict-lookup {{:a 1} {:b 2}} {:a 1})
{:B 2}
T
CLJ>
</code></pre><p>In the correctness sense, at least.</p><p>The problem is, we've entered generic function land. And that's good in terms of interface, but if the day comes when we want to squeeze extra performance out of these structures, it might be annoying to pay the cost of performing a fully polymorphic equality. What we'd really want is a way to declare the types of our <code>dict</code>s/<code>set</code>s and use the tightest applicable sense of equality for those types so that the inliner has a chance of doing us some good for those cases where performance matters.</p><p>I <i>think</i> the best way to do this is to introduce type hints. Something like</p><pre><code>(:: (map keyword integer) {:a 1 :b 2})
</code></pre><p>which would put together a map that assumes keyword keys and integer values. I'm going to do some testing, research and/or profiling before embarking on this journey. To be fair, <a href='https://clojureverse.org/t/is-fast-in-clojure/2182/2'>Clojure equality performance</a> is also kind of up in the air, so this might not be the biggest deal. I'd still like to give it some serious thought.</p><p>That's all I've got the energy for in one go. I'll keep you up to date on further developments.</p>Zippers And Clj2020-05-08T18:49:52.000Zinaimathi<p>So recently, I had to use <a href='https://www.st.cs.uni-saarland.de/edu/seminare/2005/advanced-fp/docs/huet-zipper.pdf'><code>zipper</code>s</a> at work. Specifically, the <a href='https://clojuredocs.org/clojure.zip'>Clojure implementation</a>. There were some close-to-arbitrary transformations I needed to do with some close-to-arbitrary trees and it turned out that <code>zipper</code>s were more efficient than the alternatives<a href='#fn-1' id='fnref1'><sup>1</sup></a>.</p><p>Using them this way, combined with the general state of the world and my free time, finally tipped me into doing some more Common Lisp development. Before, I go any further, let me be clear about something.</p><h2><a name="i-like-clojure"></a><a href="#i-like-clojure">I Like Clojure</a></h2><p>Seriously.</p><p>Its logo is up top in the language bar, I was one of the inaugural members of the Toronto Clojure User Group, I <a href='/posts/recommendations'>recommend it</a> as a first lisp you should learn, and have for about six years now. I'm <i>also</i> painfully aware of the <a href='/posts/recommendations#why'>shortcomings of Common Lisp</a>, and make no excuses for them.</p><p>However.</p><ul><li>I don't like the JVM. It's slow as balls, its' deployment options are less than ideal for my purposes, its' error system is at best useless, and Clojure without it <a href='https://old.reddit.com/r/Clojure/comments/6hhg1h/why_isnt_there_a_compiled_or_interpreted_clojure/diz006j/'>is unlikely</a>.</li><li>Clojurescript build incompatiblities are, if anything, worse<a href='#fn-2' id='fnref2'><sup>2</sup></a>.</li><li>I don't like the underlying <a href='https://clojure.org/community/license'>licensing decisions</a>.</li></ul><p>These are deep reasons to stay away. They're not the sort of thing I can paper over with a library or two. Fixing them would mean a superhuman amount of work poured into the underlying technical and social infrastructure, and I'm not into it. I wouldn't be into it even if the community was interested in heading that way, and near as I can tell, they're not particularly.</p><p>Whether or not I think <i>you</i> should learn Clojure as <i>your</i> first<a href='#fn-3' id='fnref3'><sup>3</sup></a> lisp, it definitely wasn't <i>my</i> first lisp. The more uniform, mostly-better-thought-out interface, lack of historical baggage and functional data structures are not enough to pull me all the way over.</p><p>It <i>is</i> enough for me to start plotting a smash-and-grab of as much of the stuff I like as I can carry. Which is exactly what <a href='https://github.com/inaimathi/clj'><code>clj</code></a> represents. As of this writing, it defines and exports exactly four symbols: <code>if-let</code>, <code>when-let</code>, <code>-></code> and <code>->></code>. This is a tiny beginning of the list, and I fully plan to put something more substantial together using <a href='https://quickref.common-lisp.net/cl-hamt.html'><code>cl-hamt</code></a>, <a href='https://common-lisp.net/project/named-readtables/#important_api_idiosyncrasies'><code>named-readtables</code></a>, <a href='https://github.com/inaimathi/test-utils'><code>test-utils</code></a> and possibly <a href='https://quickref.common-lisp.net/optima.html'><code>optima</code></a>. Stay tuned to that repo if you're interested, but it's not the focus today.</p><h2><a name="-code-cl-zipper-code-"></a><a href="#-code-cl-zipper-code-"><code>cl-zipper</code></a></h2><p>The thing that percipitated this thought was having used the Clojure Zipper implementation. So, obviously, this is something I want next time I need to manipulate trees in Common Lisp. The paper is <a href='https://www.st.cs.uni-saarland.de/edu/seminare/2005/advanced-fp/docs/huet-zipper.pdf'>here</a>, and unless you have a terminal phobia of datastructures<a href='#fn-4' id='fnref4'><sup>4</sup></a>, you should go read it. It's six pages, they're light, and one of them taken up by the intro and references.</p><p>The operations defined in the paper are <code>left</code>, <code>right</code>, <code>up</code>, <code>down</code>, <code>insert_right</code>, <code>insert_left</code>, <code>insert_down</code> and <code>delete</code>. There's a few conveniences defined for the Clojure version, and I've implemented some of my own stuff too. Lets go through <a href='https://github.com/inaimathi/cl-zipper/blob/master/src/cl-zipper.lisp'>the main file</a> in <a href='http://inaimathi.ca/archive/by-tag/almost-literate-programming'>almost-literate</a> style.</p><p>First up, we have constructors.</p><pre><code class="lisp">(defstruct path
(left) (path) (right))
(defstruct loc
(node)
(path)
(fn-branch?)
(fn-children)
(fn-make-node))
;;;;;;;;;; Constructors
(defun zipper (branch? children make-node root)
(make-loc
:node root
:fn-branch? branch? :fn-children children :fn-make-node make-node))
(defmethod make-zipper ((thing list))
(zipper #'listp #'identity (lambda (node children) (declare (ignore node)) children) thing))
(defun make-node (zipper children)
(funcall (loc-fn-make-node zipper) zipper children))
</code></pre><p>You can see influence from both <a href='https://github.com/clojure/clojure/blob/master/src/clj/clojure/zip.clj'><code>clojure.zip</code></a> and the paper here. I'm taking the lead from the paper by explicitly separating the <code>path</code> triple our from the <code>loc</code> definition. However, I'm not explicitly defining my own <code>type tree</code> the way that Huet does. Instead, I'm going to be dealing with assorted <code>lisp</code> trees. These could be implemented as <code>list</code>s, <code>vector</code>s, <code>hash</code>es, or any number of other formats. I'm going to implement a few type-distpatching built-ins, including the <code>make-zipper list</code> method above, but the basic <code>zipper</code> function just needs to take an interface as input in the form of <code>branch?</code>, <code>children</code> and <code>make-node</code> arguments. This is the same solution that the Clojure implementation went with, and I see no reason to go a different way. The only material difference is that theirs uses the Clojure <a href='https://clojure.org/reference/metadata'><code>metadata</code></a> system, while I explicitly define slots in the <code>loc</code> structure.</p><p>Now that we can construct, we need to be able to select.</p><pre><code class="lisp">;;;;;;;;;; Selectors
(defun branch? (zipper) (funcall (loc-fn-branch? zipper) (loc-node zipper)))
(defun children (zipper)
(funcall
(loc-fn-children zipper)
(loc-node zipper)))
(defun node (zipper) (loc-node zipper))
(defun path (zipper) (loc-path zipper))
(defun lefts (zipper)
(when (loc-path zipper)
(reverse (path-left (loc-path zipper)))))
(defun rights (zipper)
(when (loc-path zipper)
(path-right (loc-path zipper))))
</code></pre><p>The basic navigation is four functions; <code>down</code>, <code>up</code>, <code>left</code> and <code>right</code></p><pre><code class="lisp">;;;;;;;;;; Navigation
;;;;;;;;;;;;;;; Basic navigation
(defun down (zipper)
(when (children zipper)
(let ((fresh (copy-loc zipper)))
(setf (loc-node fresh) (first (children zipper))
(loc-path fresh)
(make-path
:left nil
:path (loc-path zipper)
:right (rest (children zipper))))
fresh)))
(defun up (zipper)
(when (path zipper)
(let ((fresh (copy-loc zipper)))
(setf (loc-node fresh)
(make-node
zipper (append
(reverse (path-left (path zipper)))
(cons (loc-node zipper)
(path-right (path zipper)))))
(loc-path fresh) (path-path (path zipper)))
fresh)))
(defun left (zipper)
(when (and (path zipper) (path-left (path zipper)))
(let ((fresh (copy-loc zipper)))
(setf (loc-node fresh) (first (path-left (path zipper)))
(loc-path fresh)
(make-path
:left (rest (path-left (path zipper)))
:path (path-path (path zipper))
:right (cons (loc-node zipper) (path-right (path zipper)))))
fresh)))
(defun right (zipper)
(when (and (path zipper) (path-right (path zipper)))
(let ((fresh (copy-loc zipper)))
(setf (loc-node fresh) (first (path-right (path zipper)))
(loc-path fresh)
(make-path
:left (cons (loc-node zipper) (path-left (path zipper)))
:path (path-path (path zipper))
:right (rest (path-right (path zipper)))))
fresh)))
</code></pre><p>The main difference between this and the paper is that I've chosen <code>nil</code> as my <code>Top</code> representation, which lets me pull the trick of using <code>when</code> to check for the presence of a <code>path</code>, and its' non-<code>Top</code>-ness at the same time.</p><p>The bad news is that since Common Lisp doesn't have <a href='file:///home/inaimathi/Downloads/ctries-techreport.pdf'>pervasive functional data structures</a>, I have to explicitly copy <code>loc</code>s while moving through a tree. The good news is that the copy is fairly light weight. Effectively, I'm copying out a set of 5 pointers, and could get that down to 3 by defining an intermediate struct.</p><p>Hm.</p><p>Which I probably should do. Note to self.</p><p>Out of those, we get three compound navigation functions. With more probably coming soon. Specifically, I found <code>find</code> useful for the work I did. It's easily externally definable, but would be even easier to bundle along. The ones I've already implemented are <code>root</code>, <code>leftmost</code> and <code>rightmost</code>.</p><pre><code class="lisp">;;;;;;;;;;;;;;; Compound navigation
(defun root (zipper)
(if-let (z (while zipper #'up))
(node z)))
(defun leftmost (zipper) (while zipper #'left))
(defun rightmost (zipper) (while zipper #'right))
</code></pre>Each of these involve an intermediate call to <code>while</code>. Which isn't a generic <code>macro</code>; it's a function defined in <a href='https://github.com/inaimathi/cl-zipper/blob/master/src/util.lisp'><code>util.lisp</code></a><pre><code class="lisp">...
(defun until (zipper f)
(let ((z zipper))
(loop for next = (funcall f z) while next
when next do (setf z next))
z))
...
</code></pre>As you can see, all it does is repeatedly call a given function on a <code>zipper</code> and return the last non-<code>nil</code> <code>loc</code> result. That's <code>loc</code>, not <code>node</code>, so this <i>doesn't</i> run into the usual Common Lisp conflict of "Did you fail to find a thing, or find the element <code>nil</code>?".<p>That's the traversals done. Next up, we've got modification, without which this library is fairly useless. The basics are <code>replace</code>, <code>delete</code> and the <code>insert</code>/<code>child</code> twins.</p><pre><code class="lisp">;;;;;;;;;; Modification
(defun replace (zipper node)
(let ((fresh (copy-loc zipper)))
(setf (loc-node fresh) node)
fresh))
(defun delete (zipper)
(when (path zipper)
(let ((fresh (copy-loc zipper))
(fresh-path (copy-path (loc-path zipper))))
(cond ((rights zipper)
(setf (loc-node fresh) (pop (path-right fresh-path))
(loc-path fresh) fresh-path))
((lefts zipper)
(setf (loc-node fresh) (pop (path-left fresh-path))
(loc-path fresh) fresh-path))
(t (setf (loc-path fresh) (path-path fresh-path))))
fresh)))
(defun insert-child (zipper node)
(replace
zipper
(make-node
zipper
(cond ((not (branch? zipper))
(list node (node zipper)))
((children zipper)
(cons node (children zipper)))
(t (list node))))))
(defun append-child (zipper node)
(replace
zipper
(make-node
zipper
(cond ((not (branch? zipper))
(list (node zipper) node))
((children zipper)
(append (children zipper) (list node)))
(t (list node))))))
(defun insert-left (zipper node)
(let ((fresh (copy-loc zipper))
(fresh-path (copy-path (loc-path zipper))))
(push node (path-left fresh-path))
(setf (loc-path fresh) fresh-path)
fresh))
(defun insert-right (zipper node)
(let ((fresh (copy-loc zipper))
(fresh-path (copy-path (loc-path zipper))))
(push node (path-right fresh-path))
(setf (loc-path fresh) fresh-path)
fresh))
</code></pre><p>The paper defines an <code>insert_down</code> function. It fails on a Leaf node, and otherwise inserts a singleton branch at the given location. The <code>insert</code>/<code>append</code> child functions above also insert nodes at a lower level at the current <code>loc</code>. They give you a choice about whether to insert the new node as the leftmost or rightmost child, and additionally succeed on Leaf nodes by including the leaf value as a child of the new branch.</p><p>There are, thus far, three compound modification functions; <code>edit</code>, <code>splice-left</code> and <code>splice-right</code>.</p><pre><code class="lisp">(defun edit (zipper f &rest args)
(replace zipper (apply f (node zipper) args)))
(defun splice-left (zipper node-list)
(reduce #'insert-left node-list :initial-value zipper))
(defun splice-right (zipper node-list)
(reduce #'insert-right (reverse node-list) :initial-value zipper))
</code></pre><p><code>edit</code> takes a function instead of a new node, and replaces the node at <code>loc</code> with the result of running that function on the existing node. The <code>splice-*</code> twins are fairly self-explanatory; they're like <code>insert-left</code>/<code>insert-right</code>, but work on multiple nodes rather than single ones.</p><p>I haven't yet implemented <code>next</code>, <code>prev</code> and <code>remove</code> because these <i>might</i> relate to the different representation of the <a href='https://github.com/clojure/clojure/blob/master/src/clj/clojure/zip.clj#L244'>traversal <code>end?</code> state</a>. The reason for this <i>seems</i> to be that <code>next</code>/<code>prev</code>/<code>remove</code> assume a <a href='https://www.cs.usfca.edu/~galles/visualization/DFS.html'>depth-first traversal</a>. The reason I'm being weasely here is that I haven't thought about it hard enough to be sure that the <code>end?</code> marker is really necessary. It also seems odd to privilege depth-first over breadth-first traversals; ideally, I think you'd want to be able to support either. Possibly interchangeably.</p><h2><a name="minor-housekeeping"></a><a href="#minor-housekeeping">Minor Housekeeping</a></h2><p>That wraps it up for this edition. My immediate intention is to do more work on the <code>cl-zipper</code> and <code>clj</code> libraries, as well as that game I mentioned last time. Ideally, I'd like to up my blogging output too. Probably not to the same volume as I had at my peak, but it was definitely helpful to keep some sort of written journal around for a while. The current state of the world is, hopefully, going to make it easy for me to get more programming time in. All things considered, I'd count that as a win. <ol class='footnotes'><li id='fn-1'>Although admittedly, it does require me to explain the concept of <code>zipper</code>s to a few other people for maintenance purposes. So ironically, this <i>adds</i> complexity despite being much more technically elegant than other options.<a href='#fnref1'>↩</a></li><li id='fn-2'>There's a reason that <a href='/static/js/langnostic.js'><code>langnostic.js</code></a> is a raw JS file, rather than compiled from <code>clojurescript</code> source, and that reason is like 90% that the compilation process is nontrivial to set up.<a href='#fnref2'>↩</a></li><li id='fn-3'>"First", not "only". You can probably make educated guesses about which other ones I think you should learn.<a href='#fnref3'>↩</a></li><li id='fn-4'>In which case, why are you here? This blog could kill you accidentally with an errant click or two. You should probably just go do something else.<a href='#fnref4'>↩</a></li></ol></p>Places, Peeps And Plagues2020-04-26T02:44:30.000Zinaimathi<pre><code class="lisp">(in-package #:cl-pestilence)
;; This is _not_ a simulation. It's just a game. And any resemblance
;; to any world, real or imaginary, is entirely coincidental.
;; You can copy/paste this post in its entirety into a Common Lisp
;; REPL and play around with it if you like. I'm documenting it where
;; possible, but it's just a small toy to poke at for the moment.
;; I've been thinking a lot about asymmetric multiplayer games and
;; <gestures wildly to world at large> all this.
;; I'm not actively _trying_ to model it accurately, but it's probably
;; obvious what's been consuming my thoughts lately.
;; Let's get right into this. I'll explain as I go, and tie a few things
;; together neatly at the end. I hope. Regardless, there will absolutely
;; be a repo sometime fairly soon.
;; A place can be tagged arbitrarily, and can contain occupants.
;; They also collect points.
(defclass place ()
((tags :initarg :tags :initform nil :accessor tags)
(occupants :initarg :occupants :initform nil :accessor occupants)
(points :initform 0 :accessor points)))
(defun place? (thing)
(eq (find-class 'place) (class-of thing)))
(defun place (&key tags occupants)
(make-instance 'place :tags tags :occupants occupants))
(defun gen-place ()
(let ((tag (pick '(:apartment-building :house :cottage
:office-building :factory :store
:cafe :lounge :theater))))
(place :tags (list tag))))
(defmethod details ((place place))
(format nil "====================~%~a {~{~a~}}~%~{ ~a~^~%~}~%"
(first (tags place))
(rest (tags place))
(mapcar #'details (occupants place))))
(defmethod show ((place place))
(format nil "~20@a ~5a [~{~a~}]~%"
(first (tags place)) (points place)
(mapcar #'show (occupants place))))
;; A peep goes places.
;; They have
;; - their daily routine (a list of places to visit)
;; - their todo (the part of their routine they still need to do;
;; they are currently at the first place in this list)
;; - their health (a number from 0 to 100)
;; - a list of plagues
;; Finally, they _also_ collect points.
(defclass peep ()
((routine :initarg :routine :initform (list) :accessor routine)
(todo :initarg :todo :initform nil :accessor todo)
(health :initarg :health :initform 100 :accessor health)
(plagues :initform nil :accessor plagues)
(points :initform 0 :accessor points)))
(defun peep? (thing)
(eq (find-class 'peep) (class-of thing)))
(defun peep (&key places)
(make-instance 'peep :routine places :todo places))
(defun health->string (health)
(cond ((>= health 90) "@")
((>= health 80) "0")
((>= health 70) "O")
((>= health 50) "o")
((>= health 30) ":")
((>= health 1) ".")
(t "☠")))
(defmethod details ((peep peep))
(format nil "[~a ~3d [~{ ~a~^ ->~}]]"
(health->string (health peep)) (health peep)
(mapcar
(lambda (place) (first (tags place)))
(routine peep))))
(defmethod show ((peep peep)) (health->string (health peep)))
;; A world is a list of places, occupied by peeps. The world we start
;; peeps in also determines their routine.
(defun gen-world (&key (num-places 20) (num-peeps 100))
(let ((places (loop repeat num-places collect (gen-place))))
(loop repeat num-peeps
do (let* ((routine (loop repeat 5 collect (pick places)))
(peep (peep :places routine)))
(push peep (occupants (first routine)))))
places))
(defmethod details ((world list))
(format nil "~%~{~a~}~%" (mapcar #'details world)))
(defmethod show ((world list))
(format nil "~%~{~a~}~%" (mapcar #'show world)))
(defmethod all-peeps ((world list))
(loop for place in world append (all-peeps place)))
(defmethod all-peeps ((place place))
(loop for o in (occupants place) if (peep? o) collect o))
;; `tick!`ing a world means moving every peep through their routine once.
;; We `tick!` each peep, then `tick!` each place until all the peeps are
;; done. Then we reset their routines.
;; You can think of this as a turn in the game.
(defmethod tick! ((world list))
(let ((peeps (all-peeps world)))
(loop while peeps
do (setf peeps
(loop for p = (pop peeps) while p
for res = (tick! p)
if res collect res))
do (mapc #'tick! world)
do (format t "~a" (show world)))
(loop for p in (all-peeps world)
do (setf (todo p) (routine p))))
world)
;; Don't worry about the details of how to `tick!` peeps or places yet.
;; Ok, here's where it gets a bit darker. Although we _did_
;; foreshadow this in the definition of `peep`. And also in the title
;; of the accompanying blog post.
;; A plague is another living thing.
;; It has
;; - a host (a peep that it's infecting)
;; - a signature (a token representing its lineage and strain)
;; - health (how well it's doing inside its host)
;; - virulence (how likely it is to spread to another host)
;; - efficiency (how efficient they are at feeding)
;; - reproduce (a function that returns a new instance to push into a new host)
;; - and a strategy (a function, possibly closed, that takes
;; itself and its host peep and mutates)
;; Plagues do not collect points; they score differently.
(defclass plague ()
((host :initarg :host :initform nil :accessor host)
(signature :initarg :host :initform "SIG" :accessor signature)
(health :initarg :health :initform 10 :accessor health)
(virulence :initarg :virulence :initform 10 :accessor virulence)
(efficiency :initarg :efficiency :initform 0.2 :accessor efficiency)
(reproduce
:initarg :reproduce
:initform
#'plague
:reader reproduce)
(strategy
:initarg :strategy
:initform
(lambda (plague peep)
(feed! plague peep 30))
:reader strategy)))
(defun plague ()
(make-instance 'plague))
;; Plagues can `feed!` on peeps or plagues. To feed means to
;; take away some of the targets' health and add some to your own.
(defmethod feed! ((self plague) (peep peep) (amount integer))
(decf (health peep) amount)
(incf (health self) (* (efficiency self) amount)))
(defmethod feed! ((self plague) (plague plague) (amount integer))
(decf (health plague) amount)
(incf (health self) (* (efficiency self) amount)))
;; Plagues can also `infect!` peeps by `reproduce`ing into them.
(defmethod infect! ((self plague) (peep peep))
(unless (infected-by? self peep)
(let ((child (funcall (reproduce self))))
(setf (host child) peep)
(push child (plagues peep)))))
(defmethod infected-by? ((self plague) (peep peep))
(member (signature self) (mapcar #'signature (plagues peep))
:test #'string=))
;; `tick!`ing a plague causes it to weaken and also carry out its strategy.
;; This models the background effect of the immune system of its host.
(defmethod tick! ((plague plague))
(decf (health plague) 1)
(funcall (strategy plague) plague (host plague))
plague)
;; `tick!`ing a peep means moving them to their next place, and also
;; `tick!`ing any plagues they may have contracted. Also, peeps are
;; resilient; they heal a small amount each time they tick (to a
;; maximum of 100).
;; If a peep dies, they no longer move. And their plagues probably
;; won't do well. Peeps like to go places. They score points for each
;; place they go to.
(defun dead? (thing) (>= 0 (health thing)))
(defmethod tick! ((peep peep))
(unless (dead? peep)
(let ((location (pop (todo peep))))
(incf (points peep))
(setf (occupants location) (remove peep (occupants location)))
(push peep (occupants (or (first (todo peep)) (first (routine peep)))))
(setf (health peep) (min 100 (+ 5 (health peep))))
(mapc #'tick! (plagues peep))
(unless (empty? (todo peep))
peep))))
;; `tick!`ing a place causes it to score for each `peep` present. And it causes
;; any `plague`s on present `peep`s to try to `infect!` other nearby peeps.
;; Places also lose points for each dead peep they contain.
(defmethod tick! ((place place))
(incf (points place) (length (occupants place)))
(loop for peep in (all-peeps place)
if (dead? peep)
do (decf (points place) 2)
else do (loop for plague in (plagues peep)
do (loop for victim in (remove peep (all-peeps place))
if (>= (virulence plague) (random 100))
do (infect! plague victim))))
place)
;; So, now we've got the basic framework of the game in place. There are three
;; players in this game: places, peeps and plagues.
;; A plague player automatically loses if they are completely cured, and
;; automatically wins if they manage to kill everyone. That's fairly simple.
;; A place player wins if they manage to cure the plague. They automatically
;; lose if all the peeps die. Also, fairly simple.
;; A peep player is trying to survive. If they manage to make it some numer
;; of turns before dying, then we have to score the game instead of declaring
;; an outright winner regardless of game state.
;; A peep player's score is the total number of points plus remaining health
;; on all of their peeps, minus the number of active plagues on said peeps.
;; A plague player's score is the total number of health of their plagues,
;; with a multiplier equal to the number of places fully infected by
;; their plague.
;; A place player's score is the total number of points in their places.
(defun score (world)
(list :peep (let ((score 0))
(loop for p in (all-peeps world)
unless (dead? p)
do (incf score (+ (health p) (points p)))
do (decf score (length (plagues p))))
score)
:place (let ((score 0))
(loop for p in world
do (incf score (points p)))
score)
:plague (let ((score 0))
(loop for victim in (all-peeps world)
do (loop for p in (plaguesvictim)
do (incf score (max 0 (health p)))))
(loop for target in world
if (every
(lambda (victim)
(not (empty? (plagues victim))))
(all-peeps target))
do (setf score (* 2 score)))
score)))
;; I think that's all I've got for now. This is definitely an idea I want
;; to run with. At the moment, it's just a tiny, in-repl proof-of-concept,
;; and not particularly fun, but I'm going to try developing it further with an
;; eye towards turning it into an actual web game playable from this site.
;; As always, I'll let you know how it goes.
(defun pick (lst)
(nth (random (length lst)) lst))
(defun empty? (lst)
(null lst))
</code></pre>Error Handling In Context Managers2019-08-28T22:18:57.000Zinaimathi<p>In various Lisps, there's a semi-common pattern of context wrapping with error handling. You have a situation in which you want to do something, and in the process bind some external resource, then free the resource afterwards.</p><pre><code>(let* ((resource (open-resource foo))
(result (progn
(bar)
(baz)
(mumble))))
(close-resource resource)
(delete-resource-from-disk resource)
result)
</code></pre><p>You can write a relatively simple wrapper macro for this situation.</p><pre><code>(defmacro with-resource ((name target) &body body)
(let ((result (gensym)))
`(let* ((,name (open-resource ,target))
(,result (progn ,@body)))
(close-resource resource)
(delete-resource-from-disk resource)
,result)))
</code></pre><p>With that definition, you can instead write.</p><pre><code>(with-resource (resource foo)
(bar)
(mumble (baz resource)))
</code></pre><p>Ok, but what if the code you've written throws an error somehow?</p><pre><code>(with-resource (resource foo)
(bar)
(error "Arbitrary Explosion")
(mumble (baz resource)))
</code></pre><p>Your routine doesn't complete, but also, the claimed resource never gets freed afterwards. You could fix this by just always wrapping the stuff you wrap with <code>with-resource</code> in some error-trapping. <code>ignore-errors</code>/<code>handler-case</code>/<code>handler-bind</code> depending on the specific situation.</p><pre><code>(with-resource (resource foo)
(ignore-errors
(bar)
(error "Arbitrary Explosion")
(mumble (baz resource))))
</code></pre><p>However, it'd still be nice to be more responsible as a macro developer and do the right thing with the bound resource without depending on your user doing the right thing. The solution is <a href='http://clhs.lisp.se/Body/s_unwind.htm'><code>unwind-protect</code></a> <a href='#fn-1' id='fnref1'><sup>1</sup></a>.</p><pre><code>(defmacro with-resource ((name target) &body body)
(let ((result (gensym)))
`(let* ((,name (open-resource ,target)))
(unwind-protect
(let ((,result (ignore-errors (progn ,@body))))
(resolve-resource resource)
,result)
(close-resource resource)
(delete-resource-from-disk resource)))))
</code></pre><p>When you're deaing with deploying micro-services, it sometimes gets a bit trickier. You generally want some central log/diagnostic server to be notified of the error condition. That's not a situation where you want something to happen regardless of error presence; it's a situation where you want something <i>different</i> to happen on error. For a concrete example, imagine needing to do something locally that involves downloading, poking, and then deletin a file from a URL. <code>unwind-protect</code> could still help, but it'd be only part of the story.</p><pre><code>(defmacro with-pdf-from-uri ((path uri) &body body)
(let ((result (gensym)))
`(handler-case
(let ((,result (http-request uri))
(,path (with-output-to-temporary-file (s) (write (http-body ,result) :stream s))))
(unwind-protect
(progn ,@body)
(delete-file))
(write-to-disk))
(http-error (e)
(remote-log "Failed to download PDF")
(error e))
(cannot-create-temporary-file (e)
(remote-log "Failed to create tempfile")
(error e))
(error (e)
(remote-log "An ancient evil stirs. Your lights flicker. In the distance, sirens." e)
(error e)))))
</code></pre><p>Off the top of my head, I'd write something like this, though there's possibly better ways of abstracting the situation.</p><h2><a name="and-now-for-something-completely-different"></a><a href="#and-now-for-something-completely-different">And Now, For Something Completely Different</a></h2><p>You can do something similar in Python too. For example</p><pre><code>@contextmanager
def logged(tag):
print(f"Starting a procedure <{tag}>...")
yield
print(f"Finished the procedure <{tag}>...")
</code></pre><pre><code>>>> with logged("MY TEST"):
... print("blah")
...
Starting a procedure <MY TEST>...
blah
Finished the procedure <MY TEST>...
>>>
</code></pre><p>And now, the point of this entire post, <i>yes</i>, you <i>can</i> wrap that <code>yield</code> in a <code>try</code>/<code>catch</code> and have it do what you're expecting.</p><pre><code>@contextmanager
def logged(tag):
print(f"Starting a procedure <{tag}>...")
try:
yield
print("IT WORKED!")
except:
print("OH NO! ETERNAL DARKNESS AWAITS YOU!")
print(f"Finished the procedure <{tag}>...")
</code></pre><p>Now you can do</p><pre><code>>>> with logged("MY TEST"):
... print("blah")
...
Starting a procedure <MY TEST>...
blah
IT WORKED!
Finished the procedure <MY TEST>...
>>> with logged("MY TEST"):
... raise("EXPLOSIONS")
...
Starting a procedure <MY TEST>...
OH NO! ETERNAL DARKNESS AWAITS YOU!
Finished the procedure <MY TEST>...
>>>
</code></pre><p>Hopefully, you found that reassuring. <ol class='footnotes'><li id='fn-1'>Incidentally, thank you to the readers who pointed this out. I left out what turned out to be a key piece of context from the real situation I was dealing with for the sake of expedience (this situation came up in a Python context in real life). I've added the relevant explanation; hopefully that clarifies everything (and I'm not being denser than I thought I was being).<a href='#fnref1'>↩</a></li></ol></p>Lisp Game Jam 20182018-05-14T04:04:34.000Zinaimathi<p>Holy fuck, I guess I'm doing this.</p><p><a href='https://inaimathi.itch.io/clobble'>This</a> is a client-side implementation of Boggle implemented entirely using <a href='https://github.com/Inaimathi/cl-notebook'><code>cl-notebook</code></a>. It's called <code>Clobble</code>, becasue honestly, why wouldn't it be? I used the official die distribution cribbed from <a href='https://boardgames.stackexchange.com/questions/29264/boggle-what-is-the-dice-configuration-for-boggle-in-various-languages'>this SE question</a> and the challenge-mode scoring rules from <a href='https://www.wikihow.com/Play-Boggle#/Image:Play-Boggle-Step-22.jpg'>this WikiHow post</a><a href='#fn-1' id='fnref1'><sup>1</sup></a>. </p><p>Also, I used a static dictionary from <a href='https://github.com/insightcoder/boggle-dictionary'>this project</a>, released under an MIT license.</p><p>Why Boggle? Er... Clobble? Because it's dead simple, so I could focus on getting something minimal together quickly and leave plenty of time for polishing up issues that come up in <a href='https://github.com/Inaimathi/cl-notebook'><code>cl-notebook</code></a> itself. In all honesty, I was hoping to get much further than I did. I had plans for alternate game modes, leaderboards and a player-specific progression system, in addition to better visuals, but all that got kicked in the head when I realized how little time I'd <i>actually</i> have this week. So what I ended up putting together was the dumbest thing that would work. There's two modes; single-level and zen (which just gives you infinite levels until you give up and hit the <code>Quit</code> button).</p><p>The challenges were many, and the <a href='https://github.com/inaimathi/cl-notebook/issues'><code>cl-notebook</code> issues list</a> has already grown somewhat as a result of this experience. So let me do a post-mortem brain dump.</p><h2><a name="-code-cl-notebook-code-needs-to-deal-with-external-files"></a><a href="#-code-cl-notebook-code-needs-to-deal-with-external-files"><code>cl-notebook</code> needs to deal with external files</a></h2><p>So the dictionary itself is contained in a ~6MB external <code>js</code> file downloadable from the <a href='https://inaimathi.itch.io/clobble'>itch page</a> that declares a global variable with the appropriate <code>object</code><a href='#fn-2' id='fnref2'><sup>2</sup></a>. I ended up hacking around this limitation, as described later in this article, but it tells me that <code>cl-notebook</code> should <i>probably</i> deal with static file bundles somehow.</p><p>Exactly <i>how</i> opens up a bunch of worm cans. Or rather, at least one, my choice.</p><p>Simply adding a cell-type to pull in local dependencies gives project exporters something to work with. It means that you can reasonably something like an <code>HTML</code>, or specific <code>itch.io</code> exporter, to slurp up local files and do something sensible with them for deployment purposes. The downside of this approach is that notebook files are suddenly not self-contained. If you want to send a notebook file to someone else, you now need to make sure to also send the local static files and expect the target user to unpack them properly<a href='#fn-3' id='fnref3'><sup>3</sup></a>.</p><p>Slurping local files in and effectively "storing" them as cell results lets exporters work, <i>and</i> keeps notebooks self-contained, but is kind of a disk hog. In particular, pulling this trick with a <code>6MB</code> dictionary file would mean that said dictionary would be copied in book history how many ever times the appropriate cell was re-evaluated. This seems like something we might be able to get around by making the evaluation step of a book more intelligent about repeated values, but I'm not sure how effective that would ultimately be at the end of the day. There's also the possibility of slurping in files that mess with a book files' appropriate encoding, and which might therefore get us into trouble when we go to read the damn thing off disk later.</p><p>Finally, defining functions that do the appropriate thing in context without messing with the <code>book</code> format or <code>exporter</code> code directly is marginally plausible, but seems <i>extra</i> hacky. In the <code>Clobble</code> situation, I'd have to define a <code>parenscript</code> function like <code>inline-script</code> or something that slurped a local file, and dumped it into the evaluation result. This would have the same problem as slurping files directly at the cell level, but doesn't define additional cell-level machinery. There's the additional downside that users need to be taught about this specifically, rather than being able to discover the functionality by exploring the <code>cl-notebook</code> UI.</p><p>I'm not yet sold on the concept, but it'd be nice to have some sort of solution, given what I'm expecting to do with this project.</p><h2><a name="itch-io-has-some-odd-behavior-for-external-files-in-web-games"></a><a href="#itch-io-has-some-odd-behavior-for-external-files-in-web-games">itch.io has some odd behavior for external files in web games</a></h2><p>Feeding the external file debate in my head is the fact that external files aren't exactly reliable on <code>itch</code>.</p><p>This might have been a problem with the loading process of the external dictionary file, or it might have been an uploading error, or it might be a bug on the server end. Whatever the case is, the initial upload of the <code>words.js</code> file ended up being shown on my front-end as an HTTP <code>400</code> error. Since I wanted to actually get this thing running for the contest, I ended up just <code>cat</code>ting the dictionary into the appropriate place in my games' <code>index.html</code> file after exporting and calling it a day. The real solution is probably to externalize it. Or, possibly, write a <code>words</code> API endpoint that I keep elsewhere so that the initial page load doesn't have to involve a <code>6MB</code> download<a href='#fn-4' id='fnref4'><sup>4</sup></a>.</p><h2><a name="the-code-qu-code-die-face-introduces-a-bunch-of-special-cases"></a><a href="#the-code-qu-code-die-face-introduces-a-bunch-of-special-cases">The <code>Qu</code> die face introduces a bunch of special cases</a></h2><p>As far as crafting the actual game itself goes, the main non-dictionary-related challenge I ran into was the stupid <code>Qu</code> challenge-mode die face. Having a particular face with multiple letters required a bunch of its own special-case in the games' global <code>keydown</code> event and some display logic. Firstly, it's not really good enough to allow typing <code>Q</code> to highlight <code>Qu</code>, because that behavior gets weird if you <i>also</i> have a <code>U</code> present in the same game. What you really want is for <code>Q</code> to put the game into a different state that expects to consume an additional <code>U</code> keypress in order to highlight <code>Qu</code>. Which means that we want the additional <code>semi-selected</code> state for letter faces. This consequently means that a <code>U</code> keypress needs to trip a check for a <code>semi-selected</code> <code>Qu</code> square and do something different if one is found. The <code>clear</code> and <code>claim</code> actions also each have to consider <code>semi-selected</code> squares in addition to <code>selected</code> ones, and appropriately reset them to the ground state.</p><p>I <i>didn't</i> end up fully generalizing this code, so it only deals with <code>Qu</code> squares, and not multi-letter squares, but I called it Good Enough For Now.</p><h2><a name="intervals-and-timeouts"></a><a href="#intervals-and-timeouts">Intervals and Timeouts</a></h2><p>A common thing you want to do in stupid HTML games is <a href='https://www.w3schools.com/js/js_timing.asp'>set <code>timeout</code>s and <code>interval</code>s</a>. The trouble is that this runs up against <code>cl-notebook</code>s display model. Javascript default delay behavior isn't to override existing delays, but to merely declare new ones. Which means that doing iterative development on a cell that calls <code>setInterval</code> directly runs into some odd edge cases. To fight this, I added a few new functions to <a href='https://github.com/inaimathi/cl-notebook/blob/master/src/ui/http-front-end/base.lisp'><code>base.lisp</code></a>. Specifically, we've got <code>interval!</code>, <code>timeout!</code>, <code>clear-delay!</code> and <code>clear-all-delays!</code>, all of which deal with <i>named</i> delays that automatically destroy previous versions of themselves rather than naively defining separate intervals/timeouts. This is one little corner that I managed to sand out fairly satisfactorily.</p><h2><a name="-code-dom-ready-code-"></a><a href="#-code-dom-ready-code-"><code>dom-ready</code></a></h2><p>There's a convenience function in <a href='https://github.com/inaimathi/cl-notebook/blob/master/src/ui/http-front-end/base.lisp'><code>base.lisp</code></a> named <code>dom-ready</code>, which does something when the HTML DOM is loaded. This lets you set up a mechanism to run one-off initialization hooks for your web thing that behave correctly in the exported HTML.</p><p>However.</p><p>This has the unsatisfactory behavior that opening the relevant book in <code>cl-notebook</code> for the first time gives you some odd errors. In particular, if you've got a <code>dom-ready</code> call set up that targets a game screen defined in one of your notebooks' cells, which seems like a reasonable thing to do, you'll get <code>element-not-found</code> errors when loading the notebook. This is because <code>dom-ready</code> works with the browsers' default <code>DOMContentLoaded</code> event.</p><p>The way I ended up solving this tension was to define a <code>book-ready</code> function that lets you set hooks that run after the <code>notebook</code> is fully loaded, rather than merely at DOM loaded time. I'm not <i>entirely</i> sure this was the right decision. The only reasonable alternative I can think of is to have <code>dom-ready</code> have the behavior of tripping hooks at <code>notebook</code>-ready time by default, and leave out the additional construct. I'm not sure if there's a situation where I might legitimately want to differentiate between the two, so I'm leaving it in for now, but I might mildly regret this later.</p><h2><a name="ui-inconveniences"></a><a href="#ui-inconveniences">UI Inconveniences</a></h2><p>The biggest remaining annoyance in using <code>cl-notebook</code> for game development remains the detail of UI definition. Specifically, at the moment, the UI cell is treated as a regular cell, which is problematic for two reasons:</p><ol><li>If you're working with another cell that affects your display somehow, you suddenly need to scroll between the target cell and the display cell fairly frequently during the development process</li><li>If your display cell does things with <code>position: absolute</code> or similar, you might get into the sitation that adjacent cells occlude part of your display</li></ol><p>In order to mitigate #2, we could just say that the <code>focused</code> cell has a much higher <code>z-order</code> than <code>unfocused</code> cells. Woo. That doesn't really solve #1 though. What I've got in mind that might kill both issues with the same stone is adding a different kind of cell. Specifically, maybe it should be possible for the user to designate a cell as "floating". It would be off to the side with a <code>position: fixed</code> behavior so that you'd never need to scroll back up to it, and it could act as a canvas for presentation displays. This would make it easier to use <code>cl-notebook</code> for giving demos, <i>and</i> it would deal with both of the above pain points.</p><h2><a name="-code-itch-io-code-exporter"></a><a href="#-code-itch-io-code-exporter"><code>itch.io</code> exporter</a></h2><p>I don't have it quite finished yet, because I'm still thinking about the structure <code>exporter</code>s should take in general, but the start of it is</p><pre><code class="common-lisp">;;;;;;;;;; itch.io exporter
(defmethod filename-of ((format (eql :itch.io)) book)
"index.html")
(defmethod mimetype-of ((format (eql :itch.io))) "text/html")
(defmethod export-as ((format (eql :itch.io)) (book notebook))
(with-html-output-to-string (s nil :prologue t :indent t)
(:html
(:head
(:title (str (notebook-name book)))
(:script :type "text/javascript" (str *base-js*)))
(:body
(:ul :class "cells"
(str (format nil "~{~a~}" (export-cells format book))))))))
(defmethod export-cell ((format (eql :itch.io)) cell-language (cell-type (eql :markup)) cell)
(html-to-str
(-cell-comment cell)
(str (-html-value cell))))
(defmethod export-cell ((format (eql :itch.io)) cell-language (cell-type (eql :parenscript)) cell)
(html-to-str
(-cell-comment cell)
(:script :type "text/javascript" (str (-html-value cell)))))
</code></pre><p>And that's exactly what I used to generate the index file you can see played at <a href='https://inaimathi.itch.io/clobble'>the <code>itch</code> page</a></p><h2><a name="next-steps-for-code-clobble-code-"></a><a href="#next-steps-for-code-clobble-code-">Next Steps for <code>Clobble</code></a></h2><p>As next steps, I kinda want to polish, and add the features I wanted there to begin with. Both in the sense of polishing <code>cl-notebook</code> into a better web-game development tool, and in the sense of polishing <code>Clobble</code> into a game that I wouldn't be ashamed to charge for. The game features I'm interested in adding are mainly different play languages, a scripting mode, and possibly some kind of level/progression system.</p><p>I have no idea how long this is going to take, given what my schedule looks like these days, but as always, I'll keep you posted. <ol class='footnotes'><li id='fn-1'>That <code>Qu</code> block was a bitch to implement, by the way. I haven't generalized it completely, but it alone accounted for an extra half-hour or so of coding.<a href='#fnref1'>↩</a></li><li id='fn-2'>I could have cut that down to ~1MB by dropping the definitions and just keeping a word list, since the current implementatoin only really checks for the <i>presence</i> of a word in the dictionary, but I had some plans that might have involved definitions.<a href='#fnref2'>↩</a></li><li id='fn-3'>Alternately, we could define a general serialized form for book files, then define importers. This would let you send a notebook file by exporting it to said serialized form, and let some consumer use it by importing it appropriately. I'm not entirely sure how I feel about this.<a href='#fnref3'>↩</a></li><li id='fn-4'>To be fair, this opens the debate about whether requiring internet connectivity to play the game is fair. If I made <code>word?</code> an API call instead of a local dictionary comparison, you couldn't just load this game into a browser on whatever device and then go play it offline. How common that use-case would be is not <i>entirely</i> clear to me, but it also seems like the sort of thing I shouldn't arbitrarily disallow if it can be avoided.<a href='#fnref4'>↩</a></li></ol></p>cl-notebook Notes2018-03-30T03:37:27.000Zinaimathi<p>So the previous article I posted got picked up by the Common Lisp community quicker than I'd thought. My plan was to finesse a few things about <a href='https://github.com/inaimathi/cl-notebook'>cl-notebook</a> over the next few weeks, <i>then</i> start promoting. Preferably by doing a talk or two using it as the presentation/live-hacking substrate. But given that the eye of other developers is now on me, it's go time.</p><p>There's a few things I've already learned since restarting development on this project, and some of it bears sharing.</p><h2><a name="common-lisp-has-a-code-bundler-code-analogue"></a><a href="#common-lisp-has-a-code-bundler-code-analogue">Common Lisp has a <code>bundler</code> analogue</a></h2><p>I've been using <a href='https://www.quicklisp.org/beta/'><code>quicklisp</code></a> basically since <code>quicklisp</code> has been a thing, because the alternative is installing mosnsters like <a href='https://edicl.github.io/hunchentoot/'><code>hunchentoot</code></a> by hand, and I <i>never</i> had <i>that</i> kind of time. Even when I was a relatively carefree university student. The one downside I've seen here in Common Lisp land compared to languages like <a href='http://bundler.io/'>Ruby</a> or <a href='http://www.pythonforbeginners.com/basics/how-to-use-python-virtualenv'>Python</a> is a locally-versioned project tree. I mean, ideally <a href='https://nixos.org/nix/'><code>nix</code></a> or <a href='https://www.gnu.org/software/guix/'><code>something like it</code></a> would get off the ground consistently and become the general standard package management <i>thing</i><a href='#fn-1' id='fnref1'><sup>1</sup></a> for every language and OS alike, and then we wouldn't have to worry about this at the individual language level. But in the absence of that, it would still be really nice to not worry about what happens when different projects I'm working on demand different versions of the same prerequisite.</p><p><a href='https://github.com/fukamachi/qlot'><code>qlot</code></a> is basically that, for Common Lisp. It lets you manage local <code>quicklisp</code> client repositories in a way that lets certain projects be effectively isolated, in dependency terms, from the rest of your running system. I'm seriously thinking about using this heavily in <code>cl-notebook</code><a href='#fn-2' id='fnref2'><sup>2</sup></a>, both to isolate the main notebook <code>quicklisp</code> stack from whatever base one might already exist on the substrate machine, and later to make sure that each notebook is similarly isolated.</p><h2><a name="columns-are-now-an-actual-thing-in-css"></a><a href="#columns-are-now-an-actual-thing-in-css">Columns are now an actual thing in CSS</a></h2><p><a href='https://css-tricks.com/guide-responsive-friendly-css-columns/'>This</a> surprised the ever-loving shit out of me. I grew up as a web developer back in the bad ol' days of IE6-8, when Firefox was just getting back in the game, and Google Chrome was still probably someones' 10% project. So I'm used to having to cobble together any meaningful layout myself from <code>div</code>s, <code>float</code> declarations, shoelaces and duct tape. Between <code>bootstrap</code> and new <code>CSS3</code> features like that adaptive columns thing, it looks like front-end developers are now living in a world of comparative opulence<a href='#fn-3' id='fnref3'><sup>3</sup></a>. It's almost enough for me to consider picking it up again exclusively for another few contracts.</p><p>Almost.</p><h2><a name="notebook-itself"></a><a href="#notebook-itself">Notebook itself</a></h2><p>The <a href='https://github.com/inaimathi/cl-notebook'><code>cl-notebook</code></a> project is going pretty well. It's at the arduous beginning stage where I've still got to get used to using it consistently. I'm ashamed to say that this blog post is <i>not</i> being written in it. But I am trying to train myself to use it for most of my development tasks. The hardest part is sitting down and actually thinking through a worthwhile modification when I stub myself on the odd corner.</p><p>One of the things I wanted to do for a recent presentation is to get definition hooks for front end components. Because <code>notebook</code>s are Lisp code, and <a href='https://github.com/inaimathi/cl-notebook'><code>cl-notebook</code></a> is a Lisp application, you can already define additional back-end things. In particular, the bare-bones charting system is currently fully implemented in a <code>notebook</code>, and not the main codebase. This is a trend I aim to continue; provide piecemeal functionality in the form of additional config notebooks that can be loaded individually for specific purposes.</p><p>The current implementation of these front-end hooks is a new <code>cell-type</code>; <code>parenscript</code> whose result gets compiled down to JS by a call to the <code>parenscript</code> library, then evaluated as client-side JS by the front-end. This mildly complicates things with front-end state, but I think the flexibility is well worth the cost, since it effectively lets me use <code>cl-notebook</code> as a platform for <a href='https://itch.io/'>HTML-game development</a>. Speaking of, the <a href='https://itch.io/jam/lisp-game-jam-2018'>Lisp Game Jam</a> is going on later in April, and you know damn well what I'm going to do about it at this point.</p><p>As soon as I work through some of the <a href='https://github.com/inaimathi/cl-notebook/issues?q=is%3Aissue+is%3Aopen'><code>cl-notebook</code> issues</a>...</p><p>Sigh. No rest for the wicked. <ol class='footnotes'><li id='fn-1'>And if I'm being honest, I'm really tempted to write a language or <a href='https://github.com/inaimathi/experimentalisp#experimentalisp'>variant</a> that hooks into the <code>nix</code> infrastructure for testing and package distribution, just to see whether it could be done in a quasi-sane way.<a href='#fnref1'>↩</a></li><li id='fn-2'>I'm, in fact, <a href='https://github.com/inaimathi/cl-notebook/commit/c133cbce2e5a6332d243d0d3fefd9436a3a050c5'>already using this</a> in <code>cl-notebook</code>. The per-notebook environment is still pending some thought though.<a href='#fnref2'>↩</a></li><li id='fn-3'>Which mildly surprises me, because outside of <a href='https://github.com/clojure-android/lein-droid/wiki/Tutorial'><code>lein-droid</code></a>, modern <i>mobile</i> development is a shit-stained mire of ass and fail. From what I've seen so far, it's directly worse in every fucking way than deskop development, and is far more hack-intensive than the worst of front-end development history I've personally witnessed. But I digress.<a href='#fnref3'>↩</a></li></ol></p>The Return Of cl-notebook2018-03-08T19:10:14.000Zinaimathi<p>I haven't <i>just</i> been directing my personal hacking/thinking time at massively distributed cellular automata. Remember when I said I was planning to put a bunch more work into <a href='https://github.com/inaimathi/cl-notebook'><code>cl-notebook</code></a><a href='#fn-1' id='fnref1'><sup>1</sup></a> when I had time? Well, guess what motherfuckers; we're doing this live.</p><p>I recently served on a contract for which my team had to use <a href='http://jupyter.org/'>Jupyter Notebook</a>, and I was pretty severely underwhelmed. I mean, the front-end has a level of polish you'd rightly never expect from a <a href='https://github.com/inaimathi/cl-notebook'>one-dev affair</a>, and it has better cross-platform support than what I'm pulling off at the moment. But in terms of the big problems that I was tackling in the Common Lisp analog, I'm quite surprised to be ahead of the curve, even after having taken four years "off" development.</p><p>The things I was starting to think about were large problems like self-hosting, the implications of multi-user editing and how to best accomodate it, intelligent full-notebook loading and use on mobile devices. Not to mention the full-history system that I'd already built most of.</p><p>As far as I can tell, Jupyter has punted on all of the above.</p><p>So as much as I'd like to, I can't declare the situation Good Enough that I can in good conscience stop working on <code>cl-notebook</code>, even if the underlying languages were equivalent. Given that situation, I've been looking at the codebase and thinking about how I'd go about getting it from where it is now to being a worthy competitor to Jupyter in terms of ease-of-use. Or at the very least, to a state where I can easily start accepting pushes from other contributors.</p><p>And having pushed <a href='https://github.com/inaimathi/cl-notebook/commit/be496750577ad37b80e9de15b5d44fc6868f0359'>a commit</a> to include general-location notebook opening, I think I've satisfied the second requirement.</p><p>There's a bunch of additional stuff noted in the <a href='https://github.com/inaimathi/cl-notebook#todo-also-this-section-should-eventually-be-moved-to-the-github-issue-tracker'>READMEs TODO section</a>, but the things that need to be settled before other people can credibly hack on this system have more or less been settled. I'd like to work out a system by which we can let notebooks materially change the client side of the system both through JavaScript and CSS additions, and I'm still debating whether we'd be better or worse off with a <a href='https://www.gnu.org/software/emacs/manual/html_node/emacs/Minibuffer.html'><code>minibuffer</code></a> added to the system, but those are relatively minor points that can be dealt with in a fairly self-contained way.</p><p>The next step for me is to start using it, and encourage other people to start contributing to the project.</p><h2><a name="side-note-on-a-href-https-github-com-inaimathi-house-code-house-code-a-"></a><a href="#side-note-on-a-href-https-github-com-inaimathi-house-code-house-code-a-">Side-note on <a href='https://github.com/inaimathi/house'><code>:house</code></a></a></h2><p><a href='https://github.com/inaimathi/house'><code>:house</code></a> fucking sucks. It performs poorly, coming in somewhere between <code>hunchentoot</code> and <code>tornado</code> on the <a href='https://github.com/fukamachi/woo#how-fast'><code>woo</code> benchmark graph</a>, it doesn't deal with <code>https</code>, it doesn't easily support <a href='https://developer.mozilla.org/en-US/docs/Web/API/WebSockets_API'><code>websocket</code>s</a> and it's dumb in dealing with underlying system resources such as threads and static files.</p><p>And yet...</p><pre><code>CL-USER> (ql:quickload :house)
To load "house":
Load 1 ASDF system:
house
; Loading "house"
(:HOUSE)
CL-USER>
</code></pre><p>... I can guarantee that'll be the effect of <code>quickload</code>ing <code>house</code> on any system where you can install <code>sbcl</code>, <code>clisp</code>, <code>lispworks</code>, <code>cmucl</code> or <code>ccl</code>. Regardless of what package manager you use, or what architecture you're on, or whether you're running a massive, 12-processor piece of heavy iron or a <a href='https://www.raspberrypi.org/'>RasPi</a>, or something even more resource constrained.</p><p>After you <code>clone</code> <code>git@github.com:inaimathi/house.git</code> into your <code>local-projects</code> directory, it will load, and it will fucking work without issue. Granted, the competition is superior along every other axis, but...</p><pre><code>CL-USER> (ql:quickload :woo)
To load "cffi-grovel":
Load 1 ASDF system:
cffi-grovel
; Loading "cffi-grovel"
.
To load "woo":
Load 1 ASDF system:
woo
; Loading "woo"
To load "clack-socket":
Install 1 Quicklisp release:
clack
; Fetching #<URL "http://beta.quicklisp.org/archive/clack/2017-06-30/clack-20170630-git.tgz">
; 188.65KB
==================================================
193,178 bytes in 1.00 seconds (188.84KB/sec)
; Loading "clack-socket"
[package clack.socket]
; Loading "woo"
To load "swap-bytes":
Load 1 ASDF system:
trivial-features
Install 1 Quicklisp release:
swap-bytes
; Fetching #<URL "http://beta.quicklisp.org/archive/swap-bytes/2016-09-29/swap-bytes-v1.1.tgz">
; 4.12KB
==================================================
4,223 bytes in 0.00 seconds (0.00KB/sec)
; Loading "swap-bytes"
[package swap-bytes].
; Loading "woo"
To load "trivial-utf-8":
Install 1 Quicklisp release:
trivial-utf-8
; Fetching #<URL "http://beta.quicklisp.org/archive/trivial-utf-8/2011-10-01/trivial-utf-8-20111001-darcs.tgz">
; 5.91KB
==================================================
6,055 bytes in 0.00 seconds (0.00KB/sec)
; Loading "trivial-utf-8"
[package trivial-utf-8].
; Loading "woo"
;
; compilation unit aborted
; caught 2 fatal ERROR conditions
; Evaluation aborted on #<CFFI:LOAD-FOREIGN-LIBRARY-ERROR "Unable to load any of the alternatives:~% ~S" {1002492F33}>.
Unable to load any of the alternatives:
("libev.4.dylib" "libev.4.so" "libev.so.4" "libev.dylib"
"libev.so")
[Condition of type CFFI:LOAD-FOREIGN-LIBRARY-ERROR]
Restarts:
0: [RETRY] Try loading the foreign library again.
1: [USE-VALUE] Use another library instead.
2: [TRY-RECOMPILING] Recompile lev and try loading it again
3: [RETRY] Retry loading FASL for #<CL-SOURCE-FILE "lev" "src" "lev">.
4: [ACCEPT] Continue, treating loading FASL for #<CL-SOURCE-FILE "lev" "src" "lev"> as having been successful.
5: [RETRY] Retry ASDF operation.
--more--
Backtrace:
0: (CFFI::FL-ERROR "Unable to load any of the alternatives:~% ~S" ("libev.4.dylib" "libev.4.so" "libev.so.4" "libev.dylib" "libev.so"))
1: (CFFI::TRY-FOREIGN-LIBRARY-ALTERNATIVES LEV::LIBEV ("libev.4.dylib" "libev.4.so" "libev.so.4" "libev.dylib" "libev.so") NIL)
2: ((FLET CFFI::%DO-LOAD :IN CFFI::%DO-LOAD-FOREIGN-LIBRARY) #<CFFI:FOREIGN-LIBRARY LIBEV> LEV::LIBEV (:OR "libev.4.dylib" "libev.4.so" "libev.so.4" "libev.dylib" "libev.so"))
3: (CFFI:LOAD-FOREIGN-LIBRARY LEV::LIBEV :SEARCH-PATH NIL)
4: (SB-FASL::LOAD-FASL-GROUP #S(SB-FASL::FASL-INPUT :STREAM #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.3.19.nixos-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/l..
5: (SB-FASL::LOAD-AS-FASL #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.3.19.nixos-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/lev-20150505-git/src/lev.fasl" {100..
6: ((FLET SB-FASL::LOAD-STREAM :IN LOAD) #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.3.19.nixos-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/lev-20150505-git/src..
7: (LOAD #P"/home/inaimathi/.cache/common-lisp/sbcl-1.3.19.nixos-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/lev-20150505-git/src/lev.fasl" :VERBOSE NIL :PRINT NIL :IF-DOES-NOT-EXIST T :E..
8: (UIOP/UTILITY:CALL-WITH-MUFFLED-CONDITIONS #<CLOSURE (LAMBDA NIL :IN UIOP/LISP-BUILD:LOAD*) {100471F61B}> ("Overwriting already existing readtable ~S." #(#:FINALIZERS-OFF-WARNING :ASDF-FINALIZERS)))
9: ((SB-PCL::EMF ASDF/ACTION:PERFORM) #<unused argument> #<unused argument> #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "lev" "src" "lev">)
10: ((:METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS (ASDF/LISP-ACTION:LOAD-OP ASDF/LISP-ACTION:CL-SOURCE-FILE)) #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "lev" "src" "lev">) [fast-method]
11: ((:METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS :AROUND (T T)) #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "lev" "src" "lev">) [fast-method]
12: ((:METHOD ASDF/PLAN:PERFORM-PLAN (LIST)) ((#<ASDF/LISP-ACTION:PREPARE-OP > . #1=#<ASDF/SYSTEM:SYSTEM "uiop">) (#2=#<ASDF/LISP-ACTION:COMPILE-OP > . #1#) (#3=#<ASDF/LISP-ACTION:LOAD-OP > . #1#) (#2# . ..
13: ((FLET SB-C::WITH-IT :IN SB-C::%WITH-COMPILATION-UNIT))
14: ((:METHOD ASDF/PLAN:PERFORM-PLAN :AROUND (T)) ((#<ASDF/LISP-ACTION:PREPARE-OP > . #1=#<ASDF/SYSTEM:SYSTEM "uiop">) (#2=#<ASDF/LISP-ACTION:COMPILE-OP > . #1#) (#3=#<ASDF/LISP-ACTION:LOAD-OP > . #1#) (#..
15: ((FLET SB-C::WITH-IT :IN SB-C::%WITH-COMPILATION-UNIT))
16: ((:METHOD ASDF/PLAN:PERFORM-PLAN :AROUND (T)) #<ASDF/PLAN:SEQUENTIAL-PLAN {1002A90153}> :VERBOSE NIL) [fast-method]
17: ((:METHOD ASDF/OPERATE:OPERATE (ASDF/OPERATION:OPERATION ASDF/COMPONENT:COMPONENT)) #<ASDF/LISP-ACTION:LOAD-OP :VERBOSE NIL> #<ASDF/SYSTEM:SYSTEM "woo"> :VERBOSE NIL) [fast-method]
18: ((SB-PCL::EMF ASDF/OPERATE:OPERATE) #<unused argument> #<unused argument> #<ASDF/LISP-ACTION:LOAD-OP :VERBOSE NIL> #<ASDF/SYSTEM:SYSTEM "woo"> :VERBOSE NIL)
19: ((LAMBDA NIL :IN ASDF/OPERATE:OPERATE))
--more--
; Evaluation aborted
CL-USER> (ql:quickload :hunchentoot)
To load "hunchentoot":
Load 1 ASDF system:
hunchentoot
; Loading "hunchentoot"
Unable to load any of the alternatives:
("libssl.so.1.0.2" "libssl.so.1.0.1l" "libssl.so.1.0.1e"
"libssl.so.1.0.1j" "libssl.so.1.0.1" "libssl.so.1.0.0q"
"libssl.so.1.0.0" "libssl.so.0.9.8ze" "libssl.so.0.9.8"
"libssl.so" "libssl.so.4" "libssl.so.10")
[Condition of type CFFI:LOAD-FOREIGN-LIBRARY-ERROR]
Restarts:
0: [RETRY] Try loading the foreign library again.
1: [USE-VALUE] Use another library instead.
2: [TRY-RECOMPILING] Recompile reload and try loading it again
3: [RETRY] Retry loading FASL for #<CL-SOURCE-FILE "cl+ssl" "src" "reload">.
4: [ACCEPT] Continue, treating loading FASL for #<CL-SOURCE-FILE "cl+ssl" "src" "reload"> as having been successful.
5: [RETRY] Retry ASDF operation.
--more--
Backtrace:
0: (CFFI::FL-ERROR "Unable to load any of the alternatives:~% ~S" ("libssl.so.1.0.2" "libssl.so.1.0.1l" "libssl.so.1.0.1e" "libssl.so.1.0.1j" "libssl.so.1.0.1" "libssl.so.1.0.0q" ...))
1: (CFFI::TRY-FOREIGN-LIBRARY-ALTERNATIVES CL+SSL::LIBSSL ("libssl.so.1.0.2" "libssl.so.1.0.1l" "libssl.so.1.0.1e" "libssl.so.1.0.1j" "libssl.so.1.0.1" "libssl.so.1.0.0q" ...) NIL)
2: ((FLET CFFI::%DO-LOAD :IN CFFI::%DO-LOAD-FOREIGN-LIBRARY) #<CFFI:FOREIGN-LIBRARY LIBSSL> CL+SSL::LIBSSL (:OR "libssl.so.1.0.2" "libssl.so.1.0.1l" "libssl.so.1.0.1e" "libssl.so.1.0.1j" "libssl.so.1.0.1..
3: (CFFI:LOAD-FOREIGN-LIBRARY CL+SSL::LIBSSL :SEARCH-PATH NIL)
4: (SB-FASL::LOAD-FASL-GROUP #S(SB-FASL::FASL-INPUT :STREAM #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.3.19.nixos-linux-x64/usr/share/common-lisp/source/cl+ssl/src/reload.fasl..
5: (SB-FASL::LOAD-AS-FASL #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.3.19.nixos-linux-x64/usr/share/common-lisp/source/cl+ssl/src/reload.fasl" {1002B52CC3}> NIL NIL)
6: ((FLET SB-FASL::LOAD-STREAM :IN LOAD) #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.3.19.nixos-linux-x64/usr/share/common-lisp/source/cl+ssl/src/reload.fasl" {1002B52CC3}> T)
7: (LOAD #P"/home/inaimathi/.cache/common-lisp/sbcl-1.3.19.nixos-linux-x64/usr/share/common-lisp/source/cl+ssl/src/reload.fasl" :VERBOSE NIL :PRINT NIL :IF-DOES-NOT-EXIST T :EXTERNAL-FORMAT :DEFAULT)
8: (UIOP/UTILITY:CALL-WITH-MUFFLED-CONDITIONS #<CLOSURE (LAMBDA NIL :IN UIOP/LISP-BUILD:LOAD*) {1002B506DB}> ("Overwriting already existing readtable ~S." #(#:FINALIZERS-OFF-WARNING :ASDF-FINALIZERS)))
9: ((SB-PCL::EMF ASDF/ACTION:PERFORM) #<unused argument> #<unused argument> #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "cl+ssl" "src" "reload">)
10: ((:METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS (ASDF/LISP-ACTION:LOAD-OP ASDF/LISP-ACTION:CL-SOURCE-FILE)) #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "cl+ssl" "src" "reload">) [fast-m..
11: ((:METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS :AROUND (T T)) #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "cl+ssl" "src" "reload">) [fast-method]
12: ((:METHOD ASDF/PLAN:PERFORM-PLAN (LIST)) ((#<ASDF/LISP-ACTION:COMPILE-OP > . #<ASDF/SYSTEM:SYSTEM "trivial-gray-streams">) (#1=#<ASDF/LISP-ACTION:PREPARE-OP > . #<ASDF/SYSTEM:SYSTEM #2="chunga">) (#1#..
13: ((FLET SB-C::WITH-IT :IN SB-C::%WITH-COMPILATION-UNIT))
14: ((:METHOD ASDF/PLAN:PERFORM-PLAN :AROUND (T)) ((#<ASDF/LISP-ACTION:COMPILE-OP > . #<ASDF/SYSTEM:SYSTEM "trivial-gray-streams">) (#1=#<ASDF/LISP-ACTION:PREPARE-OP > . #<ASDF/SYSTEM:SYSTEM #2="chunga">)..
15: ((FLET SB-C::WITH-IT :IN SB-C::%WITH-COMPILATION-UNIT))
16: ((:METHOD ASDF/PLAN:PERFORM-PLAN :AROUND (T)) #<ASDF/PLAN:SEQUENTIAL-PLAN {100672F123}> :VERBOSE NIL) [fast-method]
17: ((:METHOD ASDF/OPERATE:OPERATE (ASDF/OPERATION:OPERATION ASDF/COMPONENT:COMPONENT)) #<ASDF/LISP-ACTION:LOAD-OP :VERBOSE NIL> #<ASDF/SYSTEM:SYSTEM "hunchentoot"> :VERBOSE NIL) [fast-method]
18: ((SB-PCL::EMF ASDF/OPERATE:OPERATE) #<unused argument> #<unused argument> #<ASDF/LISP-ACTION:LOAD-OP :VERBOSE NIL> #<ASDF/SYSTEM:SYSTEM "hunchentoot"> :VERBOSE NIL)
19: ((LAMBDA NIL :IN ASDF/OPERATE:OPERATE))
--more--
; Evaluation aborted
CL-USER> (ql:quickload :wookie)
To load "wookie":
Load 1 ASDF system:
wookie
; Loading "wookie"
Unable to load any of the alternatives:
("libuv.so" "libuv.so.1" "/usr/lib/libuv.so"
"/usr/local/lib/libuv.so" "/usr/local/lib/libuv.dylib")
[Condition of type CFFI:LOAD-FOREIGN-LIBRARY-ERROR]
Restarts:
0: [RETRY] Try loading the foreign library again.
1: [USE-VALUE] Use another library instead.
2: [TRY-RECOMPILING] Recompile lib and try loading it again
3: [RETRY] Retry loading FASL for #<CL-SOURCE-FILE "cl-libuv" "lib">.
4: [ACCEPT] Continue, treating loading FASL for #<CL-SOURCE-FILE "cl-libuv" "lib"> as having been successful.
5: [RETRY] Retry ASDF operation.
--more--
Backtrace:
0: (CFFI::FL-ERROR "Unable to load any of the alternatives:~% ~S" ("libuv.so" "libuv.so.1" "/usr/lib/libuv.so" "/usr/local/lib/libuv.so" "/usr/local/lib/libuv.dylib"))
1: (CFFI::TRY-FOREIGN-LIBRARY-ALTERNATIVES LIBUV::LIBUV ("libuv.so" "libuv.so.1" "/usr/lib/libuv.so" "/usr/local/lib/libuv.so" "/usr/local/lib/libuv.dylib") NIL)
2: ((FLET CFFI::%DO-LOAD :IN CFFI::%DO-LOAD-FOREIGN-LIBRARY) #<CFFI:FOREIGN-LIBRARY LIBUV> LIBUV::LIBUV (:OR "libuv.so" "libuv.so.1" "/usr/lib/libuv.so" "/usr/local/lib/libuv.so" "/usr/local/lib/libuv.dy..
3: (CFFI:LOAD-FOREIGN-LIBRARY LIBUV::LIBUV :SEARCH-PATH NIL)
4: (SB-FASL::LOAD-FASL-GROUP #S(SB-FASL::FASL-INPUT :STREAM #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.3.19.nixos-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/c..
5: (SB-FASL::LOAD-AS-FASL #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.3.19.nixos-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/cl-libuv-20160825-git/lib.fasl" {10..
6: ((FLET SB-FASL::LOAD-STREAM :IN LOAD) #<SB-SYS:FD-STREAM for "file /home/inaimathi/.cache/common-lisp/sbcl-1.3.19.nixos-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/cl-libuv-20160825-gi..
7: (LOAD #P"/home/inaimathi/.cache/common-lisp/sbcl-1.3.19.nixos-linux-x64/home/inaimathi/quicklisp/dists/quicklisp/software/cl-libuv-20160825-git/lib.fasl" :VERBOSE NIL :PRINT NIL :IF-DOES-NOT-EXIST T :..
8: (UIOP/UTILITY:CALL-WITH-MUFFLED-CONDITIONS #<CLOSURE (LAMBDA NIL :IN UIOP/LISP-BUILD:LOAD*) {1003252B9B}> ("Overwriting already existing readtable ~S." #(#:FINALIZERS-OFF-WARNING :ASDF-FINALIZERS)))
9: ((SB-PCL::EMF ASDF/ACTION:PERFORM) #<unused argument> #<unused argument> #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "cl-libuv" "lib">)
10: ((:METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS (ASDF/LISP-ACTION:LOAD-OP ASDF/LISP-ACTION:CL-SOURCE-FILE)) #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "cl-libuv" "lib">) [fast-method]
11: ((:METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS :AROUND (T T)) #<ASDF/LISP-ACTION:LOAD-OP > #<ASDF/LISP-ACTION:CL-SOURCE-FILE "cl-libuv" "lib">) [fast-method]
12: ((:METHOD ASDF/PLAN:PERFORM-PLAN (LIST)) ((#1=#<ASDF/LISP-ACTION:COMPILE-OP > . #2=#<ASDF/COMPONENT:STATIC-FILE #3="alexandria" "LICENCE">) (#4=#<ASDF/LISP-ACTION:LOAD-OP > . #2#) (#1# . #5=#<ASDF/SYS..
13: ((FLET SB-C::WITH-IT :IN SB-C::%WITH-COMPILATION-UNIT))
14: ((:METHOD ASDF/PLAN:PERFORM-PLAN :AROUND (T)) ((#1=#<ASDF/LISP-ACTION:COMPILE-OP > . #2=#<ASDF/COMPONENT:STATIC-FILE #3="alexandria" "LICENCE">) (#4=#<ASDF/LISP-ACTION:LOAD-OP > . #2#) (#1# . #5=#<ASD..
15: ((FLET SB-C::WITH-IT :IN SB-C::%WITH-COMPILATION-UNIT))
16: ((:METHOD ASDF/PLAN:PERFORM-PLAN :AROUND (T)) #<ASDF/PLAN:SEQUENTIAL-PLAN {1001EED0D3}> :VERBOSE NIL) [fast-method]
17: ((:METHOD ASDF/OPERATE:OPERATE (ASDF/OPERATION:OPERATION ASDF/COMPONENT:COMPONENT)) #<ASDF/LISP-ACTION:LOAD-OP :VERBOSE NIL> #<ASDF/SYSTEM:SYSTEM "wookie"> :VERBOSE NIL) [fast-method]
18: ((SB-PCL::EMF ASDF/OPERATE:OPERATE) #<unused argument> #<unused argument> #<ASDF/LISP-ACTION:LOAD-OP :VERBOSE NIL> #<ASDF/SYSTEM:SYSTEM "wookie"> :VERBOSE NIL)
19: ((LAMBDA NIL :IN ASDF/OPERATE:OPERATE))
--more--
; Evaluation aborted
</code></pre><p>I want to stress that I have not failed to install the above "missing" native libraries. It's just that I use <code>nix</code> as a package manager, so they get installed in a directory that <code>cffi</code> doesn't expect. I've also tried installing the same through <code>apt-get</code> and still get similar errors. And don't even get me started on <code>OS X</code> or Windows setups of the same.</p><p>So, unfortunately, a much as <code>:house</code> sucks, I'm sticking with it, and working around its shortcomings. I've also got plans to submit it to <a href='https://github.com/quicklisp/quicklisp-projects'><code>quicklisp</code></a> once I work up a reasonable test suite.</p><p>At that point, I won't have to take the <code>clone</code> step either. <ol class='footnotes'><li id='fn-1'>And I just noticed that I started it in 2014, which puts it at 4 years old. Which means that I have both a child younger <i>and</i> a child older than this particular attempt at a cell-based editor. I feel fucking old.<a href='#fnref1'>↩</a></li></ol></p>The Router2018-01-21T06:03:32.000Zinaimathi<p>Ok, so a while ago, I gave <a href='https://www.youtube.com/watch?v=ddlG2YZuXCw'>a PW<3 talk</a> on one of <a href='http://www.cs.unm.edu/~ackley/papers/hotos-11.pdf'>Ackley's pieces</a>[PDF].</p><p>In order to properly give that talk, and point out interesting ideas and approaches in this kind of distributed computation, I had to write a <a href='https://github.com/inaimathi/trurl/blob/62f9c429710331f0d27b7ea00ede3ad489307245/machines.lisp#L23-L116'>Router</a>.</p><p><img src="/static/img/the-router/the-router.gif" alt="An animation of the router being spawned, unfolding and beginning to shunt messages" /></p><p>This is the first involved program I've written in this style, and I learned a bunch of things doing it that weren't obvious to me even after all the time I spent thinking about it, so I thought I'd share.</p><h2><a name="how-it-works"></a><a href="#how-it-works">How it works</a></h2><pre><code>;;; trurl.lisp
...
(lem:define-machine lemon nil)
(lem:define-machine router-message
(let ((dest (pick (loop for (x y) in lem:n*extended
for c = (lem:neighbor x y)
when (and c (typep (lem:occupant c) 'router-fluid)) collect c))))
(when dest (lem:move-to! dest lem:here))))
(lem:define-machine router-input
(let ((messages (loop for (x y) in lem:n*extended
for c = (lem:neighbor x y)
when (and c (typep (lem:occupant c) 'router-message)) collect c)))
(when (> 3 (length messages))
(let ((dest (apply #'lem:neighbor (pick lem:n*extended))))
(when (and dest (typep (lem:occupant dest) 'router-fluid))
(lem:spawn-in! dest (router-message) :message (format nil "~r" (random 10000000)) :x (random 10) :y (random 10)))))))
(lem:define-machine router-endpoint
(let ((x (lem:get-state lem:self :x 0))
(y (lem:get-state lem:self :y 0))
(left (lem:neighbor -3 0))
(up (lem:neighbor 0 -3))
(message-cell (pick (loop for (x y) in lem:n*extended
for c = (lem:neighbor x y)
when (and c (typep (lem:occupant c) 'router-message)) collect c))))
(when (and left (typep (lem:occupant left) 'router-fluid))
(lem:spawn-in! left lem:self :x (+ x 1) :y y))
(when (and up (typep (lem:occupant up) 'router-fluid))
(lem:spawn-in! up lem:self :x x :y (+ y 1)))
(unless (null message-cell)
(let* ((m (lem:occupant message-cell))
(mx (lem:get-state m :x))
(my (lem:get-state m :y))
(name (format nil "ENDPOINT[~a::~a]" x y))
(up (lem:neighbor 0 -2))
(left (lem:neighbor -2 0)))
(cond ((and (= x mx)
(= y my))
(lem:empty! message-cell)
(log! name (lem:get-state m :message)))
((and (not (typep (lem:occupant up) 'router-message)) (= x mx))
(lem:move-to! up message-cell))
((and (not (typep (lem:occupant left) 'router-message)) (= y my))
(lem:move-to! left message-cell)))))))
(lem:define-machine router-fluid
(let ((w (lem:get-state lem:self :w 10))
(h (lem:get-state lem:self :h 10))
(x (lem:get-state lem:self :x 0))
(y (lem:get-state lem:self :y 0)))
(labels ((any-of (cell &rest types)
(let ((o (lem:occupant cell)))
(some (lambda (tp) (typep o tp)) types)))
(spawn! (neigh &key (x x) (y y))
(when neigh
(unless (any-of neigh 'router-endpoint 'router-fluid 'router-input 'router-message)
(lem:spawn-in! neigh lem:self :x x :y y :h h :w w)))))
(when (> w x) (spawn! (lem:neighbor -1 0) :x (+ x 1)))
(when (> h y) (spawn! (lem:neighbor 0 -1) :y (+ y 1)))
(unless (zerop x) (spawn! (lem:neighbor 1 0) :x (- x 1)))
(unless (zerop y) (spawn! (lem:neighbor 0 1) :y (- y 1))))))
(lem:define-machine router
(flet ((neighbors-at (fn)
(loop for (x y) in lem:n*extended
for c = (lem:neighbor x y)
when (and c (funcall fn x y)) collect c)))
(let* ((w 25) (h 25)
(x (lem:get-state lem:self :x 0))
(y (lem:get-state lem:self :y 0))
(outsides (concatenate
'list
(when (zerop x) (neighbors-at (lambda (x y) (> x 0))))
(when (zerop y) (neighbors-at (lambda (x y) (> y 0))))
(when (= x w) (neighbors-at (lambda (x y) (> 0 x))))
(when (= y h) (neighbors-at (lambda (x y) (> 0 y)))))))
(when (and (zerop y) (> (- w 1) x 1))
(lem:spawn-in! (lem:neighbor 0 -1) (router-input)))
(when (and (zerop y) (zerop x))
(lem:spawn-in! (lem:neighbor -1 -1) (router-fluid) :h (- h 2) :w (- w 2))
(lem:spawn-in! (lem:neighbor -2 -2) (router-endpoint)))
(loop for c in outsides do (lem:spawn-in! c (lemon)))
(when (and (> w x) (or (= y 0) (= y h)))
(lem:spawn-in! (lem:neighbor -1 0) lem:self :x (+ x 1) :y y))
(unless (= 0 x)
(when (or (= y 0) (= y h))
(lem:spawn-in! (lem:neighbor 1 0) lem:self :x (- x 1) :y y)))
(when (and (> h y) (or (= x 0) (= x w)))
(lem:spawn-in! (lem:neighbor 0 -1) lem:self :x x :y (+ y 1)))
(unless (= 0 y)
(when (or (= x 0) (= x w))
(lem:spawn-in! (lem:neighbor 0 1) lem:self :x x :y (- y 1)))))))
...
</code></pre><p>This is what the code looks like. It's fugly, because I haven't had the time to really dive into what kinds of ideas we want to express in systems like this. As a consequence, we've got what should probably be abstracted logic threaded throughout these programs. And that's sort of to be expected given my inexperience in this context. But it might be instructive to go through it anyway. This style of programming involves defining <code>machine</code>s that work on the basis of a grid. The idea is that a <code>machine</code> is a prototype that defines a behavior that will be executed when an instance of the machine gets to take a turn. On a <code>machine</code>s turn, it can consider its surrounding environment, including all exposed state, terrain and population.</p><p>This specific machine, from a high-level view, is composed out of a bunch of interacting components. We've got</p><ul><li><code>router</code> which is responsible for fencing off a segment of space to use. It can be thought of as the router skeleton, it spawns the initial drop of <code>router-fluid</code>, the first <code>router-endpoint</code> and the initial <code>router-input</code>. It also constantly regenerates an event-window sized shell of <code>lemon</code>s on its outside. It's represented by the black squares.</li><li><code>router-fluid</code> which is responsible for clearing out the fenced area. It eats anything that isn't a router component. It's represented by the blue squares.</li><li><code>router-input</code> which is responsibe for respawning <code>router-input</code>s along the bottom edge of the router, and generating <code>router-message</code>s to be consumed. In this demo, they generate random, randomly addressed messages, but it's easy to imagine them using a TCP socket as a source instead. It's represented by the fuzzy red circles.</li><li><code>router-endpoint</code> which is responsible for setting up and maintaining an addressed, sparse grid of <code>router-endpoint</code>s. Additionally, it's responsible for consuming messages addressed to it, and shunting along other messages. It's represented by the green squares.</li><li><code>router-message</code> which carries addressed data along. It's responsible for nothing other than existing and occasionally hopping around to local <code>router-fluid</code>-occupied cells. It's represented by the fuzzy green circles.</li><li><code>lemon</code> which does nothing. It's merely arranged by <code>router</code> into a protective shell to guard against possible incursion from outside the router. It's, appropriately enough, represented by the yellow squares.</li></ul><h2><a name="the-environmental-concerns"></a><a href="#the-environmental-concerns">The environmental concerns</a></h2><h3><a name="simple-router-fluid"></a><a href="#simple-router-fluid">Simple Router Fluid</a></h3><p>One interesting thing that happened initially is that I defined <code>router-fluid</code> as</p><pre><code>(lem:define-machine router-bleach
(labels ((any-of (cell &rest types)
(let ((o (lem:occupant cell)))
(some (lambda (tp) (typep o tp)) types)))
(spawn! (neigh &key (x x) (y y))
(when neigh
(unless (any-of neigh 'router-endpoint 'router-bleach 'router-input 'router-message)
(lem:spawn-in! neigh lem:self)))))
(loop for (x y) in lem:n*extended
do (lem:spawn-in! (lem:neighbor x y) lem:self))))
</code></pre><p>Which is much simpler than the version you saw earlier, but also a bit more interesting at the macro scale. It's basically gray goo with a whitelist. The idea is that when fully formed, a <code>router</code>s protective shell is as wide as the event-window radius, so whitelisting those cells will be enough to keep the fluid contained through inter-cell rather than intra-cell interactions. This causes two problems. Firstly, you need to make sure that the <code>router</code> wall is sealed before you spawn the first drop of <code>router-fluid</code> because it might otherwise escape and eat the world. Second, you'd damn well better hope that nothing breaches that <code>router</code> wall for exactly the same reason. This original version was titled <code>router-bleach</code>, for perhaps obvious reasons. You probably <i>do</i> want it to eat things that aren't part of the router, because you might otherwise get hostile particles jumping around that interfere with its internal operations. But you absolutely <i>don't</i> want it eating anything past the router border.</p><p>This is one of those places where it would help to have different conceptual structures than just grid-based accessors. It might help to have an idea of what it means to be inside of a particular space that isn't quite as low-level as the current <code>x</code>/<code>y</code> co-ordinate system. Because otherwise you have the choice between bounding the fluid explicitly<a href='#fn-1' id='fnref1'><sup>1</sup></a>, and bounding it implicitly<a href='#fn-2' id='fnref2'><sup>2</sup></a>. It might be possible to split the difference by slowing down the rate at which router bleach eats things<a href='#fn-3' id='fnref3'><sup>3</sup></a>, but I'm not entirely convinced that this wouldn't merely give us both sets of problems.</p><h3><a name="gray-goo"></a><a href="#gray-goo">Gray Goo</a></h3><p>While we're on the topic, in case it's not obvious from the above, what's gray goo?</p><pre><code>(lem:define-machine gg
(loop for (x y) in lem:n*extended
do (lem:spawn-in! (lem:neighbor x y) lem:self)))
</code></pre><p>It's the machine that eats everything. If <code>box</code> is <a href='https://youtu.be/Dmlm6mtnSZs?t=4m30s'>"the machine that knows what it is to be a box"</a>, then <code>gg</code> is "the machine that knows what it is to hunger without end". In a massively distributed system with no central ownership, it's possible that someone intentionally introduces <code>gg</code> to the world, but as we've seen above, it's also entirely possible to effectively do it by accident.</p><p>One way of fighting this involves restricting the set of possibly <code>spawn!</code>able machines. The idea is that we do some amount of research into what sorts of machines make a good enough set of primitives, agree on them, and burn their definitions into the substrates of all of our cellular networks. That makes sure we've got a known-good-actor set of machines to choose from, but something tells me that the expressivity of such a system is going to suffer pretty fatally. My instinct is that what we want is a set of composition primitives; a language from which to craft machines rather than a pre-defined set of machines themselves.</p><p>A second way involves imposing a cost on the <code>spawn!</code> operation in some way. So that a machine that does nothing <i>but</i> spawn in all directions will run out of resources in short order.</p><p>A third is introducing a high error-rate or some substrate-level antagonism towards ill-behaved machines. As in, the cells themselves do some kind of tracking, inter-communication and decision procedure to decide whether to honor orders coming from a particular machine class or instance. I'm not sure exactly what shape this would take, but it's at least marginally plausible.</p><p>Also, lets be honest here, I have no idea which or any of these might be the correct solution in general, if there even is one. This is something I'll have to figure out by prototyping like a madman for the next little while. And possibly by observing natural structures that already solve these problems in different contexts.</p><h2><a name="the-metastasis-problem"></a><a href="#the-metastasis-problem">The metastasis problem</a></h2><p>There's a bunch of situations in which you want to introduce self-stabilizing populations of cells into the world. For instance, the above router wants to limit messages in some way if it's to avoid saturating its output ports. In service to that goal, messages only spawn on and move around in router fluid. That fluid might go through dry spells if enough messages get plonked into the system at the same time, and the rate of message spawning is therefore implicitly capped through the behavior of the cells. That's one approach; make sure that incoming spawns require some non-empty substrate and make sure that the substrate is not infinitely available in some way.</p><p>Another approach is introducing predation. In our router example, that would mean introducing a <code>rate-limiter</code> cell that would amble around inside of the router and occasionally kill off message cells with some low probability. This approach is shown in action by Ackley in his <code>DReg</code>/<code>Res</code> example. The end result is slow to become stable, and might kill off too much through random chance, but fundamentally works and is driven primarily by intra-cell forces.</p><p>Yet another approach is to have each spawning cell conduct a census of its neighborhood and only spawning if it finds a population below some threshold. In a router, that would mean adding code to <code>router-input</code> to check how many <code>router-message</code> cells are visible before spawning new <code>router-message</code>s. This differs from the predation approach in two ways. Firstly, it's not probability based, so some equilibrium is reached relatively quickly, and second, it relies mostly on inter-cell behavior rather than intra-cell behavior<a href='#fn-4' id='fnref4'><sup>4</sup></a>.</p><p>That's close, but not exactly the same as the <a href='https://www.ted.com/talks/deborah_gordon_digs_ants'>anthill approach</a>, where we introduce state into individual cells. They keep count of the things they've seen and act accordingly. The downside to <i>this</i> approach is that it relies on more long-lived cells than either the predation or census approaches. Reflexively, that means not having cells clobber each other quite as often, except that aggressively clobbering is a very good strategy to make sure that we don't grow over-reliant on some particular piece of internal state. Remember, the point is robustness. So relying on long-lived state which might disappear when it meets a non-cooperating<a href='#fn-5' id='fnref5'><sup>5</sup></a> <code>spawn!</code>ing cell seems like a bad idea.</p><h2><a name="the-synchronization-problem"></a><a href="#the-synchronization-problem">The synchronization problem</a></h2><p>Synchronizing a specific turn gets odd in the global context. While we're running single-threaded simulators, it's easy to imagine a turn being taken somewhere in a way that minimizes friction. In a distributed, decentralized system, it's much harder to understand how some field of 41 cells<a href='#fn-6' id='fnref6'><sup>6</sup></a> ends up deciding that a particular cell should have write priority at the same time.</p><p>In a simulator it's easy, because we're centralized and running locally. In a real system, where we're dealing with a distributed and decentralized network of cells all trying to inter-communicate, it involves either remote locking or partial neighborhood execution. Let me unpack that. We can <i>either</i> say that we're going to lock a cells' full neighborhood while it acts, <i>or</i> we can say that a cell will have to be able to execute its code while seeing only part of its neighborhood. If we go for locking the full neighborhood, we get into the phenomenally tricky remote locking problem, where we have to coordinate use of a shared resource with a number of remote agents. For this purpose, it might actually be better to have multi-cell tiles be the norm, rather than have each cell individually implemented as a separate machine<a href='#fn-7' id='fnref7'><sup>7</sup></a>.</p><p>If we instead say that a cell must be able to work on a partial neighborhood<a href='#fn-8' id='fnref8'><sup>8</sup></a>, then a bunch of the census machinery we discussed above breaks in a non-trivial way. At minimum, you'd have to start dealing with neighborhood census percentages rather than raw counts, <i>and</i> you'd have to tailor them in a way that can deal with the pessimal case of only getting one of your neighboring cells addressed in a "turn".</p><h2><a name="what-s-next"></a><a href="#what-s-next">What's Next</a></h2><p>A fuckton of thought, I guess. And I'll also want to actually talk to Dave Ackley at some point instead of merely consuming his written and video media on the topic.</p><p>The particular points I still want to prototype and figure out are:</p><ul><li>A simulation of cell tiles. Each tile contains some number of cells arranged in connected neighborhoods. Make sure that the tiles can communicate with each other in a sane way that's robust to tile failure, and ensure they can still establish neighborhood locks somewhat consistently.</li><li>More simulations of predation/census based systems. In particular see how it works when you restrict calling the <code>spawn!</code> command, but introduce a new <code>eat!</code> command that consumes a named resource in the target cell. This might change the grey goo dynamic significantly, <i>without</i> introducing existence cost into the system.</li></ul><p>I'm sure I'll find more things of interest as I actually do the work. <ol class='footnotes'><li id='fn-1'>Which seems like it would make it harder to scale the <code>router</code> out to encompass more space later.<a href='#fnref1'>↩</a></li><li id='fn-2'>Which has the problem we just discussed of posing a serious threat to the well-being of the world if it ever escapes. Although it seems like this might make for an interesting and dramatic story arc in some piece of science fiction, we realistically want to limit that risk.<a href='#fnref2'>↩</a></li><li id='fn-3'>For instance, by introducing some state in the router fluid, and using it to only eat things that remain non-whitelisted entities for three or more turns at a time.<a href='#fnref3'>↩</a></li><li id='fn-4'>There is no explicit die-roll here. We check if there's "enough" messages running around to keep us busy, and if there are, we deterministically refrain from spawning new messages. The overall system behavior might still be very chaotic because of the shunting behavior of <code>router-endpoint</code>s or <code>router-message</code>s themselves, but that chaos is introduced elsewhere and not exacerbated by the census-conducting <code>router-input</code> cells.<a href='#fnref4'>↩</a></li><li id='fn-5'>Cooperating cells are ok, since they can save any state of the things they clobber when <code>spawn!</code>ing.<a href='#fnref5'>↩</a></li><li id='fn-6'>Or whatever number you ultimately ended up picking for your thing, it doesn't matter.<a href='#fnref6'>↩</a></li><li id='fn-7'>Since that requires fewer messages to establish locks on a neihborhood. Assuming your tiles were rectangular larger than the event window, you'd be able to establish a neighborhood lock with between zero and four exchanges rather than 41.<a href='#fnref7'>↩</a></li><li id='fn-8'>Which, lets be honest, might happen anyhow in the event of a fried tile, network error or network boundary. But those would ideally be rare cases as opposed to what I'm proposing here.<a href='#fnref8'>↩</a></li></ol></p>Quickproject Revisions2017-10-15T20:42:35.000Zinaimathi<p>So I did some <a href='https://github.com/inaimathi/ribbit'><code>ribbit</code></a>/<a href='https://github.com/inaimathi/cl-fds'><code>cl-fds</code></a> prototyping a little while ago<a href='#fn-1' id='fnref1'><sup>1</sup></a>.</p><p>But in preparation, <a href='https://github.com/inaimathi/quickproject'>hacked a bit</a> on <a href='https://github.com/xach'>Xach's</a> pretty decent <a href='https://github.com/xach/quickproject'><code>quickproject</code></a> library. I've been using it to create project skeletons for Common Lisp for quite a while, but it's unsatisfying in a few ways I thought I'd fix up.</p><h2><a name="its-default-output-is-minimal"></a><a href="#its-default-output-is-minimal">Its default output is ... minimal</a></h2><p>In particular</p><ul><li>it produces a <code>README.txt</code> instead of the <code>README.md</code> I'd prefer</li><li>it doesn't set up a default <code>.travis.yml</code> or <code>.gitignore</code></li><li>it doesn't set up any sort of test harness in the generated <code>asd</code> file or source tree</li></ul><p>It's possible that the reason I find this unsatisfactory is that I've been writing a lot of <a href='https://clojure.org/'>Clojure</a> lately, and the fantastic <a href='https://leiningen.org/'><code>lein</code></a> utility there takes care of all of this and then some, but I still want the functionality.</p><h2><a name="it-s-hard-to-change-that-default-output"></a><a href="#it-s-hard-to-change-that-default-output">It's hard to change that default output</a></h2><p><code>quickproject</code> theoretically has a template-capable subsystem that lets you point it at a directory somewhere and generate from that place instead. Which is a fine thing to have, except that most of its internals are not template based. <a href='https://github.com/xach/quickproject/blob/a44d324c89a2ac214ace59c9bf339d493c138c30/quickproject.lisp#L75-L79'>There's a specific function</a> that outputs the <code>README.txt</code> file for instance, which means that even if you work up a template directory with a <code>README.md</code>, the <code>.txt</code> will be output regardless, and you'll presumably delete it by hand.</p><p>Also, because of the templating approach, it's extremely hard to make an output file named after the project. Which you'd need in order to effectively override the <code><your-project>.asd</code> and <code><your-project>.lisp</code> files generated by default.</p><h2><a name="there-isn-t-an-easily-available-example-template-directory"></a><a href="#there-isn-t-an-easily-available-example-template-directory">There isn't an easily available example template directory</a></h2><p>The template engine used here is <a href='http://weitz.de/html-template/'><code>html-template</code></a>, but <code>quickproject</code> messes with the template delimiters somewhat, which means that <code>html-template</code> documentation is <i>almost</i> helpful, but doesn't give you something you could cut/paste to work up a new project template. Which isn't a <i>huge</i> deal, but docs are nice, and since <code>quickproject</code> is the defacto default Common Lisp project generation tool, it'd be nice if those docs were present and as simple as possible to use.</p><h2><a name="fixing-it"></a><a href="#fixing-it">Fixing It</a></h2><p><a href='https://github.com/inaimathi/quickproject'>My edits</a> resolve all of the above, and can be found <a href='https://github.com/inaimathi/quickproject'>here</a>, just in case I <a href='https://github.com/inaimathi/quickproject'>didn't throw</a> enough <a href='https://github.com/inaimathi/quickproject'>links</a> at you <a href='https://github.com/inaimathi/quickproject'>already</a>.</p><p>In terms of interface, it's transparent. So if you're used to using <code>quickproject:make-project</code> yourself, there are absolutely no changes to internalize from the activation perspective. However</p><ol><li>There is a <a href='https://github.com/inaimathi/quickproject/tree/master/default-template'><code>default-template</code></a> directory available that shows you what the base template looks like, and conveniently can be copied out and cut up for your own nefarious purposes.</li><li>The internals of the library have been modified so that it automatically uses the template directory for everything, including <code>README</code> and <code>asd</code> generation. This way you can easily remove pieces, not just add or replace them</li><li>The output machinery looks for two specific files named <code>system.asd</code> and <code>application.lisp</code> which get output as <code><your-project>.asd</code> and <code><your-project>.lisp</code> rather than naively. This lets you generate your projects' <code>asd</code> and <code>lisp</code> files trivially, at the admitted cost that you can't have files literally named "<code>system.asd</code>" and "<code>application.lisp</code>" in your project tree.</li></ol><p>I've already used <a href='https://github.com/inaimathi/quickproject/tree/test-integration'>a branch</a> of <a href='https://github.com/inaimathi/quickproject'>my version</a> to generate the <code>cl-fds</code> project (which includes a generated test harness using <a href='https://github.com/inaimathi/test-utils'><code>test-utils</code></a>, <a href='https://github.com/mcandre/cl-quickcheck'><code>quickcheck</code></a> and <a href='https://github.com/fukamachi/prove/'><code>prove</code></a>).</p><p>There's an <a href='https://github.com/xach/quickproject/pull/14'>open PR</a>, so hopefully, this gets merged into the mainline <code>quickproject</code> at some point. Given how busy Xach is, I wouldn't hold my breath, but you can still clone and use mine if you like.</p><blockquote><p> EDIT: As of October 27, 2017, it has been merged. So, presumably, at this point you can get all this functionality out of the main <code>quickproject</code> project. </p></blockquote>Lem And Trurl2017-09-07T10:52:44.000Zinaimathi<p>So cellular automata.</p><p>It turns out that things like <a href='/posts/life-common-lisp-haskell-and-clojure'>life</a> and <a href='/posts/brians-brain'>Brian's Brain</a> are the tip of the iceberg. <a href='/posts/fuck-silence'>I mentioned</a> a series of <a href='https://www.youtube.com/channel/UClOeW4P8ekXaKxJaZU_LK6w'>videos by Dave Ackley</a> that talks about <a href='https://www.youtube.com/watch?v=I4flQ8XdvJM'>Robust-First Computing</a>, and simulating the sorts of machines he's got in mind for the deep future involves a surprising<a href='#fn-1' id='fnref1'><sup>1</sup></a> number of cells or similar constructs.</p><p>I've been thinking about this while putting together a basic testing/playing sandbox in the form of <a href='https://github.com/inaimathi/lem'><code>lem</code></a> and <a href='https://github.com/inaimathi/trurl'><code>trurl</code></a><a href='#fn-2' id='fnref2'><sup>2</sup></a>.</p><p>By the way, in addition to the repo, you can play around with a <code>trurl</code> server <a href='http://trurl.inaimathi.ca/'>here</a>, assuming it hasn't exploded in the meantime. No promises; there's no uptime guarantee on this one yet. There <i>are</i> multi-player implications that I haven't really worked out yet, and I'm hoping to target them a lot more specifically in a forthcoming spin-off project. Stay tuned.</p><h2><a name="-code-lem-code-"></a><a href="#-code-lem-code-"><code>lem</code></a></h2><p><a href='https://github.com/inaimathi/lem'><code>lem</code></a> itself is minimal. Apart from the system/<code>package</code> definition boilerplate, it's contained inside of <a href='https://github.com/inaimathi/lem/blob/master/lem.lisp'>one file</a>. Its core, not counting the grid simulator that I'll also explain to you, is one macro that currently exposes an interface for defining new machines, and then instantiating them.</p><pre><code class="scheme">;;; lem.lisp
...
(defmacro define-machine (name &body body)
(let ((neighborhood (gensym "NEIGH")))
`(progn
(defclass ,name (unit)
((code :initform ',body)
(behavior
:initform
(lambda (,neighborhood)
(flet ((neighbor (x y) (get-neighbor ,neighborhood x y)))
(let* ((here (neighbor 0 0))
(self (occupant here)))
(declare (ignorable here self))
,@body))))))
(defun ,name (&rest state-k/v-pairs)
(make-instance ',name :state (alexandria:plist-hash-table state-k/v-pairs))))))
...
</code></pre><p>At a high level, this lets you use the form <code>define-machine</code>, passing it a <code>name</code> and a <code>body</code>, and get from it a representation of your machine. The <code>body</code> you pass in also has access to the locally-scoped function <code>neighbor</code>, and the locally scoped symbols <code>here</code> and <code>self</code>, all of which let you more naturally refer to the neighborhood of the cell that will eventually be running your machine. That <code>body</code> form can best be thought of as a behavior; it's what an instance of your machine will do to its neighborhood whenever its "turn" comes around.</p><p>The current underlying representation of a machine is a subclass of <code>unit</code> which sets some defaults, and a function that creates an instance of that class with the potential for some initial state. This is likely only temporary, and I entirely reserve the right to change said representation once I start thinking about multiplayer and game-related implications.</p><p>One of the simplest<a href='#fn-3' id='fnref3'><sup>3</sup></a> machines you could define is</p><pre><code class="scheme">...
(define-machine ray
(spawn-in! (neighbor -1 0) self))
...
</code></pre><p>Which is an example machine that Dave goes through in one of his videos. What this does, is start an infinite line that goes west. Whenever it's a <code>ray</code> cell's turn, it will spawn a copy of itself in the neighbor immediately to its left. Note that we're following Ackley's very necessary convention here; there is no absolute cell index, and each cell thinks of itself as <code>0,0</code> with its surrounding neighborhood as some offset from that. The neighborhood a given cell has access to on its turn also doesn't extend infinitely in all directions.</p><p>A demo of <code>ray</code> might be in order before we get into how <code>turn</code>s work, and how a grid is simulated...</p><pre><code>; SLIME 2.19
CL-USER> (ql:quickload :lem)
To load "lem":
Load 1 ASDF system:
lem
; Loading "lem"
..
(:LEM)
CL-USER> (in-package :lem)
#<PACKAGE "LEM">
LEM> (defparameter +grid+ (make-grid 30 10))
+GRID+
LEM> (seed! +grid+ 25 5 (ray))
NIL
LEM> (show! +grid+)
..............................
..............................
..............................
..............................
..............................
.........................+....
..............................
..............................
..............................
..............................
NIL
LEM> (play! +grid+)
..............................
..............................
..............................
..............................
..............................
........................++....
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
.......................+++....
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
......................++++....
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
.....................+++++....
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
....................++++++....
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
...................+++++++....
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..................++++++++....
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
.................+++++++++....
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
................++++++++++....
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
..............................
...............+++++++++++....
..............................
..............................
..............................
..............................
C-c C-c
Interrupt from Emacs
[Condition of type SIMPLE-ERROR]
Restarts:
0: [CONTINUE] Continue from break.
1: [RETRY] Retry SLIME REPL evaluation request.
2: [*ABORT] Return to SLIME's top level.
3: [ABORT] abort thread (#<THREAD "repl-thread" RUNNING {1002A47FA3}>)
LEM>
</code></pre><p>So you saw the basic interface to our grid simulations here. We can make a new grid by giving it a width and height, print it using <code>show!</code>, and put down cells using <code>seed!</code>. Finally, <code>play!</code> loops forever by stepping the grid once and <code>show!</code>ing it afterwards. The only part of this process you might not be able to infer reliably is what exactly it means to <code>step!</code> a grid...</p><pre><code class="scheme">...
(defmethod step! ((sim-grid grid))
(loop for y from 0 repeat (height sim-grid)
do (loop for x from 0 repeat (width sim-grid)
for g = (get-cell sim-grid x y)
unless (empty? g)
do (funcall
(behavior (occupant g))
(neighborhood-of sim-grid x y))))
nil)
...
</code></pre><p>...and that turns out to be the simplest cellular automata game I've ever written. For each cell, unless it's <code>empty?</code>, run its <code>occupant</code>s <code>behavior</code>, passing it pointers to its immediate neighborhood. Note that this means that a given cell can mutate all of its neighboring cells arbitrarily during its "turn". Note also that this particular implementation of <code>step!</code> assumes a fixed order for cells to be given a turn. That's something I'm thinking about fixing by randomizing the order on each <code>step!</code>.</p><p>Something like</p><pre><code class="scheme">...
(let ((indices (loop for y from 0 repeat (height sim-grid) append (loop for x from 0 repeat (width sim-grid) collect (cons x y)))))
(loop for (x . y) in (shuffle indices)
do ... ))
...
</code></pre><p>would make sure that a given cell can't count on beating out any particular neighbor in terms of turn order. This is relevant, because we're building a grid simulation. The real situation we're anticipating is that each cell is going to be its own node on a massive network, which means that there can't possibly <i>be</i> a central authority for turn order.</p><p>In fact, that gives me the thought that turn consistency can't really be guaranteed in the real world. Which makes perfect sense if you think of each cell as a separate computer. It can compute anything, any time it likes, but all that taking a "turn" means is that it has consent from its neighbors to perform mutations on their memories for some duration of time. So in some sense, when your "turn" hits is a decision made collectively by your immediate <code>neighborhood</code>. The whole neighborhood might not agree, whether maliciously or through a coordination error, which seems to imply that a given cell might have to act on its neighborhood in partial "turns" during which it'll only have permission to write to some of its immediate neighbors. It seems like this doesn't materially change the behavior of the grid, other than to make it mildly less consistent. So maybe the "fix" should include something more like <code>... (shuffle (drop (5% (length indices)) indices)) ...</code>.</p><p>There seems to be a bunch of interesting ways you could change the behavior of these simulations without even considering the behaviors of the individual cells. We could introduce various degrees of inconsitency or order in the <code>step!</code> procedure as seen above, we might introduce more elaborate behavior for the <code>spawn-in!</code> procedure, or we could mess with the size/shape of a neighborhood a given cell gets access to during its turn. We could do the same sort of randomized dropping of neighbor cells when generating a neighborhood for <code>behavior</code> consumption, and those changes might have visible effects on the macro scale behavior of a grid.</p><p>The <i>current</i> structure of a <code>neighborhood</code>, rather than those experimental ones, is a three-cell-radius region centered on the cell whose "turn" it is.</p><pre><code class="scheme">CL-USER> lem:n*extended
((-4 0) (-3 -1) (-3 0) (-3 1) (-2 -2) (-2 -1) (-2 0) (-2 1) (-2 2) (-1 -3)
(-1 -2) (-1 -1) (-1 0) (-1 1) (-1 2) (-1 3) (0 -4) (0 -3) (0 -2) (0 -1) (0 0)
(0 1) (0 2) (0 3) (0 4) (1 -3) (1 -2) (1 -1) (1 0) (1 1) (1 2) (1 3) (2 -2)
(2 -1) (2 0) (2 1) (2 2) (3 -1) (3 0) (3 1) (4 0))
CL-USER>
</code></pre><p>or, in a slightly more readable format,</p><pre><code>( (0 -4)
(-1 -3)(0 -3)(1 -3)
(-2 2)(-1 -2)(0 -2)(1 -2)(2 -2)
(-3 -1)(-2 1)(-1 -1)(0 -1)(1 -1)(2 -1)(3 -1)
(-4 0)(-3 0)(-2 0)(-1 0)(0 0)(1 0)(2 0)(3 0)(4 0)
(-3 1)(-2 -1)(-1 1)(0 1)(1 1)(2 1)(3 1)
(-2 -2)(-1 2)(0 2)(1 2)(2 2)
(-1 3)(0 3)(1 3)
(0 4))
</code></pre><p>Its implementation isn't all that relevant because, if you recall the <code>define-machine</code> macro, the only access a <code>behavior</code> has into its given <code>neighborhood</code> is through the local <code>neighbor</code> function. That function takes <code>x</code>/<code>y</code>, and returns a cell, so the underlying datastructure is effectively hidden from the user.</p><pre><code class="scheme">...
(defmethod neighborhood-of ((grid grid) x y)
(loop for (xd yd) in n*extended
for new-x = (+ xd x) for new-y = (+ yd y)
when (array-in-bounds-p (spaces grid) new-x new-y)
collect (cons (cons xd yd) (get-cell grid new-x new-y))))
...
</code></pre><p>Factually, it's an <code>alist</code> at the moment, but you don't have to care about that in order to understand the intent.</p><p>So that's about it. You understand the basic behavior of this cell simulator, as well as the basic concepts underpinning the definition of new <code>machine</code>s, and you understand a few axes on which we might vary the base rules of a system in order to possibly vary its macro-scale behavior. It'd be nice if we could test this in some way...</p><h2><a name="-code-trurl-code-"></a><a href="#-code-trurl-code-"><code>trurl</code></a></h2><p><a href='https://github.com/inaimathi/trurl'><code>trurl</code></a> is a minimal <a href='http://trurl.inaimathi.ca/'>web interface</a> and API hooked up to allow modification of a <code>lem:grid</code> by spawning a fixed set of new cells. It still doesn't have all the machines I'm hoping to put in as defaults, and it still doesn't allow design of custom machines, but it does allow someone to poke at a grid graphically and observe the macro-level behavior.</p><p>This is the least complete part of the project at the moment, but there are enough unanswered questions bouncing around my head that I thought it better to record them now rather than waiting on completion before starting this blog post. The main default cell types I'd want to implement before calling that part "done" are <code>ff</code> and <code>gg</code>.</p><p><code>gg</code> is the thing I built the simulator to consider more fully. It's a fairly simple machine definition:</p><pre><code class="scheme">(define-machine gg
(loop for (x y) in n*extended
for (spawn-in! (neighbor x y) self)))
</code></pre><p>For each neighbor in its given neighborhood, it replicates itself (overwriting whatever was there). It seems like, in a giant distributed system where each "grid space" is going to be running code that it can't really trust, someone somewhere is going to think about evaluating something like this, and I want to know what possible mitigation strategies are<a href='#fn-4' id='fnref4'><sup>4</sup></a>.</p><p><code>ff</code> is sort of a benign version of <code>gg</code>. I guess. For some value of "benign".</p><pre><code class="scheme">(define-machine ff
(loop for (x y) in n*extended
for c = (neighbor x y)
do (when (empty? c) (spawn-in! c self))))
</code></pre><p>It has most of the same implications as <code>gg</code>, but it avoids stomping on existing cells and instead "merely" consumes all available space.</p><p>The big feature I'd like apart from additional default machines is the ability for users to define their own machines in-flight. And that's going to take some thought. The first approach I can see is defining a separate package that doesn't do the usual <code>(:use #:cl)</code> for machine definition, and doing a separate interning step on incoming definitions to make sure any symbols we try to evaluate come from that package. We could still use the usual shadowing tricks to provide some extra symbols, or contingent definitions for some of them. The key, though, is making sure that only a "safe" subset of Common Lisp, which means cherrypicking only things from <code>cl</code> that don't allow any kind of file, socket or probably stream output. I'd want to deny arbitrary mutation too, otherwise it'd be possible for a sufficiently clever attacker to get shit through. If I did this well enough, it would naturally allow multiple definition languages with varying power (which could provide a decent skill progression tree in a game context).</p><p>That's that. I'll keep you posted on further developments, probably something like a week or two after they unfold. <ol class='footnotes'><li id='fn-1'>Or possibly unsurprising, depending on exactly how much thinking you've done on the subject.<a href='#fnref1'>↩</a></li><li id='fn-2'><code>lem</code>, by pun-analogy to the <a href='https://github.com/DaveAckley/ULAM'>Ulam</a> platform that Ackley uses, and <code>trurl</code> as a further appropriate joke that, fortunately, needs no explanation.<a href='#fnref2'>↩</a></li><li id='fn-3'>Not <i>the</i> simplest, obviously, because that would be <code>(define-machine lemon nil)</code>, which merely keeps existing until something changes that. As a side note, I'm using the name <code>lemon</code> because of the vernacular expression regarding "sitting there like a"; I'm well aware that in reality, lemons at the very least know how to build a new lemon tree out of soil, water and oxygen.<a href='#fnref3'>↩</a></li><li id='fn-4'>There is the obvious; introduce some sort of cost for calling <code>spawn-in!</code>. If there's no better way, that's a decent approach, but I have this conceit that you could have a post-scarcity situation where grey goo or analogues still don't necessarily take over. And applying costs has implications for that conceit. Beyond that though, introducing cost for spawning isn't an in-system solution to the problem. So it doesn't translate to situations where you'd want to mitigate <code>gg</code>-like scenarios, but don't necessarily have alteration privileges on the underlying substrate.<a href='#fnref4'>↩</a></li></ol></p>Fuck Silence2017-08-04T23:30:00.000Zinaimathi<p>Ok, so here's the thing.</p><p>There's no way I'm ever catching up.</p><p>Ever.</p><p>I've been reading, watching, thinking about, and working on entire freaking worlds of such intricate interest that there is absolutely no way I'm ever giving you the full picture, even if I were to somehow start writing at the staggering pace of an article per week<a href='#fn-1' id='fnref1'><sup>1</sup></a>. At some point, I have to start being honest with myself about what a realistic expectation looks like here. Which, unfortunately means writing about a relatively smaller subset of my experience, but trying to do it a lot more regularly.</p><p>This is still very probably superior in some way to sitting in spin-locked silence, but do be aware that you're not getting anywhere near the complete picture. I suppose you never <i>really</i> were, but there was a glorious, 8-year moment where we could both squint and pretend. So, with that mindset, here's an incomplete, molten core sample from my thoughts at the moment.</p><h2><a name="collective-decision-making"></a><a href="#collective-decision-making">Collective Decision Making</a></h2><p>There's <a href='https://github.com/inaimathi/cl-vote'>a project</a> I've been poking at for a few weeks at this point meant to ease some pain in a particular collective decision making process. <a href='http://compscicabal.github.io/'>We</a> need to decide which paper to read next, you see. And the way we do it right now is, embarrasingly, by mildly abusing <a href='https://github.com/CompSciCabal/SMRTYPRTY/issues'>the <code>github</code> issue system</a>. What I'm trying to do is come up with a voting and scheduling system for us that both hooks into the <code>github</code> auth system <i>and</i> doesn't suck.</p><p>The starting point is my usual prototyping toolkit of <a href='https://common-lisp.net/'>Common Lisp</a> combined with <a href='https://github.com/inaimathi/house'><code>house</code></a> and <a href='https://github.com/inaimathi/fact-base'><code>fact-base</code></a>, and the first thing I'm doing is putting together the minimal web API for interacting with collections of papers in an effort to prioritize them. I'm not going to talk more about this now, mostly because it isn't anywhere near done yet, and that's the goal state in the near future<a href='#fn-2' id='fnref2'><sup>2</sup></a>.</p><h2><a name="robustness-as-a-founding-principle"></a><a href="#robustness-as-a-founding-principle">Robustness as a founding principle</a></h2><p>"Robustness", as in, a computation should be very, <i>very</i> hard to disrupt adversarially. And "founding principle" as in, it should take priority over correctness and performance. This is the bizarre-seeming idea behind a <a href='https://www.youtube.com/watch?v=I4flQ8XdvJM'>series</a> of <a href='https://www.youtube.com/watch?v=helScS3coAE'>videos</a> that I've been <a href='https://www.youtube.com/watch?v=OQsn1c92pdY'>digesting</a> lately. The particular approach that ends up evolving is that of a massively parallel cellular automaton, where effectively each cells' behavior is specified separately.</p><p>I've got a minimal, toy simulator implemented over <a href='https://github.com/inaimathi/lem'>on github</a> that more or less works, and seems like it'll make exploring the idea relatively simple going forward. And there's a bunch of things that seem worth exploring, ranging from the implications of demoting correctness and performance in importance, to the specifics of how robustness works in the face of things like <a href='https://en.wikipedia.org/wiki/Grey_goo'>grey goo</a>.</p><h2><a name="eating-one-s-own-tail"></a><a href="#eating-one-s-own-tail">Eating One's Own Tail</a></h2><p>A <a href='http://web.cs.ucla.edu/%7Epalsberg/paper/popl16-full.pdf'>recent paper</a><a href='#fn-3' id='fnref3'><sup>3</sup></a> showed us how we might go about writing a self-interpreter for a language whose type system you would expect to prevent such shenanigans. The thrust of it so far is that this is possible by playing semantic games with the definition of "quoting" and "unquoting" in the macro sense. I'll let you know if additional insights are refined from today's reading.</p><h2><a name="the-unreliability-of-machine-supply-chains"></a><a href="#the-unreliability-of-machine-supply-chains">The Unreliability of Machine Supply Chains</a></h2><p>A <i>different</i> <a href='http://sharps.org/wp-content/uploads/BECKER-CHES.pdf'>recent paper</a> showed <a href='http://compscicabal.github.io/'>us</a> that machines are even more laughably insecure than we thought. There are supply-chain level attacks that can compromize hardware in a way that is almost fiendishly hard to detect. We didn't think much of the revelation, but discussions on how we might have some security guarantees despite the presence of hardware trojans happened regardless. There doesn't seem to be a very good way of preventing eavesdropping, but guarding against maliciously corrupted computations at least seems possible. It also seems like Robustness-first principles from the previous section might help out here in some way. That part, I'll have to get back to you on after I do a bit more prototyping. <ol class='footnotes'><li id='fn-1'>Which is already ridiculous, but that would just mean I'd start keeping up with the stream. In order to actually <i>catch up</i> in a year or two? That would take a full article every two days for the duration.<a href='#fnref1'>↩</a></li><li id='fn-2'>Though I reserve the right to re-write it in <a href='https://clojure.org/'>Clojure</a> using <a href='https://github.com/gardendb/gardendb'><code>gardendb</code></a> and some monstrosity I put together to replace the centralized routing tables that Clojure web frameworks seem to have in common.<a href='#fnref2'>↩</a></li><li id='fn-3'>Which we're actually still reading as I write this. It's one of the papers interesting enough to warrant a second week being spent on it.<a href='#fnref3'>↩</a></li></ol></p>House Performance2016-12-26T22:27:23.000Zinaimathi<p>Ok, it's about time I put <a href='https://github.com/inaimathi/house'>this fucker</a> through its paces.</p><pre><code class="lisp">;; in SLIME
; SLIME 2016-04-19
CL-USER> (ql:quickload :house)
To load "house":
Load 1 ASDF system:
house
; Loading "house"
........
(:HOUSE)
CL-USER> (in-package :house)
#<PACKAGE "HOUSE">
HOUSE> (define-handler (hello-world :content-type "text/plain") ()
"Hello world!")
#<HANDLER-TABLE {100A1BF7A3}>
HOUSE> (house:start 4040)
</code></pre><pre><code class="shell"># in eshell
~/quicklisp/local-projects/house $ wrk -t12 -c400 -d30s http://127.0.0.1:4040/hello-world
Running 30s test @ http://127.0.0.1:4040/hello-world
12 threads and 400 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 3.84ms 50.75ms 1.63s 99.56%
Req/Sec 0.98k 667.17 8.12k 82.60%
172737 requests in 30.03s, 43.00MB read
Socket errors: connect 0, read 173088, write 0, timeout 19
Requests/sec: 5752.02
Transfer/sec: 1.43MB
~/quicklisp/local-projects/house $
</code></pre><p>So that's a decent start. Out of the gate, according to <a href='https://github.com/fukamachi/woo/blob/master/benchmark.md#benchmarks'>this</a>, <code>house</code> outperforms <code>tornado</code> (unless running in <code>pypy</code>), <code>wookie</code> and <code>hunchentoot</code> in terms of requests/second<a href='#fn-1' id='fnref1'><sup>1</sup></a> on a single thread. Which is not bad for a server that had no intention whatsoever of outperforming anything.</p><p>That's all well and good, but it's not really what I'm interested in. Enhance!</p><pre><code class="lisp">C-c C-c
; Evaluation aborted on NIL.
HOUSE>
</code></pre><pre><code class="emacs">M-x slime-profile-pakcage HOUSE y y
</code></pre><pre><code class="lisp">HOUSE> (house:start 4040)
</code></pre><pre><code class="shell">~/quicklisp/local-projects/house $ wrk -t12 -c400 -d30s http://127.0.0.1:4040/hello-world
Running 30s test @ http://127.0.0.1:4040/hello-world
12 threads and 400 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 22.42ms 71.10ms 1.60s 93.01%
Req/Sec 96.75 108.40 690.00 88.96%
9446 requests in 30.04s, 2.35MB read
Socket errors: connect 0, read 9456, write 0, timeout 1
Requests/sec: 314.47
Transfer/sec: 80.15KB
~/quicklisp/local-projects/house $
</code></pre><p>So it performs predictably poorly with the profiler running, but again, not really what we're interested in.</p><pre><code class="lisp">C-c C-c
; Evaluation aborted on NIL.
HOUSE>
</code></pre><pre><code class="emacs">M-x slime-profile-report
</code></pre><pre><code>measuring PROFILE overhead..done
seconds | gc | consed | calls | sec/call | name
--------------------------------------------------------------
2.197 | 0.000 | 43,472 | 16,862,405 | 0.000000 | HOUSE::IDLING?
1.346 | 0.000 | 160 | 16,862,405 | 0.000000 | HOUSE::LAST-POKED
0.221 | 0.000 | 1,805,136 | 9,473 | 0.000023 | HOUSE::BUFFER!
0.188 | 0.000 | 47,902,976 | 18,926 | 0.000010 | HOUSE::FLEX-STREAM
0.165 | 0.000 | 3,924,080 | 18,926 | 0.000009 | HOUSE::WRITE!
0.099 | 0.000 | 25,477,856 | 18,924 | 0.000005 | HOUSE::PARSE
0.080 | 0.000 | 35,093,408 | 482,562 | 0.000000 | HOUSE::LINE-TERMINATED?
0.075 | 0.000 | 0 | 984,048 | 0.000000 | HOUSE::CONTENTS
0.072 | 0.000 | 0 | 965,135 | 0.000000 | HOUSE::TOTAL-BUFFERED
0.048 | 0.000 | 0 | 482,562 | 0.000000 | (SETF HOUSE::TOTAL-BUFFERED)
0.042 | 0.000 | 0 | 492,024 | 0.000000 | (SETF HOUSE::CONTENTS)
0.040 | 0.000 | 0 | 75,703 | 0.000001 | HOUSE::CRLF
0.032 | 0.000 | 64 | 18,924 | 0.000002 | HOUSE::->KEYWORD
0.030 | 0.000 | 880,192 | 9,462 | 0.000003 | HOUSE::NEW-SESSION-TOKEN!
0.006 | 0.000 | 0 | 9,463 | 0.000001 | HOUSE::KEEP-ALIVE?
0.006 | 0.000 | 96 | 510,958 | 0.000000 | HOUSE:REQUEST
0.004 | 0.000 | 0 | 18,924 | 0.000000 | (SETF HOUSE:PARAMETERS)
0.002 | 0.000 | 0 | 9,462 | 0.000000 | HOUSE::EXPECTING
0.002 | 0.000 | 0 | 9,462 | 0.000000 | HOUSE::SPLIT-AT
0.002 | 0.000 | 0 | 9,462 | 0.000000 | HOUSE::HTTP-METHOD
0.002 | 0.000 | 0 | 9,462 | 0.000000 | HOUSE::ANY-VARS?
0.002 | 0.000 | 0 | 9,462 | 0.000000 | HOUSE:SESSION-TOKENS
0.002 | 0.000 | 0 | 9,462 | 0.000000 | (SETF HOUSE:REQUEST)
0.002 | 0.000 | 0 | 9,463 | 0.000000 | HOUSE::CONTENT-TYPE
0.002 | 0.000 | 0 | 9,463 | 0.000000 | HOUSE::CHARSET
0.002 | 0.000 | 0 | 9,462 | 0.000000 | HOUSE::FIND-HANDLER
0.000 | 0.000 | 5,079,696 | 9,462 | 0.000000 | HOUSE::HANDLE-REQUEST!
0.000 | 0.000 | 32,736 | 18,924 | 0.000000 | HOUSE::TRIE-LOOKUP
0.000 | 0.000 | 32,768 | 9,462 | 0.000000 | (SETF HOUSE::EXPECTING)
0.000 | 0.000 | 0 | 18,924 | 0.000000 | HOUSE::TOKEN
0.000 | 0.000 | 0 | 9,473 | 0.000000 | HOUSE::BI-STREAM
0.000 | 0.000 | 0 | 9,463 | 0.000000 | HOUSE::COOKIE
0.000 | 0.000 | 0 | 9,462 | 0.000000 | HOUSE::PARSE-PARAMS
0.000 | 0.000 | 42,832 | 95 | 0.000000 | HOUSE::CLEAN-SESSIONS!
0.000 | 0.000 | 0 | 9,473 | 0.000000 | HOUSE::STARTED
0.000 | 0.000 | 0 | 9,462 | 0.000000 | HOUSE::HANDLERS
0.000 | 0.000 | 0 | 9,463 | 0.000000 | HOUSE::RESPONSE-CODE
0.000 | 0.000 | 0 | 9,463 | 0.000000 | HOUSE::BODY
0.000 | 0.000 | 0 | 9,463 | 0.000000 | HOUSE::LOCATION
0.000 | 0.000 | 0 | 18,946 | 0.000000 | HOUSE::TRIES
0.000 | 0.000 | 0 | 9,473 | 0.000000 | (SETF HOUSE::TRIES)
0.000 | 0.000 | 0 | 1 | 0.000000 | HOUSE::ERROR!
0.000 | 0.048 | 56,180,928 | 18,936 | 0.000000 | HOUSE::PROCESS-READY
0.000 | 0.000 | 0 | 9,462 | 0.000000 | HOUSE:RESOURCE
0.000 | 0.000 | 1,828,992 | 9,462 | 0.000000 | HOUSE:NEW-SESSION!
0.000 | 0.000 | 10,214,832 | 1 | 0.000000 | HOUSE:START
0.000 | 0.000 | 0 | 9,462 | 0.000000 | HOUSE:PARAMETERS
0.000 | 0.000 | 0 | 9,462 | 0.000000 | HOUSE:HEADERS
0.000 | 0.000 | 0 | 9,462 | 0.000000 | (SETF HOUSE:HEADERS)
--------------------------------------------------------------
4.666 | 0.048 | 188,540,224 | 38,153,240 | | Total
estimated total profiling overhead: 24.72 seconds
overhead estimation parameters:
3.2000003e-8s/call, 6.48e-7s total profiling, 2.16e-7s internal profiling
These functions were not called:
HOUSE::ARG-EXP HOUSE::ARGS-BY-TYPE-PRIORITY HOUSE::ARGUMENTS
HOUSE::ASSERTION (SETF HOUSE::BODY) (SETF HOUSE::CACHE-CONTROL)
HOUSE::CACHE-CONTROL (SETF HOUSE::CHARSET) HOUSE::CHECK-FOR-DUPES
HOUSE:CLEAR-SESSION-HOOKS! (SETF HOUSE::CONTENT-TYPE)
(SETF HOUSE::COOKIE) HOUSE::COPY-TRIE HOUSE::DATA HOUSE::DEBUG!
HOUSE:DEFINE-FILE-HANDLER HOUSE::EMPTY HOUSE::EVENT
(SETF HOUSE::EXPIRES) HOUSE::EXPIRES HOUSE:GET-SESSION!
(SETF HOUSE::HTTP-METHOD) HOUSE::ID HOUSE::INSERT-HANDLER!
(SETF HOUSE::KEEP-ALIVE?) (SETF HOUSE::LAST-POKED)
(SETF HOUSE::LOCATION) (SETF HOUSE:LOOKUP) HOUSE:LOOKUP HOUSE:MAKE-SSE
HOUSE::MAKE-TRIE HOUSE:NEW-SESSION-HOOK! HOUSE::PARSE-COOKIES
HOUSE::PARSE-VAR HOUSE::PATH->MIMETYPE HOUSE:PATH->URI HOUSE::PATH-VAR?
HOUSE::POKE! HOUSE::PROCESS-URI HOUSE:PUBLISH! HOUSE::READ-ALL
HOUSE:REDIRECT! (SETF HOUSE:RESOURCE) (SETF HOUSE::RESPONSE-CODE)
HOUSE::RETRY (SETF HOUSE:SESSION-TOKENS) HOUSE::SESSION-VALUES
HOUSE:SUBSCRIBE! HOUSE::TRIE-INSERT! (SETF HOUSE::TRIE-MAP)
HOUSE::TRIE-MAP HOUSE::TRIE-P (SETF HOUSE::TRIE-VALUE)
HOUSE::TRIE-VALUE (SETF HOUSE::TRIE-VARS) HOUSE::TRIE-VARS
HOUSE::TYPE-ASSERTION HOUSE::TYPE-EXPRESSION HOUSE::URI-DECODE
HOUSE::VAR-KEY
</code></pre><p> So a bunch of stuff was never called, and <code>buffer!</code>, <code>parse</code>, <code>write!</code> and <code>flex-stream</code> are predictably near the top time-sinks list. What mildly surprises me is that the session-handling primitives <code>idling?</code> and <code>last-poked</code> are generating so many <code>cons</code>es. The same can be said of <code>line-terminated?</code>, except I'm pretty sure I know what the issue <i>there</i> is.</p><h2><a name="low-hanging-fruit"></a><a href="#low-hanging-fruit">Low-Hanging Fruit</a></h2><p>This is already a pretty opportunistic optimization session, so we're going fairly surface-level in terms of chages we can make. The <i>lowest</i> of the low hanging fruit is <code>line-terminated?</code>, which is currently defined as</p><pre><code class="lisp">;; house.lisp
...
(defun line-terminated? (lst)
(starts-with-subseq
#-windows(list #\linefeed #\return #\linefeed #\return)
#+windows(list #\newline #\newline)
lst))
...
</code></pre><p>You can see that this seemingly innocent function is producing a lot of <code>cons</code>es, which is a shorthand for memory consumption in the above profiler report.</p><pre><code>...
seconds | gc | consed | calls | sec/call | name
--------------------------------------------------------------
...
0.080 | 0.000 | 35,093,408 | 482,562 | 0.000000 | HOUSE::LINE-TERMINATED?
...
</code></pre><p>The reason is that we're using <code>list</code> to create the sequence we're checking against. Even though it's effectively a constant, it's not getting allocated once and treated as such because of the way we construct it. Rather that list of characters gets newly allocated on each <code>line-terminated?</code> call, which happens just shy of 500k times over the course of only a few thousand requests. The easy fix here is quoting the list.</p><pre><code>M-x slime-profile-reset
</code></pre><pre><code>HOUSE> (loop repeat 1000000 do (line-terminated? "testing\\r\\n"))
NIL
</code></pre><pre><code>M-x slime-profile-report
seconds | gc | consed | calls | sec/call | name
------------------------------------------------------------
0.184 | 0.000 | 63,995,888 | 1,000,000 | 0.000000 | HOUSE::LINE-TERMINATED?
------------------------------------------------------------
0.184 | 0.000 | 63,995,888 | 1,000,000 | | Total
estimated total profiling overhead: 0.65 seconds
overhead estimation parameters:
3.2000003e-8s/call, 6.48e-7s total profiling, 2.16e-7s internal profiling
...
M-x slime-profile-reset
</code></pre><pre><code>HOUSE> (defun line-terminated? (lst)
(starts-with-subseq
#-windows'(#\linefeed #\return #\linefeed #\return)
#+windows'(#\newline #\newline)
lst))
WARNING: redefining HOUSE::LINE-TERMINATED? in DEFUN
LINE-TERMINATED?
HOUSE> (loop repeat 1000000 do (line-terminated? "testing\\r\\n"))
NIL
HOUSE>
</code></pre><pre><code>M-x slime-profile-report
seconds | gc | consed | calls | sec/call | name
--------------------------------------------------------
0.136 | 0.000 | 0 | 1,000,000 | 0.000000 | HOUSE::LINE-TERMINATED?
--------------------------------------------------------
0.136 | 0.000 | 0 | 1,000,000 | | Total
estimated total profiling overhead: 0.65 seconds
overhead estimation parameters:
3.2000003e-8s/call, 6.48e-7s total profiling, 2.16e-7s internal profiling
M-x slime-profile-reset
</code></pre><p>Did you catch the difference there? This is one of those arcane finer-points that lisp newbs wouldn't notice, so don't feel bad if you missed it.</p><pre><code class="lisp">;; house.lisp
...
(defun line-terminated? (lst)
(starts-with-subseq
#-windows'(#\linefeed #\return #\linefeed #\return)
#+windows'(#\newline #\newline)
lst))
...
</code></pre><p>We're now using <code>'</code> to create the comparison list. Which, according to either the <a href='http://clhs.lisp.se'>CLHS</a> or convention, <i>does</i> signal to the compiler/runtime that the given list is going to be an absolutely constant piece of data that never changes. It therefore gets allocated once at compile-time, and gets re-used on every <code>line-terminated?</code> call thereafter.</p><p>While we're at it, by the way. <code>buffer!</code> currently calls <code>line-terminated?</code> after every character it processes. And really, it shouldn't bother unless that character was a <code>#\linefeed</code> (<code>#\newline</code> on Windows).</p><pre><code class="lisp">;; house.lisp
...
when (and #-windows(char= char #\linefeed)
#+windows(char= char #\newline)
(line-terminated? (contents buffer)))
...
</code></pre><h2><a name="session-related-cruft"></a><a href="#session-related-cruft">Session-Related Cruft</a></h2><p>The next two two offenders, according to our highly-specific and not-at-all-real-world-reflecting profiling trial are session-related. Specifically <code>idling?</code> and <code>last-poked</code>. They both get called the same number of times, so my suspicion is that <code>last-poked</code> <i>only</i> gets called inside of <code>idling?</code>. One look at the body of <code>idling?</code> tells me this is a justified suspicion</p><pre><code>...
(defmethod idling? ((sess session))
(> (- (get-universal-time) (last-poked sess)) +max-session-idle+))
...
</code></pre><p>Additionally, <code>last-poked</code> is a getter method on the <code>session</code> class, so it does the brain-dead simple job of checking an instance slot and returning its current value. It seems like the only reasons either of these methods registered on the profiling report are</p><ol><li>This test focuses on a ridiculously simple handler that does nothing but write <code>Hello World!</code> to the client regardless of inputs or other considerations, which therefore means that usually very minor machinery is taking up more comparable runtime/memory than it would with more complicated business logic.</li><li>These particular functions get called extremely often. To the tune of 16 <i>million</i> times over the course of our very minor tests.</li></ol><p>So there seems to be two possible ways to address the issue:</p><ul><li>Call these methods less frequently</li><li>Have the compiler inline them</li></ul><h3><a name="call-them-less-frequently-"></a><a href="#call-them-less-frequently-">Call Them Less Frequently...</a></h3><p>...<i>may</i> be a non-starter. The whole point of calling either function is to evict stale sessions so that they're more difficult to hijack, which means we very probably <i>should</i> be willing to take the consistent hit on performance to ensure security. Hypothetically, if we wanted to call <code>idling?</code> probabilistically, a quick <code>grep</code> tells us that it only gets called in <code>get-session!</code>.</p><pre><code>...
(defun get-session! (token)
(awhen (gethash token *sessions*)
(if (idling? it)
(progn (remhash token *sessions*) nil)
(poke! it))))
...
</code></pre><p>Which means that we <i>could</i>, but very probably <i>shouldn't</i> do something like</p><pre><code>...
(defun get-session! (token)
(awhen (gethash token *sessions*)
(if (and (= 0 (random +idling-check-chance+)) (idling? it))
(progn (remhash token *sessions*) nil)
(poke! it))))
...
</code></pre><p>so that we only actually do the stale check some percentage of the time we'd like to. This would have no noticeable effect on behavior during a high-traffic period, but seems like it would have a pretty large impact on effective <code>session</code> lifetimes during low-traffic periods. I'm not sure I'd want to implement this naively, but <i>will</i> leave a note-to-self to seriously think about implementing some performance tweaks that only awaken during traffic spikes, when they're likely to have a large impact, and stay dormant otherwise without seriously affecting performance or behavior.</p><h3><a name="inline-them"></a><a href="#inline-them">Inline Them</a></h3><p>This <i>would</i> be close to trivial, except that both <code>idling?</code> and <code>last-poked</code> are methods. <code>idling?</code> because I've declared it that way to increase flexibility, and <code>last-poked</code> because it's created by the <code>accessor</code> option on a <code>defclass</code> form. So it'll take a bit more effort for us specifically. First off, we basically can't use <code>last-poked</code>, and must instead resort to the slightly more verbose <code>(slot-value sess 'last-poked)</code>. Since calls to <code>last-poked</code> only appear in two places, and it's not an exported symbol, this sounds like a reasonable price to pay.</p><pre><code class="lisp">;; session.lisp
...
(defmethod idling? ((sess session))
(> (- (get-universal-time) (slot-value sess 'last-poked)) +max-session-idle+))
(defmethod poke! ((sess session))
(setf (slot-value sess 'last-poked) (get-universal-time))
sess)
</code></pre><p>Second, <code>idling?</code> can no longer be a method. Which kind of sucks from the readability standpoint (since we will no longer be explicit about what type of input it's expecting), but should be worth our time from the performance perspective.</p><pre><code class="lisp">;; session.lisp
...
(defun idling? (sess)
(> (- (get-universal-time) (slot-value sess 'last-poked)) +max-session-idle+))
...
</code></pre><p>Once that's done, we just need to add an <code>inline</code> declaration preceding the function definition, and we're good.</p><pre><code class="lisp">;; session.lisp
...
(declaim (inline idling?))
(defun idling? (sess)
(> (- (get-universal-time) (slot-value sess 'last-poked)) +max-session-idle+))
...
</code></pre><p>I've also moved the definition up above its calls in the code, <i>just in case</i> that ends up mattering for some reason. Now that we've chopped our primary suspects, a quick re-run of the test should show us our next target.</p><pre><code>M-x slime-profile-reset
</code></pre><pre><code class="shell"># in eshell
~/quicklisp/local-projects/house $ wrk -t12 -c400 -d30s http://127.0.0.1:4040/hello-world
Running 30s test @ http://127.0.0.1:4040/hello-world
12 threads and 400 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 4.42ms 29.03ms 1.71s 99.87%
Req/Sec 346.45 172.64 1.35k 77.96%
57772 requests in 30.03s, 14.38MB read
Socket errors: connect 0, read 58157, write 0, timeout 7
Requests/sec: 1923.57
Transfer/sec: 490.29KB
~/quicklisp/local-projects/house $
</code></pre><pre><code>M-x slime-profile-report
seconds | gc | consed | calls | sec/call | name
----------------------------------------------------------------
5.519 | 0.000 | 52,729,616 | 116,112 | 0.000048 | HOUSE::BUFFER!
3.388 | 0.000 | 64 | 1,160 | 0.002920 | HOUSE::CLEAN-SESSIONS!
2.366 | 0.032 | 272,263,248 | 232,184 | 0.000010 | HOUSE::FLEX-STREAM
1.877 | 0.188 | 383,491,456 | 232,184 | 0.000008 | HOUSE::WRITE!
1.087 | 0.124 | 351,142,944 | 232,180 | 0.000005 | HOUSE::PARSE
0.823 | 0.000 | 16 | 5,920,590 | 0.000000 | HOUSE::LINE-TERMINATED?
0.789 | 0.028 | 59,615,552 | 116,090 | 0.000007 | HOUSE::HANDLE-REQUEST!
0.664 | 0.000 | 3,401,552 | 928,734 | 0.000001 | HOUSE::CRLF
0.385 | 0.000 | 22,653,792 | 116,090 | 0.000003 | HOUSE::NEW-SESSION-TOKEN!
0.318 | 0.000 | 7,857,040 | 232,180 | 0.000001 | HOUSE::->KEYWORD
0.197 | 0.012 | 125,392,640 | 116,090 | 0.000002 | HOUSE:NEW-SESSION!
0.120 | 0.000 | 9,105,056 | 232,180 | 0.000001 | HOUSE::TRIE-LOOKUP
0.117 | 0.008 | 6,587,360 | 116,090 | 0.000001 | HOUSE::SPLIT-AT
0.044 | 0.000 | 0 | 116,090 | 0.000000 | HOUSE::FIND-HANDLER
0.029 | 0.000 | 1,340,640 | 116,090 | 0.000000 | HOUSE::PARSE-PARAMS
0.017 | 0.000 | 0 | 116,112 | 0.000000 | (SETF HOUSE::TRIES)
0.013 | 0.000 | 0 | 116,092 | 0.000000 | HOUSE::COOKIE
0.013 | 0.000 | 0 | 116,092 | 0.000000 | HOUSE::CHARSET
0.009 | 0.000 | 0 | 116,112 | 0.000000 | HOUSE::BI-STREAM
0.005 | 0.000 | 0 | 116,090 | 0.000000 | (SETF HOUSE:REQUEST)
0.001 | 0.000 | 0 | 116,090 | 0.000000 | HOUSE::ANY-VARS?
0.001 | 0.000 | 0 | 116,090 | 0.000000 | HOUSE:PARAMETERS
0.000 | 0.000 | 0 | 116,092 | 0.000000 | HOUSE::KEEP-ALIVE?
0.000 | 0.000 | 0 | 232,180 | 0.000000 | HOUSE::TOKEN
0.000 | 0.000 | 0 | 116,092 | 0.000000 | HOUSE::CONTENT-TYPE
0.000 | 0.000 | 0 | 116,090 | 0.000000 | HOUSE::HTTP-METHOD
0.000 | 0.000 | 0 | 116,092 | 0.000000 | HOUSE::LOCATION
0.000 | 0.000 | 0 | 232,224 | 0.000000 | HOUSE::TRIES
0.000 | 0.000 | 0 | 11,841,202 | 0.000000 | HOUSE::TOTAL-BUFFERED
0.000 | 0.000 | 0 | 5,920,590 | 0.000000 | (SETF HOUSE::TOTAL-BUFFERED)
0.000 | 0.000 | 0 | 116,092 | 0.000000 | HOUSE::RESPONSE-CODE
0.000 | 0.000 | 0 | 116,090 | 0.000000 | HOUSE::EXPECTING
0.000 | 0.000 | 0 | 116,090 | 0.000000 | (SETF HOUSE::EXPECTING)
0.000 | 0.000 | 0 | 116,112 | 0.000000 | HOUSE::STARTED
0.000 | 0.056 | 558,371,856 | 232,204 | 0.000000 | HOUSE::PROCESS-READY
0.000 | 0.000 | 0 | 2 | 0.000000 | HOUSE::ERROR!
0.000 | 0.000 | 0 | 116,090 | 0.000000 | HOUSE::HANDLERS
0.000 | 0.000 | 0 | 12,073,360 | 0.000000 | HOUSE::CONTENTS
0.000 | 0.000 | 0 | 6,036,680 | 0.000000 | (SETF HOUSE::CONTENTS)
0.000 | 0.000 | 0 | 116,092 | 0.000000 | HOUSE::BODY
0.000 | 0.000 | 0 | 116,090 | 0.000000 | HOUSE:RESOURCE
0.000 | 0.000 | 93,299,376 | 2 | 0.000000 | HOUSE:START
0.000 | 0.000 | 0 | 232,180 | 0.000000 | (SETF HOUSE:PARAMETERS)
0.000 | 0.000 | 0 | 116,090 | 0.000000 | HOUSE:HEADERS
0.000 | 0.000 | 0 | 116,090 | 0.000000 | (SETF HOUSE:HEADERS)
0.000 | 0.000 | 0 | 116,090 | 0.000000 | HOUSE:SESSION-TOKENS
0.000 | 0.000 | 128 | 6,268,880 | 0.000000 | HOUSE:REQUEST
----------------------------------------------------------------
17.781 | 0.448 | 1,947,252,336 | 54,331,518 | | Total
estimated total profiling overhead: 37.81 seconds
overhead estimation parameters:
8.000001e-9s/call, 6.9600003e-7s total profiling, 3.36e-7s internal profiling
These functions were not called:
HOUSE::ARG-EXP HOUSE::ARGS-BY-TYPE-PRIORITY HOUSE::ARGUMENTS
HOUSE::ASSERTION (SETF HOUSE::BODY) (SETF HOUSE::CACHE-CONTROL)
HOUSE::CACHE-CONTROL (SETF HOUSE::CHARSET) HOUSE::CHECK-FOR-DUPES
HOUSE:CLEAR-SESSION-HOOKS! (SETF HOUSE::CONTENT-TYPE)
(SETF HOUSE::COOKIE) HOUSE::COPY-TRIE HOUSE::DATA HOUSE::DEBUG!
HOUSE:DEFINE-FILE-HANDLER HOUSE::EMPTY HOUSE::EVENT
(SETF HOUSE::EXPIRES) HOUSE::EXPIRES HOUSE:GET-SESSION!
(SETF HOUSE::HTTP-METHOD) HOUSE::ID HOUSE::IDLING?
HOUSE::INSERT-HANDLER! (SETF HOUSE::KEEP-ALIVE?)
(SETF HOUSE::LAST-POKED) HOUSE::LAST-POKED (SETF HOUSE::LOCATION)
(SETF HOUSE:LOOKUP) HOUSE:LOOKUP HOUSE:MAKE-SSE HOUSE::MAKE-TRIE
HOUSE:NEW-SESSION-HOOK! HOUSE::PARSE-COOKIES HOUSE::PARSE-VAR
HOUSE::PATH->MIMETYPE HOUSE:PATH->URI HOUSE::PATH-VAR? HOUSE::POKE!
HOUSE::PROCESS-URI HOUSE:PUBLISH! HOUSE::READ-ALL HOUSE:REDIRECT!
(SETF HOUSE:RESOURCE) (SETF HOUSE::RESPONSE-CODE) HOUSE::RETRY
(SETF HOUSE:SESSION-TOKENS) HOUSE::SESSION-VALUES HOUSE:SUBSCRIBE!
HOUSE::TRIE-INSERT! (SETF HOUSE::TRIE-MAP) HOUSE::TRIE-MAP
HOUSE::TRIE-P (SETF HOUSE::TRIE-VALUE) HOUSE::TRIE-VALUE
(SETF HOUSE::TRIE-VARS) HOUSE::TRIE-VARS HOUSE::TYPE-ASSERTION
HOUSE::TYPE-EXPRESSION HOUSE::URI-DECODE HOUSE::VAR-KEY
</code></pre><h2><a name="buffer-related-cruft"></a><a href="#buffer-related-cruft">Buffer-related cruft</a></h2><p>Ok, there's one more piece of session infrastructure that's still causing pains; <code>clean-sessions!</code>. That's something we very probably <i>can</i> handle probabilistically, so I'll leave it for a bit later. But seven of the top-ten biggest time/space consumers at this point are either a direct or indirect result of an architectural choice inside of <code>buffer!</code> that I think it's finally time to explore.</p><pre><code> seconds | gc | consed | calls | sec/call | name
----------------------------------------------------------------
5.519 | 0.000 | 52,729,616 | 116,112 | 0.000048 | HOUSE::BUFFER!
...
2.366 | 0.032 | 272,263,248 | 232,184 | 0.000010 | HOUSE::FLEX-STREAM
1.877 | 0.188 | 383,491,456 | 232,184 | 0.000008 | HOUSE::WRITE!
1.087 | 0.124 | 351,142,944 | 232,180 | 0.000005 | HOUSE::PARSE
0.823 | 0.000 | 16 | 5,920,590 | 0.000000 | HOUSE::LINE-TERMINATED?
0.789 | 0.028 | 59,615,552 | 116,090 | 0.000007 | HOUSE::HANDLE-REQUEST!
0.664 | 0.000 | 3,401,552 | 928,734 | 0.000001 | HOUSE::CRLF
...
</code></pre><p>Specifically, early on, I made the decision that <code>buffer!</code> needed to work in a streaming fashion. Which meant doing a very low-level non-blocking read in a tight loop. Unfortunately, there's no way to do this on byte-streams in Common Lisp so I ended up having to call <code>read-char-no-hang</code> through a bi-valent stream abstraction layer provided by <a href='http://weitz.de/flexi-streams/'><code>flexi-streams</code></a>. That may also have had a ripple effect on the <code>write!</code> procedure, as well as <code>line-terminated?</code> and <code>crlf</code>. And according to my profiler, that means the decision may very well be coming back to bite me in the ass right now.</p><p>The alternative decision would be to chuck streaming in a fucking bin, and read bytes directly into an in-memory array with a blocking, but very small timeout using <code>trivial-timeout</code>, and do a fairly aggressive but probably cheaper line-termination check before we even bother converting things into <code>ascii</code>. So, lets see how this pans out.</p><p>First off, <code>buffer!</code> needs to change completely.</p><pre><code class="lisp">;; house.lisp
...
(defmethod buffer! ((buffer buffer))
;; TODO - grow buffer up to +max-request-size+ when exhausted by doubling size
;; TODO - binary search for the first empty slot (rather than iterating)
;; TODO - seriously refactor this for repetition
(unless (contents buffer)
(setf (contents buffer) (coerce (make-array '(500)) '(vector (unsigned-byte 8)))))
(let* ((buffed (total-buffered buffer))
(count
(handler-case
(trivial-timeout:with-timeout (0.01)
(read-sequence
(contents buffer) (bi-stream buffer)
:start (total-buffered buffer)))
(com.metabang.trivial-timeout:timeout-error ()
(- (loop for i from buffed
when (zerop (aref (contents buffer) i)) return i)
buffed)))))
(incf (total-buffered buffer) count)
(when (request buffer) (decf (expecting buffer) count))
(when (line-terminated? (contents buffer) (total-buffered buffer))
(multiple-value-bind (parsed expecting) (parse buffer)
(setf (request buffer) parsed
(expecting buffer) expecting
(contents buffer) (coerce (make-array '(100)) '(vector (unsigned-byte 8))))))
(aref (contents buffer) (max 0 (- count 1)))))
...
</code></pre><p>Instead of doing a char-wise read through a <code>flexi-stream</code> like we were doing before, we're now instead reading raw octets into an array. This means we also need to change our line-termination check</p><pre><code class="lisp">;; house.lisp
(defun line-terminated? (vec fill)
(and (> fill 4)
(= (aref vec (- fill 4)) 13)
(= (aref vec (- fill 3)) 10)
(= (aref vec (- fill 2)) 13)
(= (aref vec (- fill 1)) 10)))
</code></pre><p>...and <code>process-ready</code> needs to pass the raw <code>socket-stream</code> instead of a <code>flex</code>ed stream to a new <code>buffer</code>.</p><pre><code class="lisp">;; house.lisp
...
(defmethod process-ready ((ready stream-usocket) (conns hash-table))
(let ((buf (or (gethash ready conns) (setf (gethash ready conns) (make-instance 'buffer :bi-stream (socket-stream ready))))))
...
</code></pre><p>And, finally, <code>parse</code> needs to expect an octet vector in the <code>contents</code> slot of its input buffer, rather than a reversed <code>list</code> of <code>char</code>s.</p><pre><code class="lisp">;; house.lisp
...
(defmethod parse ((buf buffer))
(let ((str (babel:octets-to-string (subseq (contents buf) 0 (total-buffered buf)))))
...
</code></pre><p>Ok; moment of truth here. Evaluating that, killing the profiler, emptying session cache and running the benchtest gives us...</p><p>drumroll...</p><p>significant, further pause...</p><pre><code>~/quicklisp/local-projects/house $ wrk -t12 -c400 -d30s http://127.0.0.1:4040/hello-world
Running 30s test @ http://127.0.0.1:4040/hello-world
12 threads and 400 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 72.87ms 8.30ms 270.73ms 96.97%
Req/Sec 62.30 29.22 101.00 54.98%
2878 requests in 30.04s, 733.55KB read
Socket errors: connect 0, read 2878, write 0, timeout 3
Requests/sec: 95.81
Transfer/sec: 24.42KB
~/quicklisp/local-projects/house $
</code></pre><p>Well... fuck.</p><p>Ok; so I'm guessing <code>trivial-timeout</code> introduces a bunch of overhead into the equation, which cancels out any gains we get from using the faster data-structure. The macro-expander tells me that in <code>sbcl</code>, it basically just expands out to an <code>sb-ext:with-timeout</code> call along with some surrounding cruft.</p><pre><code class="lisp">(LET ((#:|seconds-800| 0.01))
(FLET ((#:|doit-801| ()
(PROGN
(READ-SEQUENCE (CONTENTS BUFFER) (BI-STREAM BUFFER) :START
(TOTAL-BUFFERED BUFFER)))))
(COND
(#:|seconds-800|
(HANDLER-CASE
(SB-EXT:WITH-TIMEOUT #:|seconds-800|
(#:|doit-801|))
(SB-EXT:TIMEOUT (COM.METABANG.TRIVIAL-TIMEOUT::C)
(DECLARE (IGNORE COM.METABANG.TRIVIAL-TIMEOUT::C))
(ERROR 'COM.METABANG.TRIVIAL-TIMEOUT:TIMEOUT-ERROR))))
(T (#:|doit-801|)))))
</code></pre><p>So, just to satisfy my curiosity, lets see if we get anything out of calling the implementation-specific thing directly. That means <code>buffer!</code> changes yet again</p><pre><code class="lisp">;; house.lisp
(defmethod buffer! ((buffer buffer))
;; TODO - grow buffer up to +max-request-size+ when exhausted by doubling size
;; TODO - binary search for the first empty slot (rather than iterating)
;; TODO - seriously refactor this for repetition
(unless (contents buffer)
(setf (contents buffer) (coerce (make-array '(500)) '(vector (unsigned-byte 8)))))
(let* ((buffed (total-buffered buffer))
(count
(handler-case
(sb-ext:with-timeout 0.01
(read-sequence
(contents buffer) (bi-stream buffer)
:start (total-buffered buffer)))
(sb-ext:timeout ()
(- (loop for i from buffed
when (zerop (aref (contents buffer) i)) return i)
buffed)))))
(incf (total-buffered buffer) count)
(when (request buffer) (decf (expecting buffer) count))
(when (line-terminated? (contents buffer) (total-buffered buffer))
(multiple-value-bind (parsed expecting) (parse buffer)
(setf (request buffer) parsed
(expecting buffer) expecting
(contents buffer) (coerce (make-array '(100)) '(vector (unsigned-byte 8))))))
(aref (contents buffer) (max 0 (- count 1)))))
</code></pre><p>Ok; one more time.</p><pre><code>~/quicklisp/local-projects/house $ wrk -t12 -c400 -d30s http://127.0.0.1:4040/hello-world
Running 30s test @ http://127.0.0.1:4040/hello-world
12 threads and 400 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 74.18ms 45.39ms 1.81s 99.41%
Req/Sec 32.94 14.26 70.00 68.08%
2875 requests in 30.04s, 732.79KB read
Socket errors: connect 0, read 2875, write 0, timeout 2
Requests/sec: 95.71
Transfer/sec: 24.39KB
~/quicklisp/local-projects/house $
</code></pre><p>So at this point, I'm sort of ready to admit defeat here. I mean, I know that I'm serching element-by-element through each incoming buffer for its termination point, and that could be done more efficiently, <strong>but</strong></p><ol><li>That's a pretty tiny buffer. Straight up 500 bytes at the moment, which means that it won't be a <i>major</i> source of slowdown.</li><li>Hypothetically, even if that was the case, it can't possibly be making our requests/sec ~100 times lower.</li></ol><p>In other words, I guess my hypothesis was wrong.</p><p>The char-wise processing approach doesn't cost us anything here. So lets put all of that away and focus on more micro-optimization. Incidentally, just to make sure I'm not going insane somehow, once I put it back, perf metrics go back up to the level expected.</p><pre><code class="lisp">~/quicklisp/local-projects/house $ wrk -t12 -c400 -d30s http://127.0.0.1:4040/hello-world
Running 30s test @ http://127.0.0.1:4040/hello-world
12 threads and 400 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 4.24ms 54.74ms 1.63s 99.51%
Req/Sec 1.47k 1.05k 6.88k 79.98%
174596 requests in 30.03s, 43.46MB read
Socket errors: connect 0, read 174651, write 0, timeout 17
Requests/sec: 5813.36
Transfer/sec: 1.45MB
~/quicklisp/local-projects/house $
</code></pre><h2><a name="back-to-micros"></a><a href="#back-to-micros">Back to Micros</a></h2><p>So the current major culprit here is <code>clean-sessions!</code>.</p><h3><a name="-code-clean-sessions-code-"></a><a href="#-code-clean-sessions-code-"><code>clean-sessions!</code></a></h3><p>Which is understandable, because</p><ol><li>it currently runs every 100 times we start a fresh session (which means it runs ~500 or so times over the course of one of these bench tests)</li><li>it iterates over the full session table when it runs</li><li>it never cleans out any sessions, since they won't age enough over the course of a test to get evicted, which means that the table it's iterating over only ever gets larger</li></ol><p>The easiest solution is to make calling it probabilistic. In addition to being mildly faster, that will also remove the need for the local state variable <code>session-count</code>, which always kind of bugged me.</p><p>So, step one, <code>new-session!</code> changes to</p><pre><code class="lisp">;; session.lisp
...
(defun new-session! ()
(when (zerop (random +clean-sessions-every+))
(clean-sessions!))
(let ((session (make-instance 'session :token (new-session-token!))))
(setf (gethash (token session) *sessions*) session)
(loop for hook in *new-session-hook*
do (funcall hook session))
session))
...
</code></pre><p>and while we're at it, we may as well bump <code>+clean-sessions-every+</code> up a bit.</p><pre><code class="lisp">;; package.lisp
...
(defparameter +clean-sessions-every+ 10000)
</code></pre><p>I'm also considering re-factoring the server to make sessions optional. It's not a strong concern mainly because most applications of any size will want session state, and the ones that don't probably don't care about using an application server to begin with. In other words, it feels like this would be making things less convenient for the programmer specifically to do better on a benchmark, and that's not the sort of shit I typically like pulling.</p><p>With the new settings and implementation, <code>clean-sessoins!</code> and <code>new-session!</code> both drop pretty far down our list of culprits anyhow.</p><pre><code> seconds | gc | consed | calls | sec/call | name
----------------------------------------------------------------
1.721 | 0.000 | 56,793,248 | 70,064 | 0.000025 | HOUSE::BUFFER!
1.475 | 0.052 | 111,406,304 | 140,108 | 0.000011 | HOUSE::FLEX-STREAM
1.079 | 0.036 | 146,585,744 | 140,108 | 0.000008 | HOUSE::WRITE!
0.526 | 0.012 | 166,425,216 | 140,106 | 0.000004 | HOUSE::PARSE
0.468 | 0.012 | 14,476,848 | 70,053 | 0.000007 | HOUSE::HANDLE-REQUEST!
0.305 | 0.000 | 0 | 560,431 | 0.000001 | HOUSE::CRLF
0.298 | 0.000 | 17,791,024 | 70,053 | 0.000004 | HOUSE::NEW-SESSION-TOKEN!
0.172 | 0.000 | 0 | 12 | 0.014333 | HOUSE::CLEAN-SESSIONS!
0.159 | 0.000 | 16,344,288 | 140,106 | 0.000001 | HOUSE::->KEYWORD
0.127 | 0.000 | 93,279,184 | 70,053 | 0.000002 | HOUSE:NEW-SESSION!
0.105 | 0.012 | 34,233,792 | 420,318 | 0.000000 | HOUSE::LINE-TERMINATED?
0.074 | 0.000 | 2,032,096 | 70,053 | 0.000001 | HOUSE::SPLIT-AT
0.030 | 0.000 | 0 | 140,106 | 0.000000 | HOUSE::TRIE-LOOKUP
0.028 | 0.000 | 0 | 70,053 | 0.000000 | HOUSE::FIND-HANDLER
0.014 | 0.000 | 0 | 70,053 | 0.000000 | HOUSE::ANY-VARS?
...
</code></pre><p>I'm not taking a look at <code>buffer!</code> right this very second, because I just spent a bunch of time on it. Which means that <code>flex-stream</code> is my next target.</p><h2><a name="-code-flex-stream-code-and-code-crlf-code-"></a><a href="#-code-flex-stream-code-and-code-crlf-code-"><code>flex-stream</code> and <code>crlf</code></a></h2><p>This is another method, and I get the feeling that's hurting us here. Specifically, it means that method dispatch happens every time we call <code>flex-stream</code>, <i>and</i> it means we can't inline it. That second one is also the only problem I can see with <code>crlf</code>. So lets give this a shot, I guess.</p><pre><code class="lisp">;; util.lisp
...
(declaim (inline flex-stream))
(defun flex-stream (sock)
(flex:make-flexi-stream (socket-stream sock) :external-format :utf-8))
...
</code></pre><pre><code class="lisp">;; house.lisp
...
(declaim (inline crlf))
...
</code></pre><h2><a name="-code-write-code-"></a><a href="#-code-write-code-"><code>write!</code></a></h2><p>This is another place where we've got <code>method</code>s <code>def</code>ed to make things clearer, but that dispatch between argument types ends up costing performance. Given that this is now at the top of our hot code points, it's time to see what we can do about that.</p><p>We really have three different scenarios that <code>write!</code> handles for us ambiguously.</p><ol><li><code>write!</code> something to a <code>usocket</code> (which involves writing that same thing to the <code>socket-stream</code> of the <code>usocket</code>)</li><li><code>write!</code> an <code>sse</code> to a stream</li><li><code>write!</code> a <code>response</code> to a stream</li></ol><p>What we'll need to do is <code>def</code> separate f<code>un</code>ctions for each situation, and call the appropriate one in each case. This will both cut down on the <code>method</code> dispatch overhead, and potentially let us inline the results through a declaration later. Before we go that far, I have a mild suspicion that most of <code>write!</code>s' time is actually spent inside of the <code>write-ln</code> internal function. And making that function local to the scope that includes <code>stream</code> means that it can't be handled very efficiently until we have a value for <code>stream</code>, which in turn means that it's basically re-evaluated on most calls to <code>write!</code>. So, lets try extracting it so that the profiler can prove or disprove the hypothesis.</p><pre><code class="lisp">;; house.lisp
...
(defun write-ln (stream &rest sequences)
(dolist (s sequences) (write-sequence s stream))
(crlf stream))
(defmethod write! ((res response) (stream stream))
(write-ln stream "HTTP/1.1 " (response-code res))
(write-ln stream "Content-Type: " (content-type res) "; charset=" (charset res))
(write-ln stream "Cache-Control: no-cache, no-store, must-revalidate")
(write-ln stream "Access-Control-Allow-Origin: *")
(awhen (cookie res)
(if (null *cookie-domains*)
(write-ln stream "Set-Cookie: name=" it)
(loop for d in *cookie-domains*
do (write-ln stream "Set-Cookie: name=" it "; domain=" d))))
(awhen (location res)
(write-ln stream "Location: " it))
(when (keep-alive? res)
(write-ln stream "Connection: keep-alive")
(write-ln stream "Expires: Thu, 01 Jan 1970 00:00:01 GMT"))
(awhen (body res)
(write-ln stream "Content-Length: " (write-to-string (length it)))
#-windows(crlf stream)
#+windows(format stream "~%")
(write-ln stream it))
(values))
...
</code></pre><p>Once that's out in the open, and accepting the stream as an argument, survey says...</p><pre><code>~/quicklisp/local-projects/house $ wrk -t12 -c400 -d30s http://127.0.0.1:4040/hello-world
Running 30s test @ http://127.0.0.1:4040/hello-world
12 threads and 400 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 4.65ms 42.41ms 1.63s 99.73%
Req/Sec 446.98 270.23 2.19k 85.86%
72091 requests in 30.03s, 17.94MB read
Socket errors: connect 0, read 72718, write 0, timeout 13
Requests/sec: 2400.39
Transfer/sec: 611.82KB
~/quicklisp/local-projects/house $
</code></pre><pre><code>measuring PROFILE overhead..done
seconds | gc | consed | calls | sec/call | name
----------------------------------------------------------------
1.766 | 0.000 | 43,764,656 | 72,121 | 0.000024 | HOUSE::BUFFER!
1.627 | 0.012 | 97,533,056 | 504,776 | 0.000003 | HOUSE::WRITE-LN
0.729 | 0.000 | 54,697,424 | 144,222 | 0.000005 | HOUSE::WRITE!
0.629 | 0.036 | 199,897,776 | 144,220 | 0.000004 | HOUSE::PARSE
0.339 | 0.000 | 90,483,936 | 72,110 | 0.000005 | HOUSE::HANDLE-REQUEST!
0.263 | 0.000 | 22,082,848 | 72,110 | 0.000004 | HOUSE::NEW-SESSION-TOKEN!
0.186 | 0.000 | 11,166,240 | 144,220 | 0.000001 | HOUSE::->KEYWORD
0.168 | 0.000 | 55,233,808 | 72,110 | 0.000002 | HOUSE:NEW-SESSION!
0.108 | 0.000 | 0 | 3,749,720 | 0.000000 | (SETF HOUSE::CONTENTS)
0.107 | 0.000 | 0 | 432,660 | 0.000000 | HOUSE::LINE-TERMINATED?
0.063 | 0.000 | 31,829,072 | 72,110 | 0.000001 | HOUSE::SPLIT-AT
0.051 | 0.000 | 0 | 4,254,490 | 0.000000 | HOUSE::CONTENTS
0.049 | 0.000 | 16 | 3,677,610 | 0.000000 | (SETF HOUSE::TOTAL-BUFFERED)
0.032 | 0.000 | 64 | 72,110 | 0.000000 | HOUSE::FIND-HANDLER
0.022 | 0.000 | 0 | 7,355,231 | 0.000000 | HOUSE::TOTAL-BUFFERED
0.019 | 0.000 | 0 | 72,110 | 0.000000 | HOUSE:RESOURCE
0.019 | 0.000 | 0 | 72,111 | 0.000000 | HOUSE::CHARSET
0.016 | 0.000 | 0 | 13 | 0.001230 | HOUSE::CLEAN-SESSIONS!
0.013 | 0.000 | 1,572,112 | 144,220 | 0.000000 | HOUSE::TRIE-LOOKUP
0.011 | 0.000 | 0 | 72,111 | 0.000000 | HOUSE::KEEP-ALIVE?
0.011 | 0.000 | 0 | 72,111 | 0.000000 | HOUSE::RESPONSE-CODE
0.007 | 0.000 | 1,341,760 | 72,110 | 0.000000 | HOUSE::PARSE-PARAMS
0.007 | 0.000 | 0 | 72,111 | 0.000000 | HOUSE::CONTENT-TYPE
0.007 | 0.000 | 0 | 72,111 | 0.000000 | HOUSE::BODY
0.003 | 0.000 | 0 | 72,111 | 0.000000 | HOUSE::COOKIE
0.003 | 0.000 | 0 | 72,111 | 0.000000 | HOUSE::LOCATION
0.003 | 0.000 | 0 | 72,121 | 0.000000 | HOUSE::STARTED
0.000 | 0.000 | 0 | 144,220 | 0.000000 | HOUSE::TOKEN
0.000 | 0.000 | 0 | 72,110 | 0.000000 | HOUSE::HTTP-METHOD
0.000 | 0.000 | 0 | 144,242 | 0.000000 | HOUSE::TRIES
0.000 | 0.000 | 0 | 72,121 | 0.000000 | (SETF HOUSE::TRIES)
0.000 | 0.000 | 0 | 72,110 | 0.000000 | HOUSE::EXPECTING
0.000 | 0.000 | 0 | 72,110 | 0.000000 | (SETF HOUSE::EXPECTING)
0.000 | 0.220 | 543,580,336 | 144,232 | 0.000000 | HOUSE::PROCESS-READY
0.000 | 0.000 | 32,768 | 1 | 0.000000 | HOUSE::ERROR!
0.000 | 0.000 | 0 | 72,110 | 0.000000 | HOUSE::HANDLERS
0.000 | 0.000 | 0 | 72,121 | 0.000000 | HOUSE::BI-STREAM
0.000 | 0.000 | 0 | 72,110 | 0.000000 | HOUSE::ANY-VARS?
0.000 | 0.000 | 69,628,640 | 1 | 0.000000 | HOUSE:START
0.000 | 0.000 | 0 | 72,110 | 0.000000 | HOUSE:PARAMETERS
0.000 | 0.000 | 0 | 144,220 | 0.000000 | (SETF HOUSE:PARAMETERS)
0.000 | 0.000 | 0 | 72,110 | 0.000000 | HOUSE:HEADERS
0.000 | 0.000 | 0 | 72,110 | 0.000000 | (SETF HOUSE:HEADERS)
0.000 | 0.000 | 0 | 72,110 | 0.000000 | HOUSE:SESSION-TOKENS
0.000 | 0.000 | 0 | 3,893,950 | 0.000000 | HOUSE:REQUEST
0.000 | 0.000 | 0 | 72,110 | 0.000000 | (SETF HOUSE:REQUEST)
----------------------------------------------------------------
6.262 | 0.268 | 1,222,844,512 | 27,041,379 | | Total
estimated total profiling overhead: 18.82 seconds
overhead estimation parameters:
8.000001e-9s/call, 6.9600003e-7s total profiling, 2.88e-7s internal profiling
These functions were not called:
HOUSE::ARG-EXP HOUSE::ARGS-BY-TYPE-PRIORITY HOUSE::ARGUMENTS
HOUSE::ASSERTION (SETF HOUSE::BODY) (SETF HOUSE::CACHE-CONTROL)
HOUSE::CACHE-CONTROL (SETF HOUSE::CHARSET) HOUSE::CHECK-FOR-DUPES
HOUSE:CLEAR-SESSION-HOOKS! (SETF HOUSE::CONTENT-TYPE)
(SETF HOUSE::COOKIE) HOUSE::COPY-TRIE HOUSE::CRLF HOUSE::DATA
HOUSE::DEBUG! HOUSE:DEFINE-FILE-HANDLER HOUSE::EMPTY HOUSE::EVENT
(SETF HOUSE::EXPIRES) HOUSE::EXPIRES HOUSE::FLEX-STREAM
HOUSE:GET-SESSION! (SETF HOUSE::HTTP-METHOD) HOUSE::ID HOUSE::IDLING?
HOUSE::INSERT-HANDLER! (SETF HOUSE::KEEP-ALIVE?) (SETF HOUSE::LOCATION)
(SETF HOUSE:LOOKUP) HOUSE:LOOKUP HOUSE:MAKE-SSE HOUSE::MAKE-TRIE
HOUSE:NEW-SESSION-HOOK! HOUSE::PARSE-COOKIES HOUSE::PARSE-VAR
HOUSE::PATH->MIMETYPE HOUSE:PATH->URI HOUSE::PATH-VAR? HOUSE::POKE!
HOUSE::PROCESS-URI HOUSE:PUBLISH! HOUSE::READ-ALL HOUSE:REDIRECT!
(SETF HOUSE:RESOURCE) (SETF HOUSE::RESPONSE-CODE) HOUSE::RETRY
(SETF HOUSE:SESSION-TOKENS) HOUSE::SESSION-VALUES HOUSE:SUBSCRIBE!
HOUSE::TRIE-INSERT! (SETF HOUSE::TRIE-MAP) HOUSE::TRIE-MAP
HOUSE::TRIE-P (SETF HOUSE::TRIE-VALUE) HOUSE::TRIE-VALUE
(SETF HOUSE::TRIE-VARS) HOUSE::TRIE-VARS HOUSE::TYPE-ASSERTION
HOUSE::TYPE-EXPRESSION HOUSE::URI-DECODE HOUSE::VAR-KEY
</code></pre><p>So that tells us two things.</p><ol><li>Yes, <code>write-ln</code> is the lions' share of the <code>write!</code> routine.</li><li>Even with <code>write-ln</code> separated, <code>write!</code> is one of the major time-sinks. So, yes, <code>defun</code>ing it may in fact be worth it.</li></ol><p>The next smallest thing we can do to fix <code>write!</code> is to remove the extra level of dispatch we invoke when writing to a <code>socket</code> rather than directly to its <code>stream</code>. Specifically, you can see that this <code>write!</code> method</p><pre><code class="lisp">;; house.lisp
...
(defmethod write! (res (sock usocket))
(write! res (flex-stream sock)))
...
</code></pre><p>does nothing but call <code>write!</code> recursively with the input <code>socket</code>s' <code>stream</code>. This is nice and elegant, but it does mean that <code>write!</code> gets called double the number of times it really needs to, and <i>each</i> call invokes the full <code>method</code>-lookup overhead. In order to remove it, we need to...</p><pre><code class="diff">;; define-handler.lisp
modified define-handler.lisp
@@ -93,7 +93,7 @@ parameters with a lower priority can refer to parameters of a higher priority.")
:content-type ,content-type
:cookie (unless ,cookie? (token session))
:body result))))
- (write! response sock)
+ (write! response (flex-stream sock))
(socket-close sock))))))
(defmacro make-stream-handler ((&rest args) &body body)
@@ -103,11 +103,16 @@ parameters with a lower priority can refer to parameters of a higher priority.")
,(arguments args
`(let ((res (progn ,@body))
(stream (flex-stream sock)))
- (write! (make-instance 'response
- :keep-alive? t :content-type "text/event-stream"
- :cookie (unless ,cookie? (token session))) stream)
+ (write!
+ (make-instance
+ 'response
+ :keep-alive? t :content-type "text/event-stream"
+ :cookie (unless ,cookie? (token session)))
+ stream)
(crlf stream)
- (write! (make-instance 'sse :data (or res "Listening...")) stream)
+ (write!
+ (make-instance 'sse :data (or res "Listening..."))
+ stream)
(force-output stream))))))
(defun parse-var (str)
@@ -159,7 +164,9 @@ parameters with a lower priority can refer to parameters of a higher priority.")
(with-open-file (s path :direction :input :element-type 'octet)
(let ((buf (make-array (file-length s) :element-type 'octet)))
(read-sequence buf s)
- (write! (make-instance 'response :content-type mime :body buf) sock))
+ (write!
+ (make-instance 'response :content-type mime :body buf)
+ (flex-stream sock)))
(socket-close sock))
(error! +404+ sock))))))
(t
@@ -181,5 +188,7 @@ parameters with a lower priority can refer to parameters of a higher priority.")
(list ,@(cons method (process-uri name)))
(lambda (sock ,cookie? session request)
(declare (ignorable sock ,cookie? session request))
- (write! (redirect! ,target :permanent? ,permanent?) sock)
+ (write!
+ (redirect! ,target :permanent? ,permanent?)
+ (flex-stream sock))
(socket-close sock)))))
modified house.lisp
</code></pre><pre><code class="diff">;; house.lisp
@@ -170,13 +170,10 @@
(format stream "~@[id: ~a~%~]~@[event: ~a~%~]~@[retry: ~a~%~]data: ~a~%~%"
(id res) (event res) (retry res) (data res)))
-(defmethod write! (res (sock usocket))
- (write! res (flex-stream sock)))
-
(defmethod error! ((err response) (sock usocket) &optional instance)
(declare (ignorable instance))
(ignore-errors
- (write! err sock)
+ (write! err (flex-stream sock))
(socket-close sock)))
;;;;; Channel-related
@@ -192,7 +189,7 @@
(setf (lookup channel *channels*)
(loop for sock in it
when (ignore-errors
- (write! message sock)
+ (write! message (flex-stream sock))
(force-output (socket-stream sock))
sock)
collect it))))
</code></pre><p>At which point, if we <code>reset</code> the slime profiler again and re-run our benchmark test, we should see <code>write!</code> drop fairly significantly in terms of impact.</p><pre><code>measuring PROFILE overhead..done
seconds | gc | consed | calls | sec/call | name
----------------------------------------------------------------
1.577 | 0.000 | 88,051,168 | 511,202 | 0.000003 | HOUSE::WRITE-LN
1.499 | 0.024 | 43,536,368 | 73,039 | 0.000021 | HOUSE::BUFFER!
1.136 | 0.020 | 106,240,688 | 73,028 | 0.000016 | HOUSE::HANDLE-REQUEST!
0.643 | 0.024 | 384,474,768 | 146,056 | 0.000004 | HOUSE::PARSE
0.346 | 0.056 | 25,075,872 | 73,029 | 0.000005 | HOUSE::WRITE!
0.312 | 0.012 | 83,617,440 | 73,028 | 0.000004 | HOUSE::NEW-SESSION-TOKEN!
0.231 | 0.072 | 66,517,264 | 73,028 | 0.000003 | HOUSE:NEW-SESSION!
...
</code></pre><p>Bam.</p><p>I thought I'd crack open <code>buffer!</code> and <code>handle-request!</code> next, as well as put serious thought into those spike-conditional optimizations I mentioned earlier, but I think that's enough for this sortie.</p><p>Oh, by the way, before I go, at this point turning off the profiler gives us</p><pre><code>~/quicklisp/local-projects/house $ wrk -t12 -c400 -d30s http://127.0.0.1:4040/hello-world
Running 30s test @ http://127.0.0.1:4040/hello-world
12 threads and 400 connections
Thread Stats Avg Stdev Max +/- Stdev
Latency 3.93ms 54.02ms 1.79s 99.47%
Req/Sec 1.36k 0.90k 8.65k 71.64%
233602 requests in 30.03s, 58.15MB read
Socket errors: connect 0, read 233785, write 0, timeout 33
Requests/sec: 7778.87
Transfer/sec: 1.94MB
~/quicklisp/local-projects/house $
</code></pre><p>So we're getting closer to, but haven't <i>yet</i> beaten, <code>tornado</code> on <code>pypy</code> in terms of performance.</p><p>We'll pick it up here next time and see how much further we can push it. <ol class='footnotes'><li id='fn-1'>Alternatively, the hardware I'm testing on is so much better than that of the initial benchmark that it annihilates all losses. Although it doesn't seem like it, based on the environment readout found on that benchmark page. They've got about half the memory that I do, but more CPU, and this doesn't seem like it would be a memory-bound operation given that my memory use barely registers the benchmark according to <code>htop</code>. Anyhow, given that I've been assuming that <code>house</code> is the cheap-seat web-server for Common Lisp, usable only because it's the only one written without calling into FFI code, I'm pleasantly surprised to find that it also runs decently quickly.<a href='#fnref1'>↩</a></li></ol></p>