--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/content/blog/2018/05/fun-with-macros-gathering.markdown Sun May 20 18:51:20 2018 -0400
@@ -0,0 +1,390 @@
++++
+title = "Fun with Macros: Gathering"
+snip = "Part 1 in a series of small posts about fun Common Lisp Macros"
+date = 2018-05-21T16:40:00Z
+draft = true
+
++++
+
+I haven't written anything in a while. But after seeing the [metaprogramming
+video on Computerphile](https://www.youtube.com/watch?v=dw-y3vNDRWk) the other
+day I felt the urge to write about Lisp again, so I decided to do a small series
+of posts on fun/useful little Common Lisp macros I've made over the past couple
+of years.
+
+<div id="toc"></div>
+
+## The Macro
+
+The first macro we'll look at is `gathering`:
+
+```lisp
+(defmacro gathering (&body body)
+ "Run `body` to gather some things and return a fresh list of them.
+
+ `body` will be executed with the symbol `gather` bound to a
+ function of one argument. Once `body` has finished, a list of
+ everything `gather` was called on will be returned.
+
+ It's handy for pulling results out of code that executes
+ procedurally and doesn't return anything, like `maphash` or
+ Alexandria's `map-permutations`.
+
+ The `gather` function can be passed to other functions, but should
+ not be retained once the `gathering` form has returned (it would
+ be useless to do so anyway).
+
+ Examples:
+
+ (gathering
+ (dotimes (i 5)
+ (gather i))
+ =>
+ (0 1 2 3 4)
+
+ (gathering
+ (mapc #'gather '(1 2 3))
+ (mapc #'gather '(a b)))
+ =>
+ (1 2 3 a b)
+
+ "
+ (alexandria:with-gensyms (result)
+ `(let ((,result nil))
+ (flet ((gather (item)
+ (push item ,result)))
+ (declare (dynamic-extent #'gather))
+ ,@body)
+ (nreverse ,result))))
+```
+
+## Notes
+
+As the docstring mentions, sometimes you'll encounter procedural code that
+iterates over things, but doesn't gather up and return any results (CL's
+`maphash` and Alexandria's `map-permutations` are two examples). The
+`gathering` macro provides an easy way to plug into the guts of the iteration
+and get a list back.
+
+The docstring describes how to use the macro, but there's a couple of extra
+things to note before we move on.
+
+### Default LET Bindings
+
+I'm aware that the `(let ((,result nil)) ...)` in the macro could be simplified
+to `(let (,result) ...)` because bindings without an initial value default to
+`nil`. I just personally dislike that style and prefer to be explicit about the
+initial values, even when they're `nil`.
+
+### Hygiene
+
+The `flet`ed function that actually does the gathering is named as the symbol
+`gather`, not a gensym. Some folks will dislike that because it captures the
+function name.
+
+I don't mind it. I consider that behavior part of the intended/documented API
+of the macro, and because the symbol `gather` is coming from the macro's package
+you'll need to import it (or package qualify it) to access it.
+
+If you want to provide a bit more safety here you could potentially define
+a vanilla function for `gather` like this:
+
+```lisp
+(defun gather (value)
+ "Gather `value` into the resulting list. Must be called from inside `gathering`."
+ (error "GATHER be called from within a GATHERING macro."))
+```
+
+Doing this would mean calling `gather` outside a `gathering` block would signal
+an error, and someone defining their *own* `gather` function (which could
+accidentally get shadowed by the macro's `flet` later) would get a warning about
+redefining the function, which would hopefully make them realize the potential
+conflict earlier.
+
+Of course you could write your own version of `gathering` that takes in a symbol
+to use for the function, if you prefer.
+
+### Data Structures
+
+My actual implementation of this macro uses a simple queue data structure
+instead of a list to avoid having to reverse the result at the end, but I didn't
+want to include an extra dependency just for this blog post.
+
+### Dynamic Extent
+
+Feel free to skip this section. It gets a little bit into the weeds.
+
+You might have noticed that the `gather` function is declared to have [dynamic
+extent][]. This means that some implementations (e.g. SBCL) [can stack allocate
+the closure][sbcl dynamic extent] and save a heap allocation.
+
+Whether this matters much depends on the usage patterns. If you use `gathering`
+with some code that typically gathers no elements (and only occasionally gathers
+a few), you won't have to heap allocate *anything* for the common cases, and
+things will be a little more efficient. If you typically gather a bunch of
+things then you're heap allocating all the cons cells anyway, so allocating the
+closure wouldn't be a big deal.
+
+I decided to go ahead and enable the efficiency optimization. It doesn't make
+any sense to be calling the closure once `gathering` has returned, so why not?
+
+If you want to actually see the stack allocation in action, it might be a little
+trickier than you think. SBCL is pretty smart about inlining things, so it
+might not allocate the closure at runtime *at all*, even *without* the
+`dynamic-extent` declaration:
+
+```lisp
+(disassemble (lambda ()
+ (gathering
+ (mapc #'gather '(1 2 3)))))
+
+; disassembly for (LAMBDA ())
+; Size: 149 bytes. Origin: #x10040B8340
+; 40: 498B4C2460 MOV RCX, [R12+96] ; no-arg-parsing entry point
+ ; thread.binding-stack-pointer
+; 45: 48894DF8 MOV [RBP-8], RCX
+; 49: BB17001020 MOV EBX, #x20100017 ; NIL
+; 4E: 488B0D9BFFFFFF MOV RCX, [RIP-101] ; '(1 2 3)
+; 55: EB4D JMP L3
+; 57: 660F1F840000000000 NOP
+; 60: L0: 4881FA17001020 CMP RDX, #x20100017 ; NIL
+; 67: 744A JEQ L4
+; 69: 488B71F9 MOV RSI, [RCX-7]
+; 6D: 49896C2440 MOV [R12+64], RBP ; thread.pseudo-atomic-bits
+; 72: 4D8B5C2418 MOV R11, [R12+24] ; thread.alloc-region
+; 77: 498D5310 LEA RDX, [R11+16]
+; 7B: 493B542420 CMP RDX, [R12+32]
+; 80: 7746 JNBE L5
+; 82: 4989542418 MOV [R12+24], RDX ; thread.alloc-region
+; 87: L1: 498D5307 LEA RDX, [R11+7]
+; 8B: 49316C2440 XOR [R12+64], RBP ; thread.pseudo-atomic-bits
+; 90: 7403 JEQ L2
+; 92: 0F0B09 BREAK 9 ; pending interrupt trap
+; 95: L2: 488972F9 MOV [RDX-7], RSI
+; 99: 48895A01 MOV [RDX+1], RBX
+; 9D: 488BDA MOV RBX, RDX
+; A0: 488B4901 MOV RCX, [RCX+1]
+; A4: L3: 488BD1 MOV RDX, RCX
+; A7: 8D41F9 LEA EAX, [RCX-7]
+; AA: A80F TEST AL, 15
+; AC: 74B2 JEQ L0
+; AE: 0F0B0A BREAK 10 ; error trap
+; B1: 2F BYTE #X2F ; OBJECT-NOT-LIST-ERROR
+; B2: 10 BYTE #X10 ; RDX
+; B3: L4: 488BD3 MOV RDX, RBX
+; B6: B902000000 MOV ECX, 2
+; BB: FF7508 PUSH QWORD PTR [RBP+8]
+; BE: B8B8733120 MOV EAX, #x203173B8 ; #<FDEFN SB-IMPL::LIST-NREVERSE>
+; C3: FFE0 JMP RAX
+; C5: 0F0B10 BREAK 16 ; Invalid argument count trap
+; C8: L5: 6A10 PUSH 16
+; CA: 41BB3000B021 MOV R11D, #x21B00030 ; ALLOC-TO-R11
+; D0: 41FFD3 CALL R11
+; D3: EBB2 JMP L1
+NIL
+```
+
+Here SBCL [knows what `mapc` is][package lock] and expands it inline (notice how
+there's no function call to `mapc`). It then realizes it never needs to
+allocate a closure for `gather` at all, it can just inline that too! All the
+allocation stuff in that disassembly is for the `push`ing of new cons cells (to
+convince yourself of this, run `(disassemble (lambda (&aux result) (push
+1 result) result))` and compare the assembly).
+
+But if we make our own version of `mapc`:
+
+```lisp
+(defun my-mapc (function list)
+ (mapc function list))
+```
+
+Now we can see a difference, because SBCL won't necessarily know it can
+stack allocate the closure unless we tell it. Here's what the disassembly
+looks like *without* the `dynamic-extent` inside `gathering`:
+
+```lisp
+(disassemble (lambda ()
+ (gathering
+ (my-mapc #'gather '(1 2 3)))))
+
+; disassembly for (LAMBDA ())
+; Size: 212 bytes. Origin: #x1004331A20
+; 20: 498B4C2460 MOV RCX, [R12+96] ; no-arg-parsing entry point
+ ; thread.binding-stack-pointer
+; 25: 48894DF8 MOV [RBP-8], RCX
+; 29: B817001020 MOV EAX, #x20100017 ; NIL
+; 2E: 49896C2440 MOV [R12+64], RBP ; thread.pseudo-atomic-bits
+; 33: 4D8B5C2418 MOV R11, [R12+24] ; thread.alloc-region
+; 38: 498D5B10 LEA RBX, [R11+16]
+; 3C: 493B5C2420 CMP RBX, [R12+32]
+; 41: 0F874D010000 JNBE #x1004331B94
+; 47: 49895C2418 MOV [R12+24], RBX ; thread.alloc-region
+; 4C: 498D5B0F LEA RBX, [R11+15]
+; 50: 66C743F14101 MOV WORD PTR [RBX-15], 321
+; 56: 488943F9 MOV [RBX-7], RAX
+; 5A: 49316C2440 XOR [R12+64], RBP ; thread.pseudo-atomic-bits
+; 5F: 7403 JEQ L0
+; 61: 0F0B09 BREAK 9 ; pending interrupt trap
+; 64: L0: 48895DE8 MOV [RBP-24], RBX
+; 68: 49896C2440 MOV [R12+64], RBP ; thread.pseudo-atomic-bits
+; 6D: 4D8B5C2418 MOV R11, [R12+24] ; thread.alloc-region
+; 72: 498D4B20 LEA RCX, [R11+32]
+; 76: 493B4C2420 CMP RCX, [R12+32]
+; 7B: 0F8723010000 JNBE #x1004331BA4
+; 81: 49894C2418 MOV [R12+24], RCX ; thread.alloc-region
+; 86: 498D4B0B LEA RCX, [R11+11]
+; 8A: B835020000 MOV EAX, 565
+; 8F: 480B042508011020 OR RAX, [#x20100108] ; SB-VM:FUNCTION-LAYOUT
+; 97: 488941F5 MOV [RCX-11], RAX
+; 9B: 488D058E000000 LEA RAX, [RIP+142] ; = #x1004331B30
+; A2: 488941FD MOV [RCX-3], RAX
+; A6: 49316C2440 XOR [R12+64], RBP ; thread.pseudo-atomic-bits
+; AB: 7403 JEQ L1
+; AD: 0F0B09 BREAK 9 ; pending interrupt trap
+; B0: L1: 48895905 MOV [RCX+5], RBX
+; B4: 488BD1 MOV RDX, RCX
+; B7: 488D4424F0 LEA RAX, [RSP-16]
+; BC: 4883EC10 SUB RSP, 16
+; C0: 488B3DE9FEFFFF MOV RDI, [RIP-279] ; '(1 2 3)
+; C7: B904000000 MOV ECX, 4
+; CC: 488928 MOV [RAX], RBP
+; CF: 488BE8 MOV RBP, RAX
+; D2: B838734F20 MOV EAX, #x204F7338 ; #<FDEFN MY-MAPC>
+; D7: FFD0 CALL RAX
+; D9: 480F42E3 CMOVB RSP, RBX
+; DD: 488B5DE8 MOV RBX, [RBP-24]
+; E1: 488B53F9 MOV RDX, [RBX-7]
+; E5: B902000000 MOV ECX, 2
+; EA: FF7508 PUSH QWORD PTR [RBP+8]
+; ED: B8B8733120 MOV EAX, #x203173B8 ; #<FDEFN SB-IMPL::LIST-NREVERSE>
+; F2: FFE0 JMP RAX
+NIL
+```
+
+Now we can see it's allocating the closure on the heap (note the
+`SB-VM:FUNCTION-LAYOUT`).
+
+If we add the `dynamic-extent` back into `gathering`:
+
+```lisp
+(disassemble (lambda ()
+ (gathering
+ (my-mapc #'gather '(1 2 3)))))
+
+; disassembly for (LAMBDA ())
+; Size: 136 bytes. Origin: #x10043F46E0
+; 6E0: 498B4C2460 MOV RCX, [R12+96] ; no-arg-parsing entry point
+ ; thread.binding-stack-pointer
+; 6E5: 48894DF8 MOV [RBP-8], RCX
+; 6E9: 48C745E817001020 MOV QWORD PTR [RBP-24], #x20100017 ; NIL
+; 6F1: 488BDC MOV RBX, RSP
+; 6F4: 48895DE0 MOV [RBP-32], RBX
+; 6F8: 4883EC20 SUB RSP, 32
+; 6FC: 4883E4F0 AND RSP, -16
+; 700: 488D4C240B LEA RCX, [RSP+11]
+; 705: B835020000 MOV EAX, 565
+; 70A: 480B042508011020 OR RAX, [#x20100108] ; SB-VM:FUNCTION-LAYOUT
+; 712: 488941F5 MOV [RCX-11], RAX
+; 716: 488D0583000000 LEA RAX, [RIP+131] ; = #x10043F47A0
+; 71D: 488941FD MOV [RCX-3], RAX
+; 721: 48896905 MOV [RCX+5], RBP
+; 725: 488BD1 MOV RDX, RCX
+; 728: 488D4424F0 LEA RAX, [RSP-16]
+; 72D: 4883EC10 SUB RSP, 16
+; 731: 488B3D38FFFFFF MOV RDI, [RIP-200] ; '(1 2 3)
+; 738: B904000000 MOV ECX, 4
+; 73D: 488928 MOV [RAX], RBP
+; 740: 488BE8 MOV RBP, RAX
+; 743: B838734F20 MOV EAX, #x204F7338 ; #<FDEFN MY-MAPC>
+; 748: FFD0 CALL RAX
+; 74A: 480F42E3 CMOVB RSP, RBX
+; 74E: 488B5DE0 MOV RBX, [RBP-32]
+; 752: 488BE3 MOV RSP, RBX
+; 755: 488B55E8 MOV RDX, [RBP-24]
+; 759: B902000000 MOV ECX, 2
+; 75E: FF7508 PUSH QWORD PTR [RBP+8]
+; 761: B8B8733120 MOV EAX, #x203173B8 ; #<FDEFN SB-IMPL::LIST-NREVERSE>
+; 766: FFE0 JMP RAX
+NIL
+```
+
+Much nicer.
+
+[dynamic extent]: http://clhs.lisp.se/Body/d_dynami.htm
+[sbcl dynamic extent]: http://www.sbcl.org/manual/#Dynamic_002dextent-allocation
+[package lock]: http://www.lispworks.com/documentation/lw50/CLHS/Body/11_abab.htm
+
+## Examples
+
+Let's finish up by looking at some places where I've found this macro to be
+handy. I won't go into too much depth about the individual pieces of code, but
+feel free to ask if you have questions.
+
+### Pandigitals
+
+First up, an example from my Project Euler `utils.lisp` file:
+
+```lisp
+(defun pandigitals (&optional (start 1) (end 9))
+ "Return a list of all `start` to `end` (inclusive) pandigital numbers."
+ (gathering
+ (map-permutations
+ (lambda (digits)
+ ;; 0-to-n pandigitals are annoying because we don't want
+ ;; to include those with a 0 first.
+ (unless (zerop (first digits))
+ (gather (digits-to-number digits))))
+ (irange start end)
+ :copy nil)))
+```
+
+This is a prime example of where Alexandria's `map-permutations` not returning
+anything is annoying, but also shows how `gathering` provides you a little more
+flexibility. Even if `map-permutations` returned a list of results, we'd still
+need to filter out the ones that start with zero. With `gathering` we can avoid
+collecting the unneeded results at all by simply not calling `gather` on them.
+
+### Hash Table Contents
+
+Next is an easy way to convert a hash table to lists of `(key value)`:
+
+```lisp
+(defun hash-table-contents (hash-table)
+ "Return a fresh list of `(key value)` elements of `hash-table`."
+ (gathering (maphash (compose #'gather #'list) hash-table)))
+```
+
+Because `gather` is a `flet`ed function we can use it like any other function.
+Here we `compose` it with `list` and pass it off to `maphash` (which, for some
+reason, doesn't return its results).
+
+### Triangle Generation
+
+We'll end with a triangle-generation function from [my procedural art
+bot](https://twitter.com/bit_loom/):
+
+```lisp
+(defun generate-universe-balancing (depth)
+ (gathering
+ (labels ((should-stop-p (iteration)
+ (or (= depth iteration)
+ (and (> iteration 6)
+ (randomp (map-range 0 depth
+ 0.0 0.05
+ iteration)
+ #'rand))))
+ (recur (triangle &optional (iteration 0))
+ (if (should-stop-p iteration)
+ (gather triangle)
+ (map nil (rcurry #'recur (1+ iteration))
+ (split-triangle-self-balancing triangle)))))
+ (map nil #'recur (initial-triangles)))))
+```
+
+This is used to generate the triangles for images like this:
+
+[](/media/images/blog/2018/05/triangles.jpeg)
+
+Using `gathering` lets me write the recursive generation algorithm in a natural
+way, and just plug in a simple `(gather triangle)` when we finally bottom out at
+the base case.
--- a/static/media/css/sjl.css Sun May 20 17:03:34 2018 -0400
+++ b/static/media/css/sjl.css Sun May 20 18:51:20 2018 -0400
@@ -3,7 +3,7 @@
}
body {
text-rendering: optimizeLegibility;
- color: #222222;
+ color: #222;
position: relative;
}
body a {
@@ -28,7 +28,7 @@
body h4 a,
body h5 a,
body h6 a {
- color: #222222;
+ color: #222;
}
body h1 a:hover,
body h2 a:hover,
@@ -85,7 +85,7 @@
body pre {
font-family: Consolas, Menlo, "Courier New", monospace;
font-size: 16px;
- line-height: 25px;
+ line-height: 20px;
overflow-x: auto;
border: 1px solid #d5d5d5;
border-left: 10px solid #d5d5d5;
@@ -116,6 +116,9 @@
line-height: 20px;
border: none;
}
+body pre code {
+ line-height: 20px;
+}
body p code,
body li code,
body table code {
@@ -145,7 +148,7 @@
font-style: italic;
}
body .wrap .top header a {
- color: #222222;
+ color: #222;
}
body .wrap .top header a:hover {
color: #e50053;
@@ -227,7 +230,7 @@
}
.section-listing ol li a {
font: normal 23px/32px HoeflerText-Regular, 'Hoefler Text', 'Goudy Old Style', 'Palatino', 'Palatino Linotype', serif;
- color: #222222;
+ color: #222;
display: block;
}
.section-listing ol li a:hover {