diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax.scrbl index 5545fb060b..1cd14ec155 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax.scrbl @@ -1949,12 +1949,18 @@ distinct; later bindings shadow earlier bindings. Like @racket[let], including left-to-right evaluation of the @racket[val-expr]s, but the @tech{locations} for all @racket[id]s are -created first and filled with @|undefined-const|, all +created first, all @racket[id]s are bound in all @racket[val-expr]s as well as the -@racket[body]s, and each @racket[id] is set immediately after the +@racket[body]s, and each @racket[id] is initialized immediately after the corresponding @racket[val-expr] is evaluated. The @racket[id]s must be distinct according to @racket[bound-identifier=?]. +Referencing or assigning to an @racket[id] before its initialization +raises @racket[exn:fail:contract:variable]. If an @racket[id] has an +@indexed-racket['undefined-error-name] @tech{syntax property} whose +value is a symbol, the symbol is used as the name of the variable for +error reporting, instead of the symbolic form of @racket[id]. + @mz-examples[ (letrec ([is-even? (lambda (n) (or (zero? n) @@ -1963,7 +1969,9 @@ corresponding @racket[val-expr] is evaluated. The @racket[id]s must be distinct (and (not (zero? n)) (is-even? (sub1 n))))]) (is-odd? 11)) -]} +] + +@history[#:changed "6.0.1.2" @elem{Changed reference or assignment of an uninitialized @racket[id] to an error.}]} @defform[(let-values ([(id ...) val-expr] ...) body ...+)]{ Like @racket[let], except that each @racket[val-expr] must produce as many @@ -1991,8 +1999,7 @@ for each @racket[id], all of which are bound in the later @defform[(letrec-values ([(id ...) val-expr] ...) body ...+)]{ Like @racket[letrec], except that each @racket[val-expr] must produce as many values as corresponding @racket[id]s. A separate @tech{location} is -created for each @racket[id], all of which are initialized to -@|undefined-const| and bound in all @racket[val-expr]s +created for each @racket[id], all of which are bound in all @racket[val-expr]s and in the @racket[body]s. @mz-examples[ diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/syntax.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/syntax.rktl index 463ece2111..3c20cc0cd2 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/syntax.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/syntax.rktl @@ -108,6 +108,22 @@ (syntax-test #'(lambda (x . 5) x)) (syntax-test #'(lambda (x) x . 5)) +(err/rt-test (letrec ([not-ready not-ready]) 5) + (lambda (exn) + (and (exn:fail:contract:variable? exn) + (eq? 'not-ready (exn:fail:contract:variable-id exn))))) +(err/rt-test (let-syntax ([m + (lambda (stx) + (with-syntax ([not-ready-id + (syntax-property #'not-ready + 'undefined-error-name + 'alice)]) + #'(letrec ([not-ready-id not-ready]) 5)))]) + (m)) + (lambda (exn) + (and (exn:fail:contract:variable? exn) + (eq? 'alice (exn:fail:contract:variable-id exn))))) + (let ([f (case-lambda [() 'zero] diff --git a/racket/src/racket/src/compile.c b/racket/src/racket/src/compile.c index f7adca4fbd..d025d8ec68 100644 --- a/racket/src/racket/src/compile.c +++ b/racket/src/racket/src/compile.c @@ -63,6 +63,8 @@ ROSYM static Scheme_Object *quote_symbol; ROSYM static Scheme_Object *letrec_syntaxes_symbol; ROSYM static Scheme_Object *values_symbol; ROSYM static Scheme_Object *call_with_values_symbol; +ROSYM static Scheme_Object *inferred_name_symbol; +ROSYM static Scheme_Object *undefined_error_name_symbol; THREAD_LOCAL_DECL(static Scheme_Object *quick_stx); @@ -165,6 +167,9 @@ void scheme_init_compile (Scheme_Env *env) REGISTER_SO(disappeared_binding_symbol); REGISTER_SO(compiler_inline_hint_symbol); + REGISTER_SO(inferred_name_symbol); + REGISTER_SO(undefined_error_name_symbol); + scheme_undefined->type = scheme_undefined_type; lambda_symbol = scheme_intern_symbol("lambda"); @@ -178,6 +183,9 @@ void scheme_init_compile (Scheme_Env *env) disappeared_binding_symbol = scheme_intern_symbol("disappeared-binding"); compiler_inline_hint_symbol = scheme_intern_symbol("compiler-hint:cross-module-inline"); + inferred_name_symbol = scheme_intern_symbol("inferred-name"); + undefined_error_name_symbol = scheme_intern_symbol("undefined-error-name"); + scheme_define_values_syntax = scheme_make_compiled_syntax(define_values_syntax, define_values_expand); scheme_define_syntaxes_syntax = scheme_make_compiled_syntax(define_syntaxes_syntax, @@ -367,13 +375,24 @@ Scheme_Object *scheme_check_name_property(Scheme_Object *code, Scheme_Object *cu { Scheme_Object *name; - name = scheme_stx_property(code, scheme_inferred_name_symbol, NULL); + name = scheme_stx_property(code, inferred_name_symbol, NULL); if (name && SCHEME_SYMBOLP(name)) return name; else return current_val; } +static Scheme_Object *get_local_name(Scheme_Object *id) +{ + Scheme_Object *name; + + name = scheme_stx_property(id, undefined_error_name_symbol, NULL); + if (name && SCHEME_SYMBOLP(name)) + return name; + else + return SCHEME_STX_VAL(id); +} + /**********************************************************************/ /* lambda utils */ /**********************************************************************/ @@ -498,7 +517,7 @@ Scheme_Object *scheme_build_closure_name(Scheme_Object *code, Scheme_Compile_Inf { Scheme_Object *name; - name = scheme_stx_property(code, scheme_inferred_name_symbol, NULL); + name = scheme_stx_property(code, inferred_name_symbol, NULL); if (name && SCHEME_SYMBOLP(name)) { name = combine_name_with_srcloc(name, code, 0); } else if (name && SCHEME_VOIDP(name)) { @@ -2260,7 +2279,9 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname, currently. It would be ok if we record extra names, though. */ clv_names = MALLOC_N(Scheme_Object*, lv->count); for (m = pre_k; m < k; m++) { - clv_names[m - pre_k] = SCHEME_STX_SYM(names[m]); + Scheme_Object *ln; + ln = get_local_name(names[m]); + clv_names[m - pre_k] = ln; } lv->names = clv_names; } diff --git a/racket/src/racket/src/fun.c b/racket/src/racket/src/fun.c index 3a26e0803c..5d29f16765 100644 --- a/racket/src/racket/src/fun.c +++ b/racket/src/racket/src/fun.c @@ -92,7 +92,6 @@ READ_ONLY Scheme_Object *scheme_apply_proc; READ_ONLY Scheme_Object *scheme_call_with_values_proc; /* the function bound to `call-with-values' */ READ_ONLY Scheme_Object *scheme_reduced_procedure_struct; READ_ONLY Scheme_Object *scheme_tail_call_waiting; -READ_ONLY Scheme_Object *scheme_inferred_name_symbol; READ_ONLY Scheme_Object *scheme_default_prompt_tag; READ_ONLY Scheme_Object *scheme_chaperone_undefined_property; @@ -644,12 +643,10 @@ scheme_init_fun (Scheme_Env *env) none_symbol = scheme_intern_symbol("none"); REGISTER_SO(is_method_symbol); - REGISTER_SO(scheme_inferred_name_symbol); REGISTER_SO(cont_key); REGISTER_SO(barrier_prompt_key); REGISTER_SO(prompt_cc_guard_key); is_method_symbol = scheme_intern_symbol("method-arity-error"); - scheme_inferred_name_symbol = scheme_intern_symbol("inferred-name"); cont_key = scheme_make_symbol("k"); /* uninterned */ barrier_prompt_key = scheme_make_symbol("bar"); /* uninterned */ prompt_cc_guard_key = scheme_make_symbol("cc"); /* uninterned */ diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index eda8a86ec7..dcff078dbe 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -3185,7 +3185,6 @@ void scheme_ill_formed(Mz_CPort *port); # define scheme_ill_formed_code(port) scheme_ill_formed(port) #endif -extern Scheme_Object *scheme_inferred_name_symbol; Scheme_Object *scheme_check_name_property(Scheme_Object *stx, Scheme_Object *current_name); Scheme_Object *scheme_make_lifted_defn(Scheme_Object *sys_wraps, Scheme_Object **_id, Scheme_Object *expr, Scheme_Comp_Env *env);