summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>2002-12-04 22:06:15 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>2002-12-04 22:06:15 +0000
commitabce330cedfdcc4dc0199d471382e6059e43bd93 (patch)
treee5f131c17d82d0fdc10ec07347213e59cbc19c95
parent2ab05d78432ceb0ee262c738fef97baf2e7e9650 (diff)
downloadguile-abce330cedfdcc4dc0199d471382e6059e43bd93.tar.gz
* threads.scm (par-map, par-for-each, parallel):
* documentation.scm (object-documentation): Added support for defmacros.
-rw-r--r--ice-9/ChangeLog7
-rw-r--r--ice-9/documentation.scm4
-rw-r--r--ice-9/threads.scm89
3 files changed, 97 insertions, 3 deletions
diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 67edd9caf..8f88ae0e8 100644
--- 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 1a9e04c5c..11cbc677e 100644
--- 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 fbbb029c7..c552a8596 100644
--- 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))
+(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))