- fixed np-normalize-context pass to process trivs list in mvset forms

in tail and predicate context and added regression tests.  Thanks to
  @marcomaggi for reporting the bug and @yjqww6 for providing a
  simplified test and finding the initial solution.
    cpnanopass.ss,
    3.ms

original commit: 28f31d84b6c45e2fa701655e9131801dd603d925
This commit is contained in:
Andy Keep 2017-08-31 23:24:14 -04:00
parent 55323a372b
commit c854ef9ab7
3 changed files with 28 additions and 2 deletions

6
LOG
View File

@ -576,3 +576,9 @@
added a batch script for locating Visual Studio's vcredist merge
modules, updated installer paths and names.
wininstall/*
- fixed np-normalize-context pass to process trivs list in mvset forms
in tail and predicate context and added regression tests. Thanks to
@marcomaggi for reporting the bug and @yjqww6 for providing a
simplified test and finding the initial solution.
cpnanopass.ss,
3.ms

View File

@ -2049,6 +2049,26 @@
(let ()
(import $mrvs-double-call)
(double-call 'a)))
; regression testing for handling mvset in tail context
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(+ (random 1) 7))
list))
(lambda l (equal? l '((7)))))
; regression testing for handling mvset in predicate context
(if (call-with-values
(lambda ()
(call-with-values
(lambda ()
(+ (random 1) 7))
list))
(lambda l (equal? l '((7)))))
#t
#f)
)
(mat let-values

View File

@ -9756,7 +9756,7 @@
(tail (mvcall ,info ,mdcl ,t0? ,t1 ... (,t* ...)))
(true))]
[(set! ,[lvalue] ,[rhs]) `(seq (set! ,lvalue ,rhs) (true))]
[(mvset ,info (,mdcl ,[t0?] ,[t1] ...) (,t* ...) ((,x** ...) ,interface* ,l*) ...)
[(mvset ,info (,mdcl ,[t0?] ,[t1] ...) (,[t*] ...) ((,x** ...) ,interface* ,l*) ...)
`(seq
(mvset ,info (,mdcl ,t0? ,t1 ...) (,t* ...) ((,x** ...) ,interface* ,l*) ...)
(true))]
@ -9826,7 +9826,7 @@
(guard (info-call-error? info) (fx< (debug-level) 2))
`(mvcall ,info ,mdcl ,t0? ,t1 ... (,t* ...))]
[(set! ,[lvalue] ,[rhs]) `(seq (set! ,lvalue ,rhs) ,(%constant svoid))]
[(mvset ,info (,mdcl ,[t0?] ,[t1] ...) (,t* ...) ((,x** ...) ,interface* ,l*) ...)
[(mvset ,info (,mdcl ,[t0?] ,[t1] ...) (,[t*] ...) ((,x** ...) ,interface* ,l*) ...)
`(seq
(mvset ,info (,mdcl ,t0? ,t1 ...) (,t* ...) ((,x** ...) ,interface* ,l*) ...)
,(%constant svoid))]