[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.2-103-ga4c7fe5

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=a4c7fe5cde907f3bc4cbc5190bfc7e748d6bac45

The branch, stable-2.0 has been updated
       via  a4c7fe5cde907f3bc4cbc5190bfc7e748d6bac45 (commit)
       via  ec6e09bee7bd85862dbbea8fdefb295b7cc5205f (commit)
      from  d851e32fdc3d14804108f0389faa75a57599ced4 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit a4c7fe5cde907f3bc4cbc5190bfc7e748d6bac45
Author: Ludovic Courtès <address@hidden>
Date:   Wed Sep 21 22:56:45 2011 +0200

    peval: Add test for multiple-value returns.
    
    * test-suite/tests/tree-il.test (pass-if-peval): Support the
      `resolve-primitives' keyword.
      ("partial evaluation"): Add test for `call-with-values'.

commit ec6e09bee7bd85862dbbea8fdefb295b7cc5205f
Author: Ludovic Courtès <address@hidden>
Date:   Wed Sep 21 15:17:56 2011 +0200

    peval: Rectify style.
    
    * module/language/tree-il/optimize.scm (peval): Rename `src' to
      `lv-src', and `src2' to `src'; pass `make-let-values' the right source
      locations.  Reindent `let*'.

-----------------------------------------------------------------------

Summary of changes:
 module/language/tree-il/optimize.scm |   14 +++++++-------
 test-suite/tests/tree-il.test        |   25 ++++++++++++++++++++++---
 2 files changed, 29 insertions(+), 10 deletions(-)

diff --git a/module/language/tree-il/optimize.scm 
b/module/language/tree-il/optimize.scm
index 2503e14..0cc51a0 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -465,19 +465,19 @@ it does not handle <fix> and <let-values>, it should be 
called before
              (if (const? body*)
                  body
                  (make-fix src names gensyms vals body))))
-          (($ <let-values> src producer
-              ($ <lambda-case> src2 req #f #f #f () gensyms body #f))
+          (($ <let-values> lv-src producer
+              ($ <lambda-case> src req #f #f #f () gensyms body #f))
            ;; Peval both producer and consumer, then try to inline.  If
            ;; that succeeds, peval again.
            (let* ((producer (maybe-unconst producer (loop producer env calls)))
-                  (body (maybe-unconst body (loop body env calls))))
+                  (body     (maybe-unconst body (loop body env calls))))
              (cond
-              ((inline-values producer src2 req gensyms body)
+              ((inline-values producer src req gensyms body)
                => (lambda (exp) (loop exp env calls)))
               (else
-               (make-let-values
-                src producer
-                (make-lambda-case src2 req #f #f #f '() gensyms body #f))))))
+               (make-let-values lv-src producer
+                                (make-lambda-case src req #f #f #f '()
+                                                  gensyms body #f))))))
           (($ <let-values>)
            exp)
           (($ <dynwind> src winder body unwinder)
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index bdff643..b641883 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -23,6 +23,7 @@
   #:use-module (system base pmatch)
   #:use-module (system base message)
   #:use-module (language tree-il)
+  #:use-module (language tree-il primitives)
   #:use-module (language glil)
   #:use-module (srfi srfi-13))
 
@@ -73,11 +74,19 @@
   (@@ (language tree-il optimize) peval))
 
 (define-syntax pass-if-peval
-  (syntax-rules ()
+  (syntax-rules (resolve-primitives)
     ((_ in pat)
+     (pass-if-peval in pat
+                    (compile 'in #:from 'scheme #:to 'tree-il)))
+    ((_ resolve-primitives in pat)
+     (pass-if-peval in pat
+                    (expand-primitives!
+                     (resolve-primitives!
+                      (compile 'in #:from 'scheme #:to 'tree-il)
+                      (current-module)))))
+    ((_ in pat code)
      (pass-if 'in
-       (let ((evaled (unparse-tree-il
-                      (peval (compile 'in #:from 'scheme #:to 'tree-il)))))
+       (let ((evaled (unparse-tree-il (peval code))))
          (pmatch evaled
            (pat #t)
            (_   (pk 'peval-mismatch evaled) #f)))))))
@@ -620,6 +629,16 @@
         (f)))
     (const 3))
 
+  (pass-if-peval resolve-primitives
+    ;; First order, let-values (requires primitive expansion for
+    ;; `call-with-values'.)
+    (let ((x 0))
+      (call-with-values
+          (lambda () (if (zero? x) (values 1 2) (values 3 4)))
+        (lambda (a b)
+          (+ a b))))
+    (const 3))
+
   (pass-if-peval
     ;; First order, coalesced.
     (cons 0 (cons 1 (cons 2 (list 3 4 5))))


hooks/post-receive
-- 
GNU Guile