diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2002-12-04 22:06:15 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2002-12-04 22:06:15 +0000 |
commit | abce330cedfdcc4dc0199d471382e6059e43bd93 (patch) | |
tree | e5f131c17d82d0fdc10ec07347213e59cbc19c95 | |
parent | 2ab05d78432ceb0ee262c738fef97baf2e7e9650 (diff) | |
download | guile-abce330cedfdcc4dc0199d471382e6059e43bd93.tar.gz |
* threads.scm (par-map, par-for-each, parallel):
* documentation.scm (object-documentation): Added support for
defmacros.
-rw-r--r-- | ice-9/ChangeLog | 7 | ||||
-rw-r--r-- | ice-9/documentation.scm | 4 | ||||
-rw-r--r-- | ice-9/threads.scm | 89 |
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)) |