More human-readable macroexpansions

[phoe]

Moving over from cl-library-docs/common-lisp-libraries#3

It might be worth to accomodate the needs of Lispers who don't enjoy arrows by making it possible to expand arrow macros into let* in the most naive way possible, so that the resulting macroexpansion can be normally read. For instance, let's consider a non-trivial example:

(-<> 42
  (list <> <> <>)
  (cons 1 <>)
  (cons <> 2)
  (list <> :foo <>)
  (print <>))

The following currently expans into:

(PRINT
 (LET ((#:R674
        (CONS
         (CONS 1
               (LET ((#:R673 42))
                 (LIST #:R673 #:R673 #:R673)))
         2)))
   (LIST #:R674 :FOO #:R674)))

The nested let is ugly and makes the macroexpansion very hard to grok.

I suggest that the above should expand into a variant of the following instead:

(LET* ((#:VAR561 42)
       (#:VAR562 (LIST #:VAR561 #:VAR561 #:VAR561))
       (#:VAR563 (CONS 1 #:VAR563))
       (#:VAR564 (CONS #:VAR563 2))
       (#:VAR565 (LIST #:VAR564 :FOO #:VAR564)))
  (DECLARE (IGNORABLE #:VAR561 #:VAR562 #:VAR563 #:VAR564 #:VAR565))
  (PRINT #:VAR565))

This should be able to provide better readability for macroexpansions (importantly, slime-macrostep) and more debuggability for high debug settings since because the bound locals will be visible in the debugger. (One argument against this is that simple bindings, like the ones for variables number 561, 563, 564 up above, should be simplified into direct value passing, but IMO compilers are going to optimize those away anyway for low debug settings.)

[Hexstream]

accomodate the needs of Lispers who don't enjoy arrows

For whatever it's worth, there is no point in trying to "accomodate my needs" with respect to arrows because I simply refuse to read code that contains them. I suspect this is a fairly pervasive feeling among arrow haters, an hopefully vast population.

[phoe]

You are not the targeted audience of this issue. If someone decides to read code containing arrows (and therefore they are not you by definition), but they do not know the details of how arrows work, then they might find such macroexpansion helpful to understand what's going on.

[Harleqin]

Yes, I think that can be done and even improve the expansion code (there seems to be a let*-expdander waiting to get out).

I must admit that I do not expand macros much, but this might help people form the (actually quite straightforward) mental model for these.

And for the “haters” it can be a way to quickly refactor arrows out by just replacing the forms with their macro expansion, so non-uglyness seems to be a win for everyone.

[phoe]

OK. I'll send a PR tomorrow.

[phoe]

OK, I'm submitting it here for the time being; I'll write more tests (including macroexpansion/readability tests) and make a proper PR in the morning, when I am less sleepy. Please let me know if this looks good - it's a preliminary implementation, but it seems to work with the simple macrostepping test cases I've made so far.

TODO: add ignorables, write tests.

I've allowed myself to depend on Alexandria for convenience. If that's not something you'd like, we can gut out the functions we need and paste them at the beginning of the file.

---

(This blob of implementation details can be copied into some sorta README later on.)

The code is structured in four parts. The main heavy lifting is done in the arrow expansion engine that generates the let* body. The three moving parts of it that are customizable are:

• the list of symbols that are bound as variables in successive bindings.
• the function that provides the value for a binding,
• the function that produces the binding.

This architecture allows for creating two series of helper functions that are then appropriately invoked in each macro definition, along with any frobbing of symbols and forms that is necessary for a given arrow.

In result, each macro definition is a call to the main arrow expansion engine, configured with proper parameters. I guess that's kinda clean, and should be extensible enough as long as the core of each arrow is going to be a let* - which is, IMO, a decently safe assumption.

In cond arrows, I did not expand the inner arrow calls in value forms, because I cannot easily avoid the nested let that results from macroexpansion; this hurts macro readability. Therefore, I leave them as-is for the macrostepping person to macroexpand on their own, if they wish so.

---

(defpackage #:arrows
  (:use #:common-lisp)
  (:local-nicknames (#:a #:alexandria))
  (:export #:-> #:->>
           #:-<> #:-<>>
           #:as->
           #:some-> #:some->>
           #:cond-> #:cond->>
           #:->* #:as->*))

(in-package #:arrows)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Arrow expansion function

(defun make-value-form (value-fn prev-symbol form)
  (if (null prev-symbol)
      form
      (funcall value-fn prev-symbol (a:ensure-cons form))))

(defun make-binding (binding-fn prev-symbol next-symbol value-form)
  (if (null prev-symbol)
      (list next-symbol value-form)
      (funcall binding-fn prev-symbol next-symbol value-form)))

(defun expand-arrow (forms &key
                             (symbols (a:make-gensym-list (length forms) "VAR"))
                             (value-fn #'value-first)
                             (binding-fn #'binding))
  (cond ((null forms) 'nil)
        ((null (cdr forms)) (car forms))
        (t (loop for form in forms
                 for prev-symbol = nil then next-symbol
                 for next-symbol in symbols
                 for value-form = (make-value-form value-fn prev-symbol form)
                 for binding = (make-binding binding-fn prev-symbol
                                             next-symbol value-form)
                 collect binding into bindings
                 finally (return `(let* ,bindings ,prev-symbol))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Value functions

(defun value-first (symbol form)
  (destructuring-bind (head . tail) form
    (list* head symbol tail)))

(defun value-last (symbol form)
  (append form (list symbol)))

(defun diamond-value (value-fn symbol form)
  (flet ((diamondp (form) (and (symbolp form) (string= form "<>"))))
    (if (= 0 (count-if #'diamondp form))
        (funcall value-fn symbol form)
        (substitute-if symbol #'diamondp form))))

(defun diamond-value-first (symbol form)
  (funcall #'diamond-value #'value-first symbol form))

(defun diamond-value-last (symbol form)
  (funcall #'diamond-value #'value-last symbol form))

(defun cond-value (symbol form)
  (declare (ignore symbol))
  form)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Binding functions

(defun binding (prev-symbol next-symbol value-form)
  (declare (ignore prev-symbol))
  `(,next-symbol ,value-form))

(defun some-binding (prev-symbol next-symbol value-form)
  `(,next-symbol (when ,prev-symbol ,value-form)))

(defun cond-binding (prev-symbol next-symbol value-form arrow)
  (destructuring-bind (test . forms) value-form
    (let ((arrow-form `(,arrow ,prev-symbol ,@forms)))
      `(,next-symbol (if ,test ,arrow-form ,prev-symbol)))))

(defun cond-binding-first (prev-symbol next-symbol value-form)
  (cond-binding prev-symbol next-symbol value-form '->))

(defun cond-binding-last (prev-symbol next-symbol value-form)
  (cond-binding prev-symbol next-symbol value-form '->>))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Arrow implementations

(defmacro -> (&rest forms)
  (expand-arrow forms))

(defmacro ->> (&rest forms)
  (expand-arrow forms :value-fn #'value-last))

(defmacro -<> (&rest forms)
  (expand-arrow forms :value-fn #'diamond-value-first))

(defmacro -<>> (&rest forms)
  (expand-arrow forms :value-fn #'diamond-value-last))

(defmacro as-> (initial-form var &rest forms)
  (let ((symbols (make-list (1+ (length forms)) :initial-element var)))
    (expand-arrow (cons initial-form forms) :symbols symbols)))

(defmacro some-> (&rest forms)
  (expand-arrow forms :binding-fn #'some-binding))

(defmacro some->> (&rest forms)
  (expand-arrow forms :value-fn #'value-last :binding-fn #'some-binding))

(defmacro cond-> (&rest forms)
  (let ((symbols (make-list (length forms) :initial-element (gensym "VAR"))))
    (expand-arrow forms :symbols symbols :value-fn #'cond-value
                        :binding-fn #'cond-binding-first)))

(defmacro cond->> (&rest forms)
  (let ((symbols (make-list (length forms) :initial-element (gensym "VAR"))))
    (expand-arrow forms :symbols symbols :value-fn #'cond-value
                        :binding-fn #'cond-binding-last)))

(defmacro ->* (&rest forms)
  (let ((forms (append (last forms) (butlast forms))))
    (expand-arrow forms)))

(defmacro as->* (var &rest forms)
  (let ((symbols (make-list (1+ (length forms)) :initial-element var))
        (forms (append (last forms) (butlast forms))))
    (expand-arrow forms :symbols symbols)))

[Harleqin]

Great work. I think I'll have to meditate on this a bit over the weekend, as it is a bigger leap than I anticipated.

The existing tests should just continue to work. As for testing the expansion, I could imagine to have tests that do not test the exact expansion but some property like nesting level.

What I can say is that I'd really rather not have dependencies, because I see this library at the bottom of the food chain. Any other library might want to use it, so it should preemptively avoid circular dependencies.

[phoe]

The existing tests will continue to work; breaking backwards compatibility is out of question.

I have figured out a way to test the expansion; I'll demonstrate it in the PR.

OK; I'll copy the required functions from Alexandria in order not to depend on it.

[phoe]

Closing this issue because the let* transformation is invalid - see #3 for rationale.