[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-88-g30c3dac

[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=30c3dac7a671cfdfadf8452c4ff9117fc0a5b8c0

The branch, stable-2.0 has been updated
       via  30c3dac7a671cfdfadf8452c4ff9117fc0a5b8c0 (commit)
      from  5ad85ba15f901163190b365ddd744db22bbbfc42 (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 30c3dac7a671cfdfadf8452c4ff9117fc0a5b8c0
Author: Andy Wingo <address@hidden>
Date:   Thu Feb 14 17:33:40 2013 +0100

    peval can inline let-bound lambdas
    
    * module/language/tree-il/peval.scm (peval): Better inlining of
      complicated operators.
    
    * test-suite/tests/peval.test ("partial evaluation"): Add a couple
      tests.

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

Summary of changes:
 module/language/tree-il/peval.scm |   27 ++++++++++++++++++++++++++-
 test-suite/tests/peval.test       |   14 +++++++++++++-
 2 files changed, 39 insertions(+), 2 deletions(-)

diff --git a/module/language/tree-il/peval.scm 
b/module/language/tree-il/peval.scm
index a1281fd..9a409d6 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1117,7 +1117,7 @@ top-level bindings from ENV and return the resulting 
expression."
             (make-application src apply (cons (for-value proc) args))))))
       (($ <application> src orig-proc orig-args)
        ;; todo: augment the global env with specialized functions
-       (let ((proc (visit orig-proc 'operator)))
+       (let revisit-proc ((proc (visit orig-proc 'operator)))
          (match proc
            (($ <primitive-ref> _ (? constructor-primitive? name))
             (cond
@@ -1305,6 +1305,31 @@ top-level bindings from ENV and return the resulting 
expression."
 
                   (log 'inline-end result exp)
                   result)))))
+           (($ <let> _ _ _ vals _)
+            ;; Attempt to inline `let' in the operator position.
+            ;;
+            ;; We have to re-visit the proc in value mode, since the
+            ;; `let' bindings might have been introduced or renamed,
+            ;; whereas the lambda (if any) in operator position has not
+            ;; been renamed.
+            (if (or (and-map constant-expression? vals)
+                    (and-map constant-expression? orig-args))
+                ;; The arguments and the let-bound values commute.
+                (match (for-value orig-proc)
+                  (($ <let> lsrc names syms vals body)
+                   (log 'inline-let orig-proc)
+                   (for-tail
+                    (make-let lsrc names syms vals
+                              (make-application src body orig-args))))
+                  ;; It's possible for a `let' to go away after the
+                  ;; visit due to the fact that visiting a procedure in
+                  ;; value context will prune unused bindings, whereas
+                  ;; visiting in operator mode can't because it doesn't
+                  ;; traverse through lambdas.  In that case re-visit
+                  ;; the procedure.
+                  (proc (revisit-proc proc)))
+                (make-application src (for-call orig-proc)
+                                  (map for-value orig-args))))
            (_
             (make-application src (for-call orig-proc)
                               (map for-value orig-args))))))
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index 7fae423..aa36182 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 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2009, 2010, 2011, 2012, 2013 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
@@ -830,6 +830,18 @@
              (((x) #f #f #f () (_))
               (apply (toplevel top) (lexical x _)))))))
   
+  (pass-if-peval resolve-primitives
+    ;; The inliner sees through a `let'.
+    ((let ((a 10)) (lambda (b) (* b 2))) 30)
+    (const 60))
+
+  (pass-if-peval
+      ((lambda ()
+         (define (const x) (lambda (_) x))
+         (let ((v #f))
+           ((const #t) v))))
+    (const #t))
+
   (pass-if-peval
    ;; Constant folding: cons of #nil does not make list
    (cons 1 #nil)


hooks/post-receive
-- 
GNU Guile