Derick are there any flaws in this simplification of your (and Aziz's) idea?
(library (some suitable name)
(export free-identifier-bound?)
(import (rnrs) (rnrs eval))
(define free-identifier-bound?
(let ((empty-ctxt (eval '(syntax id) (environment '(only (rnrs) syntax)))))
(lambda (id)
(unless (identifier? id)
(assertion-violation 'free-identifier-bound? "not an identifier" id))
(or (free-identifier=? id #'syntax)
(not (free-identifier=? id
(datum->syntax empty-ctxt
(syntax->datum id)))))))))
On Mon, Jun 22, 2009 at 11:57 AM, Derick
Eddington<[email protected]> wrote:
> 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
