Dear Chickeneers,
the attached patch changes the implementation of promises to be slightly
more efficient when forcing a promise more than once (one procedure call
less). Also, instead of keeping the promise result in the promise
thunk's closure it is now kept in a slot of the promise structure. This
allows for removing the reference to the thunk once the promise has been
forced and thus saving some memory. I measured its effect by running the
following program with and without the patch:
(define seq
(let next ((n 0))
(cons n (delay (next (+ n 1))))))
(define (run)
(print
(time
(let loop ((seq seq))
(if (< (car seq) 1000000)
(loop (force (cdr seq)))
(car seq)))))
(print (memory-statistics)))
(run)
(run)
The results of which are:
without patch:
0.856s CPU time, 0.352s GC time (major), 500000 mutations, 9/1539 GCs
(major/minor)
500000
#(268435456 230448536 1048576)
0.034s CPU time, 0/213 GCs (major/minor)
500000
#(268435456 230448536 1048576)
with the patch:
0.506s CPU time, 0.233s GC time (major), 500000 mutations, 11/1500 GCs
(major/minor)
500000
#(134217728 107357264 1048576)
0.03s CPU time, 0/198 GCs (major/minor)
500000
#(134217728 107357264 1048576)
Hope it's of interested and not fatally flawed!
Moritz
>From b42464bccb2852121148c726eb49b90566d4519e Mon Sep 17 00:00:00 2001
From: Moritz Heidkamp <mor...@twoticketsplease.de>
Date: Mon, 5 Nov 2012 16:14:36 +0100
Subject: [PATCH] Make promises slightly more efficient and less memory
intensive
Instead of keeping the promise result in the promise thunk's closure
the implementation is changed to keep the result in a slot of the
promise structure. This allows for removing the reference to the thunk
once the promise has been forced and thus saving some memory.
---
library.scm | 28 ++++++++++------------------
1 file changed, 10 insertions(+), 18 deletions(-)
diff --git a/library.scm b/library.scm
index 438004a..1711b84 100644
--- a/library.scm
+++ b/library.scm
@@ -341,8 +341,15 @@ EOF
(define (##sys#force promise)
(if (##sys#structure? promise 'promise)
- ((##sys#slot promise 1))
- promise) )
+ (apply ##sys#values
+ (or (##sys#slot promise 2)
+ (let ((results (##sys#call-with-values (##sys#slot promise 1) (lambda xs xs))))
+ (or (##sys#slot promise 2)
+ (begin
+ (##sys#setslot promise 1 #f)
+ (##sys#setslot promise 2 results)
+ results)))))
+ promise))
(define force ##sys#force)
@@ -4708,22 +4715,7 @@ EOF
;;; Promises:
(define (##sys#make-promise proc)
- (let ([result-ready #f]
- [results #f] )
- (##sys#make-structure
- 'promise
- (lambda ()
- (if result-ready
- (apply ##sys#values results)
- (##sys#call-with-values
- proc
- (lambda xs
- (if result-ready
- (apply ##sys#values results)
- (begin
- (set! result-ready #t)
- (set! results xs)
- (apply ##sys#values results) ) ) ) ) ) ) ) ) )
+ (##sys#make-structure 'promise proc #f))
(define (promise? x)
(##sys#structure? x 'promise) )
--
1.7.12
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
