Peter Siebel - Practical Common Lisp

(print 'hello)

(when (plusp (random 10)) (go top)))

An even sillier example of TAGBODY , which shows you can have multiple tags in a single TAGBODY , looks like this:

(tagbody

a (print 'a) (if (zerop (random 2)) (go c))

b (print 'b) (if (zerop (random 2)) (go a))

c (print 'c) (if (zerop (random 2)) (go b)))

This form will jump around randomly printing a s, b s, and c s until eventually the last RANDOM expression returns 1 and the control falls off the end of the TAGBODY .

TAGBODY is rarely used directly since it's almost always easier to write iterative constructs in terms of the existing looping macros. It's handy, however, for translating algorithms written in other languages into Common Lisp, either automatically or manually. An example of an automatic translation tool is the FORTRAN-to-Common Lisp translator, f2cl, that translates FORTRAN source code into Common Lisp in order to make various FORTRAN libraries available to Common Lisp programmers. Since many FORTRAN libraries were written before the structured programming revolution, they're full of gotos. The f2cl compiler can simply translate those gotos to GO s within appropriate TAGBODY s. [210] One version of f2cl is available as part of the Common Lisp Open Code Collection (CLOCC): http://clocc.sourceforge.net/ . By contrast, consider the tricks the authors of f2j, a FORTRAN-to-Java translator, have to play. Although the Java Virtual Machine (JVM) has a goto instruction, it's not directly exposed in Java. So to compile FORTRAN gotos, they first compile the FORTRAN code into legal Java source with calls to a dummy class to represent the labels and gotos. Then they compile the source with a regular Java compiler and postprocess the byte codes to translate the dummy calls into JVM-level byte codes. Clever, but what a pain.

Similarly, TAGBODY and GO can be handy when translating algorithms described in prose or by flowcharts—for instance, in Donald Knuth's classic series The Art of Computer Programming , he describes algorithms using a "recipe" format: step 1, do this; step 2, do that; step 3, go back to step 2; and so on. For example, on page 142 of The Art of Computer Programming, Volume 2: Seminumerical Algorithms , Third Edition (Addison-Wesley, 1998), he describes Algorithm S, which you'll use in Chapter 27, in this form:

Algorithm S (Selection sampling technique). To select n records at random from a set of N, where 0 < n <= N.

S1. [Initialize.] Set t <���— 0, m <���— 0. (During this algorithm, m represents the number of records selected so far, and t is the total number of input records that we have dealt with.)

S2. [Generate U.] Generate a random number U, uniformly distributed between zero and one.

S3. [Test.] If (N - t)U >= n - m, go to step S5.

S4. [Select.] Select the next record for the sample, and increase m and t by 1. If m < n, go to step S2; otherwise the sample is complete and the algorithm terminates.

S5. [Skip.] Skip the next record (do not include it in the sample), increase t by 1, and go back to step S2.

This description can be easily translated into a Common Lisp function, after renaming a few variables, as follows:

(defun algorithm-s (n max) ; max is N in Knuth's algorithm

(let (seen ; t in Knuth's algorithm

selected ; m in Knuth's algorithm

u ; U in Knuth's algorithm

(records ())) ; the list where we save the records selected

(tagbody

s1

(setf seen 0)

(setf selected 0)

s2

(setf u (random 1.0))

s3

(when (>= (* (- max seen) u) (- n selected)) (go s5))

s4

(push seen records)

(incf selected)

(incf seen)

(if (< selected n)

(go s2)

(return-from algorithm-s (nreverse records)))

s5

(incf seen)

(go s2))))

It's not the prettiest code, but it's easy to verify that it's a faithful translation of Knuth's algorithm. But, this code, unlike Knuth's prose description, can be run and tested. Then you can start refactoring, checking after each change that the function still works. [211] Since this algorithm depends on values returned by RANDOM , you may want to test it with a consistent random seed, which you can get by binding *RANDOM-STATE* to the value of (make-random-state nil) around each call to algorithm-s . For instance, you can do a basic sanity check of algorithm-s by evaluating this: (let ((*random-state* (make-random-state nil))) (algorithm-s 10 200)) If your refactorings are all valid, this expression should evaluate to the same list each time.

After pushing the pieces around a bit, you might end up with something like this:

(defun algorithm-s (n max)

(loop for seen from 0

when (< (* (- max seen) (random 1.0)) n)

collect seen and do (decf n)

until (zerop n)))

While it may not be immediately obvious that this code correctly implements Algorithm S, if you got here via a series of functions that all behave identically to the original literal translation of Knuth's recipe, you'd have good reason to believe it's correct.

Another aspect of the language that special operators give you control over is the behavior of the call stack. For instance, while you normally use BLOCK and TAGBODY to manage the flow of control within a single function, you can also use them, in conjunction with closures, to force an immediate nonlocal return from a function further down on the stack. That's because BLOCK names and TAGBODY tags can be closed over by any code within the lexical scope of the BLOCK or TAGBODY . For example, consider this function:

(defun foo ()

(format t "Entering foo~%")

(block a

(format t " Entering BLOCK~%")

(bar #'(lambda () (return-from a)))

(format t " Leaving BLOCK~%"))

(format t "Leaving foo~%"))

The anonymous function passed to baruses RETURN-FROM to return from the BLOCK . But that RETURN-FROM doesn't get evaluated until the anonymous function is invoked with FUNCALL or APPLY . Now suppose barlooks like this:

(defun bar (fn)

(format t " Entering bar~%")

(baz fn)

(format t " Leaving bar~%"))

Still, the anonymous function isn't invoked. Now look at baz.

(defun baz (fn)

(format t " Entering baz~%")

(funcall fn)

(format t " Leaving baz~%"))

Finally the function is invoked. But what does it mean to RETURN-FROM a block that's several layers up on the call stack? Turns out it works fine—the stack is unwound back to the frame where the BLOCK was established and control returns from the BLOCK . The FORMAT expressions in foo, bar, and bazshow this: