You're still using a syntax object in datum->syntax rather than a
"template id". Does anyone know what a template id is?
Here's another version that works (I claim) (in Ikarus - I don't have
the others) for all but two identifiers, and so may give a hint to
what's going on.
% cat unbound.scm
(library (unbound)
(export unbound-identifier?)
(import (rnrs) (empty-ctxt))
(define (unbound-identifier? x)
(free-identifier=? x (datum->syntax empty-ctxt (syntax->datum x)))))
% cat empty-ctxt.scm
(library (empty-ctxt)
(export empty-ctxt)
(import (only (rnrs) define syntax))
(define empty-ctxt (syntax empty-ctxt)))
% cat t.ss
(import (rnrs) (unbound))
(define-syntax if-unbound
(lambda (x)
(syntax-case x ()
[(_ (id) then else)
(if (unbound-identifier? #'id) #'then #'else)])))
(define-syntax when-bound
(syntax-rules ()
[(_ (id) e* ...)
(if-unbound (id) (begin) (begin e* ...))]))
(define-syntax when-unbound
(syntax-rules ()
[(_ (id) e* ...)
(if-unbound (id) (begin e* ...) (begin))]))
(when-bound (let)
(display "let is bound\n"))
(when-bound (foo)
cannot happen)
(define-syntax q1
(syntax-rules ()
[(_)
(begin
(define q1* 12)
(when-bound (q1*) (display "q1 is bound\n")))]))
(q1)
(when-bound (q1*) (display "q1* is bound\n"))
(define-syntax q2
(syntax-rules ()
[(_ q2)
(begin
(define q2 12)
(when-bound (q2) (display 'q2) (display " is bound\n")))]))
(q2 quux)
(define-syntax q3
(syntax-rules ()
[(_ q3 q4)
(begin
(define q3 12)
(when-bound (q4) (display 'q4) (display " is bound\n")))]))
(q3 quux1 quux1)
(q3 quux2 quux3)
(define a.cons 12)
(when-bound (a.cons) (display "a.cons bound\n"))
(when-bound (cons) (display "cons bound\n"))
% cat t2.ss
(import (unbound) (prefix (rnrs) r.))
(r.when (unbound-identifier? (r.syntax syntax))
(r.display "syntax unbound")
(r.newline))
(r.when (unbound-identifier? (r.syntax define))
(r.display "define unbound")
(r.newline))
(r.when (unbound-identifier? (r.syntax when))
(r.display "when unbound")
(r.newline))
(r.when (unbound-identifier? (r.syntax foo))
(r.display "foo unbound")
(r.newline))
% scheme-script t.ss
let is bound
q1 is bound
quux is bound
quux1 is bound
a.cons bound
cons bound
% scheme-script t2.ss
when unbound
foo unbound
On Fri, Jun 19, 2009 at 5:55 AM, Abdulaziz Ghuloum<[email protected]> wrote:
>
> On Jun 18, 2009, at 4:42 PM, Ramana Kumar wrote:
>
>>> I already said I don't think it's 100% correct, but it works
>>> on most implementations, and it satisfies your requirements.
>>> If you don't want to use it, that's absolutely fine.
>
>> Oh I do want to use it =) But I also want to see the 100% correct version
>> =P
>
> Okay. We ditch generate-temporaries which had underspecified
> behavior. How about the following? [An idea clicked in my
> head, I wrote it down, and it worked the first time, and when
> I read the solution (2 lines really), it made no sense at all!
> This is bizarre! Thanks Ramana! Maybe someone can explain it
> to me. :-)]
>
> Aziz,,,
>
> PS. ypsilon still misses one test case
>
> $ ls b/*
> b/bound.sls b/bound1.sls b/bound2.sls
>
> $ cat b/bound*
> #!r6rs
> (library (b bound)
> (export unbound-identifier?)
> (import (rnrs) (b bound1) (b bound2))
> (define (unbound-identifier? x)
> (and
> (free-identifier=? x (datum->syntax a.ctxt (syntax->datum x)))
> (free-identifier=? x (datum->syntax b.ctxt (syntax->datum x))))))
>
> #!r6rs
> (library (b bound1)
> (export a.ctxt)
> (import (prefix (rnrs) a.))
> (a.define a.ctxt (a.syntax here)))
>
> #!r6rs
> (library (b bound2)
> (export b.ctxt)
> (import (prefix (rnrs) b.))
> (b.define b.ctxt (b.syntax here)))
>
> $ cat t.ss
> #!r6rs
> (import (rnrs) (for (b bound) expand))
>
> (define-syntax if-unbound
> (lambda (x)
> (syntax-case x ()
> [(_ (id) then else)
> (if (unbound-identifier? #'id) #'then #'else)])))
>
> (define-syntax when-bound
> (syntax-rules ()
> [(_ (id) e* ...)
> (if-unbound (id) (begin) (begin e* ...))]))
>
> (define-syntax when-unbound
> (syntax-rules ()
> [(_ (id) e* ...)
> (if-unbound (id) (begin e* ...) (begin))]))
>
> (when-bound (let)
> (display "let is bound\n"))
>
> (when-bound (foo)
> cannot happen)
>
> (define-syntax q1
> (syntax-rules ()
> [(_)
> (begin
> (define q1* 12)
> (when-bound (q1*) (display "q1 is bound\n")))]))
> (q1)
>
> (when-bound (q1*) (display "q1* is bound\n"))
>
> (define-syntax q2
> (syntax-rules ()
> [(_ q2)
> (begin
> (define q2 12)
> (when-bound (q2) (display 'q2) (display " is bound\n")))]))
>
> (q2 quux)
>
> (define-syntax q3
> (syntax-rules ()
> [(_ q3 q4)
> (begin
> (define q3 12)
> (when-bound (q4) (display 'q4) (display " is bound\n")))]))
>
> (q3 quux1 quux1)
> (q3 quux2 quux3)
>
> (define a.cons 12)
> (when-bound (a.cons) (display "a.cons bound\n"))
> (when-bound (cons) (display "cons bound\n"))
>
>
> $ IKARUS_LIBRARY_PATH='.' ikarus --r6rs-script t.ss
> let is bound
> q1 is bound
> quux is bound
> quux1 is bound
> a.cons bound
> cons bound
>
> $ plt-r6rs ++path . t.ss
> let is bound
> q1 is bound
> quux is bound
> quux1 is bound
> a.cons bound
> cons bound
>
> $ larceny -path . -r6rs -program t.ss
> let is bound
> q1 is bound
> quux is bound
> quux1 is bound
> a.cons bound
> cons bound
>
> $ ypsilon --sitelib=. --r6rs t.ss
> let is bound
> q1 is bound
> quux is bound
> quux1 is bound
> a.cons bound
>
>
>
>
