On Mon, 2009-06-22 at 10:31 +1000, Ramana Kumar wrote:
> If you could create an identifier whose wrap was known to be empty
> (i.e. had no substitutions), then your trick with free-identifier=?
> would work for imports and top-level definitions as well as
> lower-level (e.g. let) bindings. That's why I asked whether such a
> guarantee of an empty wrap could be made for the results of
> generate-temporaries.
>
> Relying on the subtleties of free-identifier=? and
> generate-temporaries would not be ideal, however. Since you "see no
> way of identifying what is bound and what is not at the root level of
> a library form or at the top-level using a simple technique", I
> contest that a primitive bound-identifier? is wanting.
I think the predicate Aziz and I worked out [1] is R6RS-portable,
handles top-level and local bindings, and is correct. Though, it's not
simple. The version I'm considering adding to my libraries is below. I
renamed the predicate to free-identifier-bound? because it's testing if
an identifier is bound if it is free in the output of a macro
transformer. Some of the imports' phase level declarations are
unnecessary, but they're there for conceptual completeness and
syntactical consistency (though I'd prefer that none of them be
necessary, which implicit phasing allows, but that's a separate debate).
(library (xitomatl macro-utils fib)
(export
free-identifier-bound?)
(import
(for (rnrs base)
(meta 0))
(for (only (rnrs control) unless)
(meta 0))
(for (rnrs syntax-case)
(meta 0))
(for (only (rnrs base) define)
(meta -1))
(for (only (rnrs syntax-case) syntax)
(meta -1))
(for (xitomatl macro-utils fib ctxt)
(meta -1) (meta 0))
(for (xitomatl macro-utils fib p-ctxt)
(meta -1) (meta 0)))
(define (free-identifier-bound? id)
(unless (identifier? id)
(assertion-violation 'free-identifier-bound? "not an identifier" id))
;; Thanks to Aziz Ghuloum for thinking of these tricks.
(or (free-identifier=? id #'define)
(free-identifier=? id #'syntax)
(free-identifier=? id #'ctxt)
(free-identifier=? id #'p-ctxt)
(let ((sym (syntax->datum id)))
(not (or (free-identifier=? id (datum->syntax ctxt sym))
(free-identifier=? id (datum->syntax p-ctxt sym)))))))
)
(library (xitomatl macro-utils fib ctxt)
(export
ctxt)
(import
(for (only (rnrs base) define)
(meta -1) (meta 0))
(for (only (rnrs syntax-case) syntax)
(meta -1) (meta 0)))
(define ctxt #'here)
)
(library (xitomatl macro-utils fib p-ctxt)
(export
p-ctxt)
(import
(for (prefix (only (rnrs base) define) p-)
(meta -1) (meta 0))
(for (prefix (only (rnrs syntax-case) syntax) p-)
(meta -1) (meta 0)))
(p-define p-ctxt (p-syntax here))
)
Test program:
(import
(for (except (rnrs base) define)
(meta 0))
(for (prefix (only (rnrs base) define) rnrs:)
(meta 0))
(for (only (rnrs base) lambda)
(meta 1))
(for (only (rnrs io simple) display)
(meta 0))
(for (except (rnrs syntax-case) syntax)
(meta 1))
(for (prefix (only (rnrs syntax-case) syntax) rnrs:)
(meta 0) (meta 1))
(for (only (xitomatl macro-utils) free-identifier-bound?)
(meta 1))
(for (xitomatl macro-utils fib ctxt)
(meta 0))
(for (xitomatl macro-utils fib p-ctxt)
(meta 0)))
(define-syntax test
(lambda (stx)
(syntax-case stx ()
((_ id bool)
(with-syntax ((bound? (free-identifier-bound? (rnrs:syntax id))))
(rnrs:syntax
(begin
(display 'id) (display " => ")
(display (if bound? "bound " "unbound "))
(display (if (boolean=? bound? bool) "(pass)\n" "(FAIL)\n")))))))))
(test list #T)
(test foobar #F)
(let ((foobar 1))
(test foobar #T))
(test rnrs:define #T)
(test rnrs:syntax #T)
(test ctxt #T)
(test p-ctxt #T)
(test define #F)
(test syntax #F)
(let ((define 1)
(syntax 1))
(test define #T)
(test syntax #T))
(test p-define #F)
(test p-syntax #F)
(let ((p-define 1)
(p-syntax 1))
(test p-define #T)
(test p-syntax #T))
[1]
http://groups.google.com/group/ikarus-users/browse_thread/thread/b4fdf0c5060a9f72
--
: Derick
----------------------------------------------------------------
_______________________________________________
r6rs-discuss mailing list
[email protected]
http://lists.r6rs.org/cgi-bin/mailman/listinfo/r6rs-discuss
