[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.2-123-g05c9389

[Andy Wingo]

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=05c9389e3f869f3158d97289f50a52dc2b3caa26

The branch, stable-2.0 has been updated
       via  05c9389e3f869f3158d97289f50a52dc2b3caa26 (commit)
       via  ef6c0883c3467b0b4b3c3e3cfb94f2b80422d875 (commit)
      from  02ebea537fa805c615df44c4228db6a44d74c4b3 (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 05c9389e3f869f3158d97289f50a52dc2b3caa26
Author: Andy Wingo <address@hidden>
Date:   Mon Sep 26 22:32:45 2011 +0200

    peval: fix inlining of lambda* with #:optional
    
    * module/language/tree-il/optimize.scm (peval): Fix calculation of how
      many init expressions to drop when inlining lambdas.
    
    * test-suite/tests/tree-il.test ("partial evaluation"): Add tests.

commit ef6c0883c3467b0b4b3c3e3cfb94f2b80422d875
Author: Andy Wingo <address@hidden>
Date:   Mon Sep 26 22:24:00 2011 +0200

    remove unused peval helpers
    
    * module/language/tree-il/optimize.scm (peval): Remove a couple unused
      helpers.

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

Summary of changes:
 module/language/tree-il/optimize.scm |   21 ++-------------------
 test-suite/tests/tree-il.test        |   21 +++++++++++++++++++++
 2 files changed, 23 insertions(+), 19 deletions(-)

diff --git a/module/language/tree-il/optimize.scm 
b/module/language/tree-il/optimize.scm
index 1af55a1..8c5ae94 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -423,9 +423,6 @@ it does not handle <fix> and <let-values>, it should be 
called before
        (make-application src (make-primitive-ref src 'values)
                          values))))
 
-  (define (const*? x)
-    (or (const? x) (lambda? x) (void? x)))
-
   (define (constant-expression? x)
     ;; Return true if X is constant---i.e., if it is known to have no
     ;; effects, does not allocate storage for a mutable object, and does
@@ -474,14 +471,6 @@ it does not handle <fix> and <let-values>, it should be 
called before
        0 x)
       #t))
   
-  (define (mutable? exp)
-    ;; Return #t if EXP is a mutable object.
-    ;; todo: add an option to assume pairs are immutable
-    (or (pair? exp)
-        (vector? exp)
-        (struct? exp)
-        (string? exp)))
-
   (define (make-value-construction src exp)
     ;; Return an expression that builds a fresh copy of EXP at run-time,
     ;; or #f.
@@ -839,10 +828,7 @@ it does not handle <fix> and <let-values>, it should be 
called before
                     (loop (make-let src (append req (or opt '()))
                                     gensyms
                                     (append orig-args
-                                            (drop inits
-                                                  (max 0
-                                                       (- nargs
-                                                          (+ nreq nopt)))))
+                                            (drop inits (- nargs nreq)))
                                     body)
                       env counter ctx))
                    (else
@@ -859,10 +845,7 @@ it does not handle <fix> and <let-values>, it should be 
called before
                         (loop (make-let src (append req (or opt '()))
                                         gensyms
                                         (append orig-args
-                                                (drop inits
-                                                      (max 0
-                                                           (- nargs
-                                                              (+ nreq nopt)))))
+                                                (drop inits (- nargs nreq)))
                                         body)
                           env
                           (cond
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 6299f14..4c5b6d6 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -949,6 +949,27 @@
     (const 42))
 
   (pass-if-peval
+    ;; Higher order with optional argument (side-effecting default
+    ;; value).
+    ((lambda* (f x #:optional (y (foo)))
+       (+ y (f (* (car x) (cadr x)))))
+     (lambda (x)
+       (+ x 1))
+     '(2 3))
+    (let (y) (_) ((apply (toplevel foo)))
+         (apply (primitive +) (lexical y _) (const 7))))
+
+  (pass-if-peval
+    ;; Higher order with optional argument (caller-supplied value).
+    ((lambda* (f x #:optional (y (foo)))
+       (+ y (f (* (car x) (cadr x)))))
+     (lambda (x)
+       (+ x 1))
+     '(2 3)
+     35)
+    (const 42))
+
+  (pass-if-peval
     ;; Higher order.
     ((lambda (f) (f x)) (lambda (x) x))
     (toplevel x))


hooks/post-receive
-- 
GNU Guile