[Guile-commits] GNU Guile branch, master, updated. v2.1.0-751-g82490a6

[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=82490a665cfcf1053c2e14712679f114fb9c4477

The branch, master has been updated
       via  82490a665cfcf1053c2e14712679f114fb9c4477 (commit)
      from  26c19d79d90d3b3bdb05db2aa592869db55a3fba (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 82490a665cfcf1053c2e14712679f114fb9c4477
Author: Andy Wingo <address@hidden>
Date:   Mon Feb 17 22:23:40 2014 +0100

    Don't peval-penalize let-bound lambdas only referenced once
    
    * module/language/tree-il/peval.scm (peval): When going to peval a call
      whose operator isn't just a lambda but is a let-bound lambda, as one
      bound via define-inlinable, don't create a new counter if the lambda
      is only referenced once in the source.  Avoids needless failure to
      inline once-referenced procedures.
    
    * test-suite/tests/peval.test ("partial evaluation"): Wheeeee

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

Summary of changes:
 module/language/tree-il/peval.scm |   13 +++++++++++--
 test-suite/tests/peval.test       |   29 +++++++++++------------------
 2 files changed, 22 insertions(+), 20 deletions(-)

diff --git a/module/language/tree-il/peval.scm 
b/module/language/tree-il/peval.scm
index 8a60d7b..15487b0 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1,6 +1,6 @@
 ;;; Tree-IL partial evaluator
 
-;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -1352,6 +1352,15 @@ top-level bindings from ENV and return the resulting 
expression."
                    (rest (if rest (list rest) '()))
                    (nopt (length opt))
                    (key (source-expression proc)))
+              (define (singly-referenced-lambda? orig-proc)
+                (match orig-proc
+                  (($ <lambda>) #t)
+                  (($ <lexical-ref> _ _ sym)
+                   (and (not (assigned-lexical? sym))
+                        (= (lexical-refcount sym) 1)
+                        (singly-referenced-lambda?
+                         (operand-source (lookup sym)))))
+                  (_ #f)))
               (define (inlined-call)
                 (let ((req-vals (list-head orig-args nreq))
                       (opt-vals (let lp ((args (drop orig-args nreq))
@@ -1396,7 +1405,7 @@ top-level bindings from ENV and return the resulting 
expression."
                 ;; An error, or effecting arguments.
                 (make-call src (for-call orig-proc) (map for-value orig-args)))
                ((or (and=> (find-counter key counter) counter-recursive?)
-                    (lambda? orig-proc))
+                    (singly-referenced-lambda? orig-proc))
                 ;; A recursive call, or a lambda in the operator
                 ;; position of the source expression.  Process again in
                 ;; tail context.
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index 4d8a280..2c1c609 100644
--- a/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@ -1,7 +1,7 @@
 ;;;; tree-il.test --- test suite for compiling tree-il   -*- scheme -*-
 ;;;; Andy Wingo <address@hidden> --- May 2009
 ;;;;
-;;;;   Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, 
Inc.
+;;;;   Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Free Software 
Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -797,23 +797,16 @@
    ;; "b c a" is the current order that we get with unordered letrec,
    ;; but it's not important to this test, so if it changes, just adapt
    ;; the test.
-   (letrec (b c a) (_ _ _)
-     ((lambda _
-        (lambda-case
-         ((() #f #f #f () ())
-          (call (lexical a _)))))
-      (lambda _
-        (lambda-case
-         (((x) #f #f #f () (_))
-          (lexical x _))))
-      (lambda _
-        (lambda-case
-         ((() #f #f #f () ())
-          (call (lexical a _))))))
-     (let (d)
-       (_)
-       ((call (toplevel foo) (lexical b _)))
-       (call (lexical c _) (lexical d _)))))
+   (letrec (b a) (_ _)
+           ((lambda _
+              (lambda-case
+               ((() #f #f #f () ())
+                (call (lexical a _)))))
+            (lambda _
+              (lambda-case
+               ((() #f #f #f () ())
+                (call (lexical a _))))))
+     (call (toplevel foo) (lexical b _))))
 
   (pass-if-peval
    ;; In this case, we can prune the bindings.  `a' ends up being copied


hooks/post-receive
-- 
GNU Guile