make a small optimization

2016-06-03 02:42:48 +09:00 · 2016-06-03 02:42:48 +09:00 · f1b6109b2f
parent 365ccc7a51
commit f1b6109b2f
1 changed files with 5 additions and 1 deletions
--- a/contrib/20.r7rs/scheme/lazy.scm
+++ b/contrib/20.r7rs/scheme/lazy.scm
@ -30,7 +30,11 @@
    (let ((v (promise-value p)))
      (case (promise-state p)
        ((cached)  v)
-        ((chained) (force v))
+        ((chained) (let ()
+                     (when (eq? 'cached (promise-state v))
+                       (set-promise-state! p 'cached)
+                       (set-promise-value! p (promise-value v)))
+                     (force v)))
        ((pending) (let ((q (v)))
                     (when (eq? 'pending (promise-state p))
                       (set-promise-state! p 'chained)