tail recursion hack in Emacs Lisp?

[Oliver Scholz]

I like tail recursion a lot, because I regard it as a means to specify
the flow of control that is IMO the right way for /some/ problems.
Thus tail call reduction is on the top of my personal wish list for
enhancements of Emacs Lisp---even before closures and greater speed.

I have been wondering for a while, whether it would be possible to
fake tail recursion without hacking the byte code compiler.  Say, if
we have an `iterate' macro like in CMU CL (which in turn is inspired
by Scheme's named let): would it be possible that the macroexpanded
code would be non-recursive Emacs Lisp code?

Today I got bored in my lunch break and came up with this.

(iterate fact ((n n)
               (r 1))
  (if (= n 1)
      r
    (fact (1- n) (* n r))))

should expand to:

(let ((continue t)
      (result (list n 1)))
  (while continue
    (setq result
          (catch 'repeat
            (setq result
                  (apply
                   (lambda (n r)
                     (if (= n 1)
                         r
                       (throw 'repeat (list (1- n) (* n r)))))
                   result))
            (setq continue nil)
            result)))
  result)


(Of course, a code walker would be necessary.) I can't see any
problems with that approach right know. But lacking experience in
implementing Lisp, I might be missing something.

So my question is: Can anybody think of a case where this approach
would break?

While I am at it: I quickly hacked something together:

(defmacro iterate (name arglist &rest body)
  (let ((catch-symbol (make-symbol "--repeat"))
        (continue (make-symbol "--continue"))
        (result (make-symbol "--result"))
        (lambda-list (mapcar 'car arglist))
        (initial-args (mapcar 'cadr arglist)))
    (setq body (iterate-code-walk body name catch-symbol))
    `(let ((,continue t)
           (,result (list ,@initial-args)))
       (while ,continue
         (setq ,result
               (catch ',catch-symbol
                 (setq ,result
                       (apply
                        (lambda ,lambda-list
                          ,@body)
                        ,result))
                 (setq ,continue nil)
                 ,result)))
       ,result)))

(defun iterate-code-walk (exp sym catch-sym)
  (cond ((and (listp exp)
              (eq (car exp) 'quote))
         exp)
        ((and (listp exp)
              (eq (car exp) sym))
         (list 'throw `(quote ,catch-sym)
               (cons 'list (cdr exp))))
        ((listp exp)
         (iterate-code-walk-list exp sym catch-sym))
        (t exp)))

(defun iterate-code-walk-list (exp sym catch-sym)
  (mapcar (lambda (el)
            (iterate-code-walk el sym catch-sym))
          exp))       


    Oliver
-- 
29 Messidor an 212 de la Révolution
Liberté, Egalité, Fraternité!