~ chicken-core (chicken-5) 9079b9b7ab57f296c9e3bf9f9cd42b1bad1a6baf


commit 9079b9b7ab57f296c9e3bf9f9cd42b1bad1a6baf
Author:     Moritz Heidkamp <moritz@twoticketsplease.de>
AuthorDate: Mon Nov 5 16:14:36 2012 +0100
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Mon Nov 5 19:50:48 2012 +0100

    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.
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/library.scm b/library.scm
index 438004a1..1711b84a 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) )
Trap