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

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

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 67edd9c..8f88ae0 100644 (file)
--- a/ice-9/ChangeLog
+++ b/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

diff --git a/ice-9/documentation.scm b/ice-9/documentation.scm
index 1a9e04c..11cbc67 100644 (file)
--- a/ice-9/documentation.scm
+++ b/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

diff --git a/ice-9/threads.scm b/ice-9/threads.scm
index fbbb029..c552a85 100644 (file)
--- a/ice-9/threads.scm
+++ b/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)
-  :export (%thread-handler))
+                 monitor))
 
 \f
 
+(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))