[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.2-124-g153ca
From: |
Andy Wingo |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.2-124-g153ca1d |
Date: |
Mon, 26 Sep 2011 22:22:45 +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=153ca1d2391115f1428837b9465bce89c76691de
The branch, stable-2.0 has been updated
via 153ca1d2391115f1428837b9465bce89c76691de (commit)
from 05c9389e3f869f3158d97289f50a52dc2b3caa26 (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 153ca1d2391115f1428837b9465bce89c76691de
Author: Andy Wingo <address@hidden>
Date: Tue Sep 27 00:21:16 2011 +0200
peval: more strict accounting
* module/language/tree-il/optimize.scm (transfer!, make-nested-counter):
(make-recursive-counter, peval): Limit the algorithm's time to be
strictly O(N) by transferring effort and size counters of recursive
inlining attempts from containing counters.
* test-suite/tests/tree-il.test ("partial evaluation"): Update
expectations for the ((lambda (x) (x x)) (lambda (x) (x x))) case, as
the new accounting policy will cause the entire inlining attempt to
abort.
-----------------------------------------------------------------------
Summary of changes:
module/language/tree-il/optimize.scm | 91 +++++++++++++++++++++++-----------
test-suite/tests/tree-il.test | 10 ++--
2 files changed, 67 insertions(+), 34 deletions(-)
diff --git a/module/language/tree-il/optimize.scm
b/module/language/tree-il/optimize.scm
index 8c5ae94..d097331 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -247,6 +247,19 @@ references to the new symbols."
counter
(find-counter data (counter-prev counter)))))
+(define* (transfer! from to #:optional
+ (effort (variable-ref (effort-counter from)))
+ (size (variable-ref (size-counter from))))
+ (define (transfer-counter! from-v to-v amount)
+ (let* ((from-balance (variable-ref from-v))
+ (to-balance (variable-ref to-v))
+ (amount (min amount from-balance)))
+ (variable-set! from-v (- from-balance amount))
+ (variable-set! to-v (+ to-balance amount))))
+
+ (transfer-counter! (effort-counter from) (effort-counter to) effort)
+ (transfer-counter! (size-counter from) (size-counter to) size))
+
(define (make-top-counter effort-limit size-limit continuation data)
(%make-counter (make-variable effort-limit)
(make-variable size-limit)
@@ -256,20 +269,24 @@ references to the new symbols."
#f))
(define (make-nested-counter continuation data current)
- (%make-counter (effort-counter current)
- (size-counter current)
- continuation
- #f
- data
- current))
+ (let ((c (%make-counter (make-variable 0)
+ (make-variable 0)
+ continuation
+ #f
+ data
+ current)))
+ (transfer! current c)
+ c))
(define (make-recursive-counter effort-limit size-limit orig current)
- (%make-counter (make-variable effort-limit)
- (make-variable size-limit)
- (counter-continuation orig)
- #t
- (counter-data orig)
- current))
+ (let ((c (%make-counter (make-variable 0)
+ (make-variable 0)
+ (counter-continuation orig)
+ #t
+ (counter-data orig)
+ current)))
+ (transfer! current c effort-limit size-limit)
+ c))
(define* (peval exp #:optional (cenv (current-module)) (env vlist-null)
#:key
@@ -837,29 +854,43 @@ it does not handle <fix> and <let-values>, it should be
called before
;; integration of a procedure that hasn't been seen
;; yet.
(let/ec k
- (let ((abort (lambda ()
- (k (make-application
- src
- (for-value orig-proc)
- (map for-value orig-args))))))
+ (define (abort)
+ (k (make-application src
+ (for-value orig-proc)
+ (map for-value orig-args))))
+ (define new-counter
+ (cond
+ ;; These first two cases will transfer effort
+ ;; from the current counter into the new
+ ;; counter.
+ ((find-counter key counter)
+ => (lambda (prev)
+ (make-recursive-counter recursive-effort-limit
+ operand-size-limit
+ prev counter)))
+ (counter
+ (make-nested-counter abort key counter))
+ ;; This case opens a new account, effectively
+ ;; printing money. It should only do so once
+ ;; for each call site in the source program.
+ (else
+ (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
- (cond
- ((find-counter key counter)
- => (lambda (prev)
- (make-recursive-counter recursive-effort-limit
- operand-size-limit
- prev counter)))
- (counter
- (make-nested-counter abort key counter))
- (else
- (make-top-counter effort-limit operand-size-limit
- abort key)))
- ctx)))))))
+ env new-counter ctx))
+
+ (if counter
+ ;; The nested inlining attempt succeeded.
+ ;; Deposit the unspent effort and size back
+ ;; into the current counter.
+ (transfer! new-counter counter))
+
+ result)))))
((or ($ <primitive-ref>)
($ <lambda>)
($ <toplevel-ref>)
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 4c5b6d6..290a483 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -793,12 +793,14 @@
(pass-if-peval
;; Infinite recursion
((lambda (x) (x x)) (lambda (x) (x x)))
- (let (x) (_)
- ((lambda _
+ (apply (lambda _
(lambda-case
(((x) _ _ _ _ _)
- (apply (lexical x _) (lexical x _))))))
- (apply (lexical x _) (lexical x _))))
+ (apply (lexical x _) (lexical x _)))))
+ (lambda _
+ (lambda-case
+ (((x) _ _ _ _ _)
+ (apply (lexical x _) (lexical x _)))))))
(pass-if-peval
;; First order, aliased primitive.
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.2-124-g153ca1d,
Andy Wingo <=