TAGBODY in Scheme
Nils M Holm
I have recently wondered how to implement Common LISP TAGBODYs in
Scheme. Not that I can imagine any real use for this, but I thought
it might be fun to try (it was). So I hacked up some code that works
surprisingly well, but I wonder if there is a more efficient and/or
obvious way to do this.
Here is what I came up with. (Nested TAGBODYs do not work properly
in this version an probably never will).
A TAGBODY is like BEGIN, but allows to place labels in its scope
and jump to them. Here is the endless loop using TAGBODY:
(TAGBODY
HERE
(GO HERE))
Anything that is atomic is a label, everything else is a statement.
Here is a TAGBODY computing the X'th fibonacci number. X, X0, and X1
have to be defined outside of the TAGBODY:
(tagbody
test
(if (zero? x)
(go end))
(let ((t x1))
(set! x1 (+ x0 x1))
(set! x0 t))
(if (zero? (remainder x 10))
(go print))
(go next)
print
(display x1)
(newline)
next
(set! x (- x 1))
(go test)
end)
The program has been written to maximize the number of labels, not
for efficiency. It prints intermediate results when x mod 10 = 0.
To translate a TAGBODY to Scheme, some means of transferring control
non-locally is needed, so the solution involves CALL/CC. My approach
packages each block of code (the statements between two labels) in
a separate function and the functions in a vector:
(vector (lambda () ; test
(if (zero? x)
(go end))
(let ((t x1))
(set! x1 (+ x0 x1))
(set! x0 t))
(if (zero? (remainder x 10))
(go print))
(go next))
(lambda () ; print
(display x1)
(newline))
(lambda () ; next
(set! x (- x 1))
(go test)))
(lambda () ; end
#f))
The TAGBODY is evaluated by iterating over the vector and calling
the procedures in sequence. When (go <label>) is evaluated, the label
is looked up in an alist mapping names to offsets and then CALL/CC
is used to exit from the current block.
This method allows to go to labels from anywhere inside of the
dynamic scope of the TAGBODY, as desribed in the Common LISP
standard. The following code will *not* display anything:
(define (f x) (x))
(tagbody
(f (lambda ()
(go exit)))
(display "skip me")
exit)
For those interested in the details here is a macro-expanded version
of the above fibonacci program:
(let ((test 'test) ; so we can use (GO label) instead of (GO 'label)
(print 'print)
(next 'next)
(end 'end))
(let* ((symtab-700 '((test . 0) ; symbol --> vector offset
(print . 1)
(next . 2)
(end . 3)))
; GOTO-xxx will be bound to (K . P)
; where K is the exit continuation and
; P is the offset of the next block to run.
(goto-697 (call/cc (lambda (k) (cons k 0))))
(go (lambda (label)
((car goto-697) (cons (car goto-697)
(cdr (assq label symtab-700))))))
(blocks-699 (vector (lambda ()
(if (zero? x)
(go end))
(let ((t x1))
(set! x1 (+ x0 x1))
(set! x0 t))
(if (zero? (remainder x 10))
(go print))
(go next))
(lambda ()
(display x1)
(newline))
(lambda ()
(set! x (- x 1))
(go test))
(lambda ()
#f)))
(end-698 (vector-length blocks-699)))
(let loop ()
(if (< (cdr goto-697) end-698)
(begin ((vector-ref blocks-699 (cdr goto-697)))
(set-cdr! goto-697 (+ 1 (cdr goto-697)))
(loop))))))
The code of the TAGBODY macro is not yet on my homepage. Mail me
if you are interested.
--
Nils M Holm | http://t3x.org
Rob Warnock
+---------------
| I have recently wondered how to implement Common LISP TAGBODYs in
| Scheme. Not that I can imagine any real use for this, but I thought
| it might be fun to try (it was). So I hacked up some code that works
| surprisingly well, but I wonder if there is a more efficient and/or
| obvious way to do this.
You might be interested in this classic paper:
http://home.pipeline.com/~hbaker1/MetaCircular.html
Metacircular Semantics for Common Lisp Special Forms
Henry G. Baker
ACM Lisp Pointers V, 4 (Oct-Dec 1992), 11-20
...
"BLOCK/RETURN-FROM" EMULATED BY "CATCH/THROW"
We will show that only one of the three non-local exit mechanisms
block/return-from, tagbody/go, catch/throw is required to be primitive,
by showing how to emulate any two in terms of the third.[4]
...
"BLOCK/RETURN-FROM" EMULATED BY "TAGBODY/GO"
The emulation of block/return-from using tagbody/go is more difficult
than when using catch/throw because we must communicate the returned
multiple values using a lexical variable specifically allocated for
this purpose:
...
"TAGBODY/GO" EMULATED BY "CATCH/THROW"
The emulation of tagbody/go by catch/throw is considerably less
obvious than the emulation of block/return-from. This is because
tagbody defines a number of different labels rather than a single
block name, and because the parsing of the tagbody body is considerably
more complicated. The various segments of the tagbody are emulated
by a labels nest of mutually recursive functions, which are forced
to all execute at the correct dynamic depth by means of a "trampoline".
If the implementation implements the "tail recursion" optimization
for functions which have no arguments and return no values, and if
the simpler cases of go's are optimized away, then this emulation
can be quite efficient.
...
[Footnotes:]
[4] Of the three, we strongly recommend that catch/throw be
considered the most primitive mechanism, because basing
tagbody/go and block/return-from on catch/throw makes
absolutely clear the fact that Common Lisp does not and
can not have Scheme-like first-class continuations.
[Note that he doesn't actually show TAGBODY/GO emulated by
BLOCK/RETURN-FROM in the paper, but that's not too hard an
extrapolation from the others shown.]
His emulation of TAGBODY/GO by CATCH/THROW is quite similar to yours
except that he uses the builtin LABELS special form to define local
recursive functions [with names munged from the tag names] for the
basic-blocks of the TAGBODY rather than collecting them into an array.
Because, like you, he uses a trampoline loop to call each function,
he doesn't need the full power of CALL/CC [which is good, since CL
doesn't have it!], only the single-escaping continuations provided
by CATCH.
-Rob
-----
Rob Warnock <rp...@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607
Bill
> non-locally is needed
you can also do it with set-cdr! (circular lists):
Nils M Holm
> You might be interested in this classic paper:
>
> http://home.pipeline.com/~hbaker1/MetaCircular.html
> Metacircular Semantics for Common Lisp Special Forms
> Henry G. Baker
> ACM Lisp Pointers V, 4 (Oct-Dec 1992), 11-20
It took me a while to get through that implementation, but then
it was quite interesting. Thanks for the pointer!
BTW, in the paper Baker argues strongly in favor of a definition
of CLOS that is not part of the Common LISP core language. His
argumentation sounds quite reasonable to me. How did CLOS end up
in the spec anyway then? Were there other technical issues that
made such a solution even more reasonable? I suspect so, but I
would be interested in a little background.
> His emulation of TAGBODY/GO by CATCH/THROW is quite similar to yours
> except that he uses the builtin LABELS special form to define local
> recursive functions [with names munged from the tag names] for the
> basic-blocks of the TAGBODY rather than collecting them into an array.
What is nice about the CATCH/THROW approach is that seems to handle
nested TAGBODYs quite naturally. I found a solution that also does,
but it is not very efficient and involves a global variable. Maybe
I will try CATCH/THROW next and then recycle Baker's approach. :-)
Nils M Holm
I find this code a bit hard to follow, because it seems to implement
lots of non-standard Scheme semantics under the hood. For example:
(define v123
(let ((vect (vector 1 2 3)))
(make-procedure-with-setter
(lambda (index)
(vect index)) ; <-- VECT is a non-function
(lambda (index value)
(set! (vect index) value))))) ; <-- SET! modifies a non-variable
So I guess that VECTOR (and probably other procedures) are implemented in
terms of MAKE-PROCEDURE-WITH-SETTER and the latter requires quite a bit of
cooperation from SET!. What would DEFINE-WITH-GOTO look like without the
extra semantics? Or would it be too cumbersome?
Pascal Costanza
> Rob Warnock<rp...@rpw3.org> wrote:
>> You might be interested in this classic paper:
>>
>> http://home.pipeline.com/~hbaker1/MetaCircular.html
>> Metacircular Semantics for Common Lisp Special Forms
>> Henry G. Baker
>> ACM Lisp Pointers V, 4 (Oct-Dec 1992), 11-20
>
> It took me a while to get through that implementation, but then
> it was quite interesting. Thanks for the pointer!
>
> BTW, in the paper Baker argues strongly in favor of a definition
> of CLOS that is not part of the Common LISP core language. His
> argumentation sounds quite reasonable to me. How did CLOS end up
> in the spec anyway then? Were there other technical issues that
> made such a solution even more reasonable? I suspect so, but I
> would be interested in a little background.
If I understand correctly, there were political issues involved
(essentially, getting the Interlisp people from Xerox PARC on board who
were not involved in CLtL1). At a technical level, contrary to popular
belief, CLOS is not a plain library, but requires extension of the core
language with "funcallable objects", and probably also benefits from
optimizations the compilers can do because they "know" about CLOS.
I think it's good that there is a language available that takes the
notion of generic functions really seriously. I hope that once Scheme
adds OOP, that it will be based on generic functions as well, and not on
message sending.
Pascal
--
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
Bill
> extra semantics?
less amusing.
Or would it be too cumbersome?
no.
T. Kurt Bond
> I have recently wondered how to implement Common LISP TAGBODYs in
> Scheme. Not that I can imagine any real use for this, but I thought
> it might be fun to try (it was). So I hacked up some code that works
> surprisingly well, but I wonder if there is a more efficient and/or
> obvious way to do this.
Isn't the solution to this in Scheme the subject of section 2.2, "The
GO TO Statement", of "LAMBDA: the Ultimate Imperative" (AIM-353,
http://repository.readscheme.org/ftp/papers/ai-lab-pubs/AIM-353.pdf ),
by Steele & Sussman? That is to say, proper tail call optimization
and lexical scope?