named-let

[Stefan Monnier <monnier@iro.umontreal.ca>]

The recent discussion around loops motivated me to look a bit further
into named-let.  It's actually easy to define:

    (defmacro named-let (name bindings &rest body)
      "Looping construct taken from Scheme.
    Like `let', bind variables in BINDINGS and then evaluate BODY,
    but with the twist that BODY can evaluate itself recursively by
    calling NAME, where the arguments passed to NAME are used
    as the new values of the bound variables in the recursive invocation."
      (declare (indent 2) (debug (symbolp (&rest (symbolp form)) body)))
      (let ((fargs (mapcar (lambda (b) (if (consp b) (car b) b)) bindings))
            (aargs (mapcar (lambda (b) (if (consp b) (cadr b))) bindings)))
        ;; According to the Scheme semantics of named let, `name' is not in scope
        ;; while evaluating the expressions in `bindings', and for this reason, the
        ;; "initial" function call below needs to be outside of the `cl-labels'.
        `(funcall
          (cl-labels ((,name ,fargs . ,body)) #',name)
          . ,aargs)))

You can then define

    (defun my-length (xs)
      (named-let loop ((xs xs) (n 0))
        (if xs
            (loop (cdr xs) (1+ n))
          n)))

Now this definition of length is recursive, so without some proper tail
call optimization, it'll burp on any longish list (apparently 1000
elements are sufficient).

But with the recent tail-call optimization I installed into `master`,
the above `my-length` now works without eating up stack space.
It's still not as efficient as a hand-written `while` loop, but it's not
that bad.  Here's the byte-code for the above function:

    byte code:
      doc:   ...
      args: (arg1)
    0       dup       
    1       constant  0
    2       constant  nil
    3:1     stack-ref 2
    4       stack-ref 2
    5       stack-ref 1
    6       goto-if-nil 2
    9       stack-ref 1
    10      cdr       
    11      stack-set 5
    13      dup       
    14      add1      
    15      stack-set 4
    17      constant  :recurse
    18      goto      3
    21:2    dup       
    22      stack-set 3
    24      constant  nil
    25:3    discardN-preserve-tos 2
    27      goto-if-not-nil 1
    30      dup       
    31      stack-set 1
    33      return    

Notice how there's really no `lambda` nor `funcall` that remains.


        Stefan