I may have gone off the deep end.
The idea is to extend TAGBODY in a simple way: give the tags named
parameters, and provide a GOTO that takes argument expressions. The
parameters are simply the names of variables that are in scope of the
body, and the GOTO simply assigns the argument value to the
variables. The syntactic sugar is considerable though. And there /is/
a subtlety: shadowing is handled. If a GOTO occurs in some inner scope
in which a a label parameter is shadowed, the GOTO will properly
initialize the outer variable. It won't blindly assign to the inner
variable.
With this, you can express tail recursion, including mutual tail
recursion, with nearly the same syntactic sugar. And it turns into
stackless iteration: jumping around within a TAGBODY.
E.g. in the thread ``better way to enumerate'', viper-2 posted this:
(defun enumerate-with-op (start end &optional elist)
(if (> start end)
(reverse elist)
(enumerate-with-op (1+ start) end
(cons start elist))))
With the ARGTAGS macro, we can write ENUMERATE like this, and not rely
on tail recursion optimization:
;; should be called IOTA or some variation thereof
(defun enumerate (start end)
(let (result-list)
(argtags nil
(label enumerate start end result-list)
(when (> start end)
(return (nreverse result-list)))
(goto enumerate (1+ start) end (cons start result-list)))))
Since tail recursion /is/ a freaking goto, damn it, just express it
that way! You don't need to write a compiler, and consequently you
don't need to duck out of mutual tail recursion because that part of
the compiler turns out to be too hard to write.
Anyone have any interesting mutual tail recursion examples? I'd like
to try rewriting them using ARGTAGS.
The implementation of ARGTAGS follows. There is clutter due to error
checking, and also due to the handling of the shadowing problem. The
strategy is to turn
(GOTO L A1 A2 ...)
into
(PROGN (PSETF #:G0100 A1 #:G0101 A2 ...) (GO #:G0001))
Where #:G0001 is a label within a thunk section that is inserted at
the end of the body. The entry in the thunk section looks like this:
#:G0001 (PSETF V1 #:G0100 V2 #:G0101 ...) (GO L)
Where V1 V2 ... are the real variables (parameters of label L). I.e.
we store the arguments into some secret local gensym variables, jump
to a thunk, thereby leaving the scope where the real variables might
be shadowed, then load the real variables from the secret gensyms and
bounce to the real target label.
(defmacro argtags (block-name &rest labels-and-forms)
(unless (symbolp block-name)
(error "ARGTAGS: block name must be a symbol, not ~a!" block-
name))
(let (labels forms thunks thunk-gensyms)
(dolist (item labels-and-forms)
(cond
((symbolp item)
(push `(,item () () ,item) labels)
(push item forms))
((and (consp item)
(eq (first item) 'label))
(unless (and (symbolp (second item))
(listp (rest (rest item)))
(every #'symbolp (rest (rest item))))
(error "ARGTAGS: bad label syntax ~a in block ~a" item block-
name))
(destructuring-bind (op label &rest vars) item
(let ((gensyms (mapcar (lambda (var)
(gensym (symbol-name var)))
vars))
(thunk-label (gensym (symbol-name label))))
(push `(,label ,vars ,gensyms ,thunk-label) labels)
(push thunk-label thunks)
(push
`(psetf ,@(mapcan (lambda (realvar gensym)
`(,realvar ,gensym))
vars gensyms))
thunks)
(push `(go ,label) thunks)
(setf thunk-gensyms (nconc gensyms thunk-gensyms))
(push label forms))))
(t
(push item forms))))
`(macrolet ((goto (label &rest args)
(let* ((labels ',labels)
(matching-label (find label labels :key
#'first)))
(unless matching-label
(error "ARGTAGS: goto undefined label ~a in
block ~a"
label ',block-name))
(destructuring-bind (name vars gensyms thunk-
label)
matching-label
(declare (ignore name))
(when (/= (length args) (length vars))
(error "ARGTAGS: label ~a caled with wrong
argument count in block ~a"
label ',block-name))
`(progn
,@(if args `((psetf ,@(mapcan (lambda
(gensym arg)
`(,gensym ,arg))
gensyms
args))))
(go ,thunk-label))))))
(block ,block-name
(let (,@thunk-gensyms)
(tagbody
,@(nreverse forms)
(return-from ,block-name)
,@(nreverse thunks)))))))
On Jan 30, 1:09 am, Kaz Kylheku <········@gmail.com> wrote:
> Anyone have any interesting mutual tail recursion examples? I'd like
> to try rewriting them using ARGTAGS.
Oh yeah, there is the silly even and odd thing.
TR version:
(defun even (n)
(if (> n 0) (odd (1- n) t))
(defun odd (n)
(if (> n 0) (even (1- n) nil))
With argtags we get just one entry point. Otherwise, straightforward
transliteration:
(defun even (n)
(argtags nil
(label even n)
(if (> n 0) (goto odd (1- n)) (return t))
(label odd n)
(if (> n 0) (goto even (1- n)) (return nil))))
Kaz Kylheku wrote:
> Anyone have any interesting mutual tail recursion examples? I'd like
> to try rewriting them using ARGTAGS.
The lower part of
http://classes.eclab.byu.edu/330/wiki/index.cgi?FunWithMacros
Pascal
--
1st European Lisp Symposium (ELS'08)
http://prog.vub.ac.be/~pcostanza/els08/
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
On Jan 31, 5:45 am, Klaus Harbo <·····@harbo.net> wrote:
> Cute macro. However, TAILPROG relies on NREVERSE not messing up ARGTAGS-FORMS and MACROLET-ELEMS (which it is permitted
> to do according to the standard), in LW5.1-beta I get
>
> CL-USER 12 > (let ((list '(1 2 3)))
> (values (nreverse list)
> list))
Yes of course. NREVERSE can rearrange the CONS structure without
moving around the CAR fields.
Of course, I intended this:
(setf argtags-forms (nreverse argtags-forms))
my Lisp just let me get away without the SETF, because it implements
reversal by reshuffling CAR's.
> `(macrolet ,(reverse macrolet-elems)
> (let ,let-bindings
> (argtags nil
> (return (progn ,@forms))
> ,@(reverse argtags-forms))))))
>
> instead -- that seems to work.
NREVERSE should also work here. But then if I'm going to obsess over
consing in REVERSE, then to be consistent I should also be using ,.
rather than ,@ for instances of splicing not in a tail position.
On Jan 30, 4:09 am, Kaz Kylheku <········@gmail.com> wrote:
> Anyone have any interesting mutual tail recursion examples? I'd like
> to try rewriting them using ARGTAGS.
How about implementing a finite state machine e.g. for an input
scanner? There was a recent discussion in comp.programming about
using tail-recursive functions in C to this effect.
http://groups.google.com/group/comp.programming/browse_thread/thread/73716740eadd474e/4cb364a55afea553
On Jan 31, 2:40 am, Gene <············@gmail.com> wrote:
> On Jan 30, 4:09 am, Kaz Kylheku <········@gmail.com> wrote:
>
> > Anyone have any interesting mutual tail recursion examples? I'd like
> > to try rewriting them using ARGTAGS.
>
> How about implementing a finite state machine e.g. for an input
> scanner? There was a recent discussion in comp.programming about
> using tail-recursive functions in C to this effect.
>
> http://groups.google.com/group/comp.programming/browse_thread/thread/...
Standard practice here and elsewhere. You just use LABELS and let the
compiler do the optimizing (if it implements it).
Cheers
--
Marco
On Jan 31, 8:55 am, Marco Antoniotti <·······@gmail.com> wrote:
> On Jan 31, 2:40 am, Gene <············@gmail.com> wrote:
>
> > On Jan 30, 4:09 am, Kaz Kylheku <········@gmail.com> wrote:
>
> > > Anyone have any interesting mutual tail recursion examples? I'd like
> > > to try rewriting them using ARGTAGS.
>
> > How about implementing a finite state machine e.g. for an input
> > scanner? There was a recent discussion in comp.programming about
> > using tail-recursive functions in C to this effect.
>
> >http://groups.google.com/group/comp.programming/browse_thread/thread/...
>
> Standard practice here and elsewhere. You just use LABELS and let the
> compiler do the optimizing (if it implements it).
>
> Cheers
> --
> Marco
Right! That was the point of the discussion in comp.programming.
There was some acrimonious insistance that tail-recursive
implementation of a DFA is "not practical." But even in (gasp) C
(compiled with gcc) it turned out to be a fine idea, notwithstanding
that it's obvious in lisp.