[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

tail recursion hack in Emacs Lisp?

From: Oliver Scholz
Subject: tail recursion hack in Emacs Lisp?
Date: Fri, 16 Jul 2004 17:07:19 +0200
User-agent: Gnus/5.1006 (Gnus v5.10.6) Emacs/21.3.50 (windows-nt)

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)
    (fact (1- n) (* n r))))

should expand to:

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

(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
                        (lambda ,lambda-list
                 (setq ,continue nil)

(defun iterate-code-walk (exp sym catch-sym)
  (cond ((and (listp exp)
              (eq (car exp) 'quote))
        ((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))

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

reply via email to

[Prev in Thread] Current Thread [Next in Thread]