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

validator: thread structure-type info all the way through

Browse Source 
The optimizer now makes more choices based on imported structure-type
info that thet validator needs to reconstruct, so pass that
information all the way through.
This commit is contained in:
Matthew Flatt 2016-07-29 09:02:51 -06:00
parent ef41bf21cb
commit 6e4a4f4949
4 changed files with 60 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
racket/collects/compiler/cm.rkt
View File

@ -553,7 +553,8 @@
(get-source-sha1 path))])
(if (and zo-exists?
src-sha1
(equal? src-sha1 (caadr deps))
(equal? src-sha1 (and (pair? (cadr deps))
(caadr deps)))
(equal? (get-dep-sha1s (cddr deps) up-to-date collection-cache read-src-syntax path->mode roots #f seen)
(cdadr deps)))
(begin
@ -636,7 +637,7 @@
(with-handlers ([exn:fail:filesystem? (lambda (ex) (list (version) '#f))])
(with-module-reading-parameterization
(lambda ()
(call-with-input-file
(call-with-input-file*
(path-add-extension (get-compilation-path path->mode roots path) #".dep")
read)))))
(define (do-check)

3
racket/src/racket/src/eval.c
View File

@ -2591,7 +2591,8 @@ void scheme_delay_load_closure(Scheme_Lambda *data)
SCHEME_INT_VAL(SCHEME_VEC_ELS(vinfo)[6]),
(SCHEME_TRUEP(SCHEME_VEC_ELS(vinfo)[7])
? (Scheme_Hash_Tree *)SCHEME_VEC_ELS(vinfo)[7]
: NULL));
: NULL),
(Scheme_Hash_Table **)SCHEME_VEC_ELS(vinfo)[11]);
}
}
}

3
racket/src/racket/src/schpriv.h
View File

@ -3585,7 +3585,8 @@ void scheme_validate_closure(Mz_CPort *port, Scheme_Object *expr,
char *closure_stack, Validate_TLS tls,
int num_toplevels, int num_stxes, int num_lifts, void *tl_use_map,
mzshort *tl_state, mzshort tl_timestamp,
int self_pos_in_closure, Scheme_Hash_Tree *procs);
int self_pos_in_closure, Scheme_Hash_Tree *procs,
Scheme_Hash_Table **_st_ht);
#define TRACK_ILL_FORMED_CATCH_LINES 1
#if TRACK_ILL_FORMED_CATCH_LINES

104
racket/src/racket/src/validate.c
View File

@ -158,7 +158,7 @@ void scheme_validate_code(Mz_CPort *port, Scheme_Object *code,
struct Validate_Clearing *vc;
Validate_TLS tls;
mzshort *tl_state;
Scheme_Hash_Table *st_ht = NULL;
Scheme_Hash_Table **_st_ht = NULL;
Scheme_Object *form;
depth += ((num_toplevels || num_stxes || num_lifts) ? 1 : 0);
@ -172,6 +172,7 @@ void scheme_validate_code(Mz_CPort *port, Scheme_Object *code,
delta = depth - ((num_toplevels || num_stxes || num_lifts) ? 1 : 0);
tls = MALLOC_N(mzshort*, num_lifts);
_st_ht = MALLOC_N(Scheme_Hash_Table*, 1);
if (code_vec) {
int i;
@ -184,7 +185,7 @@ void scheme_validate_code(Mz_CPort *port, Scheme_Object *code,
intptr_t k;
tl_state[i] = SCHEME_TOPLEVEL_CONST;
if (scheme_decode_struct_shape(((Module_Variable *)toplevels[i])->shape, &k))
add_struct_mapping(&st_ht, i, k);
add_struct_mapping(_st_ht, i, k);
} else if (mv_flags & SCHEME_MODVAR_FIXED)
tl_state[i] = SCHEME_TOPLEVEL_FIXED;
else
@ -226,7 +227,7 @@ void scheme_validate_code(Mz_CPort *port, Scheme_Object *code,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0,
vc, 1, 0, NULL, -1, &st_ht)) {
vc, 1, 0, NULL, -1, _st_ht)) {
tl_timestamp++;
if (0) {
printf("increment to %d for %d %p\n", tl_timestamp,
@ -484,7 +485,8 @@ static int set_validate(Scheme_Object *data, Mz_CPort *port,
mzshort *tl_state, mzshort tl_timestamp,
int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
Scheme_Hash_Tree *procs,
Scheme_Hash_Table **_st_ht)
{
Scheme_Set_Bang *sb = (Scheme_Set_Bang *)data;
int r1, r2;
@ -492,7 +494,7 @@ static int set_validate(Scheme_Object *data, Mz_CPort *port,
r1 = validate_expr(port, sb->val, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0, vc, 0, 0, procs, 1, NULL);
NULL, 0, 0, vc, 0, 0, procs, 1, _st_ht);
r2 = validate_toplevel(sb->var, port, stack, tls, depth, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
@ -530,7 +532,8 @@ static int apply_values_validate(Scheme_Object *data, Mz_CPort *port,
mzshort *tl_state, mzshort tl_timestamp,
int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
Scheme_Hash_Tree *procs,
Scheme_Hash_Table **_st_ht)
{
Scheme_Object *f, *e;
int r1, r2;
@ -542,12 +545,12 @@ static int apply_values_validate(Scheme_Object *data, Mz_CPort *port,
depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0, vc, 0, 0, procs, 1, NULL);
NULL, 0, 0, vc, 0, 0, procs, 1, _st_ht);
r2 = validate_expr(port, e, stack, tls,
depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0, vc, 0, 0, procs, -1, NULL);
NULL, 0, 0, vc, 0, 0, procs, -1, _st_ht);
return validate_join(r1, r2);
}
@ -560,7 +563,8 @@ static void inline_variant_validate(Scheme_Object *data, Mz_CPort *port,
mzshort *tl_state, mzshort tl_timestamp,
int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
Scheme_Hash_Tree *procs,
Scheme_Hash_Table **_st_ht)
{
Scheme_Object *f1, *f2;
@ -571,12 +575,12 @@ static void inline_variant_validate(Scheme_Object *data, Mz_CPort *port,
depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0, vc, 0, 0, procs, 1, NULL);
NULL, 0, 0, vc, 0, 0, procs, 1, _st_ht);
validate_expr(port, f2, stack, tls,
depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0, vc, 0, 0, procs, 1, NULL);
NULL, 0, 0, vc, 0, 0, procs, 1, _st_ht);
}
static void case_lambda_validate(Scheme_Object *data, Mz_CPort *port, char *stack, Validate_TLS tls,
@ -586,7 +590,8 @@ static void case_lambda_validate(Scheme_Object *data, Mz_CPort *port, char *stac
mzshort *tl_state, mzshort tl_timestamp,
int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs)
Scheme_Hash_Tree *procs,
Scheme_Hash_Table **_st_ht)
{
Scheme_Case_Lambda *seq = (Scheme_Case_Lambda *)data;
Scheme_Object *e;
@ -603,7 +608,7 @@ static void case_lambda_validate(Scheme_Object *data, Mz_CPort *port, char *stac
validate_expr(port, e, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0, vc, 0, 0, procs, 1, NULL);
NULL, 0, 0, vc, 0, 0, procs, 1, _st_ht);
}
}
@ -627,6 +632,7 @@ static int bangboxenv_validate(Scheme_Object *data, Mz_CPort *port,
int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs,
Scheme_Hash_Table **_st_ht,
int expected_results)
{
validate_boxenv(SCHEME_INT_VAL(SCHEME_PTR1_VAL(data)), port, stack, depth, delta, letlimit);
@ -634,7 +640,7 @@ static int bangboxenv_validate(Scheme_Object *data, Mz_CPort *port,
return validate_expr(port, SCHEME_PTR2_VAL(data), stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, result_ignored, vc, tailpos, 0, procs, expected_results, NULL);
NULL, 0, result_ignored, vc, tailpos, 0, procs, expected_results, _st_ht);
}
static int begin0_validate(Scheme_Object *data, Mz_CPort *port,
@ -646,6 +652,7 @@ static int begin0_validate(Scheme_Object *data, Mz_CPort *port,
int result_ignored,
struct Validate_Clearing *vc, int tailpos,
Scheme_Hash_Tree *procs,
Scheme_Hash_Table **_st_ht,
int expected_results)
{
Scheme_Sequence *seq = (Scheme_Sequence *)data;
@ -661,7 +668,7 @@ static int begin0_validate(Scheme_Object *data, Mz_CPort *port,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, i > 0, vc, 0, 0, procs,
(i > 0) ? -1 : expected_results, NULL);
(i > 0) ? -1 : expected_results, _st_ht);
result = validate_join_seq(r, result);
}
@ -901,7 +908,8 @@ void scheme_validate_closure(Mz_CPort *port, Scheme_Object *expr,
char *closure_stack, Validate_TLS tls,
int num_toplevels, int num_stxes, int num_lifts, void *tl_use_map,
mzshort *tl_state, mzshort tl_timestamp,
int self_pos_in_closure, Scheme_Hash_Tree *procs)
int self_pos_in_closure, Scheme_Hash_Tree *procs,
Scheme_Hash_Table **_st_ht)
{
Scheme_Lambda *data = (Scheme_Lambda *)expr;
int i, sz, cnt, base, base2;
@ -976,7 +984,7 @@ void scheme_validate_closure(Mz_CPort *port, Scheme_Object *expr,
validate_expr(port, data->body, new_stack, tls, sz, sz, base,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0, vc, 1, 0, procs, -1, NULL);
NULL, 0, 0, vc, 1, 0, procs, -1, _st_ht);
}
static Scheme_Hash_Tree *as_nonempty_procs(Scheme_Hash_Tree *procs)
@ -992,7 +1000,8 @@ static void validate_lambda(Mz_CPort *port, Scheme_Object *expr,
int num_toplevels, int num_stxes, int num_lifts, void *tl_use_map,
mzshort *tl_state, mzshort tl_timestamp,
Scheme_Object *app_rator, int proc_with_refs_ok,
int self_pos, Scheme_Hash_Tree *procs)
int self_pos, Scheme_Hash_Tree *procs,
Scheme_Hash_Table **_st_ht)
{
Scheme_Lambda *data = (Scheme_Lambda *)expr;
int i, cnt, q, p, sz, base, stack_delta, vld, self_pos_in_closure = -1, typed_arg = 0;
@ -1088,7 +1097,7 @@ static void validate_lambda(Mz_CPort *port, Scheme_Object *expr,
if (SCHEME_RPAIRP(data->body)) {
/* Delay validation */
Scheme_Object *vec;
vec = scheme_make_vector(11, NULL);
vec = scheme_make_vector(12, NULL);
SCHEME_VEC_ELS(vec)[0] = SCHEME_CAR(data->body);
SCHEME_VEC_ELS(vec)[1] = (Scheme_Object *)closure_stack;
SCHEME_VEC_ELS(vec)[2] = (Scheme_Object *)tls;
@ -1100,12 +1109,13 @@ static void validate_lambda(Mz_CPort *port, Scheme_Object *expr,
SCHEME_VEC_ELS(vec)[8] = tl_use_map ? tl_use_map : scheme_false;
SCHEME_VEC_ELS(vec)[9] = tl_state ? (Scheme_Object *)tl_state : scheme_false;
SCHEME_VEC_ELS(vec)[10] = scheme_make_integer(tl_timestamp);
SCHEME_VEC_ELS(vec)[11] = (Scheme_Object *)_st_ht;
SCHEME_CAR(data->body) = vec;
} else
scheme_validate_closure(port, expr, closure_stack, tls,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
self_pos_in_closure, new_procs);
self_pos_in_closure, new_procs, _st_ht);
}
static void check_self_call_valid(Scheme_Object *rator, Mz_CPort *port, struct Validate_Clearing *vc,
@ -1272,12 +1282,6 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
Scheme_Object *r;
void **pr;
int *args;
Scheme_Hash_Table **_2st_ht = NULL;
if (_st_ht) {
_2st_ht = MALLOC_N(Scheme_Hash_Table*, 1);
*_2st_ht = *_st_ht;
}
args = MALLOC_N_ATOMIC(int, 12);
@ -1306,16 +1310,12 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
pr[3] = (void *)procs;
pr[4] = tl_use_map;
pr[5] = tl_state;
pr[6] = _2st_ht;
pr[6] = _st_ht;
p->ku.k.p5 = (void *)pr;
r = scheme_handle_stack_overflow(validate_k);
if (_st_ht) {
*_st_ht = *_2st_ht;
}
return SCHEME_INT_VAL(r);
}
#endif
@ -1537,7 +1537,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
r = validate_expr(port, app->args[i], stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
i ? app->args[0] : NULL, i + 1, 0, vc, 0, 0, procs, 1, NULL);
i ? app->args[0] : NULL, i + 1, 0, vc, 0, 0, procs, 1, _st_ht);
result = validate_join(result, r);
}
@ -1565,12 +1565,12 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
r = validate_expr(port, app->rator, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 1, 0, vc, 0, 0, procs, 1, NULL);
NULL, 1, 0, vc, 0, 0, procs, 1, _st_ht);
result = validate_join(r, result);
r = validate_expr(port, app->rand, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
app->rator, 2, 0, vc, 0, 0, procs, 1, NULL);
app->rator, 2, 0, vc, 0, 0, procs, 1, _st_ht);
result = validate_join(r, result);
if (tailpos)
@ -1606,17 +1606,17 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
r = validate_expr(port, app->rator, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 1, 0, vc, 0, 0, procs, 1, NULL);
NULL, 1, 0, vc, 0, 0, procs, 1, _st_ht);
result = validate_join(r, result);
r = validate_expr(port, app->rand1, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
app->rator, 2, 0, vc, 0, 0, procs, 1, NULL);
app->rator, 2, 0, vc, 0, 0, procs, 1, _st_ht);
result = validate_join(r, result);
r = validate_expr(port, app->rand2, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
app->rator, 3, 0, vc, 0, 0, procs, 1, NULL);
app->rator, 3, 0, vc, 0, 0, procs, 1, _st_ht);
result = validate_join(r, result);
if (tailpos)
@ -1652,7 +1652,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
r = validate_expr(port, seq->array[i], stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 1, vc, 0, 0, procs, -1, NULL);
NULL, 0, 1, vc, 0, 0, procs, -1, _st_ht);
result = validate_join_seq(result, r);
}
@ -1669,7 +1669,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
r = validate_expr(port, b->test, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0, vc, 0, 0, procs, 1, NULL);
NULL, 0, 0, vc, 0, 0, procs, 1, _st_ht);
result = validate_join(r, result);
/* This is where letlimit is useful. It prevents let-assignment in the
@ -1682,7 +1682,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, result_ignored, vc, tailpos, need_local_type, procs,
expected_results, NULL);
expected_results, _st_ht);
result = validate_join_seq(result, r);
/* since we're branchig, the result isn't constant: */
@ -1724,12 +1724,12 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
r = validate_expr(port, wcm->key, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0, vc, 0, 0, procs, 1, NULL);
NULL, 0, 0, vc, 0, 0, procs, 1, _st_ht);
result = validate_join_seq(result, r);
r = validate_expr(port, wcm->val, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0, vc, 0, 0, procs, 1, NULL);
NULL, 0, 0, vc, 0, 0, procs, 1, _st_ht);
result = validate_join_seq(result, r);
expr = wcm->body;
@ -1775,7 +1775,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
validate_lambda(port, expr, stack, tls, depth, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
app_rator, proc_with_refs_ok, -1, procs);
app_rator, proc_with_refs_ok, -1, procs, _st_ht);
result = validate_join_const(result, expected_results);
}
@ -1788,7 +1788,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
r = validate_expr(port, lv->value, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0, vc, 0, 0, procs, lv->count, NULL);
NULL, 0, 0, vc, 0, 0, procs, lv->count, _st_ht);
result = validate_join_seq(r, result);
/* memset(stack, VALID_NOT, delta); <-- seems unnecessary (and slow) */
@ -1885,7 +1885,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
validate_lambda(port, l->procs[i], stack, tls, depth, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 1, i, procs);
NULL, 1, i, procs, _st_ht);
}
expr = l->body;
@ -1956,7 +1956,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
set_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
result_ignored, vc, tailpos, procs));
result_ignored, vc, tailpos, procs, _st_ht));
break;
case scheme_boxenv_type:
no_typed(need_local_type, port);
@ -1964,7 +1964,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
bangboxenv_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
result_ignored, vc, tailpos, procs, expected_results));
result_ignored, vc, tailpos, procs, _st_ht, expected_results));
break;
case scheme_begin0_sequence_type:
no_typed(need_local_type, port);
@ -1972,7 +1972,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
begin0_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
result_ignored, vc, tailpos, procs, expected_results));
result_ignored, vc, tailpos, procs, _st_ht, expected_results));
break;
case scheme_require_form_type:
no_typed(need_local_type, port);
@ -1994,7 +1994,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
apply_values_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
result_ignored, vc, tailpos, procs);
result_ignored, vc, tailpos, procs, _st_ht);
result = validate_join(0, result);
break;
case scheme_with_immed_mark_type:
@ -2032,7 +2032,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
case_lambda_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
result_ignored, vc, tailpos, procs);
result_ignored, vc, tailpos, procs, _st_ht);
result = validate_join_const(result, expected_results);
break;
case scheme_module_type:
@ -2048,7 +2048,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
inline_variant_validate(expr, port, stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
result_ignored, vc, tailpos, procs);
result_ignored, vc, tailpos, procs, _st_ht);
result = validate_join_const(result, expected_results);
break;
case scheme_ir_local_type:
@ -2084,7 +2084,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
validate_expr(port, seq->array[i], stack, tls, depth, letlimit, delta,
num_toplevels, num_stxes, num_lifts, tl_use_map,
tl_state, tl_timestamp,
NULL, 0, 0, vc, 0, 0, procs, 1, NULL);
NULL, 0, 0, vc, 0, 0, procs, 1, _st_ht);
}
} else if (need_local_type) {
if (SCHEME_DBLP(expr) && (need_local_type == SCHEME_LOCAL_TYPE_FLONUM))