Tail recursion syntactic sugar faked with TAGBODY-based construct?

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)))))))
.

Relevant Pages

  • Re: On Local Error Goto Somewhere
    ... an EXIT DO or EXIT FOR. ... going if there is no label to show you the destination. ... IMO the GoTo statement has never been "THE" problem. ... ON ERROR GOTO MySubErr Dim lFNbr as long ...
    (microsoft.public.vb.general.discussion)
  • Re: function pointers
    ... The simple goto. ... fixed target label. ... The computed goto, aka switch, select, or caseof, depending ... In C it is the switch. ...
    (comp.lang.c)
  • Re: COBOL aint quite dead - yet !
    ... If you accept a definition of GOTO's as a transfer of control, ... would probably not have said that a goto by any other name would still be a ... label then, in a program that has gotos, it is not possible to know ... the SECTION keyword is an assurance that there will be no down- ...
    (comp.lang.cobol)
  • [BUG] futex_handle_fault always fails.
    ... jump to the pi_faulted label. ... From the retry label, with ret still zero, we again hit EFAULT on the ... goto retry; ...
    (Linux-Kernel)
  • Re: F: Repeat .... until-Schleifen
    ... label Label_Fehler; ... if not CheckHardwarethen Goto Label_Fehler; ... Der eine mit Goto, der andere mit Exception. ... der andere nicht. ...
    (de.comp.lang.delphi.misc)
Loading