* threads.scm (parallel, letpar): Rewritten.

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index f25b13a..481d2a5 100644 (file)
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,3 +1,7 @@
+2003-01-24  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
+
+       * threads.scm (parallel, letpar): Rewritten.
+
 2003-01-23  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
        * threads.scm (par-mapper, n-par-map, n-par-for-each): Use

diff --git a/ice-9/threads.scm b/ice-9/threads.scm
index f36aaea..32c5a15 100644 (file)
--- a/ice-9/threads.scm
+++ b/ice-9/threads.scm
@@ -165,16 +165,22 @@
   (cond ((null? forms) '(begin))
        ((null? (cdr forms)) (car forms))
        (else
-        `(apply values
-                (map future-ref
-                     (list ,@(map (lambda (form) `(future ,form)) forms)))))))
+        (let ((vars (map (lambda (f)
+                           (make-symbol "f"))
+                         forms)))
+          `((lambda ,vars
+              (values ,@(map (lambda (v) `(future-ref ,v)) vars)))
+            ,@(map (lambda (form) `(future ,form)) forms))))))
 
 (define-macro (letpar bindings . body)
-  `(call-with-values
-       (lambda ()
-        (parallel ,@(map cadr bindings)))
-     (lambda ,(map car bindings)
-       ,@body)))
+  (cond ((or (null? bindings) (null? (cdr bindings)))
+        `(let ,bindings ,@body))
+       (else
+        (let ((vars (map car bindings)))
+          `((lambda ,vars
+              ((lambda ,vars ,@body)
+               ,@(map (lambda (v) `(future-ref ,v)) vars)))
+            ,@(map (lambda (b) `(future ,(cadr b))) bindings))))))
 
 (define-macro (make-thread proc . args)
   `(call-with-new-thread