optimizer: fix with-continuation-mark optimization

Misuse of the function to optimize applications constrained the
body of a `with-continuation-mark` form to a single result
value.
This commit is contained in:
Matthew Flatt 2014-06-20 06:21:51 +01:00
parent 0c5239fb51
commit da979b6c8d
3 changed files with 22 additions and 9 deletions

View File

@ -1240,6 +1240,9 @@
(test-comp '(lambda (w) (if (void (list w)) 1 2))
'(lambda (w) 1))
(test null
call-with-values (lambda () (with-continuation-mark 'a 'b (values))) list)
;; Ok to move `box' past a side effect (that can't capture a
;; resumable continuation):
(test-comp '(let ([h (box 0.0)])

View File

@ -634,6 +634,21 @@ static Scheme_Object *optimize_ignored(Scheme_Object *e, Optimize_Info *info, in
return e;
}
static Scheme_Object *make_sequence_2(Scheme_Object *a, Scheme_Object *b)
{
return scheme_make_sequence_compilation(scheme_make_pair(a, scheme_make_pair(b, scheme_null)), 1);
}
static Scheme_Object *make_discarding_first_sequence(Scheme_Object *e1, Scheme_Object *e2, Optimize_Info *info)
/* Like make_discarding_sequence(), but second expression is not constrained to
a single result. */
{
e1 = optimize_ignored(e1, info, 1, 1, 5);
if (!e1)
return e2;
return make_sequence_2(e1, e2);
}
static int is_inspector_call(Scheme_Object *a)
{
if (SAME_TYPE(SCHEME_TYPE(a), scheme_application_type)) {
@ -3515,11 +3530,6 @@ static void add_types(Scheme_Object *t, Optimize_Info *info, int fuel)
}
}
static Scheme_Object *make_sequence_2(Scheme_Object *a, Scheme_Object *b)
{
return scheme_make_sequence_compilation(scheme_make_pair(a, scheme_make_pair(b, scheme_null)), 1);
}
static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int context)
{
Scheme_Branch_Rec *b;
@ -3674,7 +3684,7 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
/* Try optimize: (if <omitable-expr> v v) => v */
if (equivalent_exprs(tb, fb)) {
info->size -= 1; /* could be more precise */
return make_discarding_sequence(t, tb, info);
return make_discarding_first_sequence(t, tb, info);
}
/* Convert: (if (if M N #f) M2 K) => (if M (if N M2 K) K)
@ -3734,7 +3744,7 @@ static Scheme_Object *optimize_wcm(Scheme_Object *o, Optimize_Info *info, int co
if (omittable_key(k, info)
&& scheme_omittable_expr(b, -1, 20, 0, info, info, -1, 0))
return make_discarding_sequence(v, b, info);
return make_discarding_first_sequence(v, b, info);
/* info->single_result is already set */
info->preserves_marks = 0;

View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "6.0.1.12"
#define MZSCHEME_VERSION "6.0.1.13"
#define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 1
#define MZSCHEME_VERSION_W 12
#define MZSCHEME_VERSION_W 13
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)