Merge pull request #490 from mflatt/cp-push-mvrs
fix missing continuation call in `cp-push-mvrs` original commit: 585068e174bde7d685ca8743533ea0f02f157753
This commit is contained in:
commit
c1a4de6f4f
4
LOG
4
LOG
|
@ -1769,3 +1769,7 @@
|
|||
is enabled, so local transformer code can be profiled.
|
||||
syntax.ss,
|
||||
profile.ms
|
||||
- fix compiler bug related to call-with-values and a first argument
|
||||
whose body result is compiled to an allocation, inline form, or
|
||||
foreign call
|
||||
cpnanopass.ss, 3.ms
|
||||
|
|
18
mats/3.ms
18
mats/3.ms
|
@ -2069,6 +2069,24 @@
|
|||
(lambda l (equal? l '((7)))))
|
||||
#t
|
||||
#f)
|
||||
|
||||
; regression test for handling mvcall with inline form
|
||||
(equal?
|
||||
'(result x)
|
||||
(let ([bx (box #f)])
|
||||
(define-record-type thing
|
||||
(fields pos)
|
||||
(nongenerative #{thing hlg584lmg5htbdauw7dkid2sh-0}))
|
||||
(set-box! bx (make-thing 'x))
|
||||
(let ([posx (unbox bx)])
|
||||
(cons 'result
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(if (thing? posx)
|
||||
;; compiled as inline load:
|
||||
(thing-pos posx)
|
||||
(do-something-else)))
|
||||
list)))))
|
||||
)
|
||||
|
||||
(mat let-values
|
||||
|
|
|
@ -9738,7 +9738,7 @@
|
|||
(let ([tmp (make-tmp 't)])
|
||||
`(seq
|
||||
(set! ,tmp ,rhs)
|
||||
(mvcall ,(make-info-call (info-call-src info) (info-call-sexpr info) #f #f #f) #f ,consumer ,tmp ())))]
|
||||
,(k `(mvcall ,(make-info-call (info-call-src info) (info-call-sexpr info) #f #f #f) #f ,consumer ,tmp ()))))]
|
||||
[else ; set! & mvset
|
||||
`(seq ,e ,(k `(mvcall ,(make-info-call (info-call-src info) (info-call-sexpr info) #f #f #f) #f ,consumer ,(%constant svoid) ())))])))))
|
||||
(CaseLambdaClause : CaseLambdaClause (ir) -> CaseLambdaClause ()
|
||||
|
|
Loading…
Reference in New Issue
Block a user