optimizer: drop redundant with-continuation-marks

Simplify `(wcm <k1> <v1> (wcm <k1> <v2> <e>))` to
`(begin <v1> (wcm <k1> <v2> <e>))` for a simple enough <k1>.
A variable simple enough, so this is useful for improving
errortrace output.
This commit is contained in:
Matthew Flatt 2016-03-03 08:00:32 -07:00
parent 7e4d7dfdee
commit 254dac4625
2 changed files with 58 additions and 0 deletions

View File

@ -3612,6 +3612,49 @@
`(lambda () `(lambda ()
(with-continuation-mark 'x (values 1 2) (list 1))) (with-continuation-mark 'x (values 1 2) (list 1)))
#f) #f)
(test-comp `(lambda (x)
(with-continuation-mark
x 1
(with-continuation-mark
x 2
(x))))
`(lambda (x)
(with-continuation-mark
x 2
(x))))
(test-comp `(lambda (x)
(with-continuation-mark
x (display x)
(with-continuation-mark
x 2
(x))))
`(lambda (x)
(display x)
(with-continuation-mark
x 2
(x))))
(test-comp `(lambda (x)
(with-continuation-mark
x 1
(with-continuation-mark
x (current-continuation-marks)
(x))))
`(lambda (x)
(with-continuation-mark
x (current-continuation-marks)
(x)))
#f)
(test-comp '(lambda (v)
(let ([x (with-continuation-mark
'x 10
(+ v v))])
x))
'(lambda (v)
(begin0
(with-continuation-mark
'x 10
(+ v v))
#f)))
(test-comp `(lambda (x y f) (test-comp `(lambda (x y f)
(set! x 5) (set! x 5)

View File

@ -4721,6 +4721,8 @@ static Scheme_Object *optimize_wcm(Scheme_Object *o, Optimize_Info *info, int co
optimize_info_seq_done(info, &info_seq); optimize_info_seq_done(info, &info_seq);
/* If the body cannot inspect the continution, and if the key is not
a chaperone, no need to add the mark: */
if (omittable_key(k, info) if (omittable_key(k, info)
&& scheme_omittable_expr(b, -1, 20, 0, info, info)) && scheme_omittable_expr(b, -1, 20, 0, info, info))
return make_discarding_first_sequence(v, b, info); return make_discarding_first_sequence(v, b, info);
@ -4734,6 +4736,19 @@ static Scheme_Object *optimize_wcm(Scheme_Object *o, Optimize_Info *info, int co
info->size += 1; info->size += 1;
/* Simplify (with-continuation-mark <same-key> <val1>
(with-continuation-mark <same-key> <val2>
<body>))
to (begin
<val1>
(with-continuation-mark <same-key> <val2>
<body>))
as long as <val2> doesn't inspect the continuation. */
if (SAME_TYPE(SCHEME_TYPE(wcm->body), scheme_with_cont_mark_type)
&& equivalent_exprs(wcm->key, ((Scheme_With_Continuation_Mark *)wcm->body)->key, NULL, NULL, 0)
&& scheme_omittable_expr(((Scheme_With_Continuation_Mark *)wcm->body)->val, 1, 20, 0, info, info))
return make_discarding_first_sequence(wcm->val, wcm->body, info);
return (Scheme_Object *)wcm; return (Scheme_Object *)wcm;
} }