Re: CL Implementations and Tail-Call Elimination

On Sep 12, 1:57 pm, r...@xxxxxxxx (Rob Warnock) wrote:

(defmacro tail-call (form)
`(locally (declare (special *current-tail-marker*))
(setf (car *current-tail-marker*)
(lambda () ,form))

(defmacro with-tail-calls-enabled (&body forms)
`(let ((*current-tail-marker* (list (lambda () (progn ,@forms)))))
(declare (special *current-tail-marker*))
(tail-call-trampoline-loop *current-tail-marker*)))

(defun tail-call-trampoline-loop (marker)
(declare (special *current-tail-marker*))
(loop while (eq marker *current-tail-marker*)
do (setf marker (funcall (car marker)))
finally (return marker)))

I cannot quite understand these, but they are really good!!!
I got quite excited because they almost solve some problems
I had a while ago, but not quite yet...

I find the (eq marker *current-tail-marker*) thing quite
confusing, so to understand it, I've rewritten a more
readable version. Have I missed anything subtle?
(*tail-call-marker* was renamed to *tail-call*). I thought
this way is much clearer. I also tried to record any
tail-calls for debugging purposes: tail-calls and
stack-frame debugging are orthogonal issues! Afterall,
nobody complains about goto not leaving a trail behind, do

(defvar *tail-call* nil)
(defvar *tail-call-optimised* (gensym "TAIL-CALL-OPTIMISED")
"If a user accidentally runs a tail-call outside of with-tail-calls-
they'll see this symbol (and be able to guess what went wrong).")
(defvar *call-stack* (list)
"Call history for debugging.")

(defmacro tail-call ((&rest debug) &body body)
(setf *tail-call*
(cons (list ,@debug) (lambda () ,@body)))

(defmacro with-tail-calls-enabled (&body body)
(tail-call ('tail-calls-enabled)

(defun trampoline ()
(setf *call-stack* (list))
(loop for (debug . f) = *tail-call*
for result = (progn (push debug *call-stack*)
(funcall f))
while (eq result *tail-call-optimised*)
(setf *tail-call* nil)
(return result)))

> (labels ((fact/accum (x accum)
(if (plusp x)
(tail-call (fact/accum (1- x) (* x accum)))
(fact/accum 50 1)))

Example of how the debugging info above can be used:

(labels ((fact/accum (x accum)
(if (plusp x)
(tail-call ('fact/accum x accum)
(fact/accum (1- x) (* x accum)))
(fact/accum 50 1)))

This (with improvements) is similar to a stack trace.

Exercise for the reader: Tweak the above to handle
multiple values in the final non-tail-call return. [Easy.]


Exercise for the reader#2: Minimize the consing of
the multiple values version. [Somewhat harder.]

Not possible? You'll need to know in advance if a function
returns multiple values, so you can switch to
multiple-values-list. I've thought a bit, and cannot come up
with any ideas (ok, sleep time). Any hints?

Rob Warnock <r...@xxxxxxxx>
627 26th Avenue <URL:>
San Mateo, CA 94403 (650)572-2607