***
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.
-al
And so unreadably!
> 2. That's no argument against extensions and alternatives that make
> some of those things easier to write and easier (possible) to compile
> quickly.
See my comments to #1.
> 3. I clearly have too much time on my hands.
Indeed.
> Someone please hire me before I commit more senseless acts of random
> research.
Well, I don't know about that. For sheer entertainment (in an "I'm
going to have to think about *that* one" sort of way) you're up to #2
on my list, right after Oleg Kiselyov. Keep up the good work!
david rush
-----BEGIN GEEK CODE BLOCK-----
Version 3.12
GCS d? s-: a C++$ ULSAH+++$ P+(---) L++ E+++ W+(--) N++ K w(---) O++@
PS+++(--) PE(++) Y+ PGP !tv b+++ DI++ D+(--) e*(+++>+++) h---- r+++
z++++
-----END GEEK CODE BLOCK-----
You know, it occurs to me that this sort of thing is why religions have
apparently pointless proscriptions against strange things, like boiling a
kid (goat) in its mother's milk (hey, it's in the Bible)...
One day, some guy with way too much time on his hands tried something, with
results that ought to have been predictable but weren't actually predicted.
When the village elders heard about it, they convened a quick meeting and
decided to add the activity in question to the list of activities proscribed
by the local religion, to avoid further carnage/embarrassment/scandal/etc.
"Thou shalt not..."
I guess this is a long way round of saying that I think, perhaps, the
statement "a macro that cannot be written with syntax-rules..." really needs
to be read as "a macro that Thou Shalt Not Write with syntax-rules..."
For the transgressions listed heretofore, I hereby sentence Alderman
Petrofsky to the posting of at least three messages containing code that I
would actually want to use in a real application!
Anton