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



Reply via email to