Compose example in Paul Graham's ANSI Common Lisp

Question

Can anybody explain an example in Paul Graham's ANSI Common Lisp page 110?

The example try to explain the use &rest and lambda to create functional programming facilities. One of them is a function to compose functional arguments. I cannot find anything explaining how it worked. The code is as follows:

(defun compose (&rest fns)
  (destructuring-bind (fn1 . rest) (reverse fns)
    #'(lambda (&rest args)
        (reduce #'(lambda (v f) (funcall f v))
                rest
                :initial-value (apply fn1 args)))))

The usage is:

(mapcar (compose #'list #'round #'sqrt)
        '(4 9 16 25))

The output is:

((2) (3) (4) (5))

Line 2 and 6 look especially like magic to me.

Corpulence

Answer 1

The compose function returns a closure that calls each of the functions from last to first, passing on the result of each function call to the next.

The closure resulting from calling (compose #'list #'round #'sqrt) first calculates the square root of its argument, rounds the result to the nearest integer, then creates a list of the result. Calling the closure with say 3 as argument is equivalent to evaluating (list (round (sqrt 3))).

The destructuring-bind evaluates the (reverse fns) expression to get the arguments of compose in reverse order, and binds its first item of the resulting list to the fn1 local variable and the rest of the resulting list to the rest local variable. Hence fn1 holds the last item of fns, #'sqrt.

The reduce calls each the fns functions with the accumulated result. The :initial-value (apply fn1 args) provides the initial value to the reduce function and supports calling the closure with multiple arguments. Without the requirement of multiple arguments, compose can be simplified to:

(defun compose (&rest fns)
  #'(lambda (arg)
      (reduce #'(lambda (v f) (funcall f v))
              (reverse fns)
              :initial-value arg)))

Dialogize

(reduce ... (reverse fns) ... should be written as (reduce ... fns :from-end t ... – Finedraw

with :from-end t it becomes simply (reduce 'funcall fns :from-end t :initial-value arg) – Guimond

Answer 2

destructuring-bind combines destructors with binding. A destructor is a function that lets you access a part of a data structure. car and cdr are simple destructors to extract the head and tail of a list. getf is a general destructor framework. Binding is most commonly performed by let. In this example, fns is (#'list #'round #'sqrt) (the arguments to compose), so (reverse fns) is (#'sqrt #'round #'list). Then

(destructuring-bind (fn1 . rest) '(#'sqrt #'round #'list)
  ...)

is equivalent to

(let ((tmp '(#'sqrt #'round #'list)))
  (let ((fn1 (car tmp))
        (rest (cdr tmp)))
    ...))

except that it doesn't bind tmp, of course. The idea of destructuring-bind is that it's a pattern matching construct: its first argument is a pattern that the data must match, and symbols in the pattern are bound to the corresponding pieces of the data.

So now fn1 is #'sqrt and rest is (#'round #'list). The compose function returns a function: (lambda (&rest args) ...). Now consider what happens when you apply that function to some argument such as 4. The lambda can be applied, yielding

(reduce #'(lambda (v f) (funcall f v))
            '(#'round #'list)
            :initial-value (apply #'sqrt 4)))

The apply function applies fn1 to the argument; since this argument is not a list, this is just (#'sqrt 4) which is 2. In other words, we have

(reduce #'(lambda (v f) (funcall f v))
            '(#'round #'list)
            :initial-value 2)

Now the reduce function does its job, which is to apply #'(lambda (v f) (funcall f v)) successively to the #'round and to #'list, starting with 2. This is equivalent to

(funcall #'list (funcall #'round 2))
→ (#'list (#'round 2))
→ '(2)

Shonda

Answer 3

Okay, here goes:

1. It takes the functions given, reverses it (in your example, it becomes (#'sqrt #'round #'list)), then sticks the first item into fn1, and the rest into rest. We have: fn1 = #'sqrt, and rest = (#'round #'list).
2. Then it performs a fold, using (apply sqrt args) (where args are the values given to the resulting lambda) as the initial value, and with each iteration grabbing the next function from rest to call.
   1. For the first iteration you end up with (round (apply sqrt args)), and the second iteration you end up with (list (round (apply sqrt args))).
3. Interestingly, only the initial function (sqrt in your case) is allowed to take multiple arguments. The rest of the functions are called with single arguments only, even if any particular function in the chain does a multiple-value return.

Intra

So, I think that super creative :initial-value confused me :) Very nice though. Thanks. – Corpulence

Answer 4

This example stumped me for a day. I could finally understand it by renaming some of the arguments and commenting each line before it made sense. Below is what helped me explain it to myself.

In the book example using the call:

(mapcar (compose #'list #'round #'sqrt) '(4 9 16 25))

The parameter functions becomes (#'LIST #'ROUND #'SQRT)

(defun compose (&rest functions)
  (destructuring-bind (fx . fxs) (reverse functions)
    ;; fx becomes #'SQRT
    ;; fxs becomes '(#'ROUND #'LIST)
    #'(lambda (&rest args) ; This is the function returned as result.
    ;; The args parameter will be (4) on the mapcar's first
    ;; iteration on the (4 9 16 25) list passed in the call:
    ;; (mapcar #'(compose #'List #'round #'sqrt) '(4 9 16 25)) => ((2) (3) (4) (5))
    ;; or e.g. the (4) in (funcall (compose #'list #'sqrt '(4)) => (2.0) 
    ;; Note that args is not ((#'ROUND #'LIST)).
    (reduce #'(lambda (x y) (funcall y x))
        ;; fxs is (#'ROUND #'LIST) - captuted as closure since it is now
        ;; locally unbound.
        fxs
        ;; Initial value is: (apply #'SQRT '(4) => 2.0.
        ;; In Paul Graham's example, the mapcar passes
        ;; each square number individually.
        ;; The reverse order of parameters in the second lambda
        ;; first invokes: (ROUND 2.0) => 2
        ;; and then invokes: (LIST 2) => (2)
        :initial-value (apply fx args)))))

Hypothalamus