summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-12-03 00:35:15 +0100
committerLudovic Courtès <ludo@gnu.org>2010-12-03 00:38:29 +0100
commit0d4e6ca38f1c51f5f92effc7d97c8b69eb85d071 (patch)
tree875670574fd0eae6104463b4ffb2af31ad9fa502
parentfe613fe25d55ac293fbce510a3ac6057b270fa31 (diff)
downloadguile-0d4e6ca38f1c51f5f92effc7d97c8b69eb85d071.tar.gz
Add `(ice-9 futures)'.
* doc/ref/api-scheduling.texi (Threads): Add short introduction. Mention the `threads' feature. Add cross-reference to futures. (Futures): New node. * module/Makefile.am (ICE_9_SOURCES): Add `ice-9/futures.scm'. * module/ice-9/futures.scm: New file. * test-suite/Makefile.am (SCM_TESTS): Add `tests/future.test'. * test-suite/tests/future.test: New file.
-rw-r--r--doc/ref/api-scheduling.texi99
-rw-r--r--module/Makefile.am1
-rw-r--r--module/ice-9/futures.scm177
-rw-r--r--test-suite/Makefile.am1
-rw-r--r--test-suite/tests/future.test83
5 files changed, 360 insertions, 1 deletions
diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi
index ce6e9521f..28e90e3d1 100644
--- a/doc/ref/api-scheduling.texi
+++ b/doc/ref/api-scheduling.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
-@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009
+@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009, 2010
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -15,6 +15,7 @@
* Blocking:: How to block properly in guile mode.
* Critical Sections:: Avoiding concurrency and reentries.
* Fluids and Dynamic States:: Thread-local variables, etc.
+* Futures:: Fine-grain parallelism.
* Parallel Forms:: Parallel execution of forms.
@end menu
@@ -195,6 +196,16 @@ Execute all thunks from the marked asyncs of the list @var{list_of_a}.
@cindex Guile threads
@cindex POSIX threads
+Guile supports POSIX threads, unless it was configured with
+@code{--without-threads} or the host lacks POSIX thread support. When
+thread support is available, the @code{threads} feature is provided
+(@pxref{Feature Manipulation, @code{provided?}}).
+
+The procedures below manipulate Guile threads, which are wrappers around
+the system's POSIX threads. For application-level parallelism, using
+higher-level constructs, such as futures, is recommended
+(@pxref{Futures}).
+
@deffn {Scheme Procedure} all-threads
@deffnx {C Function} scm_all_threads ()
Return a list of all threads.
@@ -791,6 +802,92 @@ Like @code{scm_with_dynamic_state}, but call @var{func} with
@var{data}.
@end deftypefn
+@node Futures
+@subsection Futures
+@cindex futures
+@cindex fine-grain parallelism
+@cindex parallelism
+
+The @code{(ice-9 futures)} module provides @dfn{futures}, a construct
+for fine-grain parallelism. A future is a wrapper around an expression
+whose computation may occur in parallel with the code of the calling
+thread, and possibly in parallel with other futures. Like promises,
+futures are essentially proxies that can be queried to obtain the value
+of the enclosed expression:
+
+@lisp
+(touch (future (+ 2 3)))
+@result{} 5
+@end lisp
+
+However, unlike promises, the expression associated with a future may be
+evaluated on another CPU core, should one be available. This supports
+@dfn{fine-grain parallelism}, because even relatively small computations
+can be embedded in futures. Consider this sequential code:
+
+@lisp
+(define (find-prime lst1 lst2)
+ (or (find prime? lst1)
+ (find prime? lst2)))
+@end lisp
+
+The two arms of @code{or} are potentially computation-intensive. They
+are independent of one another, yet, they are evaluated sequentially
+when the first one returns @code{#f}. Using futures, one could rewrite
+it like this:
+
+@lisp
+(define (find-prime lst1 lst2)
+ (let ((f (future (find prime? lst2))))
+ (or (find prime? lst1)
+ (touch f))))
+@end lisp
+
+This preserves the semantics of @code{find-prime}. On a multi-core
+machine, though, the computation of @code{(find prime? lst2)} may be
+done in parallel with that of the other @code{find} call, which can
+reduce the execution time of @code{find-prime}.
+
+Guile's futures are implemented on top of POSIX threads
+(@pxref{Threads}). Internally, a fixed-size pool of threads is used to
+evaluate futures, such that offloading the evaluation of an expression
+to another thread doesn't incur thread creation costs. By default, the
+pool contains one thread per CPU core, minus one, to account for the
+main thread.
+
+@deffn {Scheme Syntax} future exp
+Return a future for expression @var{exp}. This is equivalent to:
+
+@lisp
+(make-future (lambda () exp))
+@end lisp
+@end deffn
+
+@deffn {Scheme Procedure} make-future thunk
+Return a future for @var{thunk}, a zero-argument procedure.
+
+This procedure returns immediately. Execution of @var{thunk} may begin
+in parallel with the calling thread's computations, if idle CPU cores
+are available, or it may start when @code{touch} is invoked on the
+returned future.
+
+If the execution of @var{thunk} throws an exception, that exception will
+be re-thrown when @code{touch} is invoked on the returned future.
+@end deffn
+
+@deffn {Scheme Procedure} future? obj
+Return @code{#t} if @var{obj} is a future.
+@end deffn
+
+@deffn {Scheme Procedure} touch f
+Return the result of the expression embedded in future @var{f}.
+
+If the result was already computed in parallel, @code{touch} returns
+instantaneously. Otherwise, it waits for the computation to complete,
+if it already started, or initiates it.
+@end deffn
+
+
@node Parallel Forms
@subsection Parallel forms
@cindex parallel forms
diff --git a/module/Makefile.am b/module/Makefile.am
index d2a44b8a9..e16cd557f 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -187,6 +187,7 @@ ICE_9_SOURCES = \
ice-9/documentation.scm \
ice-9/expect.scm \
ice-9/format.scm \
+ ice-9/futures.scm \
ice-9/getopt-long.scm \
ice-9/hcons.scm \
ice-9/i18n.scm \
diff --git a/module/ice-9/futures.scm b/module/ice-9/futures.scm
new file mode 100644
index 000000000..b2e4c0da5
--- /dev/null
+++ b/module/ice-9/futures.scm
@@ -0,0 +1,177 @@
+;;; -*- mode: scheme; coding: utf-8; -*-
+;;;
+;;; Copyright (C) 2010 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
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (ice-9 futures)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (ice-9 match)
+ #:export (future make-future future? touch))
+
+;;; Author: Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; Commentary:
+;;;
+;;; This module provides an implementation of futures, a mechanism for
+;;; fine-grain parallelism. Futures were first described by Henry Baker
+;;; in ``The Incremental Garbage Collection of Processes'', 1977, and
+;;; then implemented in MultiLisp (an implicit variant thereof, i.e.,
+;;; without `touch'.)
+;;;
+;;; This modules uses a fixed thread pool, normally one per CPU core.
+;;; Futures are off-loaded to these threads, when they are idle.
+;;;
+;;; Code:
+
+
+;;;
+;;; Futures.
+;;;
+
+(define-record-type <future>
+ (%make-future thunk done? mutex)
+ future?
+ (thunk future-thunk)
+ (done? future-done? set-future-done?!)
+ (result future-result set-future-result!)
+ (mutex future-mutex))
+
+(define (make-future thunk)
+ "Return a new future for THUNK. Execution may start at any point
+concurrently, or it can start at the time when the returned future is
+touched."
+ (let ((future (%make-future thunk #f (make-mutex))))
+ (register-future! future)
+ future))
+
+
+;;;
+;;; Future queues.
+;;;
+
+(define %futures '())
+(define %futures-mutex (make-mutex))
+(define %futures-available (make-condition-variable))
+
+(define (register-future! future)
+ ;; Register FUTURE as being processable.
+ (lock-mutex %futures-mutex)
+ (set! %futures (cons future %futures)) ;; FIXME: use a FIFO
+ (signal-condition-variable %futures-available)
+ (unlock-mutex %futures-mutex))
+
+(define (unregister-future! future)
+ ;; Assume %FUTURES-MUTEX is taken.
+ (set! %futures (delq future %futures)))
+
+(define (process-future! future)
+ ;; Process FUTURE, assuming its mutex is already taken.
+ (set-future-result! future
+ (catch #t
+ (lambda ()
+ (let ((result ((future-thunk future))))
+ (lambda ()
+ result)))
+ (lambda args
+ (lambda ()
+ (apply throw args)))))
+ (set-future-done?! future #t))
+
+(define (process-futures)
+ ;; Wait for futures to be available and process them.
+ (lock-mutex %futures-mutex)
+ (let loop ()
+ (wait-condition-variable %futures-available
+ %futures-mutex)
+ (match %futures
+ (() (loop))
+ ((future _ ...)
+ (lock-mutex (future-mutex future))
+ (or (future-done? future)
+ (begin
+ ;; Do the actual work.
+ (unregister-future! future)
+
+ ;; We want to release %FUTURES-MUTEX so that other workers
+ ;; can progress. However, to avoid deadlocks, we have to
+ ;; unlock FUTURE as well, to preserve lock ordering.
+ (unlock-mutex (future-mutex future))
+ (unlock-mutex %futures-mutex)
+
+ (lock-mutex (future-mutex future))
+ (or (future-done? future) ; lost the race?
+ (process-future! future))
+
+ (lock-mutex %futures-mutex)))
+ (unlock-mutex (future-mutex future))
+ (loop)))))
+
+(define (touch future)
+ "Return the result of FUTURE, computing it if not already done."
+ (lock-mutex (future-mutex future))
+ (or (future-done? future)
+ (begin
+ ;; Do the actual work. Unlock FUTURE first to preserve lock
+ ;; ordering.
+ (unlock-mutex (future-mutex future))
+
+ (lock-mutex %futures-mutex)
+ (unregister-future! future)
+ (unlock-mutex %futures-mutex)
+
+ (lock-mutex (future-mutex future))
+ (or (future-done? future) ; lost the race?
+ (process-future! future))))
+ (unlock-mutex (future-mutex future))
+ ((future-result future)))
+
+
+;;;
+;;; Workers.
+;;;
+
+(define %worker-count
+ (if (provided? 'threads)
+ (if (defined? 'getaffinity)
+ (- (bit-count #t (getaffinity (getpid))) 1)
+ 3) ;; FIXME: use Gnulib's `nproc' here.
+ 0))
+
+(define %workers
+ ;; A dock of workers that stay here forever.
+
+ ;; TODO
+ ;; 1. Allocate lazily.
+ ;; 2. Allow the pool to be shrunk, as in libgomp (though that we'd
+ ;; need semaphores, which aren't yet in libguile!).
+ ;; 3. Provide a `worker-count' fluid.
+ (unfold (lambda (i) (>= i %worker-count))
+ (lambda (i)
+ (call-with-new-thread process-futures))
+ 1+
+ 0))
+
+
+;;;
+;;; Syntax.
+;;;
+
+(define-syntax future
+ (syntax-rules ()
+ "Return a new future for BODY."
+ ((_ body)
+ (make-future (lambda () body)))))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 7ca4c54ea..2e43e877b 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -50,6 +50,7 @@ SCM_TESTS = tests/00-initial-env.test \
tests/format.test \
tests/fractions.test \
tests/ftw.test \
+ tests/future.test \
tests/gc.test \
tests/getopt-long.test \
tests/goops.test \
diff --git a/test-suite/tests/future.test b/test-suite/tests/future.test
new file mode 100644
index 000000000..440376d7a
--- /dev/null
+++ b/test-suite/tests/future.test
@@ -0,0 +1,83 @@
+;;;; future.test --- Futures. -*- mode: scheme; coding: utf-8; -*-
+;;;;
+;;;; Ludovic Courtès <ludo@gnu.org>
+;;;;
+;;;; Copyright (C) 2010 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
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-future)
+ #:use-module (test-suite lib)
+ #:use-module (ice-9 futures)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26))
+
+(define specific-exception-key (gensym))
+
+(define specific-exception
+ (cons specific-exception-key ".*"))
+
+
+(with-test-prefix "futures"
+
+ (pass-if "make-future"
+ (future? (make-future (lambda () #f))))
+
+ (pass-if "future"
+ (future? (future #t)))
+
+ (pass-if "true"
+ (touch (future #t)))
+
+ (pass-if "(+ 2 3)"
+ (= 5 (touch (future (+ 2 3)))))
+
+ (pass-if "many"
+ (equal? (iota 1234)
+ (map touch
+ (map (lambda (i)
+ (make-future (lambda () i)))
+ (iota 1234)))))
+
+ (pass-if "touch several times"
+ (let* ((f+ (unfold (cut >= <> 123)
+ (lambda (i)
+ (make-future
+ (let ((x (1- i)))
+ (lambda ()
+ (set! x (1+ x))
+ i))))
+ 1+
+ 0))
+ (r1 (map touch f+))
+ (r2 (map touch f+))
+ (r3 (map touch f+)))
+ (equal? (iota 123) r1 r2 r3)))
+
+ (pass-if "nested"
+ (= (touch (future (+ 2 (touch (future -2))
+ (reduce + 0
+ (map touch
+ (map (lambda (i)
+ (future i))
+ (iota 123)))))))
+ (reduce + 0 (iota 123))))
+
+ (pass-if "no exception"
+ (future? (future (throw 'foo 'bar))))
+
+ (pass-if-exception "exception"
+ specific-exception
+ (touch (future (throw specific-exception-key 'test "thrown!")))))