suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix expander+compiler to report source name for use-before-init

Browse Source 
Lots of plumbling was in place to preserve the source name (instead of
the symbol generated to avoid collisions for macro-introduced
definitions), but some small pieces were missing.

Closes #2288
This commit is contained in:
Matthew Flatt 2018-10-04 18:52:05 -06:00
parent daba4f518b
commit 4396b841c0
7 changed files with 130 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
pkgs/compiler-lib/compiler/decompile.rkt
View File

@ -225,6 +225,7 @@
[import-shape (in-list import-shapes)]
#:when import-shape)
`[,import ,import-shape]))
'(source-names: ,source-names)
,@body-l))]))
(define (decompile-data-linklet l)

19
pkgs/racket-test-core/tests/racket/syntax.rktl
View File

@ -2133,4 +2133,23 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module tries-to-use-foo-before-defined racket/base
(provide result)
(define-syntax-rule (go result)
;; `foo` will be macro-introduced
(begin
(define result
(with-handlers ([exn:fail:contract:variable? values])
(foo "bar")))
(define foo 5)))
(go result))
(let ([v (dynamic-require ''tries-to-use-foo-before-defined 'result)])
(test #t exn? v)
(test #t symbol? (exn:fail:contract:variable-id v))
(test #t regexp-match? #rx"^foo:" (exn-message v))
(test 5 eval (exn:fail:contract:variable-id v) (module->namespace ''tries-to-use-foo-before-defined)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

8
racket/src/expander/compile/correlate.rkt
View File

@ -13,6 +13,7 @@
correlate~
correlate/app
->correlated
correlate-source-name
compile-keep-source-locations!)
@ -37,6 +38,13 @@
(define (->correlated s)
(datum->correlated s #f))
(define (correlate-source-name sym e-sym)
(if (eq? sym e-sym)
sym
(correlated-property (datum->correlated sym #f)
'source-name
e-sym)))
(define (compile-keep-source-locations! on?)
(set! keep-source-locations? on?))

9
racket/src/expander/compile/form.rkt
View File

@ -113,9 +113,12 @@
(cond
[(compile-context-module-self cctx)
;; In a module, look up name for local definition:
(for/list ([binding-sym (in-list binding-syms)])
(hash-ref (header-binding-sym-to-define-sym header)
binding-sym))]
(for/list ([binding-sym (in-list binding-syms)]
[id (in-list ids)])
(correlate-source-name
(hash-ref (header-binding-sym-to-define-sym header)
binding-sym)
(syntax-e id)))]
[else
;; Outside of a module, look up name to `set!`
(for/list ([binding-sym (in-list binding-syms)])

18
racket/src/racket/src/compile.c
View File

@ -82,6 +82,8 @@ static Scheme_Object *generate_defn_name(Scheme_Object *base_sym,
Scheme_Hash_Tree *also_used_names,
int search_start);
static Scheme_Object *extract_source_name(Scheme_Object *e);
#ifdef MZ_PRECISE_GC
static void register_traversers(void);
#endif
@ -1939,10 +1941,12 @@ static Scheme_Object *define_parse(Scheme_Object *form,
Scheme_Object **_vars, Scheme_Object **_val,
Scheme_Comp_Env **_env,
DupCheckRecord *r,
int *_extra_vars_pos)
int *_extra_vars_pos,
Scheme_Hash_Tree **_source_names)
{
Scheme_Object *vars, *rest, *name, *v, *extra_vars = scheme_null;
Scheme_Object *vars, *rest, *name, *src_name, *v, *extra_vars = scheme_null;
Scheme_Comp_Env *env;
Scheme_Hash_Tree *source_names = *_source_names;
int len;
len = check_form(form, form);
@ -1960,6 +1964,10 @@ static Scheme_Object *define_parse(Scheme_Object *form,
name = SCHEME_STX_CAR(vars);
scheme_check_identifier(NULL, name, NULL, form);
src_name = extract_source_name(name);
if (!SAME_OBJ(src_name, SCHEME_STX_SYM(name)))
source_names = scheme_hash_tree_set(source_names, SCHEME_STX_SYM(name), src_name);
vars = SCHEME_STX_CDR(vars);
scheme_dup_symbol_check(r, NULL, name, "binding", form);
@ -1981,6 +1989,8 @@ static Scheme_Object *define_parse(Scheme_Object *form,
if (!SCHEME_STX_NULLP(vars))
scheme_wrong_syntax(NULL, vars, form, "bad variable list");
*_source_names = source_names;
return extra_vars;
}
@ -2005,7 +2015,7 @@ static void check_import_export_clause(Scheme_Object *e, Scheme_Object *orig_for
scheme_wrong_syntax(NULL, e, orig_form, "bad import/export clause");
}
Scheme_Object *extract_source_name(Scheme_Object *e)
static Scheme_Object *extract_source_name(Scheme_Object *e)
{
Scheme_Object *a;
@ -2130,7 +2140,7 @@ Scheme_Linklet *scheme_compile_linklet(Scheme_Object *form, int set_undef, Schem
e = SCHEME_STX_CAR(a);
if (is_define_values(e)) {
Scheme_Object *vars, *vals;
extra_vars = define_parse(e, &vars, &vals, &env, &r, &extra_vars_pos);
extra_vars = define_parse(e, &vars, &vals, &env, &r, &extra_vars_pos, &source_names);
if (extra_vars) {
all_extra_vars = scheme_append(extra_vars, all_extra_vars);
}

27
racket/src/racket/src/error.c
View File

@ -2578,23 +2578,28 @@ void scheme_unbound_global(Scheme_Bucket *b)
Scheme_Object *src_name;
const char *errmsg;
if (SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC)))
errmsg = ("%S: undefined;\n"
" cannot reference an identifier before its definition\n"
" in module: %D\n"
" internal name: %S");
else
errmsg = ("%S: undefined;\n"
" cannot reference an identifier before its definition%_%_");
src_name = scheme_hash_tree_get(home->source_names, name);
if (!src_name)
src_name = name;
if (SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC))) {
if (!SAME_OBJ(name, src_name))
errmsg = ("%S: undefined;\n"
" cannot reference an identifier before its definition\n"
" in module: %D\n"
" internal name: %S");
else
errmsg = ("%S: undefined;\n"
" cannot reference an identifier before its definition\n"
" in module: %D");
} else
errmsg = ("%S: undefined;\n"
" cannot reference an identifier before its definition%_%_");
scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE,
src_name,
errmsg,
name,
errmsg,
src_name,
home->name,
name);
} else {

105
racket/src/racket/src/startup.inc
View File

@ -27502,6 +27502,10 @@ static const char *startup_source =
"(correlate/app)"
"(lambda(stx_0 s-exp_0)(begin(if keep-source-locations?(correlate* stx_0 s-exp_0)(correlate~ stx_0 s-exp_0)))))"
"(define-values(->correlated)(lambda(s_0)(begin(datum->correlated s_0 #f))))"
"(define-values"
"(correlate-source-name)"
"(lambda(sym_0 e-sym_0)"
"(begin(if(eq? sym_0 e-sym_0) sym_0(correlated-property(datum->correlated sym_0 #f) 'source-name e-sym_0)))))"
"(define-values(compile-keep-source-locations!)(lambda(on?_0)(begin(set! keep-source-locations? on?_0))))"
"(define-values"
"(compile$2)"
@ -28888,7 +28892,9 @@ static const char *startup_source =
"(let-values()"
"(reverse$1"
"(let-values(((lst_2)"
" binding-syms_0))"
" binding-syms_0)"
"((lst_3)"
" ids_0))"
"(begin"
"(if(variable-reference-from-unsafe?"
"(#%variable-reference))"
@ -28896,19 +28902,35 @@ static const char *startup_source =
"(let-values()"
"(check-list"
" lst_2)))"
"(if(variable-reference-from-unsafe?"
"(#%variable-reference))"
"(void)"
"(let-values()"
"(check-list"
" lst_3)))"
"((letrec-values(((for-loop_1)"
"(lambda(fold-var_0"
" lst_3)"
" lst_4"
" lst_5)"
"(begin"
" 'for-loop"
"(if(pair?"
" lst_3)"
"(if(if(pair?"
" lst_4)"
"(pair?"
" lst_5)"
" #f)"
"(let-values(((binding-sym_0)"
"(unsafe-car"
" lst_3))"
" lst_4))"
"((rest_1)"
"(unsafe-cdr"
" lst_3)))"
" lst_4))"
"((id_0)"
"(unsafe-car"
" lst_5))"
"((rest_2)"
"(unsafe-cdr"
" lst_5)))"
"(let-values(((fold-var_1)"
"(let-values(((fold-var_1)"
" fold-var_0))"
@ -28916,10 +28938,13 @@ static const char *startup_source =
"(let-values()"
"(cons"
"(let-values()"
"(correlate-source-name"
"(hash-ref"
"(header-binding-sym-to-define-sym"
" header_0)"
" binding-sym_0))"
" binding-sym_0)"
"(syntax-e$1"
" id_0)))"
" fold-var_1))))"
"(values"
" fold-var_2)))))"
@ -28927,12 +28952,14 @@ static const char *startup_source =
" #f)"
"(for-loop_1"
" fold-var_1"
" rest_1)"
" rest_1"
" rest_2)"
" fold-var_1)))"
" fold-var_0)))))"
" for-loop_1)"
" null"
" lst_2)))))"
" lst_2"
" lst_3)))))"
"(let-values()"
"(reverse$1"
"(let-values(((lst_2)"
@ -50377,11 +50404,11 @@ static const char *startup_source =
" radix83_0"
" exactness85_0"
" temp86_0)))))))))))))))"
"(let-values(((c1_0)"
"(let-values(((c5_0)"
"(if(char-sign? c_0)"
"(read-special-number s_0 start_0 end_0 convert-mode_0)"
" #f)))"
"(if c1_0"
"(if c5_0"
"((lambda(v_0)"
"(if(eq? exactness_0 'exact)"
"(let-values()"
@ -50389,8 +50416,8 @@ static const char *startup_source =
" (let-values () (format \"no exact representation for `~a`\" v_0))"
"(let-values() #f)))"
"(let-values() v_0)))"
" c1_0)"
"(let-values(((c2_0)"
" c5_0)"
"(let-values(((c4_0)"
"(if(char-sign? c_0)"
"(if(not in-complex_0)"
"(if(fx>(fx- end_0 start_0) 7)"
@ -50406,7 +50433,7 @@ static const char *startup_source =
" #f)"
" #f)"
" #f)))"
"(if c2_0"
"(if c4_0"
"((lambda(v_0)"
"(let-values(((s87_0) s_0)"
"((temp88_0)(fx+ start_0 6))"
@ -50430,7 +50457,7 @@ static const char *startup_source =
" convert-mode92_0"
" v94_0"
" temp95_0)))"
" c2_0)"
" c4_0)"
"(let-values(((c3_0)"
"(if(not in-complex_0)"
"(if(fx>=(fx- end_0 start_0) 7)"
@ -50474,7 +50501,7 @@ static const char *startup_source =
" v2104_0"
" temp105_0)))))"
" c3_0)"
"(let-values(((c4_0)"
"(let-values(((c2_0)"
"(if(char-sign? c_0)"
"(if(not in-complex_0)"
"(if(fx>(fx- end_0 start_0) 7)"
@ -50488,7 +50515,7 @@ static const char *startup_source =
" #f)"
" #f)"
" #f)))"
"(if c4_0"
"(if c2_0"
"((lambda(v_0)"
"(let-values(((s106_0) s_0)"
"((temp107_0)(fx+ start_0 7))"
@ -50512,8 +50539,8 @@ static const char *startup_source =
" convert-mode111_0"
" v113_0"
" temp114_0)))"
" c4_0)"
"(let-values(((c5_0)"
" c2_0)"
"(let-values(((c1_0)"
"(if(not in-complex_0)"
"(if(fx>(fx- end_0 start_0) 7)"
"(if(char=? '#\\@(string-ref s_0(fx- end_0 7)))"
@ -50525,7 +50552,7 @@ static const char *startup_source =
" #f)"
" #f)"
" #f)))"
"(if c5_0"
"(if c1_0"
"((lambda(v2_0)"
"(let-values(((s115_0) s_0)"
"((start116_0) start_0)"
@ -50550,7 +50577,7 @@ static const char *startup_source =
" convert-mode120_0"
" v2123_0"
" temp124_0)))"
" c5_0)"
" c1_0)"
"(let-values()"
"(let-values(((s125_0) s_0)"
"((start126_0) start_0)"
@ -59844,8 +59871,8 @@ static const char *startup_source =
"(with-module-reading-parameterization+delay-source"
" path_0"
"(lambda()"
"(let-values(((c1_0)(linklet-directory-start i_0)))"
"(if c1_0"
"(let-values(((c2_0)(linklet-directory-start i_0)))"
"(if c2_0"
"((lambda(pos_0)"
"(let-values(((b-pos_0)(search-directory i_0 pos_0(encode-symbols expected-mod_0))))"
"(if b-pos_0"
@ -59873,12 +59900,12 @@ static const char *startup_source =
" 'default-load-handler"
" (string-append \"could not find main module\\n\" \" in: ~e\")"
"(object-name i_0)))))))"
" c1_0)"
" c2_0)"
"(if(if(pair? expected-mod_0)(not(car expected-mod_0)) #f)"
"(let-values() void)"
"(let-values(((c2_0)(cached-bundle i_0)))"
"(if c2_0"
"((lambda(thunk_0) thunk_0) c2_0)"
"(let-values(((c1_0)(cached-bundle i_0)))"
"(if c1_0"
"((lambda(thunk_0) thunk_0) c1_0)"
"(let-values()"
"(let-values(((s_0)(1/read-syntax(object-name i_0) i_0)))"
"(let-values((()"
@ -60351,7 +60378,7 @@ static const char *startup_source =
"(begin"
" 'with-dir"
"(with-dir*_0 base_1 t_0)))))"
"(let-values(((c1_0)"
"(let-values(((c4_0)"
"(if try-main?_0"
"(date>=?_0"
" modes_0"
@ -60359,7 +60386,7 @@ static const char *startup_source =
" so_0"
" path-d_0)"
" #f)))"
"(if c1_0"
"(if c4_0"
"((lambda(so-d_0)"
"(with-continuation-mark"
" parameterization-key"
@ -60375,8 +60402,8 @@ static const char *startup_source =
"((current-load-extension)"
"(car so-d_0)"
" expect-module_0))))))"
" c1_0)"
"(let-values(((c2_0)"
" c4_0)"
"(let-values(((c3_0)"
"(if try-alt?_0"
"(date>=?_0"
" modes_0"
@ -60384,7 +60411,7 @@ static const char *startup_source =
" alt-so_0"
" alt-path-d_0)"
" #f)))"
"(if c2_0"
"(if c3_0"
"((lambda(so-d_0)"
"(with-continuation-mark"
" parameterization-key"
@ -60400,8 +60427,8 @@ static const char *startup_source =
"((current-load-extension)"
"(car so-d_0)"
" expect-module_0))))))"
" c2_0)"
"(let-values(((c3_0)"
" c3_0)"
"(let-values(((c2_0)"
"(if try-main?_0"
"(date>=?_0"
" modes_0"
@ -60409,7 +60436,7 @@ static const char *startup_source =
" zo_0"
" path-d_0)"
" #f)))"
"(if c3_0"
"(if c2_0"
"((lambda(zo-d_0)"
"(begin"
"(register-zo-path"
@ -60432,8 +60459,8 @@ static const char *startup_source =
"((1/current-load)"
"(car zo-d_0)"
" expect-module_0)))))))"
" c3_0)"
"(let-values(((c4_0)"
" c2_0)"
"(let-values(((c1_0)"
"(if try-alt?_0"
"(date>=?_0"
" modes_0"
@ -60441,7 +60468,7 @@ static const char *startup_source =
" alt-zo_0"
" path-d_0)"
" #f)))"
"(if c4_0"
"(if c1_0"
"((lambda(zo-d_0)"
"(begin"
"(register-zo-path"
@ -60464,7 +60491,7 @@ static const char *startup_source =
"((1/current-load)"
"(car zo-d_0)"
" expect-module_0)))))))"
" c4_0)"
" c1_0)"
"(if(let-values(((or-part_0)"
"(not"
"(pair?"