* threads.scm (par-map, par-for-each, parallel):

* documentation.scm (object-documentation): Added support for
defmacros.

ice-9/ChangeLog

@@ -1,3 +1,10 @@
+2002-12-04  Mikael Djurfeldt  <mdj@linnaeus>
+
+	* threads.scm (par-map, par-for-each, parallel): 
+
+	* documentation.scm (object-documentation): Added support for
+	defmacros.
+
 2002-11-24  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
 	* boot-9.scm (re-export-syntax):  Re-introduced after accidentally

ice-9/documentation.scm

@@ -1,4 +1,4 @@
-;;;; 	Copyright (C) 2000,2001 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2000,2001, 2002 Free Software Foundation, Inc.
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -210,6 +210,8 @@ OBJECT can be a procedure, macro or any object that has its
 `documentation' property set."
   (or (and (procedure? object)
 	   (proc-doc object))
+      (and (defmacro? object)
+	   (proc-doc (defmacro-transformer object)))
       (and (macro? object)
 	   (let ((transformer (macro-transformer object)))
 	     (and transformer

ice-9/threads.scm

@@ -57,14 +57,63 @@
 ;;; Code:
 
 (define-module (ice-9 threads)
+  :export (par-map
+	   par-for-each
+	   %thread-handler)
   :export-syntax (make-thread
 		  begin-thread
+		  parallel
 		  with-mutex
-		  monitor)
+		  monitor))
-  :export (%thread-handler))
 
 
 
+(define (par-map proc . arglists)
+  (let* ((m (make-mutex))
+	 (c (make-condition-variable))
+	 (n (length (car arglists)))
+	 (counter (- n 1))
+	 (res (make-list n))
+	 (ls res))
+    (lock-mutex m)
+    (apply for-each
+	   (lambda args
+	     (let ((res ls))
+	       (set! ls (cdr ls))
+	       (call-with-new-thread
+		(lambda ()
+		  (set-car! res (apply proc args))
+		  ;; synchronize
+		  (lock-mutex m)
+		  (if (zero? counter)
+		      (signal-condition-variable c)
+		      (set! counter (- counter 1)))
+		  (unlock-mutex m))
+		%thread-handler)))
+	   arglists)
+    (wait-condition-variable c m)
+    res))
+
+(define (par-for-each proc . arglists)
+  (let* ((m (make-mutex))
+	 (c (make-condition-variable))
+	 (counter (- (length (car arglists)) 1)))
+    (lock-mutex m)
+    (apply for-each
+	   (lambda args
+	     (call-with-new-thread
+	      (lambda ()
+		(apply proc args)
+		;; synchronize
+		(lock-mutex m)
+		(if (zero? counter)
+		    (signal-condition-variable c)
+		    (set! counter (- counter 1)))
+		(unlock-mutex m))
+	      %thread-handler))
+	   arglists)
+    (wait-condition-variable c m)))
+
 (define (%thread-handler tag . args)
   (fluid-set! the-last-stack #f)
   (let ((n (length args))
@@ -103,6 +152,42 @@
 	,first ,@rest))
     %thread-handler))
 
+(defmacro parallel forms
+  (cond ((null? forms) '(begin))
+	((null? (cdr forms)) (car forms))
+	(else
+	 (let* ((m (make-symbol "m"))
+		(c (make-symbol "c"))
+		(counter (make-symbol "counter"))
+		(sync (make-symbol "sync"))
+		(n-forms (length forms))
+		(vars (map (lambda (i)
+			     (make-symbol (string-append "res"
+							 (number->string i))))
+			   (iota n-forms))))
+	   `(let* ((,m (make-mutex))
+		   (,c (make-condition-variable))
+		   (,counter ,(- n-forms 1))
+		   (,sync (lambda ()
+			    (lock-mutex ,m)
+			    (if (zero? ,counter)
+				(signal-condition-variable ,c)
+				(set! ,counter (- ,counter 1)))
+			    (unlock-mutex ,m)))
+		   ,@(map (lambda (var)
+			    `(,var #f))
+			  vars))
+	      (lock-mutex ,m)       
+	      ,@(map (lambda (var form)
+		       `(call-with-new-thread (lambda ()
+						(set! ,var ,form)
+						(,sync))
+					      %thread-handler))
+		     vars
+		     forms)
+	      (wait-condition-variable ,c ,m)
+	      (values ,@vars))))))
+
 (defmacro with-mutex (m . body)
   `(dynamic-wind
        (lambda () (lock-mutex ,m))