On Fri, 2009-06-19 at 04:26 -0700, Derick Eddington wrote:
> That's incorrect. I was wrong, the new predicate is also broken
I think I've made it work. This should be fully portable:
% cat b/bound.sls
#!r6rs
(library (b bound)
(export unbound-identifier?)
(import
(for (rnrs base)
(meta 0))
(for (rnrs syntax-case)
(meta 0))
(for (only (rnrs base) define)
(meta -1))
(for (only (rnrs syntax-case) syntax)
(meta -1))
(for (b ctxt)
(meta -1) (meta 0))
(for (b p-ctxt)
(meta -1) (meta 0)))
(define (unbound-identifier? x)
(and (not (free-identifier=? x #'define))
(not (free-identifier=? x #'syntax))
(not (free-identifier=? x #'ctxt))
(not (free-identifier=? x #'p-ctxt))
(or (free-identifier=? x (datum->syntax ctxt (syntax->datum x)))
(free-identifier=? x (datum->syntax p-ctxt (syntax->datum x)))))))
% cat b/ctxt.sls
#!r6rs
(library (b 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))
% cat b/p-ctxt.sls
#!r6rs
(library (b 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)))
% cat b/bound-tests.sps
#!r6rs
(import
(for (except (rnrs base) define)
(meta 0))
(for (prefix (only (rnrs base) define) rnrs:)
(meta 0))
(for (only (rnrs base) lambda not)
(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 (b bound)
(meta 1))
(for (b ctxt)
(meta 0))
(for (b p-ctxt)
(meta 0)))
(define-syntax test
(lambda (stx)
(syntax-case stx ()
((_ id bool)
(with-syntax ((bound? (not (unbound-identifier? (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))
%
% IKARUS_LIBRARY_PATH=. ikarus --r6rs-script b/bound-tests.sps
list => bound (pass)
foobar => unbound (pass)
foobar => bound (pass)
rnrs:define => bound (pass)
rnrs:syntax => bound (pass)
ctxt => bound (pass)
p-ctxt => bound (pass)
define => unbound (pass)
syntax => unbound (pass)
define => bound (pass)
syntax => bound (pass)
p-define => unbound (pass)
p-syntax => unbound (pass)
p-define => bound (pass)
p-syntax => bound (pass)
% plt-r6rs ++path . b/bound-tests.sps
list => bound (pass)
foobar => unbound (pass)
foobar => bound (pass)
rnrs:define => bound (pass)
rnrs:syntax => bound (pass)
ctxt => bound (pass)
p-ctxt => bound (pass)
define => unbound (pass)
syntax => unbound (pass)
define => bound (pass)
syntax => bound (pass)
p-define => unbound (pass)
p-syntax => unbound (pass)
p-define => bound (pass)
p-syntax => bound (pass)
% larceny --path . --r6rs --program b/bound-tests.sps
list => bound (pass)
foobar => unbound (pass)
foobar => bound (pass)
rnrs:define => bound (pass)
rnrs:syntax => bound (pass)
ctxt => bound (pass)
p-ctxt => bound (pass)
define => unbound (pass)
syntax => unbound (pass)
define => bound (pass)
syntax => bound (pass)
p-define => unbound (pass)
p-syntax => unbound (pass)
p-define => bound (pass)
p-syntax => bound (pass)
% ypsilon --sitelib . --r6rs b/bound-tests.sps
list => unbound (FAIL)
foobar => unbound (pass)
foobar => bound (pass)
rnrs:define => bound (pass)
rnrs:syntax => bound (pass)
ctxt => bound (pass)
p-ctxt => bound (pass)
define => bound (FAIL)
syntax => bound (FAIL)
define => bound (pass)
syntax => bound (pass)
p-define => unbound (pass)
p-syntax => unbound (pass)
p-define => bound (pass)
p-syntax => bound (pass)
%
I'll report the Ypsilon bug to Ypsilon's bug tracker.
Now back to working on my (xitomatl numeral-system balanced-nonary)
library.
--
: Derick
----------------------------------------------------------------
