Fix make_discarding_first_sequence

Ensure that the first expression is single valued.
This commit is contained in:
Gustavo Massaccesi 2014-12-23 10:40:35 -03:00 committed by Matthew Flatt
parent 8056c79699
commit 92615049aa
2 changed files with 19 additions and 0 deletions

View File

@ -1537,6 +1537,9 @@
'(lambda (x) x))
(test-comp '(lambda (x) (if (cons 1 x) 78 78))
'(lambda (x) 78))
(test-comp '(lambda (x) (if (values 1 2) 78 78))
'(lambda (x) (values 1 2) 78)
#f)
(test-comp '(lambda (x) (if (let ([r (something)])
(if r r (something-else)))
@ -2982,6 +2985,20 @@
`(lambda (b)
(with-continuation-mark 'x 'y (box (box b)))))
(test-comp `(lambda () (list 1))
`(lambda ()
(with-continuation-mark 'x 'y (list 1))))
(test-comp `(lambda () (random) (list 1))
`(lambda ()
(with-continuation-mark 'x (random) (list 1))))
(test-comp `(lambda (f) (values (f)) (list 1))
`(lambda (f)
(with-continuation-mark 'x (f) (list 1))))
(test-comp `(lambda () (values 1 2) (list 1))
`(lambda ()
(with-continuation-mark 'x (values 1 2) (list 1)))
#f)
(test-comp `(lambda (x y f)
(set! x 5)
(list

View File

@ -685,6 +685,8 @@ static Scheme_Object *make_discarding_first_sequence(Scheme_Object *e1, Scheme_O
e1 = optimize_ignored(e1, info, id_offset, 1, 1, 5);
if (!e1)
return e2;
if (!single_valued_noncm_expression(e1, 5))
e1 = ensure_single_value(e1);
return make_sequence_2(e1, e2);
}