1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 14:30:34 +02:00

Fix peval on (call-with-values foo (lambda (x) x))

* module/language/tree-il/peval.scm (peval): Don't
  inline (call-with-values foo (lambda (x) exp)) to (let ((x (foo)))
  exp).  The idea is that call-with-values sets up an explicit context
  in which we are requesting an explicit return arity, and that dropping
  extra values when there's not a rest argument is the wrong thing.
  Fixes #13966.
* test-suite/tests/peval.test ("partial evaluation"): Update test.
This commit is contained in:
Andy Wingo 2016-06-20 22:04:45 +02:00
parent 5b6eaa91d2
commit fff013215f
2 changed files with 4 additions and 6 deletions

View file

@ -1014,10 +1014,6 @@ top-level bindings from ENV and return the resulting expression."
;; reconstruct the let-values, pevaling the consumer.
(let ((producer (for-values producer)))
(or (match consumer
(($ <lambda-case> src (req-name) #f #f #f () (req-sym) body #f)
(for-tail
(make-let src (list req-name) (list req-sym) (list producer)
body)))
((and ($ <lambda-case> src () #f rest #f () (rest-sym) body #f)
(? (lambda _ (singly-valued-expression? producer))))
(let ((tmp (gensym "tmp ")))

View file

@ -1354,8 +1354,10 @@
(pass-if-peval
(call-with-values foo (lambda (x) (bar x)))
(let (x) (_) ((call (toplevel foo)))
(call (toplevel bar) (lexical x _))))
(let-values (call (toplevel foo))
(lambda-case
(((x) #f #f #f () (_))
(call (toplevel bar) (lexical x _))))))
(pass-if-peval
((lambda (foo)