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))
*current-tail-marker*))

(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
they?


(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-
enabled,
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)
`(progn
(setf *tail-call*
(cons (list ,@debug) (lambda () ,@body)))
*tail-call-optimised*))

(defmacro with-tail-calls-enabled (&body body)
`(progn
(tail-call ('tail-calls-enabled)
,@body)
(trampoline)))

(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*)
finally
(setf *tail-call* nil)
(return result)))


> (labels ((fact/accum (x accum)
(if (plusp x)
(tail-call (fact/accum (1- x) (* x accum)))
accum)))
(with-tail-calls-enabled
(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)))
accum)))
(with-tail-calls-enabled
(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.]

multiple-value-list?

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:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607


.