bug#13966: inlining issue?

[Ludovic Courtès]

Hi Daniel,

Daniel Llorens <address@hidden> skribis:

> Compare 
>
> (define f (lambda (a) a))
> (call-with-values (lambda () (values 3 3)) f)
>
> vs
>
> (call-with-values (lambda () (values 3 3)) (lambda (a) a))
>
> The first one fails with
>
> <unnamed port>:1:0: In procedure f:
> <unnamed port>:1:0: Wrong number of arguments to #<procedure f (a)>
>
> The second one gives 3. 
>
> This is Guile 2.0.7.112-f5ea5.
>
> The behavior of the first case makes (compose f g) fail when f takes less 
> args tan g produces.

That is unfortunate but I think the former is correct.

R5RS doesn’t say anything about the expected behavior when the producer
returns a number of values incompatible with what the consumer accepts.

R6RS says (Section 5.8):

  If the number of return values passed to a continuation created by a
  call to call-with-values is not accepted by its consumer that was
  passed in that call, then an exception is raised.

and Section 11.5:

  Consumer must be a procedure and should accept as many values as
  producer returns.

R7RS draft #6 uses equivalent wording (I think):

  Calls its producer argument with no values and a continuation that,
  when passed some values, calls the consumer procedure with those
  values as arguments.

This patch fixes peval to not inline

  (call-with-values (lambda () (values vals ...)) (lambda (args ...) ...))

when the length of ‘vals’ differs from that of ‘args’.

However, it’s not very elegant, IMO.  Andy?

Ludo’.

diff --git a/module/language/tree-il/peval.scm 
b/module/language/tree-il/peval.scm
index bf96179..25dded4 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1155,6 +1155,25 @@ top-level bindings from ENV and return the resulting 
expression."
           (simplify-conditional
            (make-conditional src c (for-tail subsequent)
                              (for-tail alternate))))))
+
+      (($ <application> src
+          ($ <primitive-ref> _ '@call-with-values)
+          (($ <lambda> _ _
+              ($ <lambda-case> _
+                 () #f #f #f () ()
+                 ($ <application> _ ($ <primitive-ref> _ 'values)
+                    (produced ...))
+                 #f))
+           ($ <lambda> _ _
+              (and consumer
+                   ($ <lambda-case> _
+                      (? (negate (compose (cute = <> (length produced))
+                                          length)))
+                      #f #f #f () gensyms body #f)))))
+       ;; Producer is (values args ...) but consumer expects a different
+       ;; number of values, which is an error.
+       exp)
+
       (($ <application> src
           ($ <primitive-ref> _ '@call-with-values)
           (producer