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