***

The task is to write a macro for (loop <expression> ...) that causes
the expressions to be evaluated in an infinite loop, with the variable
break bound to a procedure that will exit the loop.  The naive
implementation with syntax-rules would be something like this:

  ;; (First two simple almost-standard bindings that we will use throughout.)
  (define call/cc call-with-current-continuation)
  (define-syntax let/cc
    (syntax-rules () ((_ name . body) (call/cc (lambda (name) . body)))))

  (define-syntax loop
    (syntax-rules ()
      ((_ exp ...)
       (let/cc break
         (let f () exp ... (f))))))

  (loop
    (break 'foo))
  =>  error: unbound variable break

The problem with this is that because break is a free identifier
inserted at the expansion of loop, its binding will not capture any
uses of break in the expressions passed in to the macro.  The obvious
work-around is to require the desired name of the exit procedure to be
passed in as an argument to loop:

  (define-syntax loop
    (syntax-rules ()
      ((_ break exp ...)
       (let/cc break
         (let f () exp ... (f))))))

  (loop break
    (break 'foo))
  =>  foo

This has the feature that the binding of break in the program is more
lexically apparent.  But if loop is used extensively and every
occurrence uses break as the first argument, it is natural to want to
abbreviate the calling sequence.

It appears an inescapable fact that to create a binding that will
capture references made in the expressions, the variable to be bound
must be passed in as a parameter to the macro.  The trick is to
realize that if any of the expressions contain uses of the identifier
break, then the identifier break is indeed being passed in to the
macro.  We just have to dig through the expressions to find it!  On
the other hand, if none of the expressions use break, then there is no
need to actually bind it.  Here then, is how to write loop:

  ;; (find-identifier ident form (s-f . s-args) fk) looks for an
  ;; identifier in form that has the same binding as ident.  If
  ;; successful, we expand to (s-f ident* . s-args) where ident* is a
  ;; copy of the instance that was found in the form.  If we fail to
  ;; find ident, then we expand to fk.
  ;;
  ;; This is meaningful because even though ident and ident* have the
  ;; same binding, they could have been inserted at different places in
  ;; the program, in which case a binding of one would not capture
  ;; instances of the other.
  (define-syntax find-identifier
    (syntax-rules ()
      ((_ ident (x . y) sk fk)
       (find-identifier ident x sk (find-identifier ident y sk fk)))
      ((_ ident #(x ...) sk fk)
       (find-identifier ident (x ...) sk fk))
      ((_ ident form sk fk)
       (let-syntax
           ((check
             (syntax-rules (ident)
               ((_ ident ident* (s-f . s-args) fk_) (s-f ident* . s-args))
               ((_ x y sk_ fk_) fk_))))
         (check form form sk fk)))))

  (define-syntax loop
    (syntax-rules ()
      ((_ . exps)
       (let-syntax
           ((l (syntax-rules ()
                 ((_ ident exps_)
                  (let/cc ident
                    (let f ()
                      (begin 'prevent-empty-begin . exps_)
                      (f)))))))
         (find-identifier break exps (l exps) (l bogus exps))))))

  (loop
    (break 'foo))
  => foo

One problem with this is that nested loops don't work as expected:

  (loop
    (loop
      (break 'foo))
    (break 'bar))
  => foo

The problem is that the inner loop occurs in the scope of the binding
for break created by the outer loop, but the loop macro was defined
outside of this scope so it cannot match against this break.  The
solution is for loop to create a local binding for loop that can match
against the local binding for break:

  ;; (find-idents (ident ...) form (f . args)) expands to (f (ident*
  ;; ...) . args), where each ident* is an identifier from form found by
  ;; find-identifier.  In the place of any ident that was not found will
  ;; be some freshly inserted identifier, which will not capture
  ;; anything if subsequently bound.
  (define-syntax find-idents
    (syntax-rules ()
      ((_ () form (f . args))
       (f () . args))
      ((_ (ident . idents) form k)
       (letrec-syntax
           ((find-next
             (syntax-rules ()
               ((_ ident* (ident_ . idents_) ident*s form_ k_)
                (find-identifier ident_ form_
                  (find-next idents_ (ident* . ident*s) form_ k_)
                  (find-next bogus idents_ (ident* . ident*s) form_ k_)))
               ((_ ident* () ident*s form_ k_)
                (reverse (ident* . ident*s) () k_))))
            (reverse
             (syntax-rules ()
               ((_ (x . rev) forward k_) (reverse rev (x . forward) k_))
               ((_ () forward (f . args)) (f forward . args)))))
         (find-identifier ident form
           (find-next idents () form k)
           (find-next bogus idents () form k))))))

  (define-syntax loop
    (syntax-rules ()
      ((_ . exps)
       (letrec-syntax
           ((l
             (syntax-rules ()
               ((_ (loop-id break-id) exps_)
                (let/cc break-id
                  (letrec-syntax
                      ((loop-id
                        (syntax-rules ()
                          ((_ . exps__)
                           (find-idents (loop-id break-id) exps__
                                        (l exps__))))))
                    (let f () (begin 'prevent-empty-begin . exps_) (f))))))))
         (find-idents (loop break) exps (l exps))))))

  (loop
    (loop
      (break 'foo))
    (break 'bar))
  => bar

With this implementation, explicit bindings cannot be shadowed by
implicit bindings, which seems a reasonable rule:

  (let/cc break
    (loop
      (break 'foo))
    (break 'bar))
  => foo

***

There are problems with writing extensions to loop.  Suppose we want
to write loop-while, which adds a test that is checked once each time
around the loop, and still binds an exit procedure.  We might think it
could be written like this:

  (define-syntax loop-while
    (syntax-rules ()
      ((_ test exp ...)
       (loop
         (if (not test) (break #f))
         exp ...))))

  (let ((n 0))
    (loop-while (< n 5)
      (set! n (+ n 1)))
    n)
  =>  5

But this doesn't really work:

  (loop
    (let ((n 0))
      (loop-while (< n 5)
        (set! n (+ n 1))
        (if (= n 2)
            (break 'foo)))
      'bar))
  =>  foo

There are two problems.  The first is that the instance of break found
by loop is the one inserted by loop-while, and so the binding for it
does not also capture the ones from the original program text.  You
would get the same behavior were you to use the syntax-case version of
loop (which can be found in the Hieb/Dybvig/Bruggeman syntax-case
paper (IU TR355) and in Dybvig's TSPL):

   (define-syntax loop
     (lambda (x)
       (syntax-case x ()
         ((k e ...)
          (with-syntax ((break (datum->syntax-object (syntax k) 'break)))
             (syntax (let/cc break
                       (let f () e ... (f)))))))))

In a syntax-rules or syntax-case system, loop-while must go to the
same trouble that loop does to find or create the break identifier.

The bigger problem with our loop-while is that uses of it inside loop
will be unable to match the identifier break because of the same
mismatched scoping problem that our first loop had with nested uses.
The general rule, therefore, is that all macros that implicitly bind a
particular identifier must be defined with knowledge of one another,
so that a use of any one can create new local bindings for all the
others as well as for itself.  Here is such a pair of definitions for
loop and loop-while:

  (define-syntax loop
    (syntax-rules ()
      ((_ . exps)
       (loop-while #t . exps))))

  (define-syntax loop-while
    (syntax-rules ()
      ((_ test . exps)
       (letrec-syntax
           ((l
             (syntax-rules ()
               ((_ (loop-while-id loop-id break-id) test_ exps_)
                (let/cc break-id
                  (letrec-syntax
                      ((loop-while-id
                        (syntax-rules ()
                          ((_ test__ . exps__)
                           (find-idents (loop-while-id loop-id break-id)
                                        (test__ exps__)
                                        (l test__ exps__)))))
                       (loop-id
                        (syntax-rules ()
                          ((_ exps__)
                           (find-idents (loop-while-id loop-id break-id)
                                        exps__
                                        (l #t exps__))))))
                    (let f ()
                      (if (not test) (break-id #f))
                      (begin 'prevent-empty-begin . exps_)
                      (f))))))))
         (find-idents (loop-while loop break) (test exps) (l test exps))))))

  (loop
    (let ((n 0))
      (loop-while (< n 5)
        (set! n (+ n 1))
        (if (= n 2)
            (break 'foo)))
      (break 'bar)))
  =>  bar

***

This technique is not applicable to another often-cited example of an
impossible syntax-rules macro: a (define-struct foo <blah>) macro that
creates bindings for foo-this, foo-that, and foo-the-other.  I don't
think syntax-rules can be conned into concatenating identifiers.

***

CONCLUSIONS:

1. Syntax-rules continues to amaze me with the unexpected things it
can do.

2. That's no argument against extensions and alternatives that make
some of those things easier to write and easier (possible) to compile
quickly.

3. I clearly have too much time on my hands.  Someone please hire me
before I commit more senseless acts of random research.