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

Remove ignored call/cc

Browse Source 
Reduce (call/cc (lambda (<ignored>) body ...)) to (begin body ...)
This commit is contained in:
Gustavo Massaccesi 2015-09-07 14:11:56 -03:00
parent d705e928ac
commit 27791ebab7
2 changed files with 54 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/racket-test-core/tests/racket/optimize.rktl
View File

@ -3539,6 +3539,16 @@
(set! f 0)) (set! f 0))
#f) #f)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that the unused continuations are removed
(test-comp '(call-with-current-continuation (lambda (ignored) 5))
5)
(test-comp '(call-with-composable-continuation (lambda (ignored) 5))
5)
(test-comp '(call-with-escape-continuation (lambda (ignored) 5))
5)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check splitting of definitions ;; Check splitting of definitions
(test-comp `(module m racket/base (test-comp `(module m racket/base

44
racket/src/racket/src/optimize.c
View File

@ -3062,6 +3062,46 @@ static Scheme_Object *try_reduce_predicate(Scheme_Object *rator, Scheme_Object *
return make_discarding_sequence(rand, (matches ? scheme_true : scheme_false), info, id_offset); return make_discarding_sequence(rand, (matches ? scheme_true : scheme_false), info, id_offset);
} }
static Scheme_Object *check_ignored_call_cc(Scheme_Object *rator, Scheme_Object *rand,
Optimize_Info *info, int context)
/* Convert (call/cc (lambda (ignored) body ...)) to (begin body ...) */
{
if (SCHEME_PRIMP(rator)
&& (IS_NAMED_PRIM(rator, "call-with-current-continuation")
|| IS_NAMED_PRIM(rator, "call-with-composable-continuation")
|| IS_NAMED_PRIM(rator, "call-with-escape-continuation"))) {
int rand_flags;
Scheme_Object *proc;
proc = lookup_constant_proc(info, rand, 0);
if (!proc)
proc = optimize_for_inline(info, rand, 1, NULL, NULL, NULL, &rand_flags, context, 0, 0);
if (proc && SAME_TYPE(SCHEME_TYPE(proc), scheme_compiled_unclosed_procedure_type)) {
Scheme_Closure_Data *data = (Scheme_Closure_Data *)proc;
if (data->num_params == 1) {
Closure_Info *cl = (Closure_Info *)data->closure_map;
if (((cl->local_flags[0] & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT) == 0) {
Scheme_Object *expr;
info->vclock++;
expr = make_application_2(rand, scheme_void, info);
if (IS_NAMED_PRIM(rator, "call-with-escape-continuation")) {
Scheme_Sequence *seq;
seq = scheme_malloc_sequence(1);
seq->so.type = scheme_begin0_sequence_type;
seq->count = 1;
seq->array[0] = expr;
expr = (Scheme_Object *)seq;
}
return scheme_optimize_expr(expr, info, context);
}
}
}
}
return NULL;
}
static Scheme_Object *make_optimize_prim_application2(Scheme_Object *prim, Scheme_Object *rand, static Scheme_Object *make_optimize_prim_application2(Scheme_Object *prim, Scheme_Object *rand,
Optimize_Info *info, int context) Optimize_Info *info, int context)
/* make (prim rand) and optimize it. rand must be already optimized */ /* make (prim rand) and optimize it. rand must be already optimized */
@ -3091,6 +3131,10 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
if (le) if (le)
return le; return le;
le = check_ignored_call_cc(app->rator, app->rand, info, context);
if (le)
return le;
le = optimize_for_inline(info, app->rator, 1, NULL, app, NULL, &rator_flags, context, 0, 0); le = optimize_for_inline(info, app->rator, 1, NULL, app, NULL, &rator_flags, context, 0, 0);
if (le) if (le)
return le; return le;