Compile-time registries with syntax-rules
Display Name
syntax-rules,
something which I had previously believed to be impossible without macro
systems that
support using Scheme data structures at expansion-time (along with the
well-known phase
headaches this entails).
The basic technique has many possible applications. For example, one might
use it in
a record or object system to keep track of previously defined symbols in one
place.
Another application is writing extensible macros, an extensible pattern
matching macro
being one example (to be posted soon).
Here it is:
(define-syntax registry
(syntax-rules ()
((registry (k . args))
(k () . args))))
(define-syntax extend
(syntax-rules ()
((extend registry x)
(registry (augment registry x)))))
(define-syntax augment
(syntax-rules ()
((augment prev registry x)
(define-syntax registry
(syntax-rules ()
((registry (k . args)) (k (x . prev) . args)))))))
(registry (quote)) ;==> ()
(extend registry foo)
(registry (quote)) ;==> (foo)
(extend registry bar)
(registry (quote)) ;==> (bar foo)
(extend registry baz)
(registry (quote)) ;==> (baz bar foo)
Cheers
Andre van Tonder
ol...@pobox.com
> I found a simple technique for keeping a compile-time registry using only
> syntax-rules,
> something which I had previously believed to be impossible without macro
> systems that
> support using Scheme data structures at expansion-time (along with the
> well-known phase
> headaches this entails).
Perhaps you might be interested in the second half of the Scheme2002 talk
http://pobox.com/~oleg/ftp/papers/Dirty-Macros-talk.pdf
-- starting from page 45, 'macro-expand-time environments'. Unlike the
environments you have illustrated, the macro-expand environments in
the talk are *lexically-scoped* (although they can be made globally
scoped if needed). The talk shows the application of the environments
that you perhaps have not yet considered.
The full source code is available at
http://pobox.com/~oleg/ftp/Scheme/dirtier-macros.scm
David A. Herman
> only syntax-rules, something which I had previously believed to be
> impossible without macro systems that support using Scheme data
> structures at expansion-time (along with the well-known phase headaches
> this entails).
This is a neat trick! I'm not sure it will play well with module systems,
though. In mzscheme, for example, you can't modify an imported binding, so
you can't use `extend' on `registry' outside the module where `registry'
is defined.
You might find this (mzscheme-specific) solution to these kinds of
problems interesting:
http://www.ccs.neu.edu/home/dherman/code.html#macro-object
It uses the structs-as-procedures trick in mzscheme to store extra
expansion-time data along with a macro. It does not, however, avoid the
phase-related headaches you speak of. :)
> The basic technique has many possible applications. For example, one
> might use it in a record or object system to keep track of previously
> defined symbols in one place. Another application is writing extensible
> macros, an extensible pattern matching macro being one example (to be
> posted soon).
Very cool! Extensible pattern matching is at the top of my wish list.
Looking forward to it.
Cheers,
Dave
Jens Axel Søgaard
>>I found a simple technique for keeping a compile-time registry using
>>only syntax-rules, something which I had previously believed to be
>>impossible without macro systems that support using Scheme data
>>structures at expansion-time (along with the well-known phase headaches
>>this entails).
> This is a neat trick! I'm not sure it will play well with module systems,
> though. In mzscheme, for example, you can't modify an imported binding, so
> you can't use `extend' on `registry' outside the module where `registry'
> is defined.
I have written a little piece that shows what the problem is.
<http://www.scheme.dk/macros-and-modules2.txt>
> Very cool! Extensible pattern matching is at the top of my wish list.
> Looking forward to it.
Ditto.
I'd like the extensions to have lexical scope. I'd also like the
expanded code to efficient.
Looks for cake.
--
Jens Axel Søgaard
Jens Axel Søgaard
> I have written a little piece that shows what the problem is.
>
> <http://www.scheme.dk/macros-and-modules2.txt>
Incidently, if someone will show me how to solve this using
eval-when, I'll include it.
--
Jens Axel Søgaard
Jens Axel Søgaard
> Incidently, if someone will show me how to solve this using
> eval-when, I'll include it.
Make that:
Incidentally, if someone will show me how to solve this using
Alsace-Lorraine Petrofsky
> I found a simple technique for keeping a compile-time registry using
> only syntax-rules, something which I had previously believed to be
> impossible without macro systems that support using Scheme data
> structures at expansion-time (along with the well-known phase
> headaches this entails).
> The basic technique has many possible applications. For example,
> one might use it in a record or object system to keep track of
> previously defined symbols in one place. Another application is
> writing extensible macros, an extensible pattern matching macro
> being one example (to be posted soon).
Here's an example of how to use van Tonder's trick to write a simple
incrementally extensible version of lisp's DESTRUCTURING-BIND:
(define-syntax rewrite-destructuring-bind
(syntax-rules ()
((rewrite-destructuring-bind destructuring-bind rules)
(define-syntax destructuring-bind
(syntax-rules (add-rule)
((destructuring-bind (add-rule destructuring-bind rule))
(rewrite-destructuring-bind destructuring-bind (rule . rules)))
. rules)))))
(rewrite-destructuring-bind destructuring-bind ())
(destructuring-bind
(add-rule destructuring-bind
((destructuring-bind ident val . body)
(let ((ident val)) . body))))
(destructuring-bind
(add-rule destructuring-bind
((destructuring-bind (struct1 . struct2) val . body)
(let ((temp val))
(destructuring-bind struct1 (car temp)
(destructuring-bind struct2 (cdr temp)
. body))))))
(destructuring-bind
(add-rule destructuring-bind
((destructuring-bind () val . body)
(apply (lambda () . body) val))))
(destructuring-bind (a (b) c) '(1 (2) 3) (+ a b c)) => 6
I'll leave it as an exercise to imagine a macro that defines a new
record type and extends destructuring-bind to recognize that record
type.
The reason the name destructuring-bind must be passed in as an
argument when extending destructuring-bind is that the flexibility
r5rs allows implementors with respect to the top-level environment
means that there's no telling what happens if a macro use expands into
a top-level definition of an identifier that was inserted by a macro
(rather than just copied from the macro's arguments).
One might try to extend destructuring-bind to handle vectors like so:
(destructuring-bind
(add-rule destructuring-bind
((destructuring-bind #(struct ...) val . body)
(destructuring-bind (struct ...) (vector->list val) . body))))
Unfortunately, this causes an error because of the well-known
limitation in r5rs that a macro cannot insert an identifier named
"...". You can fix rewrite-destructuring-bind to handle this by using
extensions to r5rs like the mechanism in draft SRFI-46 or the
"ellipsis quotation" feature in chez scheme.
You can actually get rewrite-destructuring-bind to handle
ellipsis-using rules on a plain r5rs system if you are willing to (1)
write the rules using an alternative ellipsis identifier, e.g. ":::",
and (2) pass in the alternative ellipsis and the real ellipsis as
additional arguments. Here's how:
(define-syntax rewrite-destructuring-bind
(syntax-rules ()
((rewrite-destructuring-bind destructuring-bind dots (alt ...) rules)
(rewrite-destructuring-bind destructuring-bind ((dots alt) ...) rules))
((rewrite-destructuring-bind destructuring-bind ((dots alt) ...) rules)
(begin
(define-syntax destructuring-bind
(syntax-rules ()
((destructuring-bind destructuring-bind (alt ...) alts* rules*)
(define-syntax destructuring-bind
(syntax-rules (add-rule)
((destructuring-bind
(add-rule destructuring-bind dots** alt** rule**))
(rewrite-destructuring-bind destructuring-bind
dots** (alt** . alts*) (rule** . rules*)))
. rules)))))
(destructuring-bind destructuring-bind (dots ...) (alt ...) rules)))))
(rewrite-destructuring-bind destructuring-bind ... () ())
(destructuring-bind
(add-rule destructuring-bind ... :::
((destructuring-bind ident val . body)
(let ((ident val)) . body))))
(destructuring-bind
(add-rule destructuring-bind ... :::
((destructuring-bind (struct1 . struct2) val . body)
(let ((temp val))
(destructuring-bind struct1 (car temp)
(destructuring-bind struct2 (cdr temp)
. body))))))
(destructuring-bind
(add-rule destructuring-bind ... :::
((destructuring-bind () val . body)
(apply (lambda () . body) val))))
(destructuring-bind
(add-rule destructuring-bind ... :::
((destructuring-bind #(struct :::) val . body)
(destructuring-bind (struct :::) (vector->list val) . body))))
(destructuring-bind #(foo bar baz) '#(3 4 5) (+ foo bar baz))
=> 12
That doesn't work in the old version of mzscheme I have handy,
200alpha12, because it doesn't allow a begin form at top-level to
contain a syntax definition and a use of the new syntax, i.e.:
(define-syntax foo (syntax-rules () ((foo) 1)))
(foo) => 1
(define-syntax foo (syntax-rules () ((foo) 2)))
(foo) => 2
(begin (define-syntax foo (syntax-rules () ((foo) 3)))
(foo))
=> 2
(foo) => 3
Is that a bug or a feature? If the latter, what's the rationale? Do
PLT folks consider it to be r5rs-compliant? I can see how one might
read r5rs 5.3 to disallow my hack above, but I don't really see how it
could be read to disallow this simple example.
-al
David Rush
> You can fix rewrite-destructuring-bind to handle this by using
> extensions to r5rs like the mechanism in draft SRFI-46 or the
> "ellipsis quotation" feature in chez scheme.
FWIW, SRFI-46 is going to go final RSN. I have been in discussions
with Taylor and he reckons he's got everything fixed. If anyone has
any last-minute comments, now is the time....
david rush
--
An elephant is like a building with 4 pillars.
An elephant is warm and squishy.
-- Bill Richter (on comp.lang.scheme)
Taylor Campbell
> FWIW, SRFI-46 is going to go final RSN. I have been in discussions
> with Taylor and he reckons he's got everything fixed. If anyone has
> any last-minute comments, now is the time....
Actually, I'm waiting for Al* to respond to me regarding EIOD. Hint.
Andre
> Here's an example of how to use van Tonder's trick to write a simple
> incrementally extensible version of lisp's DESTRUCTURING-BIND:
Very nice!
Here is an example of using it to implement compile-time
keyword-arguments. Everything is expanded into ordinary
positional arguments and no runtime lookup of keywords occurs.
It can be used as follows:
(extend keyword-registry
(make-customer name address telephone age))
(define (make-customer name address telephone age)
(list 'customer name address telephone age))
(call-with-keywords make-customer (name 'andre)
(age 25)
(telephone "123-4567"))
---> (customer andre <undefined> "123-4567" 25)
Since the keywords are decoupled from the actual definition of the
procedure, we can add keywords to existing procedures:
The procedure itself is not affected at all:
(extend keyword-registry (map operation list))
(call-with-keywords map (list '(1 2 3))
(operation /)) --> (1 1/2 1/3)
The implementation is below.
André
======================================================================
; Compile-time keyword arguments:
(define-syntax syntax-error (syntax-rules ()))
(define-syntax syntax-apply
(syntax-rules ()
((syntax-apply (f . args) exp ...)
(f exp ... . args))))
(define-syntax if-free=
(syntax-rules ()
((if-free= x y kt kf)
(let-syntax
((test (syntax-rules (x)
((test x kt* kf*) kt*)
((test z kt* kf*) kf*))))
(test y kt kf)))))
(define-syntax keyword-registry
(syntax-rules ()
((keyword-registry k)
(syntax-apply k ()))))
(define-syntax extend
(syntax-rules ()
((extend registry x)
(registry (emit-registry registry x)))))
(define-syntax emit-registry
(syntax-rules ()
((emit-registry prev registry x)
(define-syntax registry
(syntax-rules ()
((registry k) (syntax-apply k (x . prev))))))))
(define-syntax lookup
(syntax-rules ()
((lookup registry name k)
(registry (lookup-help name k)))))
(define-syntax lookup-help
(syntax-rules ()
((lookup-help () name k)
(syntax-error "Name not in registry"))
((lookup-help ((name* . binding) . entries) name k)
(let-syntax ((test (syntax-rules (name)
((test name sk fk) sk)
((test other sk fk) fk))))
(test name*
(syntax-apply k binding)
(lookup-help entries name k))))))
(define-syntax call-with-keywords
(syntax-rules ()
((call-with-keywords procedure-name (keyword exp) ...)
(lookup keyword-registry procedure-name
(order ((keyword . exp) ...) '<undefined>
(invoke procedure-name))))))
(define-syntax invoke
(syntax-rules ()
((invoke ((label . exp) ...) procedure-name)
(procedure-name exp ...))))
(define-syntax order
(syntax-rules ()
((order ordering alist default k)
(order ordering alist alist () default k))
((order () () () accum default k)
(syntax-apply k accum))
((order (label* . labels*) bindings () (binding* ...) default k)
(order labels* bindings bindings (binding* ... (label* . default)) default k))
((order () ((label . value) . rest) countdown bindings* default k)
(syntax-error "Illegal label in" (label value)
"Legal bindings are" bindings*))
((order (label* . labels*)
((label . value) binding ...)
(countdown . countdowns)
(binding* ...)
default
k)
(if-free= label label*
(order labels*
(binding ...)
(binding ...)
(binding* ... (label . value))
default
k)
(order (label* . labels*)
(binding ... (label . value))
countdowns
(binding* ...)
default
k)))))