[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-89-g564f5e
From: |
Andy Wingo |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-89-g564f5e7 |
Date: |
Fri, 15 Feb 2013 10:21:48 +0000 |
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=564f5e70543f771e1e7c5aa57cee6f8b8d20c9ed
The branch, stable-2.0 has been updated
via 564f5e70543f771e1e7c5aa57cee6f8b8d20c9ed (commit)
from 30c3dac7a671cfdfadf8452c4ff9117fc0a5b8c0 (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 564f5e70543f771e1e7c5aa57cee6f8b8d20c9ed
Author: Andy Wingo <address@hidden>
Date: Fri Feb 15 11:19:10 2013 +0100
procedures with rest arguments can get inlined
* module/language/tree-il/peval.scm (peval): Allow inlining of
procedures with rest arguments.
* test-suite/tests/peval.test ("partial evaluation"): Add a test.
-----------------------------------------------------------------------
Summary of changes:
module/language/tree-il/peval.scm | 40 +++++++++++++++++++++++-------------
test-suite/tests/peval.test | 8 +++++++
2 files changed, 33 insertions(+), 15 deletions(-)
diff --git a/module/language/tree-il/peval.scm
b/module/language/tree-il/peval.scm
index 9a409d6..6773dff 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1221,15 +1221,35 @@ top-level bindings from ENV and return the resulting
expression."
(or (fold-constants src name args ctx)
(make-application src proc args))))
(($ <lambda> _ _
- ($ <lambda-case> _ req opt #f #f inits gensyms body #f))
- ;; Simple case: no rest, no keyword arguments.
+ ($ <lambda-case> _ req opt rest #f inits gensyms body #f))
+ ;; Simple case: no keyword arguments.
;; todo: handle the more complex cases
(let* ((nargs (length orig-args))
(nreq (length req))
(nopt (if opt (length opt) 0))
(key (source-expression proc)))
+ (define (inlined-application)
+ (make-let src
+ (append req
+ (or opt '())
+ (if rest (list rest) '()))
+ gensyms
+ (if (> nargs (+ nreq nopt))
+ (append (list-head orig-args (+ nreq nopt))
+ (list
+ (make-application
+ #f
+ (make-primitive-ref #f 'list)
+ (drop orig-args (+ nreq nopt)))))
+ (append orig-args
+ (drop inits (- nargs nreq))
+ (if rest
+ (list (make-const #f '()))
+ '())))
+ body))
+
(cond
- ((or (< nargs nreq) (> nargs (+ nreq nopt)))
+ ((or (< nargs nreq) (and (not rest) (> nargs (+ nreq nopt))))
;; An error, or effecting arguments.
(make-application src (for-call orig-proc)
(map for-value orig-args)))
@@ -1254,12 +1274,7 @@ top-level bindings from ENV and return the resulting
expression."
(lp (counter-prev counter)))))))
(log 'inline-recurse key)
- (loop (make-let src (append req (or opt '()))
- gensyms
- (append orig-args
- (drop inits (- nargs nreq)))
- body)
- env counter ctx))
+ (loop (inlined-application) env counter ctx))
(else
;; An integration at the top-level, the first
;; recursion of a recursive procedure, or a nested
@@ -1290,12 +1305,7 @@ top-level bindings from ENV and return the resulting
expression."
(make-top-counter effort-limit operand-size-limit
abort key))))
(define result
- (loop (make-let src (append req (or opt '()))
- gensyms
- (append orig-args
- (drop inits (- nargs nreq)))
- body)
- env new-counter ctx))
+ (loop (inlined-application) env new-counter ctx))
(if counter
;; The nested inlining attempt succeeded.
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index aa36182..fdae7b1 100644
--- a/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@ -843,6 +843,14 @@
(const #t))
(pass-if-peval
+ ;; Applications of procedures with rest arguments can get inlined.
+ ((lambda (x y . z)
+ (list x y z))
+ 1 2 3 4)
+ (let (z) (_) ((apply (primitive list) (const 3) (const 4)))
+ (apply (primitive list) (const 1) (const 2) (lexical z _))))
+
+ (pass-if-peval
;; Constant folding: cons of #nil does not make list
(cons 1 #nil)
(apply (primitive cons) (const 1) (const '#nil)))
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-89-g564f5e7,
Andy Wingo <=