diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 3fec69ac01..9abf7e4a2c 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "6.6.0.3") +(define version "6.6.0.4") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/reference/stx-comp.scrbl b/pkgs/racket-doc/scribblings/reference/stx-comp.scrbl index 8b4478c889..b5c967438f 100644 --- a/pkgs/racket-doc/scribblings/reference/stx-comp.scrbl +++ b/pkgs/racket-doc/scribblings/reference/stx-comp.scrbl @@ -95,18 +95,21 @@ is @racket[#f].} @defproc[(identifier-binding [id-stx identifier?] [phase-level (or/c exact-integer? #f) - (syntax-local-phase-level)]) + (syntax-local-phase-level)] + [top-level-symbol? any/c #f]) (or/c 'lexical #f - (listof module-path-index? + (list/c module-path-index? symbol? module-path-index? symbol? exact-nonnegative-integer? (or/c exact-integer? #f) - (or/c exact-integer? #f)))]{ + (or/c exact-integer? #f)) + (list/c symbol?))]{ -Returns one of three kinds of values, depending on the binding of +Returns one of three (if @racket[top-level-symbol?] is @racket[#f]) +or four (if @racket[top-level-symbol?] is true) kinds of values, depending on the binding of @racket[id-stx] at the @tech{phase level} indicated by @racket[phase-level] (where a @racket[#f] value for @racket[phase-level] corresponds to the @tech{label phase level}): @@ -166,19 +169,29 @@ Returns one of three kinds of values, depending on the binding of ]} + @item{The result is @racket[(list _source-id)] if @racket[id-stx] has a + @tech{top-level binding} and @racket[top-level-symbol?] is true.} + @item{The result is @racket[#f] if @racket[id-stx] has a - @tech{top-level binding} (or, equivalently, if it is - @tech{unbound}).} + @tech{top-level binding} and @racket[top-level-symbol?] is + @racket[#f] or if @racket[id-stx] is @tech{unbound}. An + unbound identifier is typically treated the same as an + identifier whose top-level binding is a variable.} ] If @racket[id-stx] is bound to a @tech{rename-transformer}, the result from @racket[identifier-binding] is for the identifier in the transformer, so that @racket[identifier-binding] is consistent with -@racket[free-identifier=?].} +@racket[free-identifier=?]. + +@history[#:changed "6.6.0.4" @elem{Added the @racket[top-level-symbol?] argument to report + information on top-level bindings.}]} -@defproc[(identifier-transformer-binding [id-stx identifier?]) +@defproc[(identifier-transformer-binding [id-stx identifier?] + [rt-phase-level (or/c exact-integer? #f) + (syntax-local-phase-level)]) (or/c 'lexical #f (listof module-path-index? @@ -189,7 +202,7 @@ transformer, so that @racket[identifier-binding] is consistent with (or/c exact-integer? #f) (or/c exact-integer? #f)))]{ -Same as @racket[(identifier-binding id-stx (add1 (syntax-local-phase-level)))].} +Same as @racket[(identifier-binding id-stx (and rt-phase-level (add1 rt-phase-level)))].} @defproc[(identifier-template-binding [id-stx identifier?]) diff --git a/pkgs/racket-test-core/tests/racket/stx.rktl b/pkgs/racket-test-core/tests/racket/stx.rktl index 561f48aa2a..f20bb9462a 100644 --- a/pkgs/racket-test-core/tests/racket/stx.rktl +++ b/pkgs/racket-test-core/tests/racket/stx.rktl @@ -578,6 +578,21 @@ (test 'x cadddr b) (test #t equal? (car b) (caddr b))) +;; Top-level bindings: +(test #f identifier-binding #'test 0) +(test #f identifier-binding #'test 0 #f) +(test '(test) identifier-binding #'test 0 #t) +(test '#f identifier-binding #'this-identifier-is-never-defined 0 #t) + +(define-syntax-rule (introduce-a-definition-of-x bind-id) + (begin + (define x 10) + (define bind-id (identifier-binding #'x 0 #t)))) +(introduce-a-definition-of-x sym-list-for-x) +(test #t pair? sym-list-for-x) +(test #t symbol? (car sym-list-for-x)) +(test #f eq? 'x (car sym-list-for-x)) ; since macro-introduced + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; identifier-binding and (nominal) phase reporting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index f9153c87e3..af114434af 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "6.6.0.3" +#define MZSCHEME_VERSION "6.6.0.4" #define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_Y 6 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 3 +#define MZSCHEME_VERSION_W 4 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/racket/src/racket/src/syntax.c b/racket/src/racket/src/syntax.c index 4f5ae77180..4711e6a4a8 100644 --- a/racket/src/racket/src/syntax.c +++ b/racket/src/racket/src/syntax.c @@ -358,7 +358,7 @@ void scheme_init_stx(Scheme_Env *env) GLOBAL_IMMED_PRIM("free-template-identifier=?" , free_templ_eq , 2, 2, env); GLOBAL_IMMED_PRIM("free-label-identifier=?" , free_label_eq , 2, 2, env); - GLOBAL_IMMED_PRIM("identifier-binding" , free_binding , 1, 2, env); + GLOBAL_IMMED_PRIM("identifier-binding" , free_binding , 1, 3, env); GLOBAL_IMMED_PRIM("identifier-transformer-binding" , free_trans_binding , 1, 2, env); GLOBAL_IMMED_PRIM("identifier-template-binding" , free_templ_binding , 1, 1, env); GLOBAL_IMMED_PRIM("identifier-label-binding" , free_label_binding , 1, 1, env); @@ -8481,6 +8481,7 @@ static Scheme_Object *do_free_binding(char *name, int argc, Scheme_Object **argv { Scheme_Object *a, *m, *nom_mod, *nom_a, *phase; Scheme_Object *src_phase_index, *mod_phase, *nominal_src_phase; + int top_level_as_symbol = 0; a = argv[0]; @@ -8506,6 +8507,9 @@ static Scheme_Object *do_free_binding(char *name, int argc, Scheme_Object **argv phase = scheme_bin_plus(dphase, phase); } + if (argc > 2) + top_level_as_symbol = SCHEME_TRUEP(argv[2]); + m = scheme_stx_lookup_w_nominal(a, phase, 0, NULL, NULL, NULL, NULL, &nom_mod, &nom_a, @@ -8529,8 +8533,10 @@ static Scheme_Object *do_free_binding(char *name, int argc, Scheme_Object **argv m = SCHEME_VEC_ELS(m)[0]; if (SCHEME_FALSEP(m)) { - /* loses information; improve API in the future? */ - return scheme_false; + if (top_level_as_symbol) + return CONS(a, scheme_null); + else + return scheme_false; } return CONS(m, CONS(a, CONS(nom_mod,