(exception:string-contains-nul): New exception pattern.

[bpt/guile.git] / ice-9 / threads.scm

diff --git a/ice-9/threads.scm b/ice-9/threads.scm
index 1f360bf..cdabb24 100644 (file)
--- a/ice-9/threads.scm
+++ b/ice-9/threads.scm
@@ -1,4 +1,4 @@
-;;;;   Copyright (C) 1996, 1998, 2001, 2002, 2003 Free Software Foundation, Inc.
+;;;;   Copyright (C) 1996, 1998, 2001, 2002, 2003, 2006 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -12,7 +12,7 @@
 ;;;; 
 ;;;; You should have received a copy of the GNU Lesser General Public
 ;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 ;;;;
 ;;;; ----------------------------------------------------------------
 ;;;; threads.scm -- User-level interface to Guile's thread system
@@ -36,23 +36,22 @@
           par-for-each
           n-par-map
           n-par-for-each
-          n-for-each-par-map)
-  :re-export (future-ref)
+          n-for-each-par-map
+          %thread-handler)
   :export-syntax (begin-thread
                  parallel
                  letpar
                  make-thread
                  with-mutex
-                 monitor)
-  :re-export-syntax (future))
+                 monitor))
 
 \f
 
 (define ((par-mapper mapper)  proc . arglists)
-  (mapper future-ref
+  (mapper join-thread
          (apply map
                 (lambda args
-                  (future (apply proc args)))
+                  (begin-thread (apply proc args)))
                 arglists)))
 
 (define par-map (par-mapper map))
@@ -60,15 +59,15 @@
 
 (define (n-par-map n proc . arglists)
   (let* ((m (make-mutex))
-        (futures '())
+        (threads '())
         (results (make-list (length (car arglists))))
         (result results))
     (do ((i 0 (+ 1 i)))
        ((= i n)
-        (for-each future-ref futures)
+        (for-each join-thread threads)
         results)
-      (set! futures
-           (cons (future
+      (set! threads
+           (cons (begin-thread
                   (let loop ()
                     (lock-mutex m)
                     (if (null? result)
@@ -80,16 +79,16 @@
                           (unlock-mutex m)
                           (set-car! my-result (apply proc args))
                           (loop)))))
-                 futures)))))
+                 threads)))))
 
 (define (n-par-for-each n proc . arglists)
   (let ((m (make-mutex))
-       (futures '()))
+       (threads '()))
     (do ((i 0 (+ 1 i)))
        ((= i n)
-        (for-each future-ref futures))
-      (set! futures
-           (cons (future
+        (for-each join-thread threads))
+      (set! threads
+           (cons (begin-thread
                   (let loop ()
                     (lock-mutex m)
                     (if (null? (car arglists))
@@ -99,10 +98,10 @@
                           (unlock-mutex m)
                           (apply proc args)
                           (loop)))))
-                 futures)))))
+                 threads)))))
 
 ;;; The following procedure is motivated by the common and important
-;;; case where a lot of work should be done (not too much) in parallel
+;;; case where a lot of work should be done, (not too much) in parallel,
 ;;; but the results need to be handled serially (for example when
 ;;; writing them to a file).
 ;;;
@@ -110,15 +109,15 @@
   "Using N parallel processes, apply S-PROC in serial order on the results
 of applying P-PROC on ARGLISTS."
   (let* ((m (make-mutex))
-        (futures '())
+        (threads '())
         (no-result '(no-value))
         (results (make-list (length (car arglists)) no-result))
         (result results))
     (do ((i 0 (+ 1 i)))
        ((= i n)
-        (for-each future-ref futures))
-      (set! futures
-           (cons (future
+        (for-each join-thread threads))
+      (set! threads
+           (cons (begin-thread
                   (let loop ()
                     (lock-mutex m)
                     (cond ((null? results)
@@ -143,7 +142,7 @@ of applying P-PROC on ARGLISTS."
                              (unlock-mutex m)
                              (set-car! my-result (apply p-proc args))
                              (loop))))))
-                 futures)))))
+                 threads)))))
 
 (define (thread-handler tag . args)
   (fluid-set! the-last-stack #f)
@@ -169,7 +168,7 @@ of applying P-PROC on ARGLISTS."
     #f))
 
 ;;; Set system thread handler
-(set! %thread-handler thread-handler)
+(define %thread-handler thread-handler)
 
 ; --- MACROS -------------------------------------------------------
 
@@ -182,15 +181,15 @@ of applying P-PROC on ARGLISTS."
        %thread-handler)))
 
 (define-macro (parallel . forms)
-  (cond ((null? forms) '(begin))
+  (cond ((null? forms) '(values))
        ((null? (cdr forms)) (car forms))
        (else
         (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))))))
+              (values ,@(map (lambda (v) `(join-thread ,v)) vars)))
+            ,@(map (lambda (form) `(begin-thread ,form)) forms))))))
 
 (define-macro (letpar bindings . body)
   (cond ((or (null? bindings) (null? (cdr bindings)))
@@ -199,8 +198,8 @@ of applying P-PROC on ARGLISTS."
         (let ((vars (map car bindings)))
           `((lambda ,vars
               ((lambda ,vars ,@body)
-               ,@(map (lambda (v) `(future-ref ,v)) vars)))
-            ,@(map (lambda (b) `(future ,(cadr b))) bindings))))))
+               ,@(map (lambda (v) `(join-thread ,v)) vars)))
+            ,@(map (lambda (b) `(begin-thread ,(cadr b))) bindings))))))
 
 (define-macro (make-thread proc . args)
   `(call-with-new-thread