tail recursion hack in Emacs Lisp?

[Oliver Scholz <alkibiades@gmx.de>]

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é!