avoid building the result list in a map that is called for effect

cp0.ss

# Conflicts:
#	s/cp0.ss

original commit: 12353c17917f0979e72740592891ce928b40963f
This commit is contained in:
Gustavo Massaccesi 2017-12-20 11:26:57 -03:00
parent d593fe4a78
commit eb9d65d88c
2 changed files with 15 additions and 10 deletions

2
LOG
View File

@ -766,4 +766,6 @@
- Check that first argument of map is a procedure in cp02 expansion
to raise the same error that the non expanded version
cp0.ss
- avoid building the result list in a map that is called for effect
cp0.ss

View File

@ -3619,7 +3619,7 @@
(cons `(call ,preinfo (ref #f ,p)
,(map (lambda (t*) (build-ref (car t*))) t**) ...)
(g (map cdr t**))))))])
(if map?
(if (and map? (not (eq? ctxt 'effect)))
(build-primcall lvl 'list results)
(make-seq* ctxt results)))
(non-result-exp (value-visit-operand! (car ls*))
@ -3696,15 +3696,18 @@
(build-lambda (cons p ls*)
(let f ([n n] [ls* ls*] [ropnd* '()])
(if (fx= n 1)
(build-primcall 3 'list
(reverse
(cons
`(call ,(app-preinfo ctxt) (ref #f ,p)
,(map (lambda (x)
(build-primcall 3 'car
(list (build-ref x))))
ls*) ...)
ropnd*)))
(let ([opnd*
(reverse
(cons
`(call ,(app-preinfo ctxt) (ref #f ,p)
,(map (lambda (x)
(build-primcall 3 'car
(list (build-ref x))))
ls*) ...)
ropnd*))])
(if (eq? ctxt 'effect)
(make-seq* ctxt opnd*)
(build-primcall 3 'list opnd*)))
(let ([tls* (map (lambda (x) (cp0-make-temp #t)) ls*)])
(build-let tls*
(map (lambda (x)