or values bug?

or values bug?

[rixed]

Is it normal that this:

(or (values 'a 'b) 'c)

returns two values ('a and 'b) while this:

(or (values 'a (lambda (port) #f)) 'c)

returns only one ('a)?
Isn't it a bug?

Re: or values bug?

[Ludovic Courtès]

Hi Cédric,

rixed@happyleptic.org skribis:

> Is it normal that this:
>
> (or (values 'a 'b) 'c)
>
> returns two values ('a and 'b)

This one gets optimized by peval:

  scheme@(guile-user)> ,optimize (or (values 1 2) 'b)
  $6 = (values 1 2)

That the second value isn’t truncated is a bug (see below.)

> while this:
>
> (or (values 'a (lambda (port) #f)) 'c)
>
> returns only one ('a)?

This one doesn’t:

  scheme@(guile-user)> ,optimize (or (values 1 (lambda () #t)) 'b)
  $5 = (begin
    (letrec*
      ()
      (let ((#{t 1263}# (values 1 (lambda () #t))))
        (if #{t 1263}# #{t 1263}# 'b))))

The ‘let’, which leads to the second value being ignored, comes from the
definition of ‘or’:

  (define-syntax or
    (syntax-rules ()
      ((_) #f)
      ((_ x) x)
      ((_ x y ...) (let ((t x)) (if t t (or y ...))))))

It’s normal that the second value is ignored because ‘or’ expects
expressions returning one value.

In theory, peval should really optimize the first form to 1, instead of
multiple-values, but I think it loses information about the context
somewhere.

Namely, when partial-evaluating <let> forms, I think it should:

   (let* ((vars (map (compose truncate lookup-var) gensyms))
          ...)
     ...)

where ‘truncate’ discards all values but the first of a <let-values>
form.

Andy?

Thanks,
Ludo’.

Re: or values bug?

[Andy Wingo]

On Mon 05 Dec 2011 18:40, ludo@gnu.org (Ludovic Courtès) writes:

>   scheme@(guile-user)> ,optimize (or (values 1 2) 'b)
>   $6 = (values 1 2)
>
> That the second value isn’t truncated is a bug (see below.)

Indeed.

>    (let* ((vars (map (compose truncate lookup-var) gensyms))
>           ...)
>      ...)

Better to truncate when adding variables to all expand-time
environments, I would think, in the form of `(cut make-primcall #f
'values <>)'.

Andy
-- 
http://wingolog.org/

Re: or values bug?

[Andy Wingo]

On Mon 05 Dec 2011 21:57, Andy Wingo <wingo@pobox.com> writes:

>>    (let* ((vars (map (compose truncate lookup-var) gensyms))
>>           ...)
>>      ...)
>
> Better to truncate when adding variables to all expand-time
> environments, I would think, in the form of `(cut make-primcall #f
> 'values <>)'.

Rather, something like:

   (define (truncate x)
     (match x
       ((<const>) x)
       ;; similar provably singly-valued cases here
       (else (make-primcall #f 'values (list x)))))

Andy
-- 
http://wingolog.org/

Re: or values bug?

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 637 bytes --]

Hi Andy,

Andy Wingo <wingo@pobox.com> skribis:

> Rather, something like:
>
>    (define (truncate x)
>      (match x
>        ((<const>) x)
>        ;; similar provably singly-valued cases here
>        (else (make-primcall #f 'values (list x)))))

I’ve started poking at it and the main difficulty is that we now need to
know, for any procedure, whether it’s provably singly-valued.

I suspect it’s often the case that it cannot be proved, for instance
when a lambda calls a top-level.  In all those cases, we’d end up
wrapping the expression in (values (list EXP)), which seems like a bad
idea.

Thoughts?

Thanks,
Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 3489 bytes --]

diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index 634c6c9..b4f5144 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -99,6 +99,42 @@
            (or (proc (vlist-ref vlist i))
                (lp (1+ i)))))))
 
+(define (truncate-values x)
+  "Discard all but the first value of X."
+  (let loop ((x x))
+    (match x
+      (($ <const>) x)
+      (($ <lexical-ref>) x)
+      (($ <void>) x)
+      (($ <lexical-ref>) x)
+      (($ <primitive-ref>) x)
+      (($ <module-ref>) x)
+      (($ <toplevel-ref>) x)
+      (($ <conditional> src condition subsequent alternate)
+       (make-conditional src condition (loop subsequent) (loop alternate)))
+      (($ <application> src ($ <primitive-ref> _ 'values) (first _ ...))
+       first)
+      (($ <application> _ ($ <primitive-ref>))
+       ;; Assume all other primitives return at most one value.
+       x)
+      (($ <sequence> src (exps ... last))
+       (make-sequence src (append exps (list (loop last)))))
+      (($ <lambda>) x)
+      (($ <dynlet> src fluids vals body)
+       (make-dynlet src fluids vals (loop body)))
+      (($ <let> src names gensyms vals body)
+       (make-let src names gensyms vals (loop body)))
+      (($ <letrec> src in-order? names gensyms vals body)
+       (make-letrec src in-order? names gensyms vals (loop body)))
+      (($ <fix> src names gensyms vals body)
+       (make-fix src names gensyms vals body))
+      (($ <let-values> src exp body)
+       (make-let-values src exp (loop body)))
+      (else
+       (make-application (tree-il-src x)
+                         (make-primitive-ref #f'values)
+                         (list x))))))
+
 ;; Peval will do a one-pass analysis on the source program to determine
 ;; the set of assigned lexicals, and to identify unreferenced and
 ;; singly-referenced lexicals.
@@ -278,8 +314,10 @@
   (constant-value operand-constant-value set-operand-constant-value!))
 
 (define* (make-operand var sym #:optional source visit)
+  ;; Bind SYM to VAR, with value SOURCE.
   ;; Bound operands are considered copyable until we prove otherwise.
-  (%make-operand var sym visit source 0 #f (and source #t) #f #f))
+  (let ((source (if source (truncate-values source) source)))
+    (%make-operand var sym visit source 0 #f (and source #t) #f #f)))
 
 (define (make-bound-operands vars syms sources visit)
   (map (lambda (x y z) (make-operand x y z visit)) vars syms sources))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 5e02bd1..57fd1f4 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -664,6 +664,28 @@
           (+ a b))))
     (const 3))
 
+  (pass-if-peval resolve-primitives
+    ;; First order, multiple values.
+    (let ((x 1) (y 2))
+      (values x y))
+    (apply (primitive values) (const 1) (const 2)))
+
+  (pass-if-peval resolve-primitives
+    ;; First order, multiple values truncated.
+    (let ((x (values 1 'a)) (y 2))
+      (values x y))
+    (apply (primitive values) (const 1) (const 2)))
+
+  (pass-if-peval resolve-primitives
+    ;; First order, multiple values truncated.
+    (or (values 1 2) 3)
+    (const 1))
+
+  (pass-if-peval resolve-primitives
+    ;; First order, multiple values truncated in arguments.
+    (+ (values 1 2 3) 2)
+    (const 3))
+
   (pass-if-peval
     ;; First order, coalesced, mutability preserved.
     (cons 0 (cons 1 (cons 2 (list 3 4 5))))

Re: or values bug?

[Andy Wingo]

Hey, thanks for looking at this!

On Tue 06 Dec 2011 18:57, ludo@gnu.org (Ludovic Courtès) writes:

> Hi Andy,
>
> Andy Wingo <wingo@pobox.com> skribis:
>
>> Rather, something like:
>>
>>    (define (truncate x)
>>      (match x
>>        ((<const>) x)
>>        ;; similar provably singly-valued cases here
>>        (else (make-primcall #f 'values (list x)))))
>
> I suspect it’s often the case that it cannot be proved, for instance
> when a lambda calls a top-level.  In all those cases, we’d end up
> wrapping the expression in (values (list EXP)), which seems like a bad
> idea.

For the purposes of peval, this is probably fine.  Are there any
expressions for which we don't know the number of values that we allow
to propagate?

But if the operand residualizes, it would be nice to avoid turning

  (let ((x (foo))) (+ 1 x))

into

  (let ((x (values (foo)))) (+ 1 x))

as in this case the `values' is completely unnecessary.  Peval could
handle it, or compile-glil.scm could handle it.

Other than those comments, the patch looks nice to me!

Andy
-- 
http://wingolog.org/

Re: or values bug?

[rixed]

Thank you to both of you for the explanations and for looking 
for a solution so quickly.
Anyway, I changed my code to not use this evil multiple value feature and I
think I will keep away from this. Returning a list seams so much natural.

Do you need me actualy fill a bugreport?